C
C   AMIGA PLOT ROUTINE FOR MATLAB.  COPYRIGHT 1988,1989 BY JAMES LOCKER.
C   ALL RIGHTS RESERVED.  THIS PROGRAM FILE MAY NOT BE USED IN WHOLE OR IN 
C   PART FOR ANY COMMERCIAL APPLICATION WITHOUT THE PRIOR WRITTEN PERMISSION
C   OF THE AUTHOR, EXCEPT WHEN SUPPLIED IN COMPILED FORM AS PART OF MATLAB.
C   THIS FILE MAY BE FREELY REDISTRIBUTED SO LONG AS THIS NOTICE IS INTACT.  
C
C   MATLAB WRITTEN BY CLEVE MOLER OF UNIVERSITY OF NEW MEXICO.
C          PUBLIC DOMAIN VERSION ENHANCED BY JAMES LOCKER, SOFTECH INC.
C
C   DIGLIB WRITTEN BY HAL BRAND.
C          PORTED TO AMIGA BY DR. CRAIG WUEST OF LLNL
C          DEBUGGED AND ENHANCED BY JAMES LOCKER, SOFTECH INC.
C
C
      SUBROUTINE PLOT(LOC,M,N,INCTRL)
      INTEGER LOC,M,N,INCTRL,BGRP
      DIMENSION XXX(5005),YYY(5005)
C
C MATLAB SYSTEM VARIABLES
C
      DOUBLE PRECISION STKR(5005),STKI(5005)
      INTEGER IDSTK(4,48),LSTK(48),MSTK(48),NSTK(48),VSIZE,LSIZE,BOT,TOP
      INTEGER IDS(4,32),PSTK(32),RSTK(32),PSIZE,PT,PTZ
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
      INTEGER ALFA(52),ALFB(52),ALFL,CASE
      INTEGER EPS(4),FLOPS(4),EYE(4),RAND(4)
      INTEGER ALPHA(52),ALPHB(52)
      COMMON /VSTK/ STKR,STKI,IDSTK,LSTK,MSTK,NSTK,VSIZE,LSIZE,BOT,TOP
      COMMON /RECU/ IDS,PSTK,RSTK,PSIZE,PT,PTZ
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
      COMMON /ALFS/ ALFA,ALFB,ALFL,CASE

C
C PLOT SPECIFIC VARIABLES
C
      INTEGER*4 VAR(4)
      CHARACTER*4 ICURS(2)
      CHARACTER*1 IZ(5000)
      INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
      REAL*4 LABE3D
      CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
      DIMENSION XYLIM(2,6),CAMLOC(3)
      INTEGER*4 FGRPXY(10),ISYMNO(10)
      INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
      DIMENSION SYMSZ(10)
      LOGICAL ISECY,PLTST,SETBG,BNHERE
      CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
      CHARACTER*4 ROWTAG,COLTAG,TAG
      INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport

      INTEGER*4 WBST
      COMMON /SYS/ WBST
C
C THE GLOBAL PLOT COMMON
C
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C THE 3D PLOT ROUTINE COMMON
C
      COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
     1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
C
C THE XYPLOT ROUTINE COMMON
C
      COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
     1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
     2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
     3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
C
C BARPLT VARIABLES
C
      INTEGER NOBARS,COLIST(8),FGRPBP(8)
      REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
      DIMENSION FIMX(8)
      CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
      LOGICAL ISCYBP,STATBP
      INTEGER IMXC
      REAL*4  FBAR,YLOWBP,YHIBP
C
C THE BARPLOT COMMON
      COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
     1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
     2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
     3 SYOPBP
C
C THE CONTOUR PLOT VARIABLES
C
      CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
      DIMENSION CNLCP(20)
      REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
      REAL YMXCP
      INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
      COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
     1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
     2 ,ICNNCP,CNLCP,LBSZCP
C
C THE POLAR PLOT VARIABLES
C
      DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
      DIMENSION LNSLPP(10)
      INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
      CHARACTER*1 LABPP(80)
      INTEGER*2 MODEPP(8)
      REAL XSTPP,YSTPP,XFRCPP,YFRCPP
      REAL RMAX
      CHARACTER*4 TAGPP
      INTEGER NLINPP
      COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
     1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
     2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
C
C PLOT SAVE VARIABLES
C 
      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720),QUOT,BUFFF(4,32)
      CHARACTER*4 NAME(32)
      CHARACTER*1 NAME2(128)
      EQUIVALENCE (BUFFF,BUF),(NAME,NAME2)
C
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
C
C DIGLIB AND AMIGA SYSTEM VARIABLES, COMMONS, STRUCTURES
C
      EXTERNAL LEN
      INCLUDE GRAPH.INC
      INCLUDE EXEC.INC
      INCLUDE INTUIT.INC
      INCLUDE GCBIG.PRM
C

      DATA (ICURS(I),I=1,2)/'Plot','  >>'/,QUOT/1H'/

C
C ESTABLISH DEFAULTS
C
      COLOR1=Z'9B33336D'
      COLOR2=Z'9B30306D'
      COLOR3=Z'9B33326D'
      BGRP = 0
      SETBG = .FALSE.
      IF(PLTMAX .EQ. 0) THEN
       PLTCNT = 0
       DO 2 I=1,10
       DO 2 J=1,720
2      ISAV(I,J)=Z'20'
       DO 3 I=1,10
3      IPLTYP(I)=0
      ENDIF
C
C IF WE ARE INTERACTIVE, ISSUE STACK WARNING TO PREVENT CRASHES,
C UNLESS WE STARTED FROM WORKBENCH OR HAVE BEEN HERE BEFORE.
C
      IF(.NOT. PLTST .AND. (INCTRL .EQ. 0) .AND. (WBST .EQ. 0)
     1 .AND. .NOT. BNHERE) THEN
      WRITE(WTE,10)COLOR3,COLOR1,ICURS,COLOR2
      IF(WIO.NE.0) WRITE(WIO,10)COLOR3,COLOR1,ICURS,COLOR2
10    FORMAT(1X,"ENTERING PLOT."//,A4,"WARNING...HAS THE STACK SIZE
     1 BEEN SET TO AT LEAST 100K?"/,4A4,$)
      READ(WTE,11)ANS
11    FORMAT(A1)
      IF(WIO .NE. 0) WRITE(WIO,12)ANS
12    FORMAT(1X,A1)
      IF(ANS .NE. 'Y' .AND. ANS .NE. 'y') THEN
       WRITE(WTE,901)
       IF(WIO .NE. 0) WRITE(WIO,901)
       RETURN
      ENDIF
      ENDIF
      BNHERE = .TRUE.
C
C     START THE PLOTS
C
      ISRC=0
      DO 70 J=LOC,LOC+N*M-1
      XX = STKR(J)
      XXX(J-LOC+1) = SNGL(XX)
      XX = STKI(J)
      YYY(J-LOC+1) = SNGL(XX)
70    CONTINUE
C
C SET THE PLOT SCREEN TITLE
C
      w_title = "Matlab Plots"//CHAR(0)
C
C SELECT THE PLOT DEVICE
C
      IF (.NOT. PLTST) CALL DEVSEL(1,NDUM,IERR)
C
C FIND OUT IF THIS IS A BATCH JOB USING SAVED PLOT DEFINITIONS
C IF SO, EXTRACT THE SAVED FILE NAME AND SHIP IT TO LODFIL
C
      IF(INCTRL .EQ. 1)THEN
      DO 45 I=1,128
45    NAME2(I)=Z'20'
       ISRC = 2
       DO 22 IK=1,32
       IF(BUFFF(1,IK) .NE.QUOT)CYCLE
       GOTO 27
22     CONTINUE
27     CONTINUE
       DO 23 JK=IK+1,32
       IF(BUFFF(1,JK) .EQ. QUOT)GOTO 24
       NAME(JK-IK)=BUF(JK)
23     CONTINUE
24     CONTINUE
       GOTO 800
      ENDIF
C
75    CONTINUE
      ISRC = 0
      CALL CHKEND
      WRITE(WTE,80)
80    FORMAT(1X,//"PLEASE SELECT AN OPTION",/,
     1" [1]  3-D PLOT",/,
     2" [2]  X-Y PLOT",/,
     3" [3]  POLAR  PLOT",/,
     5" [4]  CONTOUR PLOT",/,
     6" [5]  HISTOGRAM",/,
     4" [6]  SET BACKGROUND COLOR",/,
     7" [7]  PLOT BUFFER CONTROL",/,
     8" [8]  READ PLOT FILE")
      WRITE(WTE,81)COLOR1,ICURS,COLOR2
81    FORMAT(1X,
     1"[9]  END THE CURRENT PLOT"/,
     1 " [10] EXIT TO MATLAB",/,
     2 4A4,$)
      IF(WIO .NE. 0) THEN
        WRITE(WIO,80)
        WRITE(WIO,81)
      ENDIF
      CALL VALGET(0,ICHOICE,'I')
      GOTO(100,200,300,500,600,400,700,800,899,900),ICHOICE
      CALL MENUER(10)
      GOTO 75
100   CALL D3PLOT(XXX,M,N,ISRC,IERR,IZ)
      GOTO 75
200   CALL XYPLT(XXX,M,N,ISRC,IERR)
      GOTO 75
300   CALL POLPLT(XXX,YYY,M,N,ISRC,IERR,IZ)
      GOTO 75
400   CONTINUE
      CALL CHBACK(ICURS)
      GOTO 75
500   CONTINUE
      CALL CONTUR(XXX,M,N,ISRC,IERR,IZ)
      GOTO 75
600   CONTINUE
      CALL BARPLT(XXX,M,N,ISRC,IERR)
      GOTO 75
700   CONTINUE
      IF(PLTCNT .EQ. 0) PLTCNT=PLTMAX
      CALL PLCTRL(XXX,YYY,M,N,IZ)
      GOTO 75
800   CONTINUE
      CALL LODFIL(XXX,YYY,M,N,NAME,ISRC,IERR,IZ)
      GOTO 75
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 75
900   WRITE(WTE,901)
901   FORMAT(1X,"EXITING PLOT FUNCTION")
      IF(WIO .NE. 0) WRITE(WIO,901)
      GOTO 999

C
C   FIND THE VARIABLE IN THE STACKS
C
107   CONTINUE
C      VARKEP = 0
C      DO 345 J = 1,48
C      DO 344 K = 1,4
C      IF (VAR(K) .NE. IDSTK(K,J))GOTO 346
C 344  CONTINUE
C      VARKEP = J
C 346  CONTINUE
C 345  CONTINUE
C      IF(VARKEP .EQ. 0) GOTO 90
C      M=MSTK(VARKEP)
C      N=NSTK(VARKEP)
C      L=LSTK(VARKEP)
C      WRITE(WTE,321)M,N,L
C321   FORMAT(1X,"FOUND THE VARIABLE.  IT IS A ",I3," BY ",I3
C     1," MATRIX LOCATED AT ",I4," IN STKR")
C      MN=M*N-1
C      DO 444 J=0,MN
C      WRITE(WTE,322)STKR(L+J)
C322   FORMAT(1X,"THE VALUES ARE: ",D10.3)
C444   CONTINUE
C      GOTO 91
C90    WRITE(WTE,654)
C654   FORMAT(1X,"FAILED TO FIND THE VARIABLE")
C91    CONTINUE
C

999   CONTINUE
      IF (.NOT. PLTST) CALL RLSDEV
      RETURN
      END
C
C THE 3D PLOTTING ROUTINE
C
      SUBROUTINE D3PLOT(XXX,M,N,INCTRL,IOCTRL,IZ)
      INTEGER M,N
      DIMENSION XXX(M,N)
      INTEGER INCTRL,IOCTRL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,FGRP3D,CHOICE,MARPLT
      CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE

C
C PLOT SPECIFIC VARIABLES
C

      DIMENSION XYLIM(2,6),CAMLOC(3)
      CHARACTER*1 IZ(5000)
      LOGICAL PLTST,SETBG,BNHERE
      CHARACTER*4 ICURS(2)
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST
     1,SETBG,BNHERE
      REAL LABE3D,LABSIZ
      COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
     1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
C
      DATA (ICURS(I),I=1,2)/'3DPl','ot>>'/
C
C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
C
      IF(INCTRL .NE. 0) GOTO 900
C
C SET UP THE DEFAULTS
C
      DO 25 I=1,80
      XLAB3D(I)=Z'20'
      YLAB3D(I)=Z'20'
25    ZLAB3D(I)=Z'20'
      LABE3D=0
      XST3D=0
      YST3D=0
      XFRC3D=1
      YFRC3D=1
      XYLIM(1,1)=0
      XYLIM(2,1)=M
      XYLIM(1,2)=0
      XYLIM(2,2)=N
      XYLIM(1,4)=0.0
      XYLIM(2,4)=0.0
      XYLIM(1,6)=XST3D
      XYLIM(2,6)=YST3D
      CAMLOC(1)=2000.
      CAMLOC(2)=45
      CAMLOC(3)=30
      FGRP3D=1
      IOCTRL=0
      MARPLT = 0
      XMAX = GSXLCM()
      YMAX = GSYLCM()
      XYLIM(1,5) = XMAX
      XYLIM(2,5) = YMAX * .9
      MN=M*N
C      write(WTE,657)((XXX(J,K),J=1,M ),K=1,N)
C657   FORMAT(1X,F10.2)

      CALL MINMAX(XXX,MN,ZMIN,ZMAX)
      XYLIM(1,3)=ZMIN
      XYLIM(2,3)=ZMAX
C
C DETERMINE THE CHOICES
C
C75    CONTINUE
       CALL CHKEND
C      WRITE(WTE,76)COLOR1,ICURS,COLOR2
C76    FORMAT(1X,"USE THE DEFAULT VALUES?",/4A4,$)
C      READ(RTE,80)ANS
C80    FORMAT(A1)
C      IF(ANS .EQ.'N' .OR. ANS .EQ. 'n') THEN
C      GOTO 100
C      ELSE IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
C      GOTO 900
C      ELSE
C      WRITE(WTE,87)COLOR3,COLOR2
C      IF(WIO .NE. 0)WRITE(WIO,87)COLOR3,COLOR2
C87    FORMAT(1X,A4,"ERROR. PLEASE ANSWER YES (Y) OR NO (N)",A4)
C      GOTO 75
C      ENDIF
100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
     1 " [1] CHOOSE PLOT LABELS"/,
     2 " [2] CHOOSE PLOT VALUES"/,
     3 " [3] CHOOSE VIEWER PERSPECTIVE"/,
     4 " [4] CHOOSE HIDDEN LINES OPTIONS"/,
     5 " [5] CHOOSE PLOT COLOR"/,
     6 " [6] CHOOSE PLOT SIZE"/,
     7 " [7] DO THE PLOT"/,
     8 " [8] END THE CURRENT PLOT"/,
     8 " [9] EXIT 3D PLOT"/,
     94A4,$)
      CALL VALGET(0,CHOICE,'I')
      GOTO(200,300,400,500,700,800,900,899,990),CHOICE
      CALL MENUER(9)
      GOTO 100
C
C  SELECT THE LABELS
C
200   CONTINUE
      CALL CHKEND
      WRITE(WTE,201)COLOR1,ICURS,COLOR2
201   FORMAT(1X,//"ENTER THE X AXIS LABEL"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,201)COLOR1,ICURS,COLOR2
      CALL GETLAB(XLAB3D)
      WRITE(WTE,202)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,202)COLOR1,ICURS,COLOR2
202   FORMAT(1X,//"ENTER THE Y AXIS LABEL"/,4A4,$)
      CALL GETLAB(YLAB3D)
      WRITE(WTE,203)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,203)COLOR1,ICURS,COLOR2
      CALL GETLAB(ZLAB3D)
203   FORMAT(1X,//"ENTER THE Z AXIS LABEL"/,4A4,$)
      WRITE(WTE,204)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,204)COLOR1,ICURS,COLOR2
204   FORMAT(1X,//"ENTER THE SIZE OF THE LABELS (CM)"/,A4
     1 ,4A4,$)
      CALL VALGET(LABSIZ,0,'F')
      IF(LABSIZ .NE. 0) LABE3D = LABSIZ
      GOTO 100
C
C SELECT THE DATA
C
300   CONTINUE
      CALL CHKEND
      WRITE(WTE,301)COLOR1,ICURS,COLOR2
301   FORMAT(1X,"ENTER THE MINIMUM VALUE OF X"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(1,1),0,'F')
      WRITE(WTE,302)COLOR1,ICURS,COLOR2
302   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF X"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,302)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(2,1),0,'F')
      WRITE(WTE,303)COLOR1,ICURS,COLOR2
303   FORMAT(1X,"ENTER THE MINIMUM VALUE OF Y"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,303)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(1,2),0,'F')
      WRITE(WTE,304)COLOR1,ICURS,COLOR2
304   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF Y"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,304)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(2,2),0,'F')
      WRITE(WTE,305)COLOR1,ICURS,COLOR2
305   FORMAT(1X,"ENTER THE X/Z LENGTH RATIO"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,305)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(1,4),0,'F')
      WRITE(WTE,306)COLOR1,ICURS,COLOR2
306   FORMAT(1X,"ENTER THE Y/Z LENGTH RATIO"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,306)COLOR1,ICURS,COLOR2
      CALL VALGET(XYLIM(2,4),0,'F')
      GOTO 100
C
C DEFINE THE VIEWER PERSPECTIVE
C
400   CONTINUE
      CALL CHKEND
      WRITE(WTE,430)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,430)COLOR1,ICURS,COLOR2
430   FORMAT(1X,"ENTER THE DISTANCE OF THE OBSERVER FROM THE"/,
     1 "CENTER OF THE PICTURE (SAME UNITS AS Z)"/,4A4,$)
      CALL VALGET(CAMLOC(1),0,'F')
      WRITE(WTE,431)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,431)COLOR1,ICURS,COLOR2
431   FORMAT(1X,"ENTER THE ANGLE BETWEEN THE VIEWER AND THE"/
     1 ," X-AXIS"/,4A4,$)
      CALL VALGET(CAMLOC(2),0,'F')
      WRITE(WTE,432)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,432)COLOR1,ICURS,COLOR2
432   FORMAT(1X,"ENTER THE ANGLE BETWEEN THE VIEWER AND THE"/
     1," X-Z PLANE"/,4A4,$)
      CALL VALGET(CAMLOC(3),0,'F')
      GOTO 100
C
C CHOOSE THE HIDDEN LINE DRAWING MODE
C
500   CONTINUE
      CALL CHKEND
507   WRITE(WTE,508)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,508)COLOR1,ICURS,COLOR2
508   FORMAT(1X,//"SELECT THE DRAWING MODE"/,
     1 " [1] DRAW ALL LINES, HIDDEN OR NOT"/,
     2 " [2] SUPPRESS HIDDEN LINES, BUT DRAW TOP AND BOTTOM"/,
     3 "     OF THE SURFACE"/,
     4 " [3] SUPPRESS HIDDEN LINES, AS WELL AS ALL LINES SHOWING THE"/,
     5 "     BOTTOM OF THE SURFACE"/,
     6 4A4,$)
      CALL VALGET(0,MARPLT,'I')
      GOTO (515,515,525)MARPLT
      CALL MENUER(3)
      GOTO 507
515   MARPLT = MARPLT - 1
525   CONTINUE

      GOTO 100
C
C SELECT THE PLOT COLOR
C
700   CONTINUE
      CALL CHKEND
      CALL SETFG(FGRP3D,ICURS)
      GOTO 100
C
C SELECT THE PLOT SIZE
C
800   CONTINUE
C
      CALL CHKEND
      CALL MAKSIZ(ICURS,XST3D,XFRC3D,YST3D,YFRC3D)
      XYLIM(1,6)=XST3D*XMAX
      XYLIM(2,6)=YST3D*YMAX
      XYLIM(1,5)=XFRC3D*XMAX
      XYLIM(2,5)=YFRC3D*YMAX
      GOTO 100
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 100
C
C DO THE PLOT
C
900   CONTINUE
      CALL CHKEND
C
C SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
C
      IF(INCTRL .EQ. 0) CALL SAVPLT(1)
      IF (.NOT. PLTST)THEN
       PLTST = .TRUE.
       CALL BGNPLT
      ENDIF
      IF(SETBG) THEN
       SETBG = .FALSE.
       CALL SETBAK(BGRP)
      ENDIF
      CALL GSCOLR(FGRP3D,IERR)
C       DO 940 I=1,6
C       WRITE(WTE,950)XYLIM(1,I),XYLIM(2,I)
C 950   FORMAT(1X,2F10.3)
C 940   CONTINUE
C       WRITE(WTE,960)(CAMLOC(I),I=1,3)
C 960   FORMAT(1X,"CAMLOC:",3F8.2)
C      WRITE(WTE,962)M,N,MARPLT
C962   FORMAT(3I4)
      CALL PURJOY(XXX,M,IZ,M,N,CAMLOC,XYLIM,XLAB3D,YLAB3D,
     *ZLAB3D,LABE3D,MARPLT)
      IF(INCTRL .NE. 0)RETURN
      GOTO 100
990   CONTINUE
      RETURN
      END
C
C  ROUTINE TO BRING IN AN ASCII STRING.  IF A BLANK LINE IS ENTERED,
C  THE INPUT STRING IS UNCHANGED.
C
      SUBROUTINE GETLAB(LAB1)
      CHARACTER*1 LAB1(80),LAB(80),RTN
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      DATA RTN/Z'0A'/

      DO 2 I=1,80
2     LAB(I)=Z'20'
      INDEX = 80
      READ(RTE,4)(LAB(I),I=1,80)
4     FORMAT(80A1)
C2     WRITE(WTE,13)(LAB(I),I=1,80)
C13    FORMAT(1X,80Z2)
      IF(WIO .NE. 0) WRITE(WIO,6)(LAB(I),I=1,80)
6     FORMAT(1X,80A1)
      LABTAG=0
      DO 23 I=1,80
      IF(LAB(I) .NE. ' ') THEN
       LABTAG=1
       GOTO 24
      ENDIF
23    CONTINUE
24    CONTINUE
      IF(LABTAG .NE. 0) THEN
       DO 7 I=1,80
7      LAB1(I)=LAB(I)
8      CONTINUE
       IF (LAB1(INDEX) .NE. ' ' .OR. INDEX .LE. 0) GOTO 9
          INDEX = INDEX - 1
       GOTO 8
9       LAB1(INDEX+1)=Z'00'
      ENDIF
C      WRITE(WTE,13)(LAB1(I),I=1,80)
      RETURN
      END
C
C ROUTINE TO BRING IN A NUMERIC VALUE IN FREE FORMAT
C X IS THE FLOATING POINT VERSION WHICH IS RETURNED
C INTEG IS THE INTEGER VERSION WHICH IS RETURNED
C IVAL IS A CONTROL CODE TELLING WHETHER OR NOT A FLOATING POINT VALUE
C  IS EXPECTED.
C
      SUBROUTINE VALGET(X,INTEG,IVAL)
      REAL X
      INTEGER INTEG
      CHARACTER*1,IVAL,A(80),NULL
      INTEGER INTX(80)
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      DATA NULL/Z'00'/
C
      DO 40 I=1,80
40    A(I)=Z'20'
C
C CHECK IF THE CURRENT PLOT IS DONE
C THIS IS MERELY THE MOST CONVENIENT PLACE TO DO IT
C
      CALL CHKEND
C
C GET THE TERMINAL INPUT STRING
C
      CALL GETLAB(A)
C
C TEST FOR A BLANK INPUT LINE
C IF SO, RETURN (DON'T CHANGE THE INPUT VALUE)
C
      DO 1 I = 1,80
      IF(A(I) .NE. ' ')GOTO 2
1     CONTINUE
      RETURN
2     CONTINUE
      INTEG = 0
      X = 0
C
C TEST FOR LEADING BLANKS AND LOOK FOR A NEGATIVE SIGN
C
C      WRITE(WTE,342)(A(I),I=1,80)
C342   FORMAT(1X,80Z2)
      ICOUNT = 1
      ISIGN = 1
3     CONTINUE
      IF(A(ICOUNT) .EQ. ' ' .AND. ICOUNT .LE. 80) THEN
       ICOUNT = ICOUNT + 1
C       WRITE(WTE,657)
C657    FORMAT(1X,'FOUND A LEADING BLANK')
       GOTO 3
      ENDIF
      IF(A(ICOUNT) .EQ. '-') THEN
       ISIGN = -1
       ICOUNT = ICOUNT + 1
C       WRITE(WTE,546)ICOUNT
C546    FORMAT(1X,'FOUND A NEGATIVE SIGN',I2)
      ENDIF
      ISTART=ICOUNT
C
C NOW RESOLVE THE INTEGER PORTION OF THE NUMBER.  STOP AT END OF STRING
C OR AT A DECIMAL POINT.
C
4     CONTINUE
      IF(A(ICOUNT) .NE. '.' .AND. A(ICOUNT) .NE. NULL .AND. ICOUNT
     1   .LE.80) THEN
       INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
       ICOUNT = ICOUNT+1
       GOTO 4
      ENDIF
      ICOUNT = ICOUNT-1
C      WRITE(WTE,7)ICOUNT
C7     FORMAT(1X,'ICOUNT=',I2)
      DO 5 J=ISTART,ICOUNT
5      INTEG = INTEG+INTX(J) * 10**(ICOUNT-J)
      INTEG=INTEG*ISIGN
C      WRITE(WTE,10)INTEG
C10    FORMAT(1X,I6)
C
C SEE IF THIS IS NUMBER HAS A FRACTIONAL PORTION.  IF SO,
C RESOLVE ITS VALUE AND RETURN IT AS PART OF THE FLOATING
C POINT NUMBER.
C
      ICOUNT = ICOUNT+1
      FRAC = 0.
      IF(IVAL .EQ. 'F' .AND. A(ICOUNT) .EQ. '.') THEN
       ICOUNT = ICOUNT+1
       IFCOUN = ICOUNT
20     CONTINUE
       IF(A(ICOUNT) .NE. NULL .AND. ICOUNT .LE. 80) THEN
        INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
        ICOUNT = ICOUNT+1
        GOTO 20
       ENDIF
       ICOUNT = ICOUNT - 1
       DO 25 J=IFCOUN,ICOUNT
        EX = FLOAT(IFCOUN-J-1)
        BAS = FLOAT(INTX(J))
25      FRAC = FRAC+ BAS * 10.** EX
      ENDIF
      FSIGN = ISIGN
      FRAC = FRAC*FSIGN
      X=FLOAT(INTEG)+FRAC

C      WRITE(WTE,30)X,FRAC
C30    FORMAT(1X,'X=',2F10.4)
      RETURN
      END

C
C ERROR ROUTINE FOR WRONG PLOT COLOR SELECTION
C
      SUBROUTINE PENERR
      INTEGER*4 COLOR1,COLOR2,COLOR3
      LOGICAL PLTST,SETBG,BNHERE
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      WRITE(WTE,5)COLOR3,COLOR2
5     FORMAT(1X,A4,"ERROR.  COLOR NUMBER MUST BE BETWEEN 0 AND 15",A4,/)
      IF(WIO .NE. 0)WRITE(WIO,5)COLOR3,COLOR2
      RETURN
      END
C
C  ROUTINE TO SET RASTPORT BACKGROUND COLOR
C
      SUBROUTINE SETBAK(BGRP)
      INTEGER*4 BGRP,amiga,Window,Screen,viewport,WIDTH,HEIGHT,ICOLOR
      EXTERNAL LEN
      INCLUDE WINDOW.INC
      INCLUDE GRAPH.INC
      INCLUDE EXEC.INC
      INCLUDE INTUIT.INC
C
C  DIGLIB WON'T LET US SET THE BACKGROUND IN THE AMIGA RASTPORT.  THEREFORE
C  WE MUST MAKE A DIRECT CALL TO AMIGA GRAPHICS ROUTINES HERE.  IF PORTED TO
C  ANOTHER MACHINE, THIS SEGMENT MUST BE DEFEATED.  I MIGHT FIX DIGLIB LATER.
C          J. LOCKER 11/29/88
C
C      write(WTE,967)BGRP
C967   format(1x,'here I am',i3)
       CALL amiga(SetRast,long(Window+wd_RPort),BGRP)
       RETURN
       END
C
C THE GENERAL X-Y PLOTTING ROUTINE
C
      SUBROUTINE XYPLT(XXX,M,N,INCTRL,IOCTRL)
      INTEGER M,N
      DIMENSION XXX(M,N)
      INTEGER INCTRL,IOCTRL
      DIMENSION X(10,500),Y(10,500),XPL(500),YPL(500)
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP,FGRPXY(10),ISYMNO(10)
      INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
      DIMENSION SYMSZ(10)
      LOGICAL ISECY
      CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
      CHARACTER*4 ROWTAG,COLTAG,TAG,ICURS(2)
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
      COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
     1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
     2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
     3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS

      DATA ROWTAG/' ROW'/,COLTAG/' COL'/,(ICURS(I),I=1,2)/'XYPl','ot>>'/
C
C FIND OUT WHO CALLED US
C
      IF(INCTRL .NE. 0) GOTO 800
C
C SET UP THE DEFAULTS
C
      ISECY = .FALSE.
      CHRSIZ = 0
      ISYOPT = 0
      IAXSPN = 1
      DO 1 I=1,80
      XLABXY(I)=' '
      YLABXY(I)=' '
      SYLBXY(I)=' '
      LABXY(I) =' '
1     CONTINUE
      XLABXY(2)=Z'00'
      YLABXY(2)=Z'00'
      SYLBXY(2)=Z'00'
      LABXY(2)=Z'00'
      IPLTP1 = 0
      IPLTP2 = 0
      IPLTP3 = 0
      NLINES = 0
      DO 2 I = 1,10
      LINSYL(I)=1
      SYMSZ(I)=.2
      INTSYM(I)=5
      ISYMNO(I)=0
2     FGRPXY(I)=I+1
      XLIM = GSXLCM()
      YLIM = GSYLCM()
      XSTXY = 0.
      YSTXY = 0.
      XFRCXY = 100.
      YFRCXY = 95
C
C CHOOSE THE PLOT MODE 
C
      CALL CHKEND
7     WRITE(WTE,3)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,3)COLOR1,ICURS,COLOR2
3     FORMAT(1X,"PLEASE CHOOSE THE X-Y PLOT MODE:"/,
     1" [1] IMPLICIT X, EXPLICIT Y"/,
     2" [2] EXPLICIT X, EXPLICIT Y"/,4A4,$)
      CALL VALGET(0,IDEFXY,'I')
      GOTO(4,4),IDEFXY
      CALL MENUER(2)
      GOTO 7
4     CONTINUE
C
C DO AN ERROR TEST
C
      IF((M .EQ. 1 .OR. N .EQ. 1) .AND. IDEFXY .EQ. 2) THEN
       WRITE(WTE,5)COLOR3,COLOR2
5      FORMAT(1X,A4,"ERROR.  ARRAY IS ONE DIMENSIONAL. INSUFFICIENT",/,
     1 1X,"INFORMATION TO DO AN EXPLICIT X EXPLICIT Y PLOT",A4)
       IF(WIO .NE. 0) WRITE(WIO,5)COLOR3,COLOR2
       RETURN
      ENDIF
C
C DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
C
      CALL PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAG,NLINES
     1,LINXYX,LINXYY,NPTS,IDEFXY)

C
C DETERMINE AXIS SCALING
C
      XMINXY =9999
      YMINXY =9999
      XMAXXY =-99999
      YMAXXY =-99999
      DO 150 J = 1,NLINES
      XMINH = 99999
      XMAXH = -99999
      YMINH = 99999
      YMAXH = -99999
      DO 130 K = 1,NPTS
      XMINH = AMIN1(XMINH,X(J,K))
      XMAXH = AMAX1(XMAXH,X(J,K))
      YMINH = AMIN1(YMINH,Y(J,K))
      YMAXH = AMAX1(YMAXH,Y(J,K))
130   CONTINUE
      XMINXY = AMIN1(XMINH,XMINXY)
      XMAXXY = AMAX1(XMAXH,XMAXXY)
      YMINXY = AMIN1(YMINH,YMINXY)
      YMAXXY = AMAX1(YMAXH,YMAXXY)
150   CONTINUE
      XLO=XMINXY
      XHI=XMAXXY
      YLO=YMINXY
      YHI=YMAXXY
      SYMNXY=YMINXY
      SYMXXY=YMAXXY
C
C SELECT PLOT OPTIONS:
C
160   WRITE(WTE,161)COLOR1,ICURS,COLOR2
      CALL CHKEND
161   FORMAT(1X,"PLEASE CHOOSE AN OPTION"/,
     1" [1]  SELECT THE TYPE OF PLOT AXES"/,
     2" [2]  SELECT THE X AND Y GRID MARKINGS"/,
     3" [3]  SELECT X AND Y AXIS TICK MARK OPTIONS"/,
     4" [4]  SELECT THE LINE OPTIONS"/
     4" [5]  SELECT THE PLOT COLORS"/,
     5" [6]  SELECT THE BACKGROUND COLOR"/,
     5" [7]  SELECT THE AXIS SCALES"/,
     5" [8]  CHOOSE THE PLOT SIZE"/,
     6" [9]  CHOOSE THE PLOT LABELS"/,
     4" [10]  DO THE PLOT"/,
     5" [11] END THE CURRENT PLOT"/,
     5" [12] EXIT XYPLOT"/,4A4,$)
      IF(WIO .NE. 0) WRITE(WIO,161)COLOR1,ICURS,COLOR2
      CALL VALGET(0,IANS,'I')
      GOTO (180,300,400,620,500,750,550,600,700,800,899,995),IANS
      CALL MENUER(12)
      GOTO 160
180   CONTINUE
      CALL SETAXS(ICURS,IPLTP1,ISYOPT,ISECY,SYMNXY,SYMMXY,XLO,YLO)
      GOTO 160
C
C SELECT THE GRID LINES OPTIONS
C
300   CONTINUE
      CALL CHKEND
      WRITE(WTE,310)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,310)COLOR1,ICURS,COLOR2
310   FORMAT(1X,"PLEASE CHOOSE A GRID LINE OPTION"/,
     1" [1] NO GRID LINES"/,
     2" [2] GRID LINES ON X AXIS ONLY"/,
     3" [3] GRID LINES ON Y AXIS ONLY"/,
     4" [4] GRID LINES ON BOTH AXES"/,4A4,$)
      CALL VALGET(0,IPLTP2,'I')
      GOTO (320,330,340,350),IPLTP2
      CALL MENUER(4)
      GOTO 300
320   IPLTP2 = 0
      GOTO 160
330   IPLTP2 = 4
      GOTO 160
340   IPLTP2 = 8
      GOTO 160
350   IPLTP2 = 12
      GOTO 160
C
C SELECT THE TICK MARK OPTIONS
C
400   CONTINUE
      IPLTP3=0
405   WRITE(WTE,410)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO.NE.0) WRITE(WIO,410)COLOR1,ICURS,COLOR2
410   FORMAT(1X,"PLEASE CHOOSE TICK MARK OPTIONS, ONE BY ONE."/,
     1"  NOTE THAT TICK MARK OPTIONS ARE CUMULATIVE."/,
     2" [1] CLEAR ALL TICK MARK OPTIONS"/,
     3" [2] ALLOW X AXIS TO END NOT ON A TICK MARK"/,
     4" [3] ALLOW Y AXIS TO END NOT ON A TICK MARK"/,
     5" [4] DO NOT PLOT X AXIS TICK MARKS"/,
     6" [5] DO NOT PLOT Y AXIS TICK MARKS"/,
     7" [6] EXTRA X-AXIS AND TICKS ON TOP OF PLOT"/,
     8" [7] EXTRA Y-AXIS AND TICKS TO RIGHT OF PLOT"/,
     9" [8] SELECT TICK MARK AND TICK CHARACTER SIZE"/,
     7" [9] RETURN TO XYPLOT MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (420,430,440,450,460,470,480,490,160),IANS
      CALL MENUER(9)
      GOTO 405
420   CONTINUE
      GOTO 400
430   CONTINUE
      IPLTP3=IPLTP3+16
      GOTO 405
440   IPLTP3=IPLTP3+32
      GOTO 405
450   IPLTP3=IPLTP3+512
      GOTO 405
460   IPLTP3=IPLTP3+1024
      GOTO 405
470   IPLTP3=IPLTP3+64
      GOTO 405
480   IPLTP3=IPLTP3+128
      GOTO 405
490   WRITE(WTE,492)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,492)COLOR1,ICURS,COLOR2
492   FORMAT(1X,"PLEASE CHOOSE A TICK MARK SIZING OPTION"/,
     1" [1] USE AUTO SIZING"/,
     2" [2] CHOOSE THE SIZE"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (494,496),IANS
      CALL MENUER(2)
      GOTO 490
494   CHRSIZ = 0
      GOTO 405
496   WRITE(WTE,497)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,497)COLOR1,ICURS,COLOR2
497   FORMAT(1X,"ENTER THE TICK MARK CHARACTER SIZE (CM)"/,4A4,$)
      CALL VALGET(CHRSIZ,0,'F')
      GOTO 405
C
C DEFINE THE PLOT COLORS
C
500   CONTINUE
      WRITE(WTE,510)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0)WRITE(WIO,510)COLOR1,ICURS,COLOR2
510   FORMAT(1X,"PLEASE CHOOSE A PLOT COLOR OPTION"/,
     1" [1] SELECT THE LINE COLORS"/,
     2" [2] SELECT THE AXIS COLORS"/,
     3" [3] RETURN TO XYPLOT MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (520,540,160),IANS
      CALL MENUER(3)
      GOTO 500
520   CONTINUE
      DO 536 I=1,NLINES
      WRITE(WTE,535)I
535   FORMAT(1X,"FOR LINE NUMBER ",I2)
      IF(WIO .NE. 0) WRITE(WIO,535)I
      CALL SETFG(FGRPXY(I),ICURS)
536   CONTINUE
      GOTO 500
540   WRITE(WTE,545)
      IF(WIO.NE.0) WRITE(WIO,545)
545   FORMAT(1X,"FOR THE X-Y AXES,")
      CALL SETFG(IAXSPN,ICURS)
      GOTO 500
C
C SET THE AXIS SCALING
C
550   CONTINUE
      WRITE(WTE,560)COLOR1,ICURS,COLOR2
      CALL CHKEND
560   FORMAT(1X,"PLEASE CHOOSE PLOT SCALE OPTIONS"/,
     1" [1] USE AUTO-SCALING"/,
     2" [2] SELECT X-AXIS SCALE"/,
     3" [3] SELECT Y-AXIS SCALE"/,
     4" [4] RETURN TO XYPLOT MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (565,570,580,160),IANS
      CALL MENUER(4)
565   XMINXY=XLO
      XMAXXY=XHI
      YMINXY=YLO
      YMAXXY=YHI
      GOTO 160
570   WRITE(WTE,572)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,572)COLOR1,ICURS,COLOR2
572   FORMAT(1X,"CHOOSE MINIMUM X-AXIS VALUE"/,4A4)
      CALL VALGET(XMINXY,0,'F')
      WRITE(WTE,573)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,573)COLOR1,ICURS,COLOR2
573   FORMAT(1X,"CHOOSE MAXIMUM X-AXIS VALUE"/,4A4)
      CALL VALGET(XMAXXY,0,'F')
      GOTO 550
580   WRITE(WTE,582)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,582)COLOR1,ICURS,COLOR2
582   FORMAT(1X,"CHOOSE MINIMUM Y-AXIS VALUE"/,4A4)
      CALL VALGET(YMINXY,0,'F')
      WRITE(WTE,583)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,583)COLOR1,ICURS,COLOR2
583   FORMAT(1X,"CHOOSE MAXIMUM Y-AXIS VALUE"/,4A4)
      CALL VALGET(YMAXXY,0,'F')
      GOTO 550
C
C CHOOSE THE PLOT SIZE
C
600   CONTINUE
C
      CALL CHKEND
      CALL MAKSIZ(ICURS,XSTXY,XFRCXY,YSTXY,YFRCXY)
      XSTXY=XSTXY*100.
      YSTXY=YSTXY*100.
      XFRCXY=XFRCXY*100.+XSTXY
      YFRCXY=YFRCXY*100.+YSTXY
      GOTO 160
C
C SET LINE OPTIONS
C
620   CONTINUE
      CALL CHKEND
      CALL LNOPTS(NLINES,SYMSZ,INTSYM,ISYMNO,LINSYL,ICURS)
      GOTO 160
C
C SET THE PLOT LABELS
C
700   CONTINUE
      WRITE(WTE,710)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0)WRITE(WIO,710)COLOR1,ICURS,COLOR2
710   FORMAT(1X,"ENTER THE X-AXIS LABEL"/,4A4,$)
      CALL GETLAB(XLABXY)
      WRITE(WTE,720)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,720)COLOR1,ICURS,COLOR2
720   FORMAT(1X,"ENTER THE Y-AXIS LABEL"/,4A4,$)
      CALL GETLAB(YLABXY)
      WRITE(WTE,730)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,730)COLOR1,ICURS,COLOR2
730   FORMAT(1X,"ENTER THE PLOT LABEL"/,4A4,$)
      CALL GETLAB(LABXY)
      IF(ISECY) THEN
       WRITE(WTE,740)COLOR1,ICURS,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,740)COLOR1,ICURS,COLOR2
740    FORMAT(1X,"ENTER THE SECOND Y-AXIS LABEL"/,4A4,$)
       CALL GETLAB(SYLBXY)
      ENDIF
      GOTO 160
C
C SET BACKGROUND COLOR
C
750    CONTINUE
       CALL CHKEND
       CALL CHBACK(ICURS)
       GOTO 160
C
C END THE PLOT
C
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 160
C
C BEGIN PLOTTING
C
800   CONTINUE
      CALL CHKEND
C
C SAVE THE SETTINGS UNLESS WE ARE PLOTTING FROM SAVED SETTINGS
C IF PLOTTING FROM SAVED SETTINGS, RESTORE THE VALUES TO BE
C PLOTTED.
C
      IF(INCTRL .EQ. 0) THEN
       CALL SAVPLT(2)
      ELSE
      DO 840 J=1,NLINES
      IF(TAG .EQ. ROWTAG) THEN
       DO 810 I = 1,N
       IF(IDEFXY .EQ. 2)THEN
       X(J,I)=XXX(LINXYX(J),I)
       ELSE
       X(J,I)=FLOAT(I)
       ENDIF
810   CONTINUE
      ELSE
       DO 820 I=1,M
        IF(IDEFXY .EQ. 2)THEN
        X(J,I)=XXX(I,LINXYX(J))
        ELSE
        X(J,I)=FLOAT(I)
        ENDIF
820   CONTINUE
      ENDIF
      IF(TAG .EQ. ROWTAG) THEN
       DO 830 I = 1,N
830    Y(J,I)=XXX(LINXYY(J),I)
      ELSE
       DO 832 I=1,M
832    Y(J,I)=XXX(I,LINXYY(J))
      ENDIF
840   CONTINUE
      ENDIF
C
C IF MODE 1, SCALE THE X-AXES
C
      IF(IDEFXY .EQ. 1) THEN
      DO 845 J=1,NLINES
       IF(TAG .EQ. ROWTAG) THEN
        DO 843 I=1,N
843     X(J,I)=X(J,I)*XMAXXY/FLOAT(N)
        ELSE
        DO 844 I=1,M
844     X(J,I)=X(J,I)*XMAXXY/FLOAT(M)
        ENDIF
845   CONTINUE
      ENDIF
      IF((XMINXY .LE. 0 .AND. (IPLTP1 .EQ. 1 .OR. IPLTP1 .EQ. 3))
     1 .OR. (YMINXY .LE. 0 .AND. (IPLTP1 .EQ. 2 .OR. IPLTP1 .EQ. 3)))
     2THEN
       WRITE(WTE,854)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,854)COLOR3,COLOR2
854    FORMAT(1X,A4,"ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT")
       GOTO 160
      ENDIF
      IF(ISECY .AND. SYMNXY .LE. 0 .AND. ISYOPT .EQ. 2) THEN
        WRITE(WTE,855)COLOR3,COLOR2
        IF(WIO .NE. 0)WRITE(WIO,855)COLOR3,COLOR2
855     FORMAT(1X,A4,"ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE
     1WITH LOG PLOT",A4)
        GOTO 160
       ENDIF

      IF (.NOT. PLTST)THEN
       PLTST = .TRUE.
       CALL BGNPLT
      ENDIF
      IF(SETBG) THEN
       SETBG = .FALSE.
       CALL SETBAK(BGRP)
      ENDIF
      CALL GSCOLR(IAXSPN,IERR)
C
C DEFINE PLOT SIZE
C
      IF(ISECY) THEN
       CALL MAPSZ2(XSTXY,XFRCXY,YSTXY,YFRCXY,CHRSIZ)
      ELSE
       CALL MAPSIZ(XSTXY,XFRCXY,YSTXY,YFRCXY,CHRSIZ)
      ENDIF
C
C GENERATE THE AXES
C
      IOPTNS=IPLTP1+IPLTP2+IPLTP3
      CALL GSLTYP(1)
      CALL MAPIT(XMINXY,XMAXXY,YMINXY,YMAXXY,XLABXY,YLABXY,LABXY,IOPTNS)

C
C DO THE LINES ON THE PLOT
C
      DO 900 INDEX = 1,NLINES
      DO 882 I=1,NPTS
       XPL(I)=X(INDEX,I)
882    YPL(I)=Y(INDEX,I)
      CALL GSCOLR(FGRPXY(INDEX),IERR)
      CALL GSLTYP(LINSYL(INDEX))
      CALL CURVE(XPL,YPL,NPTS,ISYMNO(INDEX),SYMSZ(INDEX),INTSYM(INDEX))
900   CONTINUE
C
C DO THE SECOND Y AXIS
C
      IF(ISECY) THEN
       CALL GSCOLR(IAXSPN,IERR)
       CALL GSLTYP(1)
       CALL SYAXIS(SYMNXY,SYMXXY,SYLBXY,ISYOPT)
      ENDIF
      IF(INCTRL .NE. 0) RETURN
      GOTO 160
995   CONTINUE
      RETURN
      END
C
C  ROUTINE TO SET THE FOREGROUND PEN COLOR
C
      SUBROUTINE SETFG(ICOL,ICURS)
      INTEGER*4 ICOL
      CHARACTER*4 ICURS(2)
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C BEGIN
C
105   WRITE(WTE,106)COLOR1,ICURS,COLOR2
106   FORMAT(1X,"ENTER THE PLOT PEN NUMBER"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,106)COLOR1,ICURS(1),ICURS(2),COLOR2
      CALL VALGET(0,ICOL,'I')
      IF(WIO .NE. 0)WRITE(WIO,108)ICOL
108   FORMAT(1X,I2)
      IF(ICOL .LT. 0 .OR. ICOL .GT. 15) THEN
       CALL PENERR
       GOTO 105
      ENDIF
      RETURN
      END
C
C  ROUTINE TO HANDLE MENU ERROR MESSAGES
C
      SUBROUTINE MENUER(I)
      INTEGER*4 I
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,ICOL
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
      WRITE(WTE,10)COLOR3,I,COLOR2
10    FORMAT(1X,A4,"ERROR.  PLEASE ENTER A VALUE BETWEEN 1 AND ",I2,A4)
      IF(WIO .NE. 0) WRITE(WIO,10)COLOR3,I,COLOR2
      RETURN
      END
C
C ROUTINE TO CHOOSE BACKGROUND COLOR
C
      SUBROUTINE CHBACK(ICURS)
      CHARACTER*4 ICURS(2)
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      LOGICAL PLTST,SETBG,BNHERE
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
      SETBG = .TRUE.
400   CONTINUE
      WRITE(WTE,401)COLOR1,ICURS,COLOR2
401   FORMAT(1X,"ENTER THE BACKGROUND COLOR NUMBER"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,401)COLOR1,ICURS,COLOR2
      CALL VALGET(0,BGRP,'I')
      IF(BGRP .LT.0 .OR. BGRP .GT. 15) THEN
       CALL PENERR
       GOTO 400
      ENDIF
      RETURN
      END
C
C ROUTINE TO DO HISTOGRAMS AND BAR PLOTS
C
      SUBROUTINE BARPLT(XXX,M,N,INCTRL,IERR)
      INTEGER M,N
      DIMENSION XXX(M,N)
      INTEGER INCTRL,IOCTRL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      CHARACTER*1 ANS
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
      INTEGER NOBARS,COLIST(8),FGRPBP(8)
      REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
      DIMENSION FIMX(8)
      CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
      LOGICAL ISCYBP,STATBP
      CHARACTER*4 ICURS(2)
C
      INTEGER I,J,IMXC,SYOPBP
      REAL*4    COUNT(512,8),STEP,FBAR,YLOWBP,YHIBP,X0,Y0,VX0,VX1
      REAL*4    VY0,VY1
C
C THE BARPLOT COMMON
      COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
     1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
     2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
     3 SYOPBP

      DATA (ICURS(I),I=1,2)/'BARP','lt>>'/
C
C SEE WHO CALLED US
C
      IF(INCTRL .NE. 0)GOTO 90
C
C SET UP THE DEFAULTS
C
      DO 9 I=1,8
9     FGRPBP(I)=I
      CALL MINMAX(XXX,M*N,XLOWBP,XHIBP)
      IMXC   = 512
      NOBARS = M
      YLOWBP   = 0.0
      YHIBP  = 1.0
      FBAR   = FLOAT(NOBARS)
      DO 1 I=1,80
      XLABBP(I)=' '
      YLABBP(I)=' '
      LABBP(I) =' '
1     CONTINUE
      XLABBP(2)=Z'00'
      YLABBP(2)=Z'00'
      LABBP(2)=Z'00'
      IMXPTS=M
      IMYPTS=N
      XSTBP=0
      YSTBP=0
      XFRCBP=100
      YFRCBP=95
      CHSZBP=0
      ISCYBP =0
      IPLBP1=0
      STATBP = .TRUE.
      IXCLBP = 1
C
C Main Menu
C
4     WRITE(WTE,5)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0)WRITE(WIO,5)COLOR1,ICURS,COLOR2
5     FORMAT(1X,"PLEASE SELECT AN OPTION"/,
     1" [1]  CHOOSE THE BAR GRAPH TYPE"/,
     1" [2]  CHOOSE BAR GRAPH AXIS TYPES"/,
     2" [3]  CHOOSE BAR GRAPH AXIS COLORS"/,
     2" [4]  CHOOSE THE BAR GRAPH LABELS"/,
     3" [5]  SET THE BAR GRAPH COLORS"/,
     4" [6]  SET THE BACKGROUND COLOR"/,
     5" [7]  SET THE PLOT SIZE"/,
     5" [8]  DO THE PLOT"/,
     6" [9]  END THE CURRENT PLOT"/,
     6" [10] EXIT BARGRAPH"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (15,10,20,60,30,40,50,90,899,9999),IANS
      CALL MENUER(10)
      GOTO 4
C
C DEFINE THE BAR GRAPH AXIS TYPES
C
10    CONTINUE
      CALL CHKEND
      CALL SETAXS(ICURS,IPLBP1,SYOPBP,ISCYBP,SYLOBP,SYHIBP,XLOWBP
     1 ,YLOWBP)
      GOTO 4
C
C DETERMINE WHETHER TO COUNT OCCURENCES OR DO STATISTICAL DISTRIBUTION
C
15    CONTINUE
      WRITE(WTE,16)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,16)COLOR1,ICURS,COLOR2
16    FORMAT(1X,"PLEASE CHOOSE THE DESIRED Y-AXIS TYPE:"/,
     1" [1] STATISTICAL (MAXIMUM Y VALUE IS 1.0)"/,
     2" [2] OCCURRENCE COUNT"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (17,18),IANS
      CALL MENUER(2)
      GOTO 15
17    STATBP = .TRUE.
      GOTO 4
18    STATBP = .FALSE.
      GOTO 4
C
C DO THE PLOT LABELS
C
20    CONTINUE
      WRITE(WTE,21)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,21)COLOR1,ICURS,COLOR2
21    FORMAT(1X,"ENTER THE X-AXIS LABEL"/,4A4,$)
      CALL GETLAB(XLABBP)
      WRITE(WTE,22)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,22)COLOR1,ICURS,COLOR2
22    FORMAT(1X,"ENTER THE Y-AXIS LABEL"/,4A4,$)
      CALL GETLAB(YLABBP)
      WRITE(WTE,23)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,23)COLOR1,ICURS,COLOR2
23    FORMAT(1X,"ENTER THE PLOT LABEL"/,4A4,$)
      CALL GETLAB(LABBP)
      GOTO 4
C
C SET THE BAR GRAPH COLORS
C
30    CONTINUE
      CALL CHKEND
      KK=IMYPTS
      IF(KK .GT. 8) KK = 8
      DO 35 I=1,KK
      WRITE(WTE,33)I
      IF(WIO .NE. 0) WRITE(WIO,33)I
33    FORMAT(1X,"FOR BAR GRAPH NUMBER ",I1)
      CALL SETFG(FGRPBP(I),ICURS)
35    CONTINUE
      GOTO 4
C
C  CHANGE THE BACKGROUND PEN COLOR
C
40    CONTINUE
      CALL CHKEND
      CALL CHBACK(ICURS)
      GOTO 4
C
C SET THE PLOT SIZE
C
50    CONTINUE
      CALL CHKEND
      CALL MAKSIZ(ICURS,XSTBP,XFRCBP,YSTBP,YFRCBP)
      XSTBP=XSTBP*100.
      YSTBP=YSTBP*100.
      XFRCBP=XFRCBP*100.+XSTBP
      YFRCBP=YFRCBP*100.+YSTBP
      GOTO 4
C
C SET THE AXIS COLORS
C
60    CONTINUE
      CALL CHKEND
      CALL SETFG(IXCLBP,IERR)
      GOTO 4
C
C DO THE PLOT
C
90    CONTINUE
      CALL CHKEND
C
C SAVE THE PLOT UNLESS THIS IS ALREADY A SAVED PLOT
C
      IF(INCTRL .EQ. 0)CALL SAVPLT(3)
C
C
      IF((XLOWBP .LE. 0 .AND. (IPLBP1 .EQ. 1 .OR. IPLBP1 .EQ. 3))
     1 .OR. (YLOWBP .LE. 0 .AND. (IPLBP1 .EQ. 2 .OR. IPLBP1 .EQ. 3)))
     2THEN
       WRITE(WTE,854)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,854)COLOR3,COLOR2
854    FORMAT(1X,A4,"ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT")
       GOTO 4
      ENDIF
      IF(ISCYBP .AND. (SYLOBP .LE. 0) .AND. (SYOPBP .EQ. 2)) THEN
        WRITE(WTE,855)COLOR3,COLOR2
        IF(WIO .NE. 0)WRITE(WIO,855)COLOR3,COLOR2
855     FORMAT(1X,A4,"ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE
     1WITH LOG PLOT",A4)
        GOTO 4
       ENDIF

        IF (XLOWBP .GT. XHIBP) THEN
         WRITE(WTE,871)COLOR3,COLOR2
         IF(WIO .NE. 0) WRITE(WIO,871)COLOR3,COLOR2
871      FORMAT(1X,A4,"INTERNAL ERROR.  XMIN GREATER THAN XMAX"/,
     1 "CALLED FROM BARPLT.  THIS CAN'T HAPPEN, SO IF IT HAS,"/,
     2 "YOU'RE SCREWED!  SORRY.",A4)
        GOTO 9999
        ENDIF

        IF (NOBARS .GT. IMXC) THEN
         WRITE(WTE,873)COLOR3,COLOR2
         IF(WIO .NE. 0) WRITE(WIO,873)COLOR3,COLOR2
873      FORMAT(1X,A4,"ERROR.  TOO MANY BINS.  THE MAXIMUM IS 512",A4)
         GOTO 9999
        ENDIF
        IF(IMYPTS .GT. 8) THEN
         WRITE(WTE,876)COLOR3,COLOR2
         IF(WIO .NE. 0)WRITE(WIO,876)COLOR3,COLOR2
876      FORMAT(1X,A4,"WARNING. TOO MANY BARGRAPHS SPECIFIED.
     1  ONLY THE FIRST 8 ROWS WILL BE GRAPHED",A4)
         IMYPTS = 8
        ENDIF
C
        STEP   = (XHIBP - XLOWBP) / FBAR
C
        DO 100 I = 1,512
        DO 100 J = 1,8
C
            COUNT(I,J) = 0.0
C
 100    CONTINUE
C
        DO 350 KK=1,IMYPTS
        DO 200 I = 1,IMXPTS
C
            J      = INT((XXX(I,KK)-XLOWBP)/STEP) + 1
            IF (J .GT. NOBARS) J = NOBARS
            COUNT(J,KK) = COUNT(J,KK) + 1.0
C
 200    CONTINUE
C
        IF(STATBP) THEN
         FIMX(KK)   = FLOAT(IMXPTS) * STEP
C
        DO 300 I = 1,NOBARS
C
            COUNT(I,KK) = COUNT(I,KK) / FIMX(KK)
C
 300    CONTINUE
        ENDIF

 350    CONTINUE
C
        CALL MINMAX(COUNT,4096,YLOWBP,YHIBP)
        YLOWBP   = 0.0
        YHIBP  = YHIBP + 0.1 * YHIBP
C
      IF (.NOT. PLTST)THEN
       PLTST = .TRUE.
       CALL BGNPLT
      ENDIF
C
C SET THE BACKGROUND COLOR
C
      IF(SETBG) THEN
        SETBG = .FALSE.
        CALL SETBAK(BGRP)
      ENDIF
C
C DEFINE PLOT SIZE
C
C      WRITE(WTE,1324)XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP
C1324  FORMAT(1X,"MAPSIZE",5F10.3)
      IF(ISCYBP) THEN
       CALL MAPSZ2(XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP)
      ELSE
       CALL MAPSIZ(XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP)
      ENDIF
         CALL GSCOLR(IXCLBP,IERR)
C      WRITE(WTE,1789)XLOWBP,XHIBP,YLOWBP,YHIBP
C1789  FORMAT(1X,"MAPIT",4F10.3)
         CALL MAPIT(XLOWBP,XHIBP,YLOWBP,YHIBP,XLABBP,YLABBP,LABBP,
     1    IPLBP1)
C
        DO 500 KK=1,IMYPTS
        CALL GSCOLR(FGRPBP(KK),IERR)
        X0     = XLOWBP
        Y0     = 0.0
        CALL SCALE(X0,Y0,VX0,VY0)
        CALL GSMOVE(VX0,VY0)
C
        DO 400 I = 1,NOBARS
C
            X0     = XLOWBP + I * STEP
            Y0     = COUNT(I,KK)
            CALL SCALE(X0,Y0,VX1,VY1)
            CALL GSDRAW(VX0,VY1)
            CALL GSDRAW(VX1,VY1)
            CALL GSDRAW(VX1,VY0)
C
            VX0    = VX1
C
 400    CONTINUE
 500    CONTINUE
C
C
C DO THE SECOND Y AXIS
C
      IF(ISCYBP) THEN
C       CALL GSCOLR(IXCLBP,IERR)
       CALL GSLTYP(1)
       CALL SYAXIS(SYLOBP,SYHIBP,SYLBBP,SYOPBP)
      ENDIF
      IF(INCTRL .NE. 0) RETURN
        GOTO 4
C
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 4
 9999   CONTINUE
C
C       BYE
C
        RETURN
        END

C
C  ROUTINE TO SET AXIS TYPES
C
      SUBROUTINE SETAXS(ICURS,IPLTP1,ISYOPT,ISECY,SYMN,SYMX,XLO,YLO)

      CHARACTER*4 ICURS(2)
      INTEGER IPLTP1,ISYOPT
      REAL SYMN,SYMX,XLO,YLO
      LOGICAL ISECY
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
180   WRITE(WTE,185)COLOR1,ICURS,COLOR2
      CALL CHKEND
185   FORMAT(1X,"PLEASE CHOOSE THE TYPE OF PLOT AXES"/,
     1" [1] LIN-LIN PLOT"/,
     2" [2] LOG-LIN PLOT"/,
     3" [3] LIN-LOG PLOT"/,
     4" [4] LOG-LOG PLOT"/,
     5" [5] USE SECOND Y-AXIS"/
     6" [6] RETURN TO PREVIOUS MENU"/,4A4,$)
      IF(WIO .NE. 0) WRITE(WIO,185)COLOR1,ICURS,COLOR2
      CALL VALGET(0,IANS,'I')
      GOTO (210,220,230,240,250,999),IANS
      CALL MENUER(6)
      GOTO 180
210   IPLTP1 = 0
      GOTO 180
220   CONTINUE
      IF(XLO .LT. 0)THEN
       WRITE(WTE,222)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,222)COLOR3,COLOR2
222    FORMAT(1X,A4,"ERROR. X-AXIS LIST HAS VALUES LESS THAN 0."/
     1," THIS IS INCOMPATIBLE WITH A LOG X AXIS",A4)
       GOTO 180
      ENDIF
      IPLTP1 = 1
      GOTO 180
230   CONTINUE
      IF(YLO .LT. 0)THEN
       WRITE(WTE,232)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,232)COLOR3,COLOR2
232    FORMAT(1X,A4,"ERROR. Y-AXIS LIST HAS VALUES LESS THAN 0."/
     1," THIS IS INCOMPATIBLE WITH A LOG Y AXIS",A4)
       GOTO 180
      ENDIF
      IPLTP1=2
      GOTO 180
240   CONTINUE
      IF(XLO .LT. 0)THEN
       WRITE(WTE,222)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,222)COLOR3,COLOR2
       GOTO 180
      ENDIF
      IF(YLO .LT. 0)THEN
       WRITE(WTE,232)COLOR3,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,232)COLOR3,COLOR2
       GOTO 180
      ENDIF
      IPLTP1 = 3
      GOTO 180
250   CONTINUE
      ISECY=.TRUE.
252   WRITE(WTE,255)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,255)COLOR1,ICURS,COLOR2
255   FORMAT(1X,"PLEASE CHOOSE SECOND Y-AXIS OPTIONS:"/,
     1" [1] LINEAR SCALE"/,
     2" [2] LOG SCALE"/,
     3" [3] CHOOSE SECOND AXIS LIMITS"/,
     3" [4] DELETE SECOND Y AXIS"/,
     4" [5] RETURN TO AXIS SELECTION MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (260,270,290,280,180),IANS
      CALL MENUER(5)
260   ISYOPT=0
      GOTO 252
270   ISYOPT=2
      GOTO 252
280   ISECY=.FALSE.
      GOTO 252
290   WRITE(WTE,292)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,292)COLOR1,ICURS,COLOR2
292   FORMAT(1X,"ENTER THE MINIMUM SCALE VALUE OF THE SECOND Y AXIS"/,
     14A4,$)
      CALL VALGET(SYMN,0,'F')
      WRITE(WTE,294)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,294)COLOR1,ICURS,COLOR2
294   FORMAT(1X,"ENTER THE MAXIMUM SCALE VALUE OF THE SECOND Y AXIS"/,
     14A4,$)
      CALL VALGET(SYMX,0,'F')
      GOTO 252
999   CONTINUE
      RETURN
      END
C
C ROUTINE TO DEFINE PLOT SIZE
C
      SUBROUTINE MAKSIZ(ICURS,XST,XFRC,YST,YFRC)
      CHARACTER*4 ICURS(2)
      REAL XST,XFRC,YST,YFRC
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP,FGRPXY(10),ISYMNO(10)
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
      WRITE(WTE,601)COLOR1,ICURS,COLOR2
601   FORMAT(1X,"ENTER THE X ORIGIN OF THE PLOT AS A FRACTION OF THE
     1 TOTAL XAXIS LENGTH"/,4A4,$)
      IF(WIO .NE. 0) WRITE(WIO,601)COLOR1,ICURS,COLOR2
      CALL VALGET(XST,0,'F')
      WRITE(WTE,602)COLOR1,ICURS,COLOR2
602   FORMAT(1X,"ENTER THE Y ORIGIN OF THE PLOT AS A FRACTION OF THE
     1 TOTAL YAXIS LENGTH"/,4A4,$)
      IF(WIO .NE. 0) WRITE(WIO,602)COLOR1,ICURS,COLOR2
      CALL VALGET(YST,0,'F')
      WRITE(WTE,603)COLOR1,ICURS,COLOR2
603   FORMAT(1X,"ENTER THE FRACTION OF THE XAXIS TO BE OCCUPIED BY
     1 THE PLOT"/,4A4,$)
      IF(WIO. NE. 0) WRITE(WIO,603)COLOR1,ICURS(1),ICURS(2),COLOR2
      CALL VALGET(XFRC,0,'F')
      WRITE(WTE,604)COLOR1,ICURS,COLOR2
604   FORMAT(1X,"ENTER THE FRACTION OF THE YAXIS TO BE OCCUPIED BY
     1 THE PLOT"/,4A4,$)
      IF(WIO .NE. 0) WRITE(WIO,604)COLOR1,ICURS,COLOR2
      CALL VALGET(YFRC,0,'F')
      RETURN
      END
C
C ROUTINE TO CLOSE OUT THE PLOTS
C
      SUBROUTINE PLTFIN
C
      CALL ENDPLT
      RETURN
      END
C
C ROUTINE TO REMEMBER PLOT SETTINGS
C
      SUBROUTINE SAVPLT(PLTP)
      INTEGER PLTP
C
C PLTP IS TYPE OF PLOT
C      =1 IS 3D PLOT
C      =2 IS X-Y PLOT OF ANY TYPE
C      =3 IS BAR PLOT (HISTOGRAM)
C      =4 IS CONTOUR PLOT
C      =5 IS POLAR PLOT
C
C
C PLOT SPECIFIC VARIABLES
C
      INTEGER VAR(4)
      CHARACTER*4 ICURS(2)
      INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
      REAL*4 LABE3D
      CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
      DIMENSION XYLIM(2,6),CAMLOC(3)
      INTEGER*4 FGRPXY(10),ISYMNO(10)
      INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
      DIMENSION SYMSZ(10)
      LOGICAL ISECY,PLTST,SETBG,BNHERE
      CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
      CHARACTER*4 TAG
      INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport
C
C THE GLOBAL PLOT COMMON
C
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C THE 3D PLOT ROUTINE COMMON
C
      COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
     1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
C
C THE XYPLOT ROUTINE COMMON
C
      COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
     1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
     2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
     3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
C
C BARPLT VARIABLES
C
      INTEGER NOBARS,COLIST(8),FGRPBP(8)
      REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
      DIMENSION FIMX(8)
      CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
      LOGICAL ISCYBP,STATBP
      INTEGER IMXC
      REAL*4  FBAR,YLOWBP,YHIBP
C
C THE BARPLOT COMMON
C
      COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
     1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
     2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
     3 SYOPBP
C
C THE CONTOUR PLOT VARIABLES
C
      CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
      DIMENSION CNLCP(20)
      REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
      REAL YMXCP
      INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP

      COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
     1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
     2 ,ICNNCP,CNLCP,LBSZCP
C
C
C THE POLAR PLOT VARIABLES
C
      DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
      DIMENSION LNSLPP(10)
      INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
      CHARACTER*1 LABPP(80)
      INTEGER*2 MODEPP(8)
      REAL XSTPP,YSTPP,XFRCPP,YFRCPP
      REAL RMAX
      CHARACTER*4 TAGPP
      INTEGER NLINPP
      COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP,
     1 XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP,
     2 ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP

      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720)
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
      CHARACTER*1 D3PL(328),XYPL(692),BPPL(440),CPPL(376),POPL(432)
      EQUIVALENCE (D3PL,XLAB3D),(XYPL,XLABXY),(BPPL,FGRPBP)
      EQUIVALENCE (XLABCP,CPPL),(RMAX,POPL)
C
      IF( PLTCNT .EQ. 0)PLTMAX = 0
      PLTCNT=PLTCNT+1
      IF(PLTCNT .GT. 10) PLTCNT = 1
      IF(PLTMAX .LE. 10)PLTMAX = PLTCNT
      IPLTYP(PLTCNT)=PLTP
      GOTO(100,200,300,400,500)PLTP
      RETURN
100   DO 110 I=1,328
110   ISAV(PLTCNT,I)=D3PL(I)
      RETURN
200   DO 210 I=1,692
210   ISAV(PLTCNT,I)=XYPL(I)
      RETURN
300   DO 310 I=1,440
310   ISAV(PLTCNT,I)=BPPL(I)
      RETURN
400   DO 410 I=1,376
410   ISAV(PLTCNT,I)=CPPL(I)
      RETURN
500   DO 510 I=1,432
510   ISAV(PLTCNT,I)=POPL(I)
      RETURN
      END
C
C ROUTINE TO RESTORE PLOTS AS SAVED BY SAVPLT
C
      SUBROUTINE PLREST(XXX,YYY,M,N,INCTRL,IOCTRL,IZ)
      INTEGER M,N,INCTRL,IOCTRL
      DIMENSION XXX(M,N),YYY(M,N)
C
C PLOT SPECIFIC VARIABLES
C
      INTEGER VAR(4)
      CHARACTER*4 ICURS(2)
      INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
      REAL*4 LABE3D
      CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
      DIMENSION XYLIM(2,6),CAMLOC(3)
      INTEGER*4 FGRPXY(10),ISYMNO(10)
      INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
      DIMENSION SYMSZ(10)
      LOGICAL ISECY,PLTST,SETBG,BNHERE
      CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
      CHARACTER*4 TAG
      INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport
C
C THE GLOBAL PLOT COMMON
C
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C THE 3D PLOT ROUTINE COMMON
C
      COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
     1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
C
C THE XYPLOT ROUTINE COMMON
C
      COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
     1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
     2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
     3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
C
C BARPLT VARIABLES
C
      INTEGER NOBARS,COLIST(8),FGRPBP(8)
      REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
      DIMENSION FIMX(8)
      CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
      LOGICAL ISCYBP,STATBP
      INTEGER IMXC
      REAL*4  FBAR,YLOWBP,YHIBP
C
C THE BARPLOT COMMON
C
      COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
     1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
     2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
     3 SYOPBP
C
C
C THE CONTOUR PLOT VARIABLES
C
      CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
      DIMENSION CNLCP(20)
      REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
      REAL YMXCP
      INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
      COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
     1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
     2 ,ICNNCP,CNLCP,LBSZCP

C
C THE POLAR PLOT VARIABLES
C
      DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
      DIMENSION LNSLPP(10)
      INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
      CHARACTER*1 LABPP(80)
      INTEGER*2 MODEPP(8)
      REAL XSTPP,YSTPP,XFRCPP,YFRCPP
      REAL RMAX
      INTEGER NLINPP
      CHARACTER*4 TAGPP
      COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
     1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
     2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP

      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720)
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
      CHARACTER*1 D3PL(328),XYPL(692),BPPL(440),CPPL(376),POPL(432)
      EQUIVALENCE (D3PL,XLAB3D),(XYPL,XLABXY),(BPPL,FGRPBP)
      EQUIVALENCE (XLABCP,CPPL),(RMAX,POPL)
C
      IF(INCTRL .EQ. 0) THEN
       ISTRT = 1
       IEND = PLTMAX
      ELSE
       ISTRT = INCTRL
       IEND =INCTRL
      ENDIF
      DO 1000 I=ISTRT,IEND
      GOTO (100,200,300,400,500)IPLTYP(I)
      CYCLE
100   DO 110 J = 1,328
110   D3PL(J)=ISAV(I,J)
      CALL D3PLOT(XXX,M,N,1,IERR,IZ)
      CYCLE
200   DO 210 J=1,692
210   XYPL(J)=ISAV(I,J)
      CALL XYPLT(XXX,M,N,1,IERR)
      CYCLE
300   DO 310 J=1,440
310   BPPL(J)=ISAV(I,J)
      CALL BARPLT(XXX,M,N,1,IERR)
      CYCLE
400   DO 410 J=1,376
410   CPPL(J)=ISAV(I,J)
      CALL CONTUR(XXX,M,N,1,IERR,IZ)
      CYCLE
500   DO 510 J=1,432
510   POPL(J)=ISAV(I,J)
      CALL POLPLT(XXX,YYY,M,N,1,IERR,IZ)
1000  CONTINUE
      RETURN
      END
C
C PLOT BUFFER CONTROL ROUTINE
C
      SUBROUTINE PLCTRL(XXX,YYY,M,N,IZ)
      INTEGER M,N
      DIMENSION XXX(M,N),YYY(M,N)
C
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 DSPLY
      LOGICAL PLTST,SETBG,BNHERE
C
C THE GLOBAL PLOT COMMON
C
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C PLOT SAVE VARIABLES
C
      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720)
      CHARACTER*4 ICURS(2)
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV

      DATA (ICURS(I),I=1,2)/'CNTR','OL>>'/
5     WRITE (WTE,10)COLOR1,ICURS,COLOR2
      DSPLY = 0
      CALL CHKEND
      IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
10    FORMAT(1X,"PLEASE CHOOSE A PLOT BUFFER CONTROL OPTION:"/,
     1" [1] CLEAR THE BUFFER"/,
     2" [2] DELETE A PLOT"/,
     3" [3] SHOW THE PLOT BUFFER"/,
     4" [4] DISPLAY ONE OF THE SAVED PLOTS"/,
     4" [5] DISPLAY ALL SAVED PLOTS"/,
     5" [6] SAVE THE PLOT BUFFER"/,
     6" [7] RETURN TO THE MAIN MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO(100,200,200,600,300,400,500)IANS
      CALL MENUER(5)
100   CONTINUE
      PLTMAX = 0
      PLTCNT = 0
      DO 120 I = 1,10
120   IPLTYP(I)=0
      RETURN
200   CONTINUE
      WRITE(WTE,210)
      IF(WIO .NE. 0) WRITE(WIO,210)
210   FORMAT(1X,"THE FOLLOWING PLOTS ARE STORED IN THE BUFFER:"//,
     1 " BUFFER LOCATION   PLOT TYPE"/)
      DO 290 I=1,10
      GOTO(220,230,240,250,260)IPLTYP(I)
      CYCLE
220   WRITE(WTE,225)I
      IF(WIO .NE. 0)WRITE(WIO,225)I
225   FORMAT(10X,I2,7X,"3-D PLOT")
      CYCLE
230   WRITE(WTE,235)I
      IF(WIO .NE. 0)WRITE(WIO,235)I
235   FORMAT(10X,I2,7X,"X-Y PLOT")
      CYCLE
240   WRITE(WTE,245)I
      IF(WIO .NE. 0) WRITE(WIO,245)I
245   FORMAT(10X,I2,7X,"HISTOGRAM")
      CYCLE
250   WRITE(WTE,255)I
      IF(WIO .NE. 0) WRITE(WIO,255)I
255   FORMAT(10X,I2,7X,"CONTOUR PLOT")
      CYCLE
260   WRITE(WTE,265)I
      IF(WIO .NE. 0) WRITE(WIO,255)I
265   FORMAT(10X,I2,7X,"POLAR PLOT")
290   CONTINUE
      IF (IANS .EQ. 2) THEN 
      WRITE(WTE,295)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,295)COLOR1,ICURS,COLOR2
295   FORMAT("DELETE WHICH GRAPH?  ENTER THE BUFFER LOCATION."/,4A4,$)
      CALL VALGET(0,IANS,'I')
      IF(IANS .GE. 1 .AND. IANS .LE. 10) THEN
      IPLTYP(IANS)=0
      ENDIF
      ELSE
      WRITE(WTE,296)
      IF(WIO .NE. 0)WRITE(WIO,296)
296   FORMAT(/)
      ENDIF      
      GOTO 5
300   CONTINUE
      CALL PLREST(XXX,YYY,M,N,DSPLY,IERR,IZ)
      RETURN
400   CALL SAVFIL
      RETURN
600   WRITE(WTE,610)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,610)COLOR1,ICURS,COLOR2
610   FORMAT(1X,"PLEASE ENTER THE PLOT BUFFER NUMBER TO BE DISPLAYED"/,
     1 4A4)
      CALL VALGET(0,DSPLY,'I')
      CALL PLREST(XXX,YYY,M,N,DSPLY,IERR,IZ)
      GOTO 5
500   RETURN      
      END
C
C ROUTINE TO SAVE PLOT DEFINITIONS
C
      SUBROUTINE SAVFIL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C THE GLOBAL PLOT COMMON
C
      LOGICAL PPLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C PLOT SAVE VARIABLES
C
      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720)
      CHARACTER*4 ICURS(2),NAME(32)
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
      DATA (ICURS(I),I=1,2)/'PLTS','AV>>'/
C
      IPL = 45
      WRITE(WTE,10)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
10    FORMAT(1X,"PLEASE ENTER THE SAVE FILE NAME."/,4A4,$)
      READ(RTE,15)NAME
15    FORMAT(32A1)
20    FORMAT(1X,32A1)
      CALL FILES(IPL,NAME)
      IF(FE .EQ. 0) THEN
      WRITE(IPL,25)PLTCNT,PLTMAX
25    FORMAT(2I2)
      DO 50 J=1,10
      IF (IPLTYP(J) .GT. 0 .AND. IPLTYP(J) .LT. 10) THEN
        WRITE(IPL,30)IPLTYP(J)
30      FORMAT(I1)
        WRITE(IPL,35)(ISAV(J,KK),KK=1,360)
        WRITE(IPL,35)(ISAV(J,KK),KK=361,720)
35      FORMAT(360Z2)
      ENDIF
50    CONTINUE
      CALL FILES(-1*IPL,NAME)
      ENDIF
      RETURN 
      END      
C
C ROUTINE TO LOAD PLOT DEFINITIONS
C
      SUBROUTINE LODFIL(XXX,YYY,M,N,NAME,INCTRL,IOCTRL,IZ)
      INTEGER M,N
      DIMENSION XXX(M,N),YYY(M,N)
      CHARACTER*4 NAME(32)
      INTEGER INCTRL,IOCTRL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C THE GLOBAL PLOT COMMON
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C PLOT SAVE VARIABLES
C
      INTEGER PLTCNT,PLTMAX
      CHARACTER*1 ISAV(10,720)
      CHARACTER*4 ICURS(2)
      LOGICAL GOTONE
C
C THE PLTSAV COMMON
C
      COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
      DATA (ICURS(I),I=1,2)/'PLTL','OD>>'/
C
      IPL = 45
      GOTONE = .FALSE.
5     CONTINUE
      IF(INCTRL .EQ. 0) THEN
       WRITE(WTE,10)COLOR1,ICURS,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
       CALL CHKEND
10     FORMAT(1X,"PLEASE ENTER THE FILE NAME TO BE LOADED."/,4A4,$)
       READ(RTE,15)NAME
15     FORMAT(32A1)
       IF(WIO .NE. 0)WRITE(WIO,20)NAME
20     FORMAT(1X,32A1)
      ENDIF
      DO 22 I=1,10
22    IPLTYP(I)=0
      CALL FILES(IPL,NAME)
      IF(FE .EQ. 0) THEN
      READ(IPL,25,END=55)PLTCNT,PLTMAX
25    FORMAT(2I2)
C
C CHECK THE HEADER FOR VALIDITY
C
      IF(PLTCNT .GT. 10 .OR. PLTCNT .LT. 1 .OR. PLTMAX .GT. 10 .OR.
     1  PLTMAX .LT. 1) THEN
        WRITE(WTE,23)COLOR3,COLOR2
        IF(WIO .NE. 0) WRITE(WIO,23)COLOR3,COLOR2
23      FORMAT(A4,"ERROR IN PLOT DEFINITION FILE"/,"NOT A VALID PLOT
     1 DEFINITION",A4)
        CALL FILES(-1*IPL,NAME)
        GOTO 5
      ENDIF
C
C READ IN THE DEFINITION
C
      DO 50 J=1,PLTMAX
        READ(IPL,30,END=55)IPLTYP(J)
30      FORMAT(I1)
        READ(IPL,35,END=55)(ISAV(J,KK),KK=1,360)
        READ(IPL,35,END=55)(ISAV(J,KK),KK=361,720)
35      FORMAT(360Z2)
        GOTONE=.TRUE.
50    CONTINUE
55    CONTINUE
      CALL FILES(-1*IPL,NAME)
      IF(GOTONE)CALL PLREST(XXX,YYY,M,N,0,IERR,IZ)
      ENDIF
      RETURN
      END
C
C ROUTINE TO END THE CURRENT PLOT
C
      SUBROUTINE CHKEND
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      LOGICAL PLTST,SETBG,BNHERE
C
C THE GLOBAL PLOT COMMON
C
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
      IF(PLTST) CALL GD13HI(13,X,Y)
      IF(X .NE. 0)PLTST = .FALSE.
      RETURN
      END
C
C THE CONTOUR PLOTTING ROUTINE
C
      SUBROUTINE CONTUR(XXX,M,N,INCTRL,IOCTRL,IZ)
      INTEGER M,N
      DIMENSION XXX(M,N)
      INTEGER INCTRL,IOCTRL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,CHOICE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE

C
C PLOT SPECIFIC VARIABLES
C

      CHARACTER*1 IZ(5000)
      LOGICAL PLTST,SETBG,BNHERE
      CHARACTER*4 ICURS(2)
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C THE CONTOUR PLOT VARIABLES
C
      CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
      DIMENSION CNLCP(20)
      REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
      REAL YMXCP
      INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
      COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
     1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
     2 ,ICNNCP,CNLCP,LBSZCP
C
      DATA (ICURS(I),I=1,2)/'Cont','or>>'/
C
C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
C
      IF(INCTRL .NE. 0) GOTO 900
C
C SET UP THE DEFAULTS
C
      DO 25 I=1,80
      XLABCP(I)=Z'20'
      YLABCP(I)=Z'20'
25    LABCP(I)=Z'20'
      LABECP=0
      XSTCP=0
      YSTCP=0
      XFRCCP=100
      YFRCCP=100
      FGRPCP=1
      IOCTRL=0
      X1CP=0
      XMXCP=M
      Y1CP=0
      YMXCP=N
      IOPTCP=0
      IOP2CP=0
      ICNNCP=20
      XMAX = GSXLCM()
      YMAX = GSYLCM()
      MN=M*N
      CALL MINMAX(XXX,MN,ZMIN,ZMAX)
      DO 55 I = 1,20
55    CNLCP(I)=ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
C
C DETERMINE THE CHOICES
C
       CALL CHKEND
100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
     1 " [1]  CHOOSE PLOT LABELS"/,
     2 " [2]  CHOOSE PLOT VALUES"/,
     3 " [3]  CHOOSE NUMBER OF CONTOURS"/,
     4 " [4]  CHOOSE CONTOUR LEVELS"/,
     5 " [5]  SET THE BACKGROUND COLOR"/,
     5 " [6]  CHOOSE PLOT COLOR"/,
     6 " [7]  CHOOSE PLOT SIZE"/,
     7 " [8]  DO THE PLOT"/,
     8 " [9]  END THE CURRENT PLOT"/,
     8 " [10] EXIT CONTOUR PLOTS"/,
     94A4,$)
      CALL VALGET(0,CHOICE,'I')
      GOTO(200,300,400,500,600,700,800,900,899,990),CHOICE
      CALL MENUER(10)
      GOTO 100
C
C  SELECT THE LABELS
C
200   CONTINUE
      CALL CHKEND
      WRITE(WTE,201)COLOR1,ICURS,COLOR2
201   FORMAT(1X,//"ENTER THE X AXIS LABEL"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,201)COLOR1,ICURS,COLOR2
      CALL GETLAB(XLABCP)
      WRITE(WTE,202)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,202)COLOR1,ICURS,COLOR2
202   FORMAT(1X,//"ENTER THE Y AXIS LABEL"/,4A4,$)
      CALL GETLAB(YLABCP)
      WRITE(WTE,203)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,203)COLOR1,ICURS,COLOR2
203   FORMAT(1X,//"ENTER THE PLOT LABEL"/,4A4,$)
      CALL GETLAB(LABCP)
      WRITE(WTE,204)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,204)COLOR1,ICURS,COLOR2
204   FORMAT(1X,//"ENTER THE SIZE OF THE LABELS (CM)"/,A4
     1 ,4A4,$)
      CALL VALGET(LABSIZ,0,'F')
      IF(LABSIZ .NE. 0) LABECP = LABSIZ
      GOTO 100
C
C SELECT THE DATA
C
300   CONTINUE
      CALL CHKEND
      WRITE(WTE,301)COLOR1,ICURS,COLOR2
301   FORMAT(1X,"ENTER THE MINIMUM VALUE OF X"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
      CALL VALGET(X1CP,0,'F')
      WRITE(WTE,302)COLOR1,ICURS,COLOR2
302   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF X"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,302)COLOR1,ICURS,COLOR2
      CALL VALGET(XMXCP,0,'F')
      WRITE(WTE,303)COLOR1,ICURS,COLOR2
303   FORMAT(1X,"ENTER THE MINIMUM VALUE OF Y"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,303)COLOR1,ICURS,COLOR2
      CALL VALGET(Y1CP,0,'F')
      WRITE(WTE,304)COLOR1,ICURS,COLOR2
304   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF Y"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,304)COLOR1,ICURS,COLOR2
      CALL VALGET(YMXCP,0,'F')
      GOTO 100
C
C DEFINE THE NUMBER OF CONTOURS
C
400   CONTINUE
      CALL CHKEND
      WRITE(WTE,425)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,425)COLOR1,ICURS,COLOR2
425   FORMAT(1X,//"ENTER THE NUMBER OF CONTOURS TO BE MAPPED"/,4A4,$)
      CALL VALGET(0,ICNNCP,'I')
      IF(ICNNCP .GT. 20) ICNNCP = 20
      DO 455 I = 1,ICNNCP
455   CNLCP(I)=ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
      GOTO 100
C
C CHOOSE THE CONTOUR LEVELS
C
500   CONTINUE
      CALL CHKEND
      GOTO 100
C
C SET THE BACKGROUND COLOR
C
600   CONTINUE
      CALL CHKEND
      CALL CHBACK(ICURS)
      GOTO 100
C
C SELECT THE PLOT COLOR
C
700   CONTINUE
      CALL CHKEND
      CALL SETFG(FGRPCP,ICURS)
      GOTO 100
C
C SELECT THE PLOT SIZE
C
800   CONTINUE
C
      CALL CHKEND
      CALL MAKSIZ(ICURS,XSTCP,XFRCCP,YSTCP,YFRCCP)
      XSTCP=XSTCP*100.
      YSTCP=YSTCP*100.
      XFRCCP=XFRCCP*100.+XSTCP
      YFRCCP=YFRCCP*100.+YSTCP
      GOTO 100
C
C END THE PLOT
C
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 100
C
C DO THE PLOT
C
900   CONTINUE
      CALL CHKEND
C
C SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
C
      IF(INCTRL .EQ. 0) CALL SAVPLT(4)
      IF (.NOT. PLTST)THEN
       PLTST = .TRUE.
       CALL BGNPLT
      ENDIF
      IF(SETBG) THEN
       SETBG = .FALSE.
       CALL SETBAK(BGRP)
      ENDIF
      CALL GSCOLR(FGRPCP,IERR)
      CALL MAPSIZ(XSTCP,XFRCCP,YSTCP,YFRCCP,LABECP)
      CALL MAPIT(X1CP,XMXCP,Y1CP,YMXCP,XLABCP,YLABCP,LABCP,IOPTCP)
      CALL CONTOR(XXX,M,IZ,M,N,X1CP,XMXCP,Y1CP,YMXCP,ICNNCP,CNLCP)
      IF(INCTRL .NE. 0)RETURN
      GOTO 100
990   CONTINUE
      RETURN
      END
C
C THE POLAR PLOTTING ROUTINE
C
      SUBROUTINE POLPLT(XXX,YYY,M,N,INCTRL,IOCTRL,IZ)
      INTEGER M,N
      DIMENSION XXX(M,N),YYY(M,N)
      INTEGER INCTRL,IOCTRL
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      INTEGER*4 COLOR1,COLOR2,COLOR3,CHOICE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE

C
C PLOT SPECIFIC VARIABLES
C

      CHARACTER*1 IZ(5000)
      LOGICAL PLTST,SETBG,BNHERE
      CHARACTER*4 ICURS(2)
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
C
C THE POLAR PLOT VARIABLES
C
      DIMENSION X(10,500),Y(10,500),XPL(500),YPL(500)
      DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
      DIMENSION LNSLPP(10)
      INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
      CHARACTER*1 LABPP(80)
      CHARACTER*4 TAGPP,ROWTAG,COLTAG
      INTEGER*2 MODEPP(8)
      REAL XSTPP,YSTPP,XFRCPP,YFRCPP
      REAL RMAX
      INTEGER NPTSPP,NLINPP
      COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
     1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
     2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
C
      DATA (ICURS(I),I=1,2)/'Pola','r >>'/,ROWTAG/' ROW'/,COLTAG/' COL'/
C
C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
C
      IF(INCTRL .NE. 0) GOTO 900
C
C SET UP THE DEFAULTS
C
      DO 25 I=1,80
25    LABPP(I)=CHAR(0)
      DO 10 I = 1,10
      SMSZPP(I) = 0
      NTSMPP(I) = 0
      ISMNPP(I) = 0
      LNSLPP(I) = 1
      LINXPP(I) = 0
      LINYPP(I) = 0
10    FGRPPP(I) = I+1
      LABEPP = 0
      MODE1A = 1
      MODE1B = 0
      MODE2A = 1
      MODEPP(2)=1
      MODEPP(3)=0
      MODEPP(4)=1
      MODEPP(5)=-30
      MODEPP(7)=2
      XSTPP=0
      YSTPP=0
      XFRCPP=100
      YFRCPP=100
      BGRPPP = 1
      IOCTRL=0
      NLINPP = 0
      MN=M*N
C
C CHOOSE THE PLOT MODE 
C
      CALL CHKEND
7     WRITE(WTE,3)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,3)COLOR1,ICURS,COLOR2
3     FORMAT(1X,"PLEASE CHOOSE THE POLAR PLOT MODE:"/,
     1" [1] R-THETA PLOT (TYPE REAL)"/,
     2" [2] COMPLEX (X+IY) PLOT"/,4A4,$)
      CALL VALGET(0,IDEFPP,'I')
      GOTO(4,4),IDEFPP
      CALL MENUER(2)
      GOTO 7
4     CONTINUE
      MODE1A = IDEFPP
      IDEFPP = IDEFPP + 2
C
C DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
C
      CALL PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAGPP,NLINPP
     1,LINXPP,LINYPP,NPTSPP,IDEFPP)
C
C DETERMINE THE CHOICES
C
100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
     1 " [1]  DEFINE THE PLOT LABEL"/,
     2 " [2]  CHOOSE PLOT AXIS TYPE"/,
     3 " [3]  CHOOSE LINE OPTIONS"/,
     4 " [4]  CHOOSE PLOT AXIS AND TICK MARK OPTIONS"/,
     5 " [5]  CHOOSE THE BACKGROUND COLOR"/,
     5 " [6]  CHOOSE PLOT COLOR"/,
     6 " [7]  CHOOSE PLOT SIZE"/,
     7 " [8]  DO THE PLOT"/,
     8 " [9]  END THE CURRENT PLOT"/,
     8 " [10] EXIT POLAR PLOTS"/,
     94A4,$)
      CALL VALGET(0,CHOICE,'I')
      GOTO(200,300,400,500,600,700,800,900,899,990),CHOICE
      CALL MENUER(10)
      GOTO 100
C
C  SELECT THE LABELS
C
200   CONTINUE
      CALL CHKEND
      WRITE(WTE,203)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,203)COLOR1,ICURS,COLOR2
203   FORMAT(1X,//"ENTER THE PLOT LABEL"/,4A4,$)
      CALL GETLAB(LABPP)
      GOTO 100
C
C SELECT THE DATA
C
300   CONTINUE
      CALL CHKEND
      WRITE(WTE,301)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
301   FORMAT(1X,//"CHOOSE THE PLOT AXIS TYPE"/
     1," [1] LINEAR RADIUS PLOT"/
     2," [2] LOGARITHMIC RADIUS"/
     3," [3] RETURN TO MAIN MENU"/,4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      GOTO (330,340,100),ICHOICE
      CALL MENUER(3)
      GOTO 300
330   MODE2A = 1
      GOTO 300
340   MODE2A = 2
      GOTO 300
C
C LINE OPTIONS
C
400   CONTINUE
      WRITE(WTE,410)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,410)COLOR1,ICURS,COLOR2
410   FORMAT(1X,"PLEASE CHOOSE A DATA LINE OPTION"/,
     1" [1] CHOOSE LINE COLOR"/,
     2" [2] CHOOSE LINE STYLE"/,
     3" [3] RETURN TO POLAR PLOT MENU"/,4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      GOTO (420,443,100),ICHOICE
      CALL MENUER(3)
      GOTO 400
420   CONTINUE
      DO 425 I = 1,NLINPP
      WRITE(WTE,421)I
421   FORMAT(1X,"FOR LINE NUMBER ",I2)
      IF(WIO .NE. 0) WRITE(WIO,421)I
      CALL SETFG(FGRPPP(I),ICURS)
425   CONTINUE
      GOTO 400
443   CONTINUE
      CALL CHKEND
      CALL LNOPTS(NLINPP,SMSZPP,NTSMPP,ISMNPP,LNSLPP,ICURS)
      GOTO 400
C
C AXIS AND TICK MARK OPTIONS
C
500   CONTINUE
      CALL CHKEND
      WRITE(WTE,505)COLOR1,ICURS,COLOR2 
      IF(WIO .NE. 0)WRITE(WIO,505)COLOR1,ICURS,COLOR2
505   FORMAT(1X,"SELECT AXIS OR TICK MARK OPTIONS"/,
     1 " [1] NO AXIS, TICK MARKS, OR RANGE RINGS"/,
     2 " [2] DRAW AXIS ONLY"/,
     3 " [3] DRAW TICK MARKS"/,
     4 " [4] DRAW RANGE RINGS"/,
     5 " [5] RETURN TO MAIN MENU"/,4A4,$)

      CALL VALGET(0,ICHOICE,'I')
      GOTO(510,520,530,540,100),ICHOICE
      CALL MENUER(5)
      GOTO 500
510   CONTINUE
      MODE1B = 2
      GOTO 500
520   MODE1B = 0
      GOTO 500
530   WRITE(WTE,535)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,535)COLOR1,ICURS,COLOR2
535   FORMAT(1X,"ENTER THE NUMBER OF DEGREES BETWEEN EACH TICK MARK"/,
     1 4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      MODEPP(5) = ICHOICE
534   CONTINUE
      WRITE(WTE,536)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,536)COLOR1,ICURS,COLOR2
536   FORMAT(1X,"PLEASE CHOOSE AN OPTION"/,
     1 "[1] INWARD POINTING TICK MARKS"/,
     2 "[2] OUTWARD POINTING TICK MARKS"/,4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      GOTO (537,538),ICHOICE
      CALL MENUER(2)
      GOTO 534
537   IF(MODEPP(5) .GT. 0)MODEPP(5) = -MODEPP(5)
      GOTO 500
538   IF(MODEPP(5) .LT. 0)MODEPP(5) = -MODEPP(5)
      GOTO 500

540   CONTINUE
      WRITE(WTE,542)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,542)COLOR1,ICURS,COLOR2
542   FORMAT(1X,"PLEASE ENTER THE NUMBER OF RANGE RINGS TO PLOT"/,4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      MODEPP(3) = ICHOICE
543   CONTINUE
      WRITE(WTE,544)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,544)COLOR1,ICURS,COLOR2
544   FORMAT(1X,"PLEASE CHOOSE A RANGE RING LINE OPTION"/,
     1" [1] SOLID LINE"/,
     2" [2] LONG DASHED LINE"/,
     3" [3] SHORT DASHED LINE"/,
     4" [4] DOT-DASH LINE"/,4A4,$)
      CALL VALGET(0,ICHOICE,'I')
      GOTO (546,546,546,546),ICHOICE
      CALL MENUER(4)
      GOTO 543
546   MODEPP(4) = ICHOICE
      GOTO 500
C
C SET THE BACKGROUND COLOR
C
600   CONTINUE
      CALL CHKEND
      CALL CHBACK(ICURS)
      GOTO 100
C
C SELECT THE PLOT COLOR
C
700   CONTINUE
      CALL CHKEND
      CALL SETFG(BGRPPP,ICURS)
      GOTO 100
C
C SELECT THE PLOT SIZE
C
800   CONTINUE
C
      CALL CHKEND
      CALL MAKSIZ(ICURS,XSTPP,XFRCPP,YSTPP,YFRCPP)
      XSTPP=XSTPP*100.
      YSTPP=YSTPP*100.
      XFRCPP=XFRCPP*100.+XSTPP
      YFRCPP=YFRCPP*100.+YSTPP
      GOTO 100
C
C END THE PLOT
C
899   IF (PLTST) THEN
       PLTST = .FALSE.
       CALL PLTFIN
      ENDIF
      GOTO 100
C
C DO THE PLOT
C
900   CONTINUE
      CALL CHKEND
C
C DETERMINE WHETHER THIS IS THE FIRST PLOT.
C
       IF(.NOT. PLTST) THEN 
         PLTST = .TRUE.
         CALL BGNPLT
       ENDIF
       IF(SETBG) THEN
         SETBG = .FALSE.
         CALL SETBAK(BGRP)
       ENDIF
C
C  IF THIS IS A BATCH JOB, DO THE FOLLOWING
C
      IF(INCTRL .NE. 0) THEN
       DO 840 J=1,NLINPP
        IF(TAGPP .EQ. ROWTAG) THEN
         DO 810 I = 1,N
          X(J,I)=XXX(LINXPP(J),I)
810      CONTINUE
        ELSE
         DO 820 I=1,M
          X(J,I)=XXX(I,LINXPP(J))
820      CONTINUE
        ENDIF
        IF(TAGPP .EQ. ROWTAG) THEN
         DO 830 I = 1,N
          IF(MODE1A .EQ. 1) THEN
           Y(J,I)=XXX(LINYPP(J),I)
          ELSE
           Y(J,I)=YYY(LINYPP(J),I)
          ENDIF
830      CONTINUE
        ELSE
         DO 832 I=1,M
          IF(MODE1A .EQ. 1) THEN
           Y(J,I)=XXX(I,LINYPP(J))
          ELSE
           Y(J,I)=YYY(I,LINYPP(J))
          ENDIF
832      CONTINUE
        ENDIF
840    CONTINUE
      ENDIF
C
C FIND THE MAXIMUM RADIUS
C
      IF(INCTRL .EQ. 0) THEN
       RMAX = -1
       DO 905 I = 1,NLINPP
       DO 905 J = 1,NPTSPP
905    RMAX = AMAX1(RMAX,X(I,J))
       IF(MODE1A .EQ. 2) THEN
         DO 906 I = 1,NLINPP
         DO 906 J = 1,NPTSPP
906      RMAX = AMAX1(RMAX,Y(I,J))
       ENDIF
      ENDIF

      DO 920 J = 1,NPTSPP
      XPL(J) = X(1,J)
      YPL(J) = Y(1,J)
920   CONTINUE
      IF(INCTRL .EQ. 0) THEN
       MODEPP(8) = LNSLPP(1)
       MODEPP(7) = FGRPPP(1)
       MODEPP(6) = BGRPPP
       MODEPP(1) = MODE1A + MODE1B
       MODEPP(2) = MODE2A
       CALL SAVPLT(5)
      ENDIF

      CALL MAPSIZ(XSTPP,XFRCPP,YSTPP,YFRCPP,LABEPP)
      CALL POLAR(RMAX,XPL,YPL,IZ,MODEPP,NPTSPP,ISMNPP(1),SMSZPP(1),
     1      NTSMPP(1),LABPP)
      IF(NLINPP .GT. 1) THEN
      WRITE(9,4554)
4554  FORMAT("TAKING MULTI LINE BRANCH")
       MODEPP(1) = MODE1A+2
       MODEPP(3) = 0
       MODEPP(4) = 0
       MODEPP(5) = 0
       MODEPP(6) = 0
       DO 950 I = 2,NLINPP
       DO 940 J = 1,NPTSPP
       XPL(J) = X(I,J)
       YPL(J) = Y(I,J)
940    CONTINUE
       MODEPP(7) = FGRPPP(I)
       MODEPP(8) = LNSLPP(I)
       CALL POLAR(RMAX,XPL,YPL,IZ,MODEPP,NPTSPP,ISMNPP(I),SMSZPP(I),
     1         NTSMPP(I),LABPP)
950    CONTINUE
      ENDIF
      IF(INCTRL .NE. 0)RETURN
      GOTO 100
990   CONTINUE
      RETURN
      END
C
C THIS ROUTINE DETERMINES THE ORDERING AND NUMBER OF LINES ON THE PLOTS
C
C THE VARIABLE IDEF IS A BRANCHING FLAG.  IDEF = 1 OR 2 INDICATES THE
C ROUTINE WAS CALLED FROM XYPLT.  IDEF = 1 INDICATES IMPLICIT X MODE,
C IDEF = 2 INDICATES EXPLICIT X MODE.  IDEF = 3 OR 4 INDICATES THE 
C ROUTINE WAS CALLED FROM POLPLT.  IDEF = 3 INDICATES THAT THE PLOT IS
C TYPE REAL (R-THETA).  IDEF = 4 INDICATES THE PLOT IS TYPE COMPLEX
C (X+IY).

      SUBROUTINE PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAG,NLINES
     1,LINX,LINY,NPTS,IDEF)
      DIMENSION X(10,500),Y(10,500)
      INTEGER M,N,NLINES,LINX(10),LINY(10),NPTS,IDEF
      DIMENSION XXX(M,N),YYY(M,N)
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      CHARACTER*1 ANS
      CHARACTER*4 ROWTAG,COLTAG,TAG,ICURS(2)
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
      DATA ROWTAG /' ROW'/,COLTAG/' COL'/

6     WRITE(WTE,10)M,N,COLOR1,ICURS,COLOR2
      CALL CHKEND
10    FORMAT(1X,"PLOTTING FROM A",I4," ROW BY",I4," COLUMN ARRAY.",/,
     1"SHOULD WE PLOT ALONG ROWS OR COLUMNS?"/,4A4,$)
      IF(WIO .NE. 0)WRITE(WIO,10)M,N,COLOR1,ICURS,COLOR2
      READ(RTE,15)ANS
15    FORMAT(A1)
      IF(WIO .NE. 0) WRITE(WIO,16)ANS
16    FORMAT(1X,A1)
      IF(ANS .NE. 'R' .AND. ANS .NE. 'r' .AND. ANS .NE. 'C' .AND.
     1 ANS .NE. 'c') THEN
       WRITE(WTE,20)COLOR3,COLOR2
20     FORMAT(1X,A4,"ERROR. PLEASE ANSWER WITH ROWS OR COLUMNS",A4)
       IF(WIO .NE. 0) WRITE(WIO,20)COLOR3,COLOR2
       GOTO 6
      ENDIF
      IF(ANS .EQ. 'R' .OR. ANS .EQ. 'r') THEN
       TAG = ROWTAG
       NPTS = N
      ELSE
       TAG = COLTAG
       NPTS = M
      ENDIF
C
C FIND OUT HOW MANY PLOTS TO PREPARE
C
24    WRITE(WTE,25)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,25)COLOR1,ICURS,COLOR2
25    FORMAT(1X,"HOW MANY LINES WILL BE ENTERED ON THIS PLOT?"/,
     14A4,$)
      CALL VALGET(0,NLINES,'I')
      IF(NLINES .GT. 10) THEN
       WRITE(WTE,27)COLOR3,COLOR2
       IF(WIO .NE. 0) WRITE(WIO,27)COLOR3,COLOR2
27     FORMAT(1X,A4,"ERROR. MAXIMUM 10 LINES PER PLOT.",A4)
       GOTO 24
      ENDIF

C
C ASK ABOUT EACH SET OF PLOTS
C
      DO 100 INDEX = 1, NLINES
      IF(IDEF .EQ. 2 .OR. IDEF .EQ. 3 .OR. IDEF .EQ. 4) THEN
26      CONTINUE
        IF(IDEF .EQ. 2) THEN
         WRITE(WTE,30)INDEX,TAG,COLOR1,ICURS,COLOR2
30       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
     1   OF THE X COMPONENT"/,4A4,$)
         IF(WIO .NE. 0) WRITE(WIO,30)INDEX,TAG,COLOR1,ICURS,COLOR2
        ELSE IF(IDEF .EQ. 3) THEN
         WRITE(WTE,31)INDEX,TAG,COLOR1,ICURS,COLOR2
31       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
     1   OF THE RADIAL COMPONENT"/,4A4,$)
         IF(WIO .NE. 0) WRITE(WIO,30)INDEX,TAG,COLOR1,ICURS,COLOR2
        ELSE IF(IDEF .EQ. 4) THEN
         WRITE(WTE,32)INDEX,TAG,COLOR1,ICURS,COLOR2
32       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE ",A4," NUMBER
     1   OF THE COMPLEX VARIABLE"/,4A4,$)
        ENDIF

        CALL VALGET(0,INDEXX,'I')
36      FORMAT(1X,I2)
35      FORMAT(I2)
        IF(TAG .EQ. COLTAG .AND.(INDEXX .GT. N .OR. INDEXX .LT. 1))
     1             THEN
        CALL MENUER(N)
         GOTO 26
        ELSE IF(TAG .EQ. ROWTAG .AND.(INDEXX .GT. M .OR.
     1           INDEXX .LT. 1)) THEN
         CALL MENUER(M)
         GOTO 26
        ENDIF
        LINX(INDEX)=INDEXX
        IF(TAG .EQ. ROWTAG) THEN
         DO 50 I = 1,N
50       X(INDEX,I)=XXX(INDEXX,I)
        ELSE
         DO 52 I=1,M
52       X(INDEX,I)=XXX(I,INDEXX)
        ENDIF
      ELSE
        LINX(INDEX)=0
        IF(TAG .EQ. ROWTAG) THEN
         DO 53 I = 1,N
53       X(INDEX,I)=FLOAT(I)
        ELSE
         DO 54 I=1,M
54       X(INDEX,I)=FLOAT(I)
        ENDIF
      ENDIF
      IF(IDEF .EQ. 1 .OR. IDEF .EQ. 2 .OR. IDEF .EQ. 3)THEN
56      CONTINUE
        IF(IDEF .EQ. 1 .OR. IDEF .EQ. 2) THEN
         WRITE(WTE,60)INDEX,TAG,COLOR1,ICURS,COLOR2
60       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
     1   OF THE Y COMPONENT"/,4A4,$)
         IF(WIO .NE. 0) WRITE(WIO,60)INDEX,TAG,COLOR1,ICURS,COLOR2
        ELSE
         WRITE(WTE,61)INDEX,TAG,COLOR1,ICURS,COLOR2
61       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER OF THE
     1   ANGULAR COMPONENT"/,4A4,$)
         IF(WIO .NE. 0) WRITE(WIO,61)INDEX,TAG,COLOR1,ICURS,COLOR2
        ENDIF
        CALL VALGET(0,INDEXY,'I')
        IF(TAG .EQ. COLTAG .AND.(INDEXY .GT. N .OR. INDEXY .LT. 1)) THEN
         CALL MENUER(N)
         GOTO 56
        ELSE IF(TAG .EQ. ROWTAG .AND. (INDEXY .GT. M .OR.
     1            INDEXY .LT. 1)) THEN
         CALL MENUER(M)
         GOTO 56
        ENDIF
      ENDIF
      LINY(INDEX)=INDEXY
      IF(IDEF .NE. 4) THEN
        IF(TAG .EQ. ROWTAG) THEN
         DO 80 I = 1,N
80       Y(INDEX,I)=XXX(INDEXY,I)
        ELSE
         DO 82 I=1,M
82       Y(INDEX,I)=XXX(I,INDEXY)
        ENDIF
      ELSE
        IF(TAG .EQ. ROWTAG) THEN
          DO 90 I = 1,N
90        Y(INDEX,I) = YYY(INDEXY,I)
        ELSE
          DO 92 I = 1,M
92        Y(INDEX,I) = YYY(I,INDEXY)
        ENDIF
      ENDIF
100   CONTINUE
      RETURN
      END
C
C SET THE LINE SYMBOL OPTIONS
C
      SUBROUTINE LNOPTS(NLINES,SYMSIZ,INTSYM,ISYMNO,LINSYL,ICURS)
      DIMENSION SYMSIZ(10),INTSYM(10),ISYMNO(10),LINSYL(10)
      INTEGER NLINES
      INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
      CHARACTER*1 ANS
      CHARACTER*4 ICURS(2)
      INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
      COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
C
C PLOT SPECIFIC VARIABLES
C
      LOGICAL PLTST,SETBG,BNHERE
      COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE

620   CONTINUE
      WRITE(WTE,625)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0)WRITE(WIO,625)COLOR1,ICURS,COLOR2
625   FORMAT(1X,"PLEASE SELECT A LINE OPTION"/,
     1" [1] CHOOSE LINE SYMBOL TYPE"/,
     2" [2] CHOOSE LINE PATTERN TYPE"/,
     3" [3] RETURN TO PREVIOUS MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (460,660,900),IANS
      CALL MENUER(3)
      GOTO 620
460   CONTINUE
      LSTART = 1
      LEND = 1
      IF(NLINES .GT. 1) THEN
       WRITE(WTE,462)COLOR1,ICURS,COLOR2
       IF(WIO .NE. 0)WRITE(WIO,462)COLOR1,ICURS,COLOR2
       CALL CHKEND
462    FORMAT(1X,"CHOOSE SYMBOLS FOR ALL LINES?"/,4A4,$)
       READ(RTE,463)ANS
463    FORMAT(A1)
       IF(WIO .NE. 0) WRITE(WIO,464)ANS
464    FORMAT(1X,A1)
       IF(ANS .NE. 'Y' .AND. ANS .NE. 'y' .AND. ANS .NE. 'N' .AND.
     1 ANS .NE. 'n') THEN
        WRITE(WTE,465)COLOR3,COLOR2
465     FORMAT(1X,A4,"ERROR. PLEASE ANSWER YES OR NO",A4)
        IF(WIO .NE. 0) WRITE(WIO,465)COLOR3,COLOR2
        GOTO 460
       ENDIF
       IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
        LSTART=1
        LEND=NLINES
       ELSE
466     WRITE(WTE,467)COLOR1,ICURS,COLOR2
        CALL CHKEND
        IF(WIO .NE. 0) WRITE(WIO,467)COLOR1,ICURS,COLOR2
467     FORMAT(1X,"PLEASE CHOOSE THE LINE NUMBER"/,4A4,$)
        CALL VALGET(0,LINENO,'I')
        IF(LINENO .GT. NLINES) THEN
         CALL MENUER(NLINES)
         GOTO 466
        ENDIF
        LSTART = LINENO
        LEND = LINENO
       ENDIF
      ENDIF
      DO 476 I = LSTART,LEND
468   CONTINUE
      WRITE(WTE,469)I,COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO.NE.0) WRITE(WIO,469)I,COLOR1,ICURS,COLOR2
469   FORMAT(1X,"FOR LINE NUMBER ",I2," PLEASE CHOOSE AN OPTION"/,
     1" [1] NO SYMBOL"/,
     2" [2] TRIANGLE"/,
     3" [3] BOX"/,
     4" [4] DIAMOND"/,
     5" [5] HOURGLASS"/,
     6" [6] RETURN TO LINE OPTIONS MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (475,470,470,470,470,900),IANS
       CALL MENUER(6)
       GOTO 468
470   ISYMNO(I)=IANS-1
471   WRITE(WTE,472)COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,472)COLOR1,ICURS,COLOR2
472   FORMAT(1X,"ENTER THE SYMBOL SIZE IN CM
     1 (BLANK LINE = DEFAULT)"/,4A4,$)
      CALL VALGET(SYMSIZ(I),0,'F')
      WRITE(WTE,474)COLOR1,ICURS,COLOR2
      IF(WIO .NE. 0) WRITE(WIO,474)COLOR1,ICURS,COLOR2
474   FORMAT(1X,"ENTER THE SYMBOL INTERVALS"/,4A4,$)
      CALL VALGET(0,INTSYM(I),'I')
      CYCLE
475   ISYMNO(I) = IANS-1
476   CONTINUE
      GOTO 620
660   CONTINUE
      LSTART = 1
      LEND = 1
      IF(NLINES .GT. 1) THEN
       WRITE(WTE,662)COLOR1,ICURS,COLOR2
       CALL CHKEND
       IF(WIO .NE. 0)WRITE(WIO,662)COLOR1,ICURS,COLOR2
662    FORMAT(1X,"CHOOSE LINE STYLES FOR ALL LINES?"/,4A4,$)
       READ(RTE,463)ANS
       IF(WIO .NE. 0) WRITE(WIO,464)ANS
       IF(ANS .NE. 'Y' .AND. ANS .NE. 'y' .AND. ANS .NE. 'N' .AND.
     1 ANS .NE. 'n') THEN
        WRITE(WTE,465)COLOR3,COLOR2
        IF(WIO .NE. 0) WRITE(WIO,465)COLOR3,COLOR2
        GOTO 660
       ENDIF
       IF(ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
        LSTART=1
        LEND=NLINES
       ELSE
666     WRITE(WTE,467)COLOR1,ICURS,COLOR2
        CALL CHKEND
        IF(WIO .NE. 0) WRITE(WIO,467)COLOR1,ICURS,COLOR2
        CALL VALGET(0,LINENO,'I')
        IF(LINENO .GT. NLINES) THEN
         CALL MENUER(NLINES)
         GOTO 666
        ENDIF
        LSTART = LINENO
        LEND = LINENO
       ENDIF
      ENDIF
      DO 675 I = LSTART,LEND
667   WRITE(WTE,668)I,COLOR1,ICURS,COLOR2
      CALL CHKEND
      IF(WIO .NE. 0) WRITE(WIO,668)I,COLOR1,ICURS,COLOR2
668   FORMAT(1X,"FOR LINE NUMBER ",I2," PLEASE CHOOSE A LINE STYLE"/,
     1" [1] SOLID LINE"/,
     2" [2] LONG DASH"/,
     3" [3] SHORT DASH"/,
     4" [4] DOT DASH"/,
     5" [5] RETURN TO LINE OPTIONS MENU"/,4A4,$)
      CALL VALGET(0,IANS,'I')
      GOTO (670,670,670,670,620),IANS
      CALL MENUER(5)
      GOTO 667
670   LINSYL(I)=IANS
675   CONTINUE
      GOTO 620
900   CONTINUE
      RETURN
      END
