home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / matlab.lha / Matlab / matlab.zoo / matlab / src / plot.for < prev   
Encoding:
Text File  |  1989-06-20  |  84.7 KB  |  3,139 lines
  1. C
  2. C   AMIGA PLOT ROUTINE FOR MATLAB.  COPYRIGHT 1988,1989 BY JAMES LOCKER.
  3. C   ALL RIGHTS RESERVED.  THIS PROGRAM FILE MAY NOT BE USED IN WHOLE OR IN 
  4. C   PART FOR ANY COMMERCIAL APPLICATION WITHOUT THE PRIOR WRITTEN PERMISSION
  5. C   OF THE AUTHOR, EXCEPT WHEN SUPPLIED IN COMPILED FORM AS PART OF MATLAB.
  6. C   THIS FILE MAY BE FREELY REDISTRIBUTED SO LONG AS THIS NOTICE IS INTACT.  
  7. C
  8. C   MATLAB WRITTEN BY CLEVE MOLER OF UNIVERSITY OF NEW MEXICO.
  9. C          PUBLIC DOMAIN VERSION ENHANCED BY JAMES LOCKER, SOFTECH INC.
  10. C
  11. C   DIGLIB WRITTEN BY HAL BRAND.
  12. C          PORTED TO AMIGA BY DR. CRAIG WUEST OF LLNL
  13. C          DEBUGGED AND ENHANCED BY JAMES LOCKER, SOFTECH INC.
  14. C
  15. C
  16.       SUBROUTINE PLOT(LOC,M,N,INCTRL)
  17.       INTEGER LOC,M,N,INCTRL,BGRP
  18.       DIMENSION XXX(5005),YYY(5005)
  19. C
  20. C MATLAB SYSTEM VARIABLES
  21. C
  22.       DOUBLE PRECISION STKR(5005),STKI(5005)
  23.       INTEGER IDSTK(4,48),LSTK(48),MSTK(48),NSTK(48),VSIZE,LSIZE,BOT,TOP
  24.       INTEGER IDS(4,32),PSTK(32),RSTK(32),PSIZE,PT,PTZ
  25.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  26.       INTEGER SYM,SYN(4),BUF(256),CHAR,FLP(2),FIN,FUN,LHS,RHS,RAN(2)
  27.       INTEGER ALFA(52),ALFB(52),ALFL,CASE
  28.       INTEGER EPS(4),FLOPS(4),EYE(4),RAND(4)
  29.       INTEGER ALPHA(52),ALPHB(52)
  30.       COMMON /VSTK/ STKR,STKI,IDSTK,LSTK,MSTK,NSTK,VSIZE,LSIZE,BOT,TOP
  31.       COMMON /RECU/ IDS,PSTK,RSTK,PSIZE,PT,PTZ
  32.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  33.       COMMON /COM/ SYM,SYN,BUF,CHAR,FLP,FIN,FUN,LHS,RHS,RAN
  34.       COMMON /ALFS/ ALFA,ALFB,ALFL,CASE
  35.  
  36. C
  37. C PLOT SPECIFIC VARIABLES
  38. C
  39.       INTEGER*4 VAR(4)
  40.       CHARACTER*4 ICURS(2)
  41.       CHARACTER*1 IZ(5000)
  42.       INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
  43.       REAL*4 LABE3D
  44.       CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
  45.       DIMENSION XYLIM(2,6),CAMLOC(3)
  46.       INTEGER*4 FGRPXY(10),ISYMNO(10)
  47.       INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
  48.       DIMENSION SYMSZ(10)
  49.       LOGICAL ISECY,PLTST,SETBG,BNHERE
  50.       CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
  51.       CHARACTER*4 ROWTAG,COLTAG,TAG
  52.       INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport
  53.  
  54.       INTEGER*4 WBST
  55.       COMMON /SYS/ WBST
  56. C
  57. C THE GLOBAL PLOT COMMON
  58. C
  59.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  60. C
  61. C THE 3D PLOT ROUTINE COMMON
  62. C
  63.       COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
  64.      1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
  65. C
  66. C THE XYPLOT ROUTINE COMMON
  67. C
  68.       COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
  69.      1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
  70.      2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
  71.      3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
  72. C
  73. C BARPLT VARIABLES
  74. C
  75.       INTEGER NOBARS,COLIST(8),FGRPBP(8)
  76.       REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
  77.       DIMENSION FIMX(8)
  78.       CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
  79.       LOGICAL ISCYBP,STATBP
  80.       INTEGER IMXC
  81.       REAL*4  FBAR,YLOWBP,YHIBP
  82. C
  83. C THE BARPLOT COMMON
  84.       COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
  85.      1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
  86.      2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
  87.      3 SYOPBP
  88. C
  89. C THE CONTOUR PLOT VARIABLES
  90. C
  91.       CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
  92.       DIMENSION CNLCP(20)
  93.       REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
  94.       REAL YMXCP
  95.       INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
  96.       COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
  97.      1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
  98.      2 ,ICNNCP,CNLCP,LBSZCP
  99. C
  100. C THE POLAR PLOT VARIABLES
  101. C
  102.       DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
  103.       DIMENSION LNSLPP(10)
  104.       INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
  105.       CHARACTER*1 LABPP(80)
  106.       INTEGER*2 MODEPP(8)
  107.       REAL XSTPP,YSTPP,XFRCPP,YFRCPP
  108.       REAL RMAX
  109.       CHARACTER*4 TAGPP
  110.       INTEGER NLINPP
  111.       COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
  112.      1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
  113.      2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
  114. C
  115. C PLOT SAVE VARIABLES
  116. C 
  117.       INTEGER PLTCNT,PLTMAX
  118.       CHARACTER*1 ISAV(10,720),QUOT,BUFFF(4,32)
  119.       CHARACTER*4 NAME(32)
  120.       CHARACTER*1 NAME2(128)
  121.       EQUIVALENCE (BUFFF,BUF),(NAME,NAME2)
  122. C
  123. C
  124. C THE PLTSAV COMMON
  125. C
  126.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  127. C
  128. C DIGLIB AND AMIGA SYSTEM VARIABLES, COMMONS, STRUCTURES
  129. C
  130.       EXTERNAL LEN
  131.       INCLUDE GRAPH.INC
  132.       INCLUDE EXEC.INC
  133.       INCLUDE INTUIT.INC
  134.       INCLUDE GCBIG.PRM
  135. C
  136.  
  137.       DATA (ICURS(I),I=1,2)/'Plot','  >>'/,QUOT/1H'/
  138.  
  139. C
  140. C ESTABLISH DEFAULTS
  141. C
  142.       COLOR1=Z'9B33336D'
  143.       COLOR2=Z'9B30306D'
  144.       COLOR3=Z'9B33326D'
  145.       BGRP = 0
  146.       SETBG = .FALSE.
  147.       IF(PLTMAX .EQ. 0) THEN
  148.        PLTCNT = 0
  149.        DO 2 I=1,10
  150.        DO 2 J=1,720
  151. 2      ISAV(I,J)=Z'20'
  152.        DO 3 I=1,10
  153. 3      IPLTYP(I)=0
  154.       ENDIF
  155. C
  156. C IF WE ARE INTERACTIVE, ISSUE STACK WARNING TO PREVENT CRASHES,
  157. C UNLESS WE STARTED FROM WORKBENCH OR HAVE BEEN HERE BEFORE.
  158. C
  159.       IF(.NOT. PLTST .AND. (INCTRL .EQ. 0) .AND. (WBST .EQ. 0)
  160.      1 .AND. .NOT. BNHERE) THEN
  161.       WRITE(WTE,10)COLOR3,COLOR1,ICURS,COLOR2
  162.       IF(WIO.NE.0) WRITE(WIO,10)COLOR3,COLOR1,ICURS,COLOR2
  163. 10    FORMAT(1X,"ENTERING PLOT."//,A4,"WARNING...HAS THE STACK SIZE
  164.      1 BEEN SET TO AT LEAST 100K?"/,4A4,$)
  165.       READ(WTE,11)ANS
  166. 11    FORMAT(A1)
  167.       IF(WIO .NE. 0) WRITE(WIO,12)ANS
  168. 12    FORMAT(1X,A1)
  169.       IF(ANS .NE. 'Y' .AND. ANS .NE. 'y') THEN
  170.        WRITE(WTE,901)
  171.        IF(WIO .NE. 0) WRITE(WIO,901)
  172.        RETURN
  173.       ENDIF
  174.       ENDIF
  175.       BNHERE = .TRUE.
  176. C
  177. C     START THE PLOTS
  178. C
  179.       ISRC=0
  180.       DO 70 J=LOC,LOC+N*M-1
  181.       XX = STKR(J)
  182.       XXX(J-LOC+1) = SNGL(XX)
  183.       XX = STKI(J)
  184.       YYY(J-LOC+1) = SNGL(XX)
  185. 70    CONTINUE
  186. C
  187. C SET THE PLOT SCREEN TITLE
  188. C
  189.       w_title = "Matlab Plots"//CHAR(0)
  190. C
  191. C SELECT THE PLOT DEVICE
  192. C
  193.       IF (.NOT. PLTST) CALL DEVSEL(1,NDUM,IERR)
  194. C
  195. C FIND OUT IF THIS IS A BATCH JOB USING SAVED PLOT DEFINITIONS
  196. C IF SO, EXTRACT THE SAVED FILE NAME AND SHIP IT TO LODFIL
  197. C
  198.       IF(INCTRL .EQ. 1)THEN
  199.       DO 45 I=1,128
  200. 45    NAME2(I)=Z'20'
  201.        ISRC = 2
  202.        DO 22 IK=1,32
  203.        IF(BUFFF(1,IK) .NE.QUOT)CYCLE
  204.        GOTO 27
  205. 22     CONTINUE
  206. 27     CONTINUE
  207.        DO 23 JK=IK+1,32
  208.        IF(BUFFF(1,JK) .EQ. QUOT)GOTO 24
  209.        NAME(JK-IK)=BUF(JK)
  210. 23     CONTINUE
  211. 24     CONTINUE
  212.        GOTO 800
  213.       ENDIF
  214. C
  215. 75    CONTINUE
  216.       ISRC = 0
  217.       CALL CHKEND
  218.       WRITE(WTE,80)
  219. 80    FORMAT(1X,//"PLEASE SELECT AN OPTION",/,
  220.      1" [1]  3-D PLOT",/,
  221.      2" [2]  X-Y PLOT",/,
  222.      3" [3]  POLAR  PLOT",/,
  223.      5" [4]  CONTOUR PLOT",/,
  224.      6" [5]  HISTOGRAM",/,
  225.      4" [6]  SET BACKGROUND COLOR",/,
  226.      7" [7]  PLOT BUFFER CONTROL",/,
  227.      8" [8]  READ PLOT FILE")
  228.       WRITE(WTE,81)COLOR1,ICURS,COLOR2
  229. 81    FORMAT(1X,
  230.      1"[9]  END THE CURRENT PLOT"/,
  231.      1 " [10] EXIT TO MATLAB",/,
  232.      2 4A4,$)
  233.       IF(WIO .NE. 0) THEN
  234.         WRITE(WIO,80)
  235.         WRITE(WIO,81)
  236.       ENDIF
  237.       CALL VALGET(0,ICHOICE,'I')
  238.       GOTO(100,200,300,500,600,400,700,800,899,900),ICHOICE
  239.       CALL MENUER(10)
  240.       GOTO 75
  241. 100   CALL D3PLOT(XXX,M,N,ISRC,IERR,IZ)
  242.       GOTO 75
  243. 200   CALL XYPLT(XXX,M,N,ISRC,IERR)
  244.       GOTO 75
  245. 300   CALL POLPLT(XXX,YYY,M,N,ISRC,IERR,IZ)
  246.       GOTO 75
  247. 400   CONTINUE
  248.       CALL CHBACK(ICURS)
  249.       GOTO 75
  250. 500   CONTINUE
  251.       CALL CONTUR(XXX,M,N,ISRC,IERR,IZ)
  252.       GOTO 75
  253. 600   CONTINUE
  254.       CALL BARPLT(XXX,M,N,ISRC,IERR)
  255.       GOTO 75
  256. 700   CONTINUE
  257.       IF(PLTCNT .EQ. 0) PLTCNT=PLTMAX
  258.       CALL PLCTRL(XXX,YYY,M,N,IZ)
  259.       GOTO 75
  260. 800   CONTINUE
  261.       CALL LODFIL(XXX,YYY,M,N,NAME,ISRC,IERR,IZ)
  262.       GOTO 75
  263. 899   IF (PLTST) THEN
  264.        PLTST = .FALSE.
  265.        CALL PLTFIN
  266.       ENDIF
  267.       GOTO 75
  268. 900   WRITE(WTE,901)
  269. 901   FORMAT(1X,"EXITING PLOT FUNCTION")
  270.       IF(WIO .NE. 0) WRITE(WIO,901)
  271.       GOTO 999
  272.  
  273. C
  274. C   FIND THE VARIABLE IN THE STACKS
  275. C
  276. 107   CONTINUE
  277. C      VARKEP = 0
  278. C      DO 345 J = 1,48
  279. C      DO 344 K = 1,4
  280. C      IF (VAR(K) .NE. IDSTK(K,J))GOTO 346
  281. C 344  CONTINUE
  282. C      VARKEP = J
  283. C 346  CONTINUE
  284. C 345  CONTINUE
  285. C      IF(VARKEP .EQ. 0) GOTO 90
  286. C      M=MSTK(VARKEP)
  287. C      N=NSTK(VARKEP)
  288. C      L=LSTK(VARKEP)
  289. C      WRITE(WTE,321)M,N,L
  290. C321   FORMAT(1X,"FOUND THE VARIABLE.  IT IS A ",I3," BY ",I3
  291. C     1," MATRIX LOCATED AT ",I4," IN STKR")
  292. C      MN=M*N-1
  293. C      DO 444 J=0,MN
  294. C      WRITE(WTE,322)STKR(L+J)
  295. C322   FORMAT(1X,"THE VALUES ARE: ",D10.3)
  296. C444   CONTINUE
  297. C      GOTO 91
  298. C90    WRITE(WTE,654)
  299. C654   FORMAT(1X,"FAILED TO FIND THE VARIABLE")
  300. C91    CONTINUE
  301. C
  302.  
  303. 999   CONTINUE
  304.       IF (.NOT. PLTST) CALL RLSDEV
  305.       RETURN
  306.       END
  307. C
  308. C THE 3D PLOTTING ROUTINE
  309. C
  310.       SUBROUTINE D3PLOT(XXX,M,N,INCTRL,IOCTRL,IZ)
  311.       INTEGER M,N
  312.       DIMENSION XXX(M,N)
  313.       INTEGER INCTRL,IOCTRL
  314.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  315.       INTEGER*4 COLOR1,COLOR2,COLOR3,FGRP3D,CHOICE,MARPLT
  316.       CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
  317.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  318.  
  319. C
  320. C PLOT SPECIFIC VARIABLES
  321. C
  322.  
  323.       DIMENSION XYLIM(2,6),CAMLOC(3)
  324.       CHARACTER*1 IZ(5000)
  325.       LOGICAL PLTST,SETBG,BNHERE
  326.       CHARACTER*4 ICURS(2)
  327.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST
  328.      1,SETBG,BNHERE
  329.       REAL LABE3D,LABSIZ
  330.       COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
  331.      1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
  332. C
  333.       DATA (ICURS(I),I=1,2)/'3DPl','ot>>'/
  334. C
  335. C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
  336. C
  337.       IF(INCTRL .NE. 0) GOTO 900
  338. C
  339. C SET UP THE DEFAULTS
  340. C
  341.       DO 25 I=1,80
  342.       XLAB3D(I)=Z'20'
  343.       YLAB3D(I)=Z'20'
  344. 25    ZLAB3D(I)=Z'20'
  345.       LABE3D=0
  346.       XST3D=0
  347.       YST3D=0
  348.       XFRC3D=1
  349.       YFRC3D=1
  350.       XYLIM(1,1)=0
  351.       XYLIM(2,1)=M
  352.       XYLIM(1,2)=0
  353.       XYLIM(2,2)=N
  354.       XYLIM(1,4)=0.0
  355.       XYLIM(2,4)=0.0
  356.       XYLIM(1,6)=XST3D
  357.       XYLIM(2,6)=YST3D
  358.       CAMLOC(1)=2000.
  359.       CAMLOC(2)=45
  360.       CAMLOC(3)=30
  361.       FGRP3D=1
  362.       IOCTRL=0
  363.       MARPLT = 0
  364.       XMAX = GSXLCM()
  365.       YMAX = GSYLCM()
  366.       XYLIM(1,5) = XMAX
  367.       XYLIM(2,5) = YMAX * .9
  368.       MN=M*N
  369. C      write(WTE,657)((XXX(J,K),J=1,M ),K=1,N)
  370. C657   FORMAT(1X,F10.2)
  371.  
  372.       CALL MINMAX(XXX,MN,ZMIN,ZMAX)
  373.       XYLIM(1,3)=ZMIN
  374.       XYLIM(2,3)=ZMAX
  375. C
  376. C DETERMINE THE CHOICES
  377. C
  378. C75    CONTINUE
  379.        CALL CHKEND
  380. C      WRITE(WTE,76)COLOR1,ICURS,COLOR2
  381. C76    FORMAT(1X,"USE THE DEFAULT VALUES?",/4A4,$)
  382. C      READ(RTE,80)ANS
  383. C80    FORMAT(A1)
  384. C      IF(ANS .EQ.'N' .OR. ANS .EQ. 'n') THEN
  385. C      GOTO 100
  386. C      ELSE IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
  387. C      GOTO 900
  388. C      ELSE
  389. C      WRITE(WTE,87)COLOR3,COLOR2
  390. C      IF(WIO .NE. 0)WRITE(WIO,87)COLOR3,COLOR2
  391. C87    FORMAT(1X,A4,"ERROR. PLEASE ANSWER YES (Y) OR NO (N)",A4)
  392. C      GOTO 75
  393. C      ENDIF
  394. 100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
  395.       CALL CHKEND
  396.       IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
  397. 101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
  398.      1 " [1] CHOOSE PLOT LABELS"/,
  399.      2 " [2] CHOOSE PLOT VALUES"/,
  400.      3 " [3] CHOOSE VIEWER PERSPECTIVE"/,
  401.      4 " [4] CHOOSE HIDDEN LINES OPTIONS"/,
  402.      5 " [5] CHOOSE PLOT COLOR"/,
  403.      6 " [6] CHOOSE PLOT SIZE"/,
  404.      7 " [7] DO THE PLOT"/,
  405.      8 " [8] END THE CURRENT PLOT"/,
  406.      8 " [9] EXIT 3D PLOT"/,
  407.      94A4,$)
  408.       CALL VALGET(0,CHOICE,'I')
  409.       GOTO(200,300,400,500,700,800,900,899,990),CHOICE
  410.       CALL MENUER(9)
  411.       GOTO 100
  412. C
  413. C  SELECT THE LABELS
  414. C
  415. 200   CONTINUE
  416.       CALL CHKEND
  417.       WRITE(WTE,201)COLOR1,ICURS,COLOR2
  418. 201   FORMAT(1X,//"ENTER THE X AXIS LABEL"/,4A4,$)
  419.       IF(WIO .NE. 0)WRITE(WIO,201)COLOR1,ICURS,COLOR2
  420.       CALL GETLAB(XLAB3D)
  421.       WRITE(WTE,202)COLOR1,ICURS,COLOR2
  422.       IF(WIO .NE. 0)WRITE(WIO,202)COLOR1,ICURS,COLOR2
  423. 202   FORMAT(1X,//"ENTER THE Y AXIS LABEL"/,4A4,$)
  424.       CALL GETLAB(YLAB3D)
  425.       WRITE(WTE,203)COLOR1,ICURS,COLOR2
  426.       IF(WIO .NE. 0) WRITE(WIO,203)COLOR1,ICURS,COLOR2
  427.       CALL GETLAB(ZLAB3D)
  428. 203   FORMAT(1X,//"ENTER THE Z AXIS LABEL"/,4A4,$)
  429.       WRITE(WTE,204)COLOR1,ICURS,COLOR2
  430.       IF(WIO .NE. 0) WRITE(WIO,204)COLOR1,ICURS,COLOR2
  431. 204   FORMAT(1X,//"ENTER THE SIZE OF THE LABELS (CM)"/,A4
  432.      1 ,4A4,$)
  433.       CALL VALGET(LABSIZ,0,'F')
  434.       IF(LABSIZ .NE. 0) LABE3D = LABSIZ
  435.       GOTO 100
  436. C
  437. C SELECT THE DATA
  438. C
  439. 300   CONTINUE
  440.       CALL CHKEND
  441.       WRITE(WTE,301)COLOR1,ICURS,COLOR2
  442. 301   FORMAT(1X,"ENTER THE MINIMUM VALUE OF X"/,4A4,$)
  443.       IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
  444.       CALL VALGET(XYLIM(1,1),0,'F')
  445.       WRITE(WTE,302)COLOR1,ICURS,COLOR2
  446. 302   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF X"/,4A4,$)
  447.       IF(WIO .NE. 0)WRITE(WIO,302)COLOR1,ICURS,COLOR2
  448.       CALL VALGET(XYLIM(2,1),0,'F')
  449.       WRITE(WTE,303)COLOR1,ICURS,COLOR2
  450. 303   FORMAT(1X,"ENTER THE MINIMUM VALUE OF Y"/,4A4,$)
  451.       IF(WIO .NE. 0)WRITE(WIO,303)COLOR1,ICURS,COLOR2
  452.       CALL VALGET(XYLIM(1,2),0,'F')
  453.       WRITE(WTE,304)COLOR1,ICURS,COLOR2
  454. 304   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF Y"/,4A4,$)
  455.       IF(WIO .NE. 0)WRITE(WIO,304)COLOR1,ICURS,COLOR2
  456.       CALL VALGET(XYLIM(2,2),0,'F')
  457.       WRITE(WTE,305)COLOR1,ICURS,COLOR2
  458. 305   FORMAT(1X,"ENTER THE X/Z LENGTH RATIO"/,4A4,$)
  459.       IF(WIO .NE. 0)WRITE(WIO,305)COLOR1,ICURS,COLOR2
  460.       CALL VALGET(XYLIM(1,4),0,'F')
  461.       WRITE(WTE,306)COLOR1,ICURS,COLOR2
  462. 306   FORMAT(1X,"ENTER THE Y/Z LENGTH RATIO"/,4A4,$)
  463.       IF(WIO .NE. 0)WRITE(WIO,306)COLOR1,ICURS,COLOR2
  464.       CALL VALGET(XYLIM(2,4),0,'F')
  465.       GOTO 100
  466. C
  467. C DEFINE THE VIEWER PERSPECTIVE
  468. C
  469. 400   CONTINUE
  470.       CALL CHKEND
  471.       WRITE(WTE,430)COLOR1,ICURS,COLOR2
  472.       IF(WIO .NE. 0) WRITE(WIO,430)COLOR1,ICURS,COLOR2
  473. 430   FORMAT(1X,"ENTER THE DISTANCE OF THE OBSERVER FROM THE"/,
  474.      1 "CENTER OF THE PICTURE (SAME UNITS AS Z)"/,4A4,$)
  475.       CALL VALGET(CAMLOC(1),0,'F')
  476.       WRITE(WTE,431)COLOR1,ICURS,COLOR2
  477.       IF(WIO .NE. 0) WRITE(WIO,431)COLOR1,ICURS,COLOR2
  478. 431   FORMAT(1X,"ENTER THE ANGLE BETWEEN THE VIEWER AND THE"/
  479.      1 ," X-AXIS"/,4A4,$)
  480.       CALL VALGET(CAMLOC(2),0,'F')
  481.       WRITE(WTE,432)COLOR1,ICURS,COLOR2
  482.       IF(WIO .NE. 0) WRITE(WIO,432)COLOR1,ICURS,COLOR2
  483. 432   FORMAT(1X,"ENTER THE ANGLE BETWEEN THE VIEWER AND THE"/
  484.      1," X-Z PLANE"/,4A4,$)
  485.       CALL VALGET(CAMLOC(3),0,'F')
  486.       GOTO 100
  487. C
  488. C CHOOSE THE HIDDEN LINE DRAWING MODE
  489. C
  490. 500   CONTINUE
  491.       CALL CHKEND
  492. 507   WRITE(WTE,508)COLOR1,ICURS,COLOR2
  493.       IF(WIO .NE. 0) WRITE(WIO,508)COLOR1,ICURS,COLOR2
  494. 508   FORMAT(1X,//"SELECT THE DRAWING MODE"/,
  495.      1 " [1] DRAW ALL LINES, HIDDEN OR NOT"/,
  496.      2 " [2] SUPPRESS HIDDEN LINES, BUT DRAW TOP AND BOTTOM"/,
  497.      3 "     OF THE SURFACE"/,
  498.      4 " [3] SUPPRESS HIDDEN LINES, AS WELL AS ALL LINES SHOWING THE"/,
  499.      5 "     BOTTOM OF THE SURFACE"/,
  500.      6 4A4,$)
  501.       CALL VALGET(0,MARPLT,'I')
  502.       GOTO (515,515,525)MARPLT
  503.       CALL MENUER(3)
  504.       GOTO 507
  505. 515   MARPLT = MARPLT - 1
  506. 525   CONTINUE
  507.  
  508.       GOTO 100
  509. C
  510. C SELECT THE PLOT COLOR
  511. C
  512. 700   CONTINUE
  513.       CALL CHKEND
  514.       CALL SETFG(FGRP3D,ICURS)
  515.       GOTO 100
  516. C
  517. C SELECT THE PLOT SIZE
  518. C
  519. 800   CONTINUE
  520. C
  521.       CALL CHKEND
  522.       CALL MAKSIZ(ICURS,XST3D,XFRC3D,YST3D,YFRC3D)
  523.       XYLIM(1,6)=XST3D*XMAX
  524.       XYLIM(2,6)=YST3D*YMAX
  525.       XYLIM(1,5)=XFRC3D*XMAX
  526.       XYLIM(2,5)=YFRC3D*YMAX
  527.       GOTO 100
  528. 899   IF (PLTST) THEN
  529.        PLTST = .FALSE.
  530.        CALL PLTFIN
  531.       ENDIF
  532.       GOTO 100
  533. C
  534. C DO THE PLOT
  535. C
  536. 900   CONTINUE
  537.       CALL CHKEND
  538. C
  539. C SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
  540. C
  541.       IF(INCTRL .EQ. 0) CALL SAVPLT(1)
  542.       IF (.NOT. PLTST)THEN
  543.        PLTST = .TRUE.
  544.        CALL BGNPLT
  545.       ENDIF
  546.       IF(SETBG) THEN
  547.        SETBG = .FALSE.
  548.        CALL SETBAK(BGRP)
  549.       ENDIF
  550.       CALL GSCOLR(FGRP3D,IERR)
  551. C       DO 940 I=1,6
  552. C       WRITE(WTE,950)XYLIM(1,I),XYLIM(2,I)
  553. C 950   FORMAT(1X,2F10.3)
  554. C 940   CONTINUE
  555. C       WRITE(WTE,960)(CAMLOC(I),I=1,3)
  556. C 960   FORMAT(1X,"CAMLOC:",3F8.2)
  557. C      WRITE(WTE,962)M,N,MARPLT
  558. C962   FORMAT(3I4)
  559.       CALL PURJOY(XXX,M,IZ,M,N,CAMLOC,XYLIM,XLAB3D,YLAB3D,
  560.      *ZLAB3D,LABE3D,MARPLT)
  561.       IF(INCTRL .NE. 0)RETURN
  562.       GOTO 100
  563. 990   CONTINUE
  564.       RETURN
  565.       END
  566. C
  567. C  ROUTINE TO BRING IN AN ASCII STRING.  IF A BLANK LINE IS ENTERED,
  568. C  THE INPUT STRING IS UNCHANGED.
  569. C
  570.       SUBROUTINE GETLAB(LAB1)
  571.       CHARACTER*1 LAB1(80),LAB(80),RTN
  572.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  573.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  574.       DATA RTN/Z'0A'/
  575.  
  576.       DO 2 I=1,80
  577. 2     LAB(I)=Z'20'
  578.       INDEX = 80
  579.       READ(RTE,4)(LAB(I),I=1,80)
  580. 4     FORMAT(80A1)
  581. C2     WRITE(WTE,13)(LAB(I),I=1,80)
  582. C13    FORMAT(1X,80Z2)
  583.       IF(WIO .NE. 0) WRITE(WIO,6)(LAB(I),I=1,80)
  584. 6     FORMAT(1X,80A1)
  585.       LABTAG=0
  586.       DO 23 I=1,80
  587.       IF(LAB(I) .NE. ' ') THEN
  588.        LABTAG=1
  589.        GOTO 24
  590.       ENDIF
  591. 23    CONTINUE
  592. 24    CONTINUE
  593.       IF(LABTAG .NE. 0) THEN
  594.        DO 7 I=1,80
  595. 7      LAB1(I)=LAB(I)
  596. 8      CONTINUE
  597.        IF (LAB1(INDEX) .NE. ' ' .OR. INDEX .LE. 0) GOTO 9
  598.           INDEX = INDEX - 1
  599.        GOTO 8
  600. 9       LAB1(INDEX+1)=Z'00'
  601.       ENDIF
  602. C      WRITE(WTE,13)(LAB1(I),I=1,80)
  603.       RETURN
  604.       END
  605. C
  606. C ROUTINE TO BRING IN A NUMERIC VALUE IN FREE FORMAT
  607. C X IS THE FLOATING POINT VERSION WHICH IS RETURNED
  608. C INTEG IS THE INTEGER VERSION WHICH IS RETURNED
  609. C IVAL IS A CONTROL CODE TELLING WHETHER OR NOT A FLOATING POINT VALUE
  610. C  IS EXPECTED.
  611. C
  612.       SUBROUTINE VALGET(X,INTEG,IVAL)
  613.       REAL X
  614.       INTEGER INTEG
  615.       CHARACTER*1,IVAL,A(80),NULL
  616.       INTEGER INTX(80)
  617.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  618.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  619.       DATA NULL/Z'00'/
  620. C
  621.       DO 40 I=1,80
  622. 40    A(I)=Z'20'
  623. C
  624. C CHECK IF THE CURRENT PLOT IS DONE
  625. C THIS IS MERELY THE MOST CONVENIENT PLACE TO DO IT
  626. C
  627.       CALL CHKEND
  628. C
  629. C GET THE TERMINAL INPUT STRING
  630. C
  631.       CALL GETLAB(A)
  632. C
  633. C TEST FOR A BLANK INPUT LINE
  634. C IF SO, RETURN (DON'T CHANGE THE INPUT VALUE)
  635. C
  636.       DO 1 I = 1,80
  637.       IF(A(I) .NE. ' ')GOTO 2
  638. 1     CONTINUE
  639.       RETURN
  640. 2     CONTINUE
  641.       INTEG = 0
  642.       X = 0
  643. C
  644. C TEST FOR LEADING BLANKS AND LOOK FOR A NEGATIVE SIGN
  645. C
  646. C      WRITE(WTE,342)(A(I),I=1,80)
  647. C342   FORMAT(1X,80Z2)
  648.       ICOUNT = 1
  649.       ISIGN = 1
  650. 3     CONTINUE
  651.       IF(A(ICOUNT) .EQ. ' ' .AND. ICOUNT .LE. 80) THEN
  652.        ICOUNT = ICOUNT + 1
  653. C       WRITE(WTE,657)
  654. C657    FORMAT(1X,'FOUND A LEADING BLANK')
  655.        GOTO 3
  656.       ENDIF
  657.       IF(A(ICOUNT) .EQ. '-') THEN
  658.        ISIGN = -1
  659.        ICOUNT = ICOUNT + 1
  660. C       WRITE(WTE,546)ICOUNT
  661. C546    FORMAT(1X,'FOUND A NEGATIVE SIGN',I2)
  662.       ENDIF
  663.       ISTART=ICOUNT
  664. C
  665. C NOW RESOLVE THE INTEGER PORTION OF THE NUMBER.  STOP AT END OF STRING
  666. C OR AT A DECIMAL POINT.
  667. C
  668. 4     CONTINUE
  669.       IF(A(ICOUNT) .NE. '.' .AND. A(ICOUNT) .NE. NULL .AND. ICOUNT
  670.      1   .LE.80) THEN
  671.        INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
  672.        ICOUNT = ICOUNT+1
  673.        GOTO 4
  674.       ENDIF
  675.       ICOUNT = ICOUNT-1
  676. C      WRITE(WTE,7)ICOUNT
  677. C7     FORMAT(1X,'ICOUNT=',I2)
  678.       DO 5 J=ISTART,ICOUNT
  679. 5      INTEG = INTEG+INTX(J) * 10**(ICOUNT-J)
  680.       INTEG=INTEG*ISIGN
  681. C      WRITE(WTE,10)INTEG
  682. C10    FORMAT(1X,I6)
  683. C
  684. C SEE IF THIS IS NUMBER HAS A FRACTIONAL PORTION.  IF SO,
  685. C RESOLVE ITS VALUE AND RETURN IT AS PART OF THE FLOATING
  686. C POINT NUMBER.
  687. C
  688.       ICOUNT = ICOUNT+1
  689.       FRAC = 0.
  690.       IF(IVAL .EQ. 'F' .AND. A(ICOUNT) .EQ. '.') THEN
  691.        ICOUNT = ICOUNT+1
  692.        IFCOUN = ICOUNT
  693. 20     CONTINUE
  694.        IF(A(ICOUNT) .NE. NULL .AND. ICOUNT .LE. 80) THEN
  695.         INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
  696.         ICOUNT = ICOUNT+1
  697.         GOTO 20
  698.        ENDIF
  699.        ICOUNT = ICOUNT - 1
  700.        DO 25 J=IFCOUN,ICOUNT
  701.         EX = FLOAT(IFCOUN-J-1)
  702.         BAS = FLOAT(INTX(J))
  703. 25      FRAC = FRAC+ BAS * 10.** EX
  704.       ENDIF
  705.       FSIGN = ISIGN
  706.       FRAC = FRAC*FSIGN
  707.       X=FLOAT(INTEG)+FRAC
  708.  
  709. C      WRITE(WTE,30)X,FRAC
  710. C30    FORMAT(1X,'X=',2F10.4)
  711.       RETURN
  712.       END
  713.  
  714. C
  715. C ERROR ROUTINE FOR WRONG PLOT COLOR SELECTION
  716. C
  717.       SUBROUTINE PENERR
  718.       INTEGER*4 COLOR1,COLOR2,COLOR3
  719.       LOGICAL PLTST,SETBG,BNHERE
  720.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  721.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  722.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  723.       WRITE(WTE,5)COLOR3,COLOR2
  724. 5     FORMAT(1X,A4,"ERROR.  COLOR NUMBER MUST BE BETWEEN 0 AND 15",A4,/)
  725.       IF(WIO .NE. 0)WRITE(WIO,5)COLOR3,COLOR2
  726.       RETURN
  727.       END
  728. C
  729. C  ROUTINE TO SET RASTPORT BACKGROUND COLOR
  730. C
  731.       SUBROUTINE SETBAK(BGRP)
  732.       INTEGER*4 BGRP,amiga,Window,Screen,viewport,WIDTH,HEIGHT,ICOLOR
  733.       EXTERNAL LEN
  734.       INCLUDE WINDOW.INC
  735.       INCLUDE GRAPH.INC
  736.       INCLUDE EXEC.INC
  737.       INCLUDE INTUIT.INC
  738. C
  739. C  DIGLIB WON'T LET US SET THE BACKGROUND IN THE AMIGA RASTPORT.  THEREFORE
  740. C  WE MUST MAKE A DIRECT CALL TO AMIGA GRAPHICS ROUTINES HERE.  IF PORTED TO
  741. C  ANOTHER MACHINE, THIS SEGMENT MUST BE DEFEATED.  I MIGHT FIX DIGLIB LATER.
  742. C          J. LOCKER 11/29/88
  743. C
  744. C      write(WTE,967)BGRP
  745. C967   format(1x,'here I am',i3)
  746.        CALL amiga(SetRast,long(Window+wd_RPort),BGRP)
  747.        RETURN
  748.        END
  749. C
  750. C THE GENERAL X-Y PLOTTING ROUTINE
  751. C
  752.       SUBROUTINE XYPLT(XXX,M,N,INCTRL,IOCTRL)
  753.       INTEGER M,N
  754.       DIMENSION XXX(M,N)
  755.       INTEGER INCTRL,IOCTRL
  756.       DIMENSION X(10,500),Y(10,500),XPL(500),YPL(500)
  757.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  758.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP,FGRPXY(10),ISYMNO(10)
  759.       INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
  760.       DIMENSION SYMSZ(10)
  761.       LOGICAL ISECY
  762.       CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
  763.       CHARACTER*4 ROWTAG,COLTAG,TAG,ICURS(2)
  764.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  765. C
  766. C PLOT SPECIFIC VARIABLES
  767. C
  768.       LOGICAL PLTST,SETBG,BNHERE
  769.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  770.       COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
  771.      1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
  772.      2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
  773.      3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
  774.  
  775.       DATA ROWTAG/' ROW'/,COLTAG/' COL'/,(ICURS(I),I=1,2)/'XYPl','ot>>'/
  776. C
  777. C FIND OUT WHO CALLED US
  778. C
  779.       IF(INCTRL .NE. 0) GOTO 800
  780. C
  781. C SET UP THE DEFAULTS
  782. C
  783.       ISECY = .FALSE.
  784.       CHRSIZ = 0
  785.       ISYOPT = 0
  786.       IAXSPN = 1
  787.       DO 1 I=1,80
  788.       XLABXY(I)=' '
  789.       YLABXY(I)=' '
  790.       SYLBXY(I)=' '
  791.       LABXY(I) =' '
  792. 1     CONTINUE
  793.       XLABXY(2)=Z'00'
  794.       YLABXY(2)=Z'00'
  795.       SYLBXY(2)=Z'00'
  796.       LABXY(2)=Z'00'
  797.       IPLTP1 = 0
  798.       IPLTP2 = 0
  799.       IPLTP3 = 0
  800.       NLINES = 0
  801.       DO 2 I = 1,10
  802.       LINSYL(I)=1
  803.       SYMSZ(I)=.2
  804.       INTSYM(I)=5
  805.       ISYMNO(I)=0
  806. 2     FGRPXY(I)=I+1
  807.       XLIM = GSXLCM()
  808.       YLIM = GSYLCM()
  809.       XSTXY = 0.
  810.       YSTXY = 0.
  811.       XFRCXY = 100.
  812.       YFRCXY = 95
  813. C
  814. C CHOOSE THE PLOT MODE 
  815. C
  816.       CALL CHKEND
  817. 7     WRITE(WTE,3)COLOR1,ICURS,COLOR2
  818.       IF(WIO .NE. 0)WRITE(WIO,3)COLOR1,ICURS,COLOR2
  819. 3     FORMAT(1X,"PLEASE CHOOSE THE X-Y PLOT MODE:"/,
  820.      1" [1] IMPLICIT X, EXPLICIT Y"/,
  821.      2" [2] EXPLICIT X, EXPLICIT Y"/,4A4,$)
  822.       CALL VALGET(0,IDEFXY,'I')
  823.       GOTO(4,4),IDEFXY
  824.       CALL MENUER(2)
  825.       GOTO 7
  826. 4     CONTINUE
  827. C
  828. C DO AN ERROR TEST
  829. C
  830.       IF((M .EQ. 1 .OR. N .EQ. 1) .AND. IDEFXY .EQ. 2) THEN
  831.        WRITE(WTE,5)COLOR3,COLOR2
  832. 5      FORMAT(1X,A4,"ERROR.  ARRAY IS ONE DIMENSIONAL. INSUFFICIENT",/,
  833.      1 1X,"INFORMATION TO DO AN EXPLICIT X EXPLICIT Y PLOT",A4)
  834.        IF(WIO .NE. 0) WRITE(WIO,5)COLOR3,COLOR2
  835.        RETURN
  836.       ENDIF
  837. C
  838. C DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
  839. C
  840.       CALL PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAG,NLINES
  841.      1,LINXYX,LINXYY,NPTS,IDEFXY)
  842.  
  843. C
  844. C DETERMINE AXIS SCALING
  845. C
  846.       XMINXY =9999
  847.       YMINXY =9999
  848.       XMAXXY =-99999
  849.       YMAXXY =-99999
  850.       DO 150 J = 1,NLINES
  851.       XMINH = 99999
  852.       XMAXH = -99999
  853.       YMINH = 99999
  854.       YMAXH = -99999
  855.       DO 130 K = 1,NPTS
  856.       XMINH = AMIN1(XMINH,X(J,K))
  857.       XMAXH = AMAX1(XMAXH,X(J,K))
  858.       YMINH = AMIN1(YMINH,Y(J,K))
  859.       YMAXH = AMAX1(YMAXH,Y(J,K))
  860. 130   CONTINUE
  861.       XMINXY = AMIN1(XMINH,XMINXY)
  862.       XMAXXY = AMAX1(XMAXH,XMAXXY)
  863.       YMINXY = AMIN1(YMINH,YMINXY)
  864.       YMAXXY = AMAX1(YMAXH,YMAXXY)
  865. 150   CONTINUE
  866.       XLO=XMINXY
  867.       XHI=XMAXXY
  868.       YLO=YMINXY
  869.       YHI=YMAXXY
  870.       SYMNXY=YMINXY
  871.       SYMXXY=YMAXXY
  872. C
  873. C SELECT PLOT OPTIONS:
  874. C
  875. 160   WRITE(WTE,161)COLOR1,ICURS,COLOR2
  876.       CALL CHKEND
  877. 161   FORMAT(1X,"PLEASE CHOOSE AN OPTION"/,
  878.      1" [1]  SELECT THE TYPE OF PLOT AXES"/,
  879.      2" [2]  SELECT THE X AND Y GRID MARKINGS"/,
  880.      3" [3]  SELECT X AND Y AXIS TICK MARK OPTIONS"/,
  881.      4" [4]  SELECT THE LINE OPTIONS"/
  882.      4" [5]  SELECT THE PLOT COLORS"/,
  883.      5" [6]  SELECT THE BACKGROUND COLOR"/,
  884.      5" [7]  SELECT THE AXIS SCALES"/,
  885.      5" [8]  CHOOSE THE PLOT SIZE"/,
  886.      6" [9]  CHOOSE THE PLOT LABELS"/,
  887.      4" [10]  DO THE PLOT"/,
  888.      5" [11] END THE CURRENT PLOT"/,
  889.      5" [12] EXIT XYPLOT"/,4A4,$)
  890.       IF(WIO .NE. 0) WRITE(WIO,161)COLOR1,ICURS,COLOR2
  891.       CALL VALGET(0,IANS,'I')
  892.       GOTO (180,300,400,620,500,750,550,600,700,800,899,995),IANS
  893.       CALL MENUER(12)
  894.       GOTO 160
  895. 180   CONTINUE
  896.       CALL SETAXS(ICURS,IPLTP1,ISYOPT,ISECY,SYMNXY,SYMMXY,XLO,YLO)
  897.       GOTO 160
  898. C
  899. C SELECT THE GRID LINES OPTIONS
  900. C
  901. 300   CONTINUE
  902.       CALL CHKEND
  903.       WRITE(WTE,310)COLOR1,ICURS,COLOR2
  904.       IF(WIO .NE. 0) WRITE(WIO,310)COLOR1,ICURS,COLOR2
  905. 310   FORMAT(1X,"PLEASE CHOOSE A GRID LINE OPTION"/,
  906.      1" [1] NO GRID LINES"/,
  907.      2" [2] GRID LINES ON X AXIS ONLY"/,
  908.      3" [3] GRID LINES ON Y AXIS ONLY"/,
  909.      4" [4] GRID LINES ON BOTH AXES"/,4A4,$)
  910.       CALL VALGET(0,IPLTP2,'I')
  911.       GOTO (320,330,340,350),IPLTP2
  912.       CALL MENUER(4)
  913.       GOTO 300
  914. 320   IPLTP2 = 0
  915.       GOTO 160
  916. 330   IPLTP2 = 4
  917.       GOTO 160
  918. 340   IPLTP2 = 8
  919.       GOTO 160
  920. 350   IPLTP2 = 12
  921.       GOTO 160
  922. C
  923. C SELECT THE TICK MARK OPTIONS
  924. C
  925. 400   CONTINUE
  926.       IPLTP3=0
  927. 405   WRITE(WTE,410)COLOR1,ICURS,COLOR2
  928.       CALL CHKEND
  929.       IF(WIO.NE.0) WRITE(WIO,410)COLOR1,ICURS,COLOR2
  930. 410   FORMAT(1X,"PLEASE CHOOSE TICK MARK OPTIONS, ONE BY ONE."/,
  931.      1"  NOTE THAT TICK MARK OPTIONS ARE CUMULATIVE."/,
  932.      2" [1] CLEAR ALL TICK MARK OPTIONS"/,
  933.      3" [2] ALLOW X AXIS TO END NOT ON A TICK MARK"/,
  934.      4" [3] ALLOW Y AXIS TO END NOT ON A TICK MARK"/,
  935.      5" [4] DO NOT PLOT X AXIS TICK MARKS"/,
  936.      6" [5] DO NOT PLOT Y AXIS TICK MARKS"/,
  937.      7" [6] EXTRA X-AXIS AND TICKS ON TOP OF PLOT"/,
  938.      8" [7] EXTRA Y-AXIS AND TICKS TO RIGHT OF PLOT"/,
  939.      9" [8] SELECT TICK MARK AND TICK CHARACTER SIZE"/,
  940.      7" [9] RETURN TO XYPLOT MENU"/,4A4,$)
  941.       CALL VALGET(0,IANS,'I')
  942.       GOTO (420,430,440,450,460,470,480,490,160),IANS
  943.       CALL MENUER(9)
  944.       GOTO 405
  945. 420   CONTINUE
  946.       GOTO 400
  947. 430   CONTINUE
  948.       IPLTP3=IPLTP3+16
  949.       GOTO 405
  950. 440   IPLTP3=IPLTP3+32
  951.       GOTO 405
  952. 450   IPLTP3=IPLTP3+512
  953.       GOTO 405
  954. 460   IPLTP3=IPLTP3+1024
  955.       GOTO 405
  956. 470   IPLTP3=IPLTP3+64
  957.       GOTO 405
  958. 480   IPLTP3=IPLTP3+128
  959.       GOTO 405
  960. 490   WRITE(WTE,492)COLOR1,ICURS,COLOR2
  961.       CALL CHKEND
  962.       IF(WIO .NE. 0) WRITE(WIO,492)COLOR1,ICURS,COLOR2
  963. 492   FORMAT(1X,"PLEASE CHOOSE A TICK MARK SIZING OPTION"/,
  964.      1" [1] USE AUTO SIZING"/,
  965.      2" [2] CHOOSE THE SIZE"/,4A4,$)
  966.       CALL VALGET(0,IANS,'I')
  967.       GOTO (494,496),IANS
  968.       CALL MENUER(2)
  969.       GOTO 490
  970. 494   CHRSIZ = 0
  971.       GOTO 405
  972. 496   WRITE(WTE,497)COLOR1,ICURS,COLOR2
  973.       IF(WIO .NE. 0)WRITE(WIO,497)COLOR1,ICURS,COLOR2
  974. 497   FORMAT(1X,"ENTER THE TICK MARK CHARACTER SIZE (CM)"/,4A4,$)
  975.       CALL VALGET(CHRSIZ,0,'F')
  976.       GOTO 405
  977. C
  978. C DEFINE THE PLOT COLORS
  979. C
  980. 500   CONTINUE
  981.       WRITE(WTE,510)COLOR1,ICURS,COLOR2
  982.       CALL CHKEND
  983.       IF(WIO .NE. 0)WRITE(WIO,510)COLOR1,ICURS,COLOR2
  984. 510   FORMAT(1X,"PLEASE CHOOSE A PLOT COLOR OPTION"/,
  985.      1" [1] SELECT THE LINE COLORS"/,
  986.      2" [2] SELECT THE AXIS COLORS"/,
  987.      3" [3] RETURN TO XYPLOT MENU"/,4A4,$)
  988.       CALL VALGET(0,IANS,'I')
  989.       GOTO (520,540,160),IANS
  990.       CALL MENUER(3)
  991.       GOTO 500
  992. 520   CONTINUE
  993.       DO 536 I=1,NLINES
  994.       WRITE(WTE,535)I
  995. 535   FORMAT(1X,"FOR LINE NUMBER ",I2)
  996.       IF(WIO .NE. 0) WRITE(WIO,535)I
  997.       CALL SETFG(FGRPXY(I),ICURS)
  998. 536   CONTINUE
  999.       GOTO 500
  1000. 540   WRITE(WTE,545)
  1001.       IF(WIO.NE.0) WRITE(WIO,545)
  1002. 545   FORMAT(1X,"FOR THE X-Y AXES,")
  1003.       CALL SETFG(IAXSPN,ICURS)
  1004.       GOTO 500
  1005. C
  1006. C SET THE AXIS SCALING
  1007. C
  1008. 550   CONTINUE
  1009.       WRITE(WTE,560)COLOR1,ICURS,COLOR2
  1010.       CALL CHKEND
  1011. 560   FORMAT(1X,"PLEASE CHOOSE PLOT SCALE OPTIONS"/,
  1012.      1" [1] USE AUTO-SCALING"/,
  1013.      2" [2] SELECT X-AXIS SCALE"/,
  1014.      3" [3] SELECT Y-AXIS SCALE"/,
  1015.      4" [4] RETURN TO XYPLOT MENU"/,4A4,$)
  1016.       CALL VALGET(0,IANS,'I')
  1017.       GOTO (565,570,580,160),IANS
  1018.       CALL MENUER(4)
  1019. 565   XMINXY=XLO
  1020.       XMAXXY=XHI
  1021.       YMINXY=YLO
  1022.       YMAXXY=YHI
  1023.       GOTO 160
  1024. 570   WRITE(WTE,572)COLOR1,ICURS,COLOR2
  1025.       IF(WIO .NE. 0) WRITE(WIO,572)COLOR1,ICURS,COLOR2
  1026. 572   FORMAT(1X,"CHOOSE MINIMUM X-AXIS VALUE"/,4A4)
  1027.       CALL VALGET(XMINXY,0,'F')
  1028.       WRITE(WTE,573)COLOR1,ICURS,COLOR2
  1029.       IF(WIO .NE. 0) WRITE(WIO,573)COLOR1,ICURS,COLOR2
  1030. 573   FORMAT(1X,"CHOOSE MAXIMUM X-AXIS VALUE"/,4A4)
  1031.       CALL VALGET(XMAXXY,0,'F')
  1032.       GOTO 550
  1033. 580   WRITE(WTE,582)COLOR1,ICURS,COLOR2
  1034.       IF(WIO .NE. 0) WRITE(WIO,582)COLOR1,ICURS,COLOR2
  1035. 582   FORMAT(1X,"CHOOSE MINIMUM Y-AXIS VALUE"/,4A4)
  1036.       CALL VALGET(YMINXY,0,'F')
  1037.       WRITE(WTE,583)COLOR1,ICURS,COLOR2
  1038.       IF(WIO .NE. 0) WRITE(WIO,583)COLOR1,ICURS,COLOR2
  1039. 583   FORMAT(1X,"CHOOSE MAXIMUM Y-AXIS VALUE"/,4A4)
  1040.       CALL VALGET(YMAXXY,0,'F')
  1041.       GOTO 550
  1042. C
  1043. C CHOOSE THE PLOT SIZE
  1044. C
  1045. 600   CONTINUE
  1046. C
  1047.       CALL CHKEND
  1048.       CALL MAKSIZ(ICURS,XSTXY,XFRCXY,YSTXY,YFRCXY)
  1049.       XSTXY=XSTXY*100.
  1050.       YSTXY=YSTXY*100.
  1051.       XFRCXY=XFRCXY*100.+XSTXY
  1052.       YFRCXY=YFRCXY*100.+YSTXY
  1053.       GOTO 160
  1054. C
  1055. C SET LINE OPTIONS
  1056. C
  1057. 620   CONTINUE
  1058.       CALL CHKEND
  1059.       CALL LNOPTS(NLINES,SYMSZ,INTSYM,ISYMNO,LINSYL,ICURS)
  1060.       GOTO 160
  1061. C
  1062. C SET THE PLOT LABELS
  1063. C
  1064. 700   CONTINUE
  1065.       WRITE(WTE,710)COLOR1,ICURS,COLOR2
  1066.       CALL CHKEND
  1067.       IF(WIO .NE. 0)WRITE(WIO,710)COLOR1,ICURS,COLOR2
  1068. 710   FORMAT(1X,"ENTER THE X-AXIS LABEL"/,4A4,$)
  1069.       CALL GETLAB(XLABXY)
  1070.       WRITE(WTE,720)COLOR1,ICURS,COLOR2
  1071.       IF(WIO .NE. 0)WRITE(WIO,720)COLOR1,ICURS,COLOR2
  1072. 720   FORMAT(1X,"ENTER THE Y-AXIS LABEL"/,4A4,$)
  1073.       CALL GETLAB(YLABXY)
  1074.       WRITE(WTE,730)COLOR1,ICURS,COLOR2
  1075.       IF(WIO .NE. 0)WRITE(WIO,730)COLOR1,ICURS,COLOR2
  1076. 730   FORMAT(1X,"ENTER THE PLOT LABEL"/,4A4,$)
  1077.       CALL GETLAB(LABXY)
  1078.       IF(ISECY) THEN
  1079.        WRITE(WTE,740)COLOR1,ICURS,COLOR2
  1080.        IF(WIO .NE. 0)WRITE(WIO,740)COLOR1,ICURS,COLOR2
  1081. 740    FORMAT(1X,"ENTER THE SECOND Y-AXIS LABEL"/,4A4,$)
  1082.        CALL GETLAB(SYLBXY)
  1083.       ENDIF
  1084.       GOTO 160
  1085. C
  1086. C SET BACKGROUND COLOR
  1087. C
  1088. 750    CONTINUE
  1089.        CALL CHKEND
  1090.        CALL CHBACK(ICURS)
  1091.        GOTO 160
  1092. C
  1093. C END THE PLOT
  1094. C
  1095. 899   IF (PLTST) THEN
  1096.        PLTST = .FALSE.
  1097.        CALL PLTFIN
  1098.       ENDIF
  1099.       GOTO 160
  1100. C
  1101. C BEGIN PLOTTING
  1102. C
  1103. 800   CONTINUE
  1104.       CALL CHKEND
  1105. C
  1106. C SAVE THE SETTINGS UNLESS WE ARE PLOTTING FROM SAVED SETTINGS
  1107. C IF PLOTTING FROM SAVED SETTINGS, RESTORE THE VALUES TO BE
  1108. C PLOTTED.
  1109. C
  1110.       IF(INCTRL .EQ. 0) THEN
  1111.        CALL SAVPLT(2)
  1112.       ELSE
  1113.       DO 840 J=1,NLINES
  1114.       IF(TAG .EQ. ROWTAG) THEN
  1115.        DO 810 I = 1,N
  1116.        IF(IDEFXY .EQ. 2)THEN
  1117.        X(J,I)=XXX(LINXYX(J),I)
  1118.        ELSE
  1119.        X(J,I)=FLOAT(I)
  1120.        ENDIF
  1121. 810   CONTINUE
  1122.       ELSE
  1123.        DO 820 I=1,M
  1124.         IF(IDEFXY .EQ. 2)THEN
  1125.         X(J,I)=XXX(I,LINXYX(J))
  1126.         ELSE
  1127.         X(J,I)=FLOAT(I)
  1128.         ENDIF
  1129. 820   CONTINUE
  1130.       ENDIF
  1131.       IF(TAG .EQ. ROWTAG) THEN
  1132.        DO 830 I = 1,N
  1133. 830    Y(J,I)=XXX(LINXYY(J),I)
  1134.       ELSE
  1135.        DO 832 I=1,M
  1136. 832    Y(J,I)=XXX(I,LINXYY(J))
  1137.       ENDIF
  1138. 840   CONTINUE
  1139.       ENDIF
  1140. C
  1141. C IF MODE 1, SCALE THE X-AXES
  1142. C
  1143.       IF(IDEFXY .EQ. 1) THEN
  1144.       DO 845 J=1,NLINES
  1145.        IF(TAG .EQ. ROWTAG) THEN
  1146.         DO 843 I=1,N
  1147. 843     X(J,I)=X(J,I)*XMAXXY/FLOAT(N)
  1148.         ELSE
  1149.         DO 844 I=1,M
  1150. 844     X(J,I)=X(J,I)*XMAXXY/FLOAT(M)
  1151.         ENDIF
  1152. 845   CONTINUE
  1153.       ENDIF
  1154.       IF((XMINXY .LE. 0 .AND. (IPLTP1 .EQ. 1 .OR. IPLTP1 .EQ. 3))
  1155.      1 .OR. (YMINXY .LE. 0 .AND. (IPLTP1 .EQ. 2 .OR. IPLTP1 .EQ. 3)))
  1156.      2THEN
  1157.        WRITE(WTE,854)COLOR3,COLOR2
  1158.        IF(WIO .NE. 0)WRITE(WIO,854)COLOR3,COLOR2
  1159. 854    FORMAT(1X,A4,"ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT")
  1160.        GOTO 160
  1161.       ENDIF
  1162.       IF(ISECY .AND. SYMNXY .LE. 0 .AND. ISYOPT .EQ. 2) THEN
  1163.         WRITE(WTE,855)COLOR3,COLOR2
  1164.         IF(WIO .NE. 0)WRITE(WIO,855)COLOR3,COLOR2
  1165. 855     FORMAT(1X,A4,"ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE
  1166.      1WITH LOG PLOT",A4)
  1167.         GOTO 160
  1168.        ENDIF
  1169.  
  1170.       IF (.NOT. PLTST)THEN
  1171.        PLTST = .TRUE.
  1172.        CALL BGNPLT
  1173.       ENDIF
  1174.       IF(SETBG) THEN
  1175.        SETBG = .FALSE.
  1176.        CALL SETBAK(BGRP)
  1177.       ENDIF
  1178.       CALL GSCOLR(IAXSPN,IERR)
  1179. C
  1180. C DEFINE PLOT SIZE
  1181. C
  1182.       IF(ISECY) THEN
  1183.        CALL MAPSZ2(XSTXY,XFRCXY,YSTXY,YFRCXY,CHRSIZ)
  1184.       ELSE
  1185.        CALL MAPSIZ(XSTXY,XFRCXY,YSTXY,YFRCXY,CHRSIZ)
  1186.       ENDIF
  1187. C
  1188. C GENERATE THE AXES
  1189. C
  1190.       IOPTNS=IPLTP1+IPLTP2+IPLTP3
  1191.       CALL GSLTYP(1)
  1192.       CALL MAPIT(XMINXY,XMAXXY,YMINXY,YMAXXY,XLABXY,YLABXY,LABXY,IOPTNS)
  1193.  
  1194. C
  1195. C DO THE LINES ON THE PLOT
  1196. C
  1197.       DO 900 INDEX = 1,NLINES
  1198.       DO 882 I=1,NPTS
  1199.        XPL(I)=X(INDEX,I)
  1200. 882    YPL(I)=Y(INDEX,I)
  1201.       CALL GSCOLR(FGRPXY(INDEX),IERR)
  1202.       CALL GSLTYP(LINSYL(INDEX))
  1203.       CALL CURVE(XPL,YPL,NPTS,ISYMNO(INDEX),SYMSZ(INDEX),INTSYM(INDEX))
  1204. 900   CONTINUE
  1205. C
  1206. C DO THE SECOND Y AXIS
  1207. C
  1208.       IF(ISECY) THEN
  1209.        CALL GSCOLR(IAXSPN,IERR)
  1210.        CALL GSLTYP(1)
  1211.        CALL SYAXIS(SYMNXY,SYMXXY,SYLBXY,ISYOPT)
  1212.       ENDIF
  1213.       IF(INCTRL .NE. 0) RETURN
  1214.       GOTO 160
  1215. 995   CONTINUE
  1216.       RETURN
  1217.       END
  1218. C
  1219. C  ROUTINE TO SET THE FOREGROUND PEN COLOR
  1220. C
  1221.       SUBROUTINE SETFG(ICOL,ICURS)
  1222.       INTEGER*4 ICOL
  1223.       CHARACTER*4 ICURS(2)
  1224.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1225.       INTEGER*4 COLOR1,COLOR2,COLOR3
  1226.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1227. C
  1228. C PLOT SPECIFIC VARIABLES
  1229. C
  1230.       LOGICAL PLTST,SETBG,BNHERE
  1231.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1232. C
  1233. C BEGIN
  1234. C
  1235. 105   WRITE(WTE,106)COLOR1,ICURS,COLOR2
  1236. 106   FORMAT(1X,"ENTER THE PLOT PEN NUMBER"/,4A4,$)
  1237.       IF(WIO .NE. 0)WRITE(WIO,106)COLOR1,ICURS(1),ICURS(2),COLOR2
  1238.       CALL VALGET(0,ICOL,'I')
  1239.       IF(WIO .NE. 0)WRITE(WIO,108)ICOL
  1240. 108   FORMAT(1X,I2)
  1241.       IF(ICOL .LT. 0 .OR. ICOL .GT. 15) THEN
  1242.        CALL PENERR
  1243.        GOTO 105
  1244.       ENDIF
  1245.       RETURN
  1246.       END
  1247. C
  1248. C  ROUTINE TO HANDLE MENU ERROR MESSAGES
  1249. C
  1250.       SUBROUTINE MENUER(I)
  1251.       INTEGER*4 I
  1252.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1253.       INTEGER*4 COLOR1,COLOR2,COLOR3,ICOL
  1254.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1255. C
  1256. C PLOT SPECIFIC VARIABLES
  1257. C
  1258.       LOGICAL PLTST,SETBG,BNHERE
  1259.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1260. C
  1261.       WRITE(WTE,10)COLOR3,I,COLOR2
  1262. 10    FORMAT(1X,A4,"ERROR.  PLEASE ENTER A VALUE BETWEEN 1 AND ",I2,A4)
  1263.       IF(WIO .NE. 0) WRITE(WIO,10)COLOR3,I,COLOR2
  1264.       RETURN
  1265.       END
  1266. C
  1267. C ROUTINE TO CHOOSE BACKGROUND COLOR
  1268. C
  1269.       SUBROUTINE CHBACK(ICURS)
  1270.       CHARACTER*4 ICURS(2)
  1271.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  1272.       LOGICAL PLTST,SETBG,BNHERE
  1273.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1274.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1275.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1276. C
  1277.       SETBG = .TRUE.
  1278. 400   CONTINUE
  1279.       WRITE(WTE,401)COLOR1,ICURS,COLOR2
  1280. 401   FORMAT(1X,"ENTER THE BACKGROUND COLOR NUMBER"/,4A4,$)
  1281.       IF(WIO .NE. 0)WRITE(WIO,401)COLOR1,ICURS,COLOR2
  1282.       CALL VALGET(0,BGRP,'I')
  1283.       IF(BGRP .LT.0 .OR. BGRP .GT. 15) THEN
  1284.        CALL PENERR
  1285.        GOTO 400
  1286.       ENDIF
  1287.       RETURN
  1288.       END
  1289. C
  1290. C ROUTINE TO DO HISTOGRAMS AND BAR PLOTS
  1291. C
  1292.       SUBROUTINE BARPLT(XXX,M,N,INCTRL,IERR)
  1293.       INTEGER M,N
  1294.       DIMENSION XXX(M,N)
  1295.       INTEGER INCTRL,IOCTRL
  1296.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1297.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  1298.       CHARACTER*1 ANS
  1299.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1300. C
  1301. C PLOT SPECIFIC VARIABLES
  1302. C
  1303.       LOGICAL PLTST,SETBG,BNHERE
  1304.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1305.       INTEGER NOBARS,COLIST(8),FGRPBP(8)
  1306.       REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
  1307.       DIMENSION FIMX(8)
  1308.       CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
  1309.       LOGICAL ISCYBP,STATBP
  1310.       CHARACTER*4 ICURS(2)
  1311. C
  1312.       INTEGER I,J,IMXC,SYOPBP
  1313.       REAL*4    COUNT(512,8),STEP,FBAR,YLOWBP,YHIBP,X0,Y0,VX0,VX1
  1314.       REAL*4    VY0,VY1
  1315. C
  1316. C THE BARPLOT COMMON
  1317.       COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
  1318.      1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
  1319.      2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
  1320.      3 SYOPBP
  1321.  
  1322.       DATA (ICURS(I),I=1,2)/'BARP','lt>>'/
  1323. C
  1324. C SEE WHO CALLED US
  1325. C
  1326.       IF(INCTRL .NE. 0)GOTO 90
  1327. C
  1328. C SET UP THE DEFAULTS
  1329. C
  1330.       DO 9 I=1,8
  1331. 9     FGRPBP(I)=I
  1332.       CALL MINMAX(XXX,M*N,XLOWBP,XHIBP)
  1333.       IMXC   = 512
  1334.       NOBARS = M
  1335.       YLOWBP   = 0.0
  1336.       YHIBP  = 1.0
  1337.       FBAR   = FLOAT(NOBARS)
  1338.       DO 1 I=1,80
  1339.       XLABBP(I)=' '
  1340.       YLABBP(I)=' '
  1341.       LABBP(I) =' '
  1342. 1     CONTINUE
  1343.       XLABBP(2)=Z'00'
  1344.       YLABBP(2)=Z'00'
  1345.       LABBP(2)=Z'00'
  1346.       IMXPTS=M
  1347.       IMYPTS=N
  1348.       XSTBP=0
  1349.       YSTBP=0
  1350.       XFRCBP=100
  1351.       YFRCBP=95
  1352.       CHSZBP=0
  1353.       ISCYBP =0
  1354.       IPLBP1=0
  1355.       STATBP = .TRUE.
  1356.       IXCLBP = 1
  1357. C
  1358. C Main Menu
  1359. C
  1360. 4     WRITE(WTE,5)COLOR1,ICURS,COLOR2
  1361.       CALL CHKEND
  1362.       IF(WIO .NE. 0)WRITE(WIO,5)COLOR1,ICURS,COLOR2
  1363. 5     FORMAT(1X,"PLEASE SELECT AN OPTION"/,
  1364.      1" [1]  CHOOSE THE BAR GRAPH TYPE"/,
  1365.      1" [2]  CHOOSE BAR GRAPH AXIS TYPES"/,
  1366.      2" [3]  CHOOSE BAR GRAPH AXIS COLORS"/,
  1367.      2" [4]  CHOOSE THE BAR GRAPH LABELS"/,
  1368.      3" [5]  SET THE BAR GRAPH COLORS"/,
  1369.      4" [6]  SET THE BACKGROUND COLOR"/,
  1370.      5" [7]  SET THE PLOT SIZE"/,
  1371.      5" [8]  DO THE PLOT"/,
  1372.      6" [9]  END THE CURRENT PLOT"/,
  1373.      6" [10] EXIT BARGRAPH"/,4A4,$)
  1374.       CALL VALGET(0,IANS,'I')
  1375.       GOTO (15,10,20,60,30,40,50,90,899,9999),IANS
  1376.       CALL MENUER(10)
  1377.       GOTO 4
  1378. C
  1379. C DEFINE THE BAR GRAPH AXIS TYPES
  1380. C
  1381. 10    CONTINUE
  1382.       CALL CHKEND
  1383.       CALL SETAXS(ICURS,IPLBP1,SYOPBP,ISCYBP,SYLOBP,SYHIBP,XLOWBP
  1384.      1 ,YLOWBP)
  1385.       GOTO 4
  1386. C
  1387. C DETERMINE WHETHER TO COUNT OCCURENCES OR DO STATISTICAL DISTRIBUTION
  1388. C
  1389. 15    CONTINUE
  1390.       WRITE(WTE,16)COLOR1,ICURS,COLOR2
  1391.       CALL CHKEND
  1392.       IF(WIO .NE. 0) WRITE(WIO,16)COLOR1,ICURS,COLOR2
  1393. 16    FORMAT(1X,"PLEASE CHOOSE THE DESIRED Y-AXIS TYPE:"/,
  1394.      1" [1] STATISTICAL (MAXIMUM Y VALUE IS 1.0)"/,
  1395.      2" [2] OCCURRENCE COUNT"/,4A4,$)
  1396.       CALL VALGET(0,IANS,'I')
  1397.       GOTO (17,18),IANS
  1398.       CALL MENUER(2)
  1399.       GOTO 15
  1400. 17    STATBP = .TRUE.
  1401.       GOTO 4
  1402. 18    STATBP = .FALSE.
  1403.       GOTO 4
  1404. C
  1405. C DO THE PLOT LABELS
  1406. C
  1407. 20    CONTINUE
  1408.       WRITE(WTE,21)COLOR1,ICURS,COLOR2
  1409.       IF(WIO .NE. 0)WRITE(WIO,21)COLOR1,ICURS,COLOR2
  1410. 21    FORMAT(1X,"ENTER THE X-AXIS LABEL"/,4A4,$)
  1411.       CALL GETLAB(XLABBP)
  1412.       WRITE(WTE,22)COLOR1,ICURS,COLOR2
  1413.       IF(WIO .NE. 0)WRITE(WIO,22)COLOR1,ICURS,COLOR2
  1414. 22    FORMAT(1X,"ENTER THE Y-AXIS LABEL"/,4A4,$)
  1415.       CALL GETLAB(YLABBP)
  1416.       WRITE(WTE,23)COLOR1,ICURS,COLOR2
  1417.       IF(WIO .NE. 0)WRITE(WIO,23)COLOR1,ICURS,COLOR2
  1418. 23    FORMAT(1X,"ENTER THE PLOT LABEL"/,4A4,$)
  1419.       CALL GETLAB(LABBP)
  1420.       GOTO 4
  1421. C
  1422. C SET THE BAR GRAPH COLORS
  1423. C
  1424. 30    CONTINUE
  1425.       CALL CHKEND
  1426.       KK=IMYPTS
  1427.       IF(KK .GT. 8) KK = 8
  1428.       DO 35 I=1,KK
  1429.       WRITE(WTE,33)I
  1430.       IF(WIO .NE. 0) WRITE(WIO,33)I
  1431. 33    FORMAT(1X,"FOR BAR GRAPH NUMBER ",I1)
  1432.       CALL SETFG(FGRPBP(I),ICURS)
  1433. 35    CONTINUE
  1434.       GOTO 4
  1435. C
  1436. C  CHANGE THE BACKGROUND PEN COLOR
  1437. C
  1438. 40    CONTINUE
  1439.       CALL CHKEND
  1440.       CALL CHBACK(ICURS)
  1441.       GOTO 4
  1442. C
  1443. C SET THE PLOT SIZE
  1444. C
  1445. 50    CONTINUE
  1446.       CALL CHKEND
  1447.       CALL MAKSIZ(ICURS,XSTBP,XFRCBP,YSTBP,YFRCBP)
  1448.       XSTBP=XSTBP*100.
  1449.       YSTBP=YSTBP*100.
  1450.       XFRCBP=XFRCBP*100.+XSTBP
  1451.       YFRCBP=YFRCBP*100.+YSTBP
  1452.       GOTO 4
  1453. C
  1454. C SET THE AXIS COLORS
  1455. C
  1456. 60    CONTINUE
  1457.       CALL CHKEND
  1458.       CALL SETFG(IXCLBP,IERR)
  1459.       GOTO 4
  1460. C
  1461. C DO THE PLOT
  1462. C
  1463. 90    CONTINUE
  1464.       CALL CHKEND
  1465. C
  1466. C SAVE THE PLOT UNLESS THIS IS ALREADY A SAVED PLOT
  1467. C
  1468.       IF(INCTRL .EQ. 0)CALL SAVPLT(3)
  1469. C
  1470. C
  1471.       IF((XLOWBP .LE. 0 .AND. (IPLBP1 .EQ. 1 .OR. IPLBP1 .EQ. 3))
  1472.      1 .OR. (YLOWBP .LE. 0 .AND. (IPLBP1 .EQ. 2 .OR. IPLBP1 .EQ. 3)))
  1473.      2THEN
  1474.        WRITE(WTE,854)COLOR3,COLOR2
  1475.        IF(WIO .NE. 0)WRITE(WIO,854)COLOR3,COLOR2
  1476. 854    FORMAT(1X,A4,"ERROR. AXIS LIMITS INCOMPATIBLE WITH LOG PLOT")
  1477.        GOTO 4
  1478.       ENDIF
  1479.       IF(ISCYBP .AND. (SYLOBP .LE. 0) .AND. (SYOPBP .EQ. 2)) THEN
  1480.         WRITE(WTE,855)COLOR3,COLOR2
  1481.         IF(WIO .NE. 0)WRITE(WIO,855)COLOR3,COLOR2
  1482. 855     FORMAT(1X,A4,"ERROR. SECOND Y-AXIS LIMITS INCOMPATIBLE
  1483.      1WITH LOG PLOT",A4)
  1484.         GOTO 4
  1485.        ENDIF
  1486.  
  1487.         IF (XLOWBP .GT. XHIBP) THEN
  1488.          WRITE(WTE,871)COLOR3,COLOR2
  1489.          IF(WIO .NE. 0) WRITE(WIO,871)COLOR3,COLOR2
  1490. 871      FORMAT(1X,A4,"INTERNAL ERROR.  XMIN GREATER THAN XMAX"/,
  1491.      1 "CALLED FROM BARPLT.  THIS CAN'T HAPPEN, SO IF IT HAS,"/,
  1492.      2 "YOU'RE SCREWED!  SORRY.",A4)
  1493.         GOTO 9999
  1494.         ENDIF
  1495.  
  1496.         IF (NOBARS .GT. IMXC) THEN
  1497.          WRITE(WTE,873)COLOR3,COLOR2
  1498.          IF(WIO .NE. 0) WRITE(WIO,873)COLOR3,COLOR2
  1499. 873      FORMAT(1X,A4,"ERROR.  TOO MANY BINS.  THE MAXIMUM IS 512",A4)
  1500.          GOTO 9999
  1501.         ENDIF
  1502.         IF(IMYPTS .GT. 8) THEN
  1503.          WRITE(WTE,876)COLOR3,COLOR2
  1504.          IF(WIO .NE. 0)WRITE(WIO,876)COLOR3,COLOR2
  1505. 876      FORMAT(1X,A4,"WARNING. TOO MANY BARGRAPHS SPECIFIED.
  1506.      1  ONLY THE FIRST 8 ROWS WILL BE GRAPHED",A4)
  1507.          IMYPTS = 8
  1508.         ENDIF
  1509. C
  1510.         STEP   = (XHIBP - XLOWBP) / FBAR
  1511. C
  1512.         DO 100 I = 1,512
  1513.         DO 100 J = 1,8
  1514. C
  1515.             COUNT(I,J) = 0.0
  1516. C
  1517.  100    CONTINUE
  1518. C
  1519.         DO 350 KK=1,IMYPTS
  1520.         DO 200 I = 1,IMXPTS
  1521. C
  1522.             J      = INT((XXX(I,KK)-XLOWBP)/STEP) + 1
  1523.             IF (J .GT. NOBARS) J = NOBARS
  1524.             COUNT(J,KK) = COUNT(J,KK) + 1.0
  1525. C
  1526.  200    CONTINUE
  1527. C
  1528.         IF(STATBP) THEN
  1529.          FIMX(KK)   = FLOAT(IMXPTS) * STEP
  1530. C
  1531.         DO 300 I = 1,NOBARS
  1532. C
  1533.             COUNT(I,KK) = COUNT(I,KK) / FIMX(KK)
  1534. C
  1535.  300    CONTINUE
  1536.         ENDIF
  1537.  
  1538.  350    CONTINUE
  1539. C
  1540.         CALL MINMAX(COUNT,4096,YLOWBP,YHIBP)
  1541.         YLOWBP   = 0.0
  1542.         YHIBP  = YHIBP + 0.1 * YHIBP
  1543. C
  1544.       IF (.NOT. PLTST)THEN
  1545.        PLTST = .TRUE.
  1546.        CALL BGNPLT
  1547.       ENDIF
  1548. C
  1549. C SET THE BACKGROUND COLOR
  1550. C
  1551.       IF(SETBG) THEN
  1552.         SETBG = .FALSE.
  1553.         CALL SETBAK(BGRP)
  1554.       ENDIF
  1555. C
  1556. C DEFINE PLOT SIZE
  1557. C
  1558. C      WRITE(WTE,1324)XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP
  1559. C1324  FORMAT(1X,"MAPSIZE",5F10.3)
  1560.       IF(ISCYBP) THEN
  1561.        CALL MAPSZ2(XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP)
  1562.       ELSE
  1563.        CALL MAPSIZ(XSTBP,XFRCBP,YSTBP,YFRCBP,CHSZBP)
  1564.       ENDIF
  1565.          CALL GSCOLR(IXCLBP,IERR)
  1566. C      WRITE(WTE,1789)XLOWBP,XHIBP,YLOWBP,YHIBP
  1567. C1789  FORMAT(1X,"MAPIT",4F10.3)
  1568.          CALL MAPIT(XLOWBP,XHIBP,YLOWBP,YHIBP,XLABBP,YLABBP,LABBP,
  1569.      1    IPLBP1)
  1570. C
  1571.         DO 500 KK=1,IMYPTS
  1572.         CALL GSCOLR(FGRPBP(KK),IERR)
  1573.         X0     = XLOWBP
  1574.         Y0     = 0.0
  1575.         CALL SCALE(X0,Y0,VX0,VY0)
  1576.         CALL GSMOVE(VX0,VY0)
  1577. C
  1578.         DO 400 I = 1,NOBARS
  1579. C
  1580.             X0     = XLOWBP + I * STEP
  1581.             Y0     = COUNT(I,KK)
  1582.             CALL SCALE(X0,Y0,VX1,VY1)
  1583.             CALL GSDRAW(VX0,VY1)
  1584.             CALL GSDRAW(VX1,VY1)
  1585.             CALL GSDRAW(VX1,VY0)
  1586. C
  1587.             VX0    = VX1
  1588. C
  1589.  400    CONTINUE
  1590.  500    CONTINUE
  1591. C
  1592. C
  1593. C DO THE SECOND Y AXIS
  1594. C
  1595.       IF(ISCYBP) THEN
  1596. C       CALL GSCOLR(IXCLBP,IERR)
  1597.        CALL GSLTYP(1)
  1598.        CALL SYAXIS(SYLOBP,SYHIBP,SYLBBP,SYOPBP)
  1599.       ENDIF
  1600.       IF(INCTRL .NE. 0) RETURN
  1601.         GOTO 4
  1602. C
  1603. 899   IF (PLTST) THEN
  1604.        PLTST = .FALSE.
  1605.        CALL PLTFIN
  1606.       ENDIF
  1607.       GOTO 4
  1608.  9999   CONTINUE
  1609. C
  1610. C       BYE
  1611. C
  1612.         RETURN
  1613.         END
  1614.  
  1615. C
  1616. C  ROUTINE TO SET AXIS TYPES
  1617. C
  1618.       SUBROUTINE SETAXS(ICURS,IPLTP1,ISYOPT,ISECY,SYMN,SYMX,XLO,YLO)
  1619.  
  1620.       CHARACTER*4 ICURS(2)
  1621.       INTEGER IPLTP1,ISYOPT
  1622.       REAL SYMN,SYMX,XLO,YLO
  1623.       LOGICAL ISECY
  1624.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1625.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1626.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  1627.       LOGICAL PLTST,SETBG,BNHERE
  1628.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1629. 180   WRITE(WTE,185)COLOR1,ICURS,COLOR2
  1630.       CALL CHKEND
  1631. 185   FORMAT(1X,"PLEASE CHOOSE THE TYPE OF PLOT AXES"/,
  1632.      1" [1] LIN-LIN PLOT"/,
  1633.      2" [2] LOG-LIN PLOT"/,
  1634.      3" [3] LIN-LOG PLOT"/,
  1635.      4" [4] LOG-LOG PLOT"/,
  1636.      5" [5] USE SECOND Y-AXIS"/
  1637.      6" [6] RETURN TO PREVIOUS MENU"/,4A4,$)
  1638.       IF(WIO .NE. 0) WRITE(WIO,185)COLOR1,ICURS,COLOR2
  1639.       CALL VALGET(0,IANS,'I')
  1640.       GOTO (210,220,230,240,250,999),IANS
  1641.       CALL MENUER(6)
  1642.       GOTO 180
  1643. 210   IPLTP1 = 0
  1644.       GOTO 180
  1645. 220   CONTINUE
  1646.       IF(XLO .LT. 0)THEN
  1647.        WRITE(WTE,222)COLOR3,COLOR2
  1648.        IF(WIO .NE. 0)WRITE(WIO,222)COLOR3,COLOR2
  1649. 222    FORMAT(1X,A4,"ERROR. X-AXIS LIST HAS VALUES LESS THAN 0."/
  1650.      1," THIS IS INCOMPATIBLE WITH A LOG X AXIS",A4)
  1651.        GOTO 180
  1652.       ENDIF
  1653.       IPLTP1 = 1
  1654.       GOTO 180
  1655. 230   CONTINUE
  1656.       IF(YLO .LT. 0)THEN
  1657.        WRITE(WTE,232)COLOR3,COLOR2
  1658.        IF(WIO .NE. 0)WRITE(WIO,232)COLOR3,COLOR2
  1659. 232    FORMAT(1X,A4,"ERROR. Y-AXIS LIST HAS VALUES LESS THAN 0."/
  1660.      1," THIS IS INCOMPATIBLE WITH A LOG Y AXIS",A4)
  1661.        GOTO 180
  1662.       ENDIF
  1663.       IPLTP1=2
  1664.       GOTO 180
  1665. 240   CONTINUE
  1666.       IF(XLO .LT. 0)THEN
  1667.        WRITE(WTE,222)COLOR3,COLOR2
  1668.        IF(WIO .NE. 0)WRITE(WIO,222)COLOR3,COLOR2
  1669.        GOTO 180
  1670.       ENDIF
  1671.       IF(YLO .LT. 0)THEN
  1672.        WRITE(WTE,232)COLOR3,COLOR2
  1673.        IF(WIO .NE. 0)WRITE(WIO,232)COLOR3,COLOR2
  1674.        GOTO 180
  1675.       ENDIF
  1676.       IPLTP1 = 3
  1677.       GOTO 180
  1678. 250   CONTINUE
  1679.       ISECY=.TRUE.
  1680. 252   WRITE(WTE,255)COLOR1,ICURS,COLOR2
  1681.       CALL CHKEND
  1682.       IF(WIO .NE. 0) WRITE(WIO,255)COLOR1,ICURS,COLOR2
  1683. 255   FORMAT(1X,"PLEASE CHOOSE SECOND Y-AXIS OPTIONS:"/,
  1684.      1" [1] LINEAR SCALE"/,
  1685.      2" [2] LOG SCALE"/,
  1686.      3" [3] CHOOSE SECOND AXIS LIMITS"/,
  1687.      3" [4] DELETE SECOND Y AXIS"/,
  1688.      4" [5] RETURN TO AXIS SELECTION MENU"/,4A4,$)
  1689.       CALL VALGET(0,IANS,'I')
  1690.       GOTO (260,270,290,280,180),IANS
  1691.       CALL MENUER(5)
  1692. 260   ISYOPT=0
  1693.       GOTO 252
  1694. 270   ISYOPT=2
  1695.       GOTO 252
  1696. 280   ISECY=.FALSE.
  1697.       GOTO 252
  1698. 290   WRITE(WTE,292)COLOR1,ICURS,COLOR2
  1699.       IF(WIO .NE. 0) WRITE(WIO,292)COLOR1,ICURS,COLOR2
  1700. 292   FORMAT(1X,"ENTER THE MINIMUM SCALE VALUE OF THE SECOND Y AXIS"/,
  1701.      14A4,$)
  1702.       CALL VALGET(SYMN,0,'F')
  1703.       WRITE(WTE,294)COLOR1,ICURS,COLOR2
  1704.       IF(WIO .NE. 0) WRITE(WIO,294)COLOR1,ICURS,COLOR2
  1705. 294   FORMAT(1X,"ENTER THE MAXIMUM SCALE VALUE OF THE SECOND Y AXIS"/,
  1706.      14A4,$)
  1707.       CALL VALGET(SYMX,0,'F')
  1708.       GOTO 252
  1709. 999   CONTINUE
  1710.       RETURN
  1711.       END
  1712. C
  1713. C ROUTINE TO DEFINE PLOT SIZE
  1714. C
  1715.       SUBROUTINE MAKSIZ(ICURS,XST,XFRC,YST,YFRC)
  1716.       CHARACTER*4 ICURS(2)
  1717.       REAL XST,XFRC,YST,YFRC
  1718.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  1719.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP,FGRPXY(10),ISYMNO(10)
  1720.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  1721. C
  1722. C PLOT SPECIFIC VARIABLES
  1723. C
  1724.       LOGICAL PLTST,SETBG,BNHERE
  1725.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1726. C
  1727.       WRITE(WTE,601)COLOR1,ICURS,COLOR2
  1728. 601   FORMAT(1X,"ENTER THE X ORIGIN OF THE PLOT AS A FRACTION OF THE
  1729.      1 TOTAL XAXIS LENGTH"/,4A4,$)
  1730.       IF(WIO .NE. 0) WRITE(WIO,601)COLOR1,ICURS,COLOR2
  1731.       CALL VALGET(XST,0,'F')
  1732.       WRITE(WTE,602)COLOR1,ICURS,COLOR2
  1733. 602   FORMAT(1X,"ENTER THE Y ORIGIN OF THE PLOT AS A FRACTION OF THE
  1734.      1 TOTAL YAXIS LENGTH"/,4A4,$)
  1735.       IF(WIO .NE. 0) WRITE(WIO,602)COLOR1,ICURS,COLOR2
  1736.       CALL VALGET(YST,0,'F')
  1737.       WRITE(WTE,603)COLOR1,ICURS,COLOR2
  1738. 603   FORMAT(1X,"ENTER THE FRACTION OF THE XAXIS TO BE OCCUPIED BY
  1739.      1 THE PLOT"/,4A4,$)
  1740.       IF(WIO. NE. 0) WRITE(WIO,603)COLOR1,ICURS(1),ICURS(2),COLOR2
  1741.       CALL VALGET(XFRC,0,'F')
  1742.       WRITE(WTE,604)COLOR1,ICURS,COLOR2
  1743. 604   FORMAT(1X,"ENTER THE FRACTION OF THE YAXIS TO BE OCCUPIED BY
  1744.      1 THE PLOT"/,4A4,$)
  1745.       IF(WIO .NE. 0) WRITE(WIO,604)COLOR1,ICURS,COLOR2
  1746.       CALL VALGET(YFRC,0,'F')
  1747.       RETURN
  1748.       END
  1749. C
  1750. C ROUTINE TO CLOSE OUT THE PLOTS
  1751. C
  1752.       SUBROUTINE PLTFIN
  1753. C
  1754.       CALL ENDPLT
  1755.       RETURN
  1756.       END
  1757. C
  1758. C ROUTINE TO REMEMBER PLOT SETTINGS
  1759. C
  1760.       SUBROUTINE SAVPLT(PLTP)
  1761.       INTEGER PLTP
  1762. C
  1763. C PLTP IS TYPE OF PLOT
  1764. C      =1 IS 3D PLOT
  1765. C      =2 IS X-Y PLOT OF ANY TYPE
  1766. C      =3 IS BAR PLOT (HISTOGRAM)
  1767. C      =4 IS CONTOUR PLOT
  1768. C      =5 IS POLAR PLOT
  1769. C
  1770. C
  1771. C PLOT SPECIFIC VARIABLES
  1772. C
  1773.       INTEGER VAR(4)
  1774.       CHARACTER*4 ICURS(2)
  1775.       INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
  1776.       REAL*4 LABE3D
  1777.       CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
  1778.       DIMENSION XYLIM(2,6),CAMLOC(3)
  1779.       INTEGER*4 FGRPXY(10),ISYMNO(10)
  1780.       INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
  1781.       DIMENSION SYMSZ(10)
  1782.       LOGICAL ISECY,PLTST,SETBG,BNHERE
  1783.       CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
  1784.       CHARACTER*4 TAG
  1785.       INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport
  1786. C
  1787. C THE GLOBAL PLOT COMMON
  1788. C
  1789.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1790. C
  1791. C THE 3D PLOT ROUTINE COMMON
  1792. C
  1793.       COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
  1794.      1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
  1795. C
  1796. C THE XYPLOT ROUTINE COMMON
  1797. C
  1798.       COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
  1799.      1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
  1800.      2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
  1801.      3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
  1802. C
  1803. C BARPLT VARIABLES
  1804. C
  1805.       INTEGER NOBARS,COLIST(8),FGRPBP(8)
  1806.       REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
  1807.       DIMENSION FIMX(8)
  1808.       CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
  1809.       LOGICAL ISCYBP,STATBP
  1810.       INTEGER IMXC
  1811.       REAL*4  FBAR,YLOWBP,YHIBP
  1812. C
  1813. C THE BARPLOT COMMON
  1814. C
  1815.       COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
  1816.      1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
  1817.      2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
  1818.      3 SYOPBP
  1819. C
  1820. C THE CONTOUR PLOT VARIABLES
  1821. C
  1822.       CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
  1823.       DIMENSION CNLCP(20)
  1824.       REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
  1825.       REAL YMXCP
  1826.       INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
  1827.  
  1828.       COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
  1829.      1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
  1830.      2 ,ICNNCP,CNLCP,LBSZCP
  1831. C
  1832. C
  1833. C THE POLAR PLOT VARIABLES
  1834. C
  1835.       DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
  1836.       DIMENSION LNSLPP(10)
  1837.       INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
  1838.       CHARACTER*1 LABPP(80)
  1839.       INTEGER*2 MODEPP(8)
  1840.       REAL XSTPP,YSTPP,XFRCPP,YFRCPP
  1841.       REAL RMAX
  1842.       CHARACTER*4 TAGPP
  1843.       INTEGER NLINPP
  1844.       COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP,
  1845.      1 XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP,
  1846.      2 ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
  1847.  
  1848.       INTEGER PLTCNT,PLTMAX
  1849.       CHARACTER*1 ISAV(10,720)
  1850. C
  1851. C THE PLTSAV COMMON
  1852. C
  1853.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  1854.       CHARACTER*1 D3PL(328),XYPL(692),BPPL(440),CPPL(376),POPL(432)
  1855.       EQUIVALENCE (D3PL,XLAB3D),(XYPL,XLABXY),(BPPL,FGRPBP)
  1856.       EQUIVALENCE (XLABCP,CPPL),(RMAX,POPL)
  1857. C
  1858.       IF( PLTCNT .EQ. 0)PLTMAX = 0
  1859.       PLTCNT=PLTCNT+1
  1860.       IF(PLTCNT .GT. 10) PLTCNT = 1
  1861.       IF(PLTMAX .LE. 10)PLTMAX = PLTCNT
  1862.       IPLTYP(PLTCNT)=PLTP
  1863.       GOTO(100,200,300,400,500)PLTP
  1864.       RETURN
  1865. 100   DO 110 I=1,328
  1866. 110   ISAV(PLTCNT,I)=D3PL(I)
  1867.       RETURN
  1868. 200   DO 210 I=1,692
  1869. 210   ISAV(PLTCNT,I)=XYPL(I)
  1870.       RETURN
  1871. 300   DO 310 I=1,440
  1872. 310   ISAV(PLTCNT,I)=BPPL(I)
  1873.       RETURN
  1874. 400   DO 410 I=1,376
  1875. 410   ISAV(PLTCNT,I)=CPPL(I)
  1876.       RETURN
  1877. 500   DO 510 I=1,432
  1878. 510   ISAV(PLTCNT,I)=POPL(I)
  1879.       RETURN
  1880.       END
  1881. C
  1882. C ROUTINE TO RESTORE PLOTS AS SAVED BY SAVPLT
  1883. C
  1884.       SUBROUTINE PLREST(XXX,YYY,M,N,INCTRL,IOCTRL,IZ)
  1885.       INTEGER M,N,INCTRL,IOCTRL
  1886.       DIMENSION XXX(M,N),YYY(M,N)
  1887. C
  1888. C PLOT SPECIFIC VARIABLES
  1889. C
  1890.       INTEGER VAR(4)
  1891.       CHARACTER*4 ICURS(2)
  1892.       INTEGER*4 COLOR1,COLOR2,COLOR3,MARPLT,FGRP3D
  1893.       REAL*4 LABE3D
  1894.       CHARACTER*1 XLAB3D(80),YLAB3D(80),ZLAB3D(80)
  1895.       DIMENSION XYLIM(2,6),CAMLOC(3)
  1896.       INTEGER*4 FGRPXY(10),ISYMNO(10)
  1897.       INTEGER*4 INTSYM(10),LINSYL(10),LINXYX(10),LINXYY(10)
  1898.       DIMENSION SYMSZ(10)
  1899.       LOGICAL ISECY,PLTST,SETBG,BNHERE
  1900.       CHARACTER*1 XLABXY(80),YLABXY(80),SYLBXY(80),LABXY(80),ANS
  1901.       CHARACTER*4 TAG
  1902.       INTEGER*4 WIDTH,HEIGHT,ICOLOR,Window,Screen,viewport
  1903. C
  1904. C THE GLOBAL PLOT COMMON
  1905. C
  1906.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  1907. C
  1908. C THE 3D PLOT ROUTINE COMMON
  1909. C
  1910.       COMMON /PLT3D/ XLAB3D,YLAB3D,ZLAB3D,XYLIM,CAMLOC,MARPLT,FGRP3D
  1911.      1,XST3D,YST3D,XFRC3D,YFRC3D,LABE3D
  1912. C
  1913. C THE XYPLOT ROUTINE COMMON
  1914. C
  1915.       COMMON /PLTXY/ XLABXY,YLABXY,SYLBXY,LABXY,IAXSPN,IPLTP1,IPLTP2
  1916.      1,IPLTP3,NLINES,IDEFXY,XMINXY,YMINXY,XMAXXY,YMAXXY,FGRPXY,INTSYM
  1917.      2,SYMSZ,ISYMNO,XLO,XHI,YLO,YHI,LINSYL,ISECY,ISYOPT,XSTXY,YSTXY
  1918.      3,XFRCXY,YFRCXY,TAG,LINXYX,LINXYY,CHRSIZ,NPTS
  1919. C
  1920. C BARPLT VARIABLES
  1921. C
  1922.       INTEGER NOBARS,COLIST(8),FGRPBP(8)
  1923.       REAL*4    XLOWBP,XHIBP,XSTBP,YSTBP,XFRCBP,YFRCBP,CHSZBP
  1924.       DIMENSION FIMX(8)
  1925.       CHARACTER*1 XLABBP(80),YLABBP(80),LABBP(80),SYLBBP(80)
  1926.       LOGICAL ISCYBP,STATBP
  1927.       INTEGER IMXC
  1928.       REAL*4  FBAR,YLOWBP,YHIBP
  1929. C
  1930. C THE BARPLOT COMMON
  1931. C
  1932.       COMMON /BAR/ FGRPBP,XLOWBP,XHIBP,IMXC,NOBARS,YLOWBP,YHIBP,
  1933.      1 FBAR,XLABBP,YLABBP,LABBP,IMXPTS,IMYPTS,XSTBP,YSTBP,XFRCBP,
  1934.      2 YFRCBP,CHSZBP,ISCYBP,IPLBP1,STATBP,IXCLBP,SYLBBP,SYLOBP,SYHIBP,
  1935.      3 SYOPBP
  1936. C
  1937. C
  1938. C THE CONTOUR PLOT VARIABLES
  1939. C
  1940.       CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
  1941.       DIMENSION CNLCP(20)
  1942.       REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
  1943.       REAL YMXCP
  1944.       INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
  1945.       COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
  1946.      1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
  1947.      2 ,ICNNCP,CNLCP,LBSZCP
  1948.  
  1949. C
  1950. C THE POLAR PLOT VARIABLES
  1951. C
  1952.       DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
  1953.       DIMENSION LNSLPP(10)
  1954.       INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
  1955.       CHARACTER*1 LABPP(80)
  1956.       INTEGER*2 MODEPP(8)
  1957.       REAL XSTPP,YSTPP,XFRCPP,YFRCPP
  1958.       REAL RMAX
  1959.       INTEGER NLINPP
  1960.       CHARACTER*4 TAGPP
  1961.       COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
  1962.      1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
  1963.      2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
  1964.  
  1965.       INTEGER PLTCNT,PLTMAX
  1966.       CHARACTER*1 ISAV(10,720)
  1967. C
  1968. C THE PLTSAV COMMON
  1969. C
  1970.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  1971.       CHARACTER*1 D3PL(328),XYPL(692),BPPL(440),CPPL(376),POPL(432)
  1972.       EQUIVALENCE (D3PL,XLAB3D),(XYPL,XLABXY),(BPPL,FGRPBP)
  1973.       EQUIVALENCE (XLABCP,CPPL),(RMAX,POPL)
  1974. C
  1975.       IF(INCTRL .EQ. 0) THEN
  1976.        ISTRT = 1
  1977.        IEND = PLTMAX
  1978.       ELSE
  1979.        ISTRT = INCTRL
  1980.        IEND =INCTRL
  1981.       ENDIF
  1982.       DO 1000 I=ISTRT,IEND
  1983.       GOTO (100,200,300,400,500)IPLTYP(I)
  1984.       CYCLE
  1985. 100   DO 110 J = 1,328
  1986. 110   D3PL(J)=ISAV(I,J)
  1987.       CALL D3PLOT(XXX,M,N,1,IERR,IZ)
  1988.       CYCLE
  1989. 200   DO 210 J=1,692
  1990. 210   XYPL(J)=ISAV(I,J)
  1991.       CALL XYPLT(XXX,M,N,1,IERR)
  1992.       CYCLE
  1993. 300   DO 310 J=1,440
  1994. 310   BPPL(J)=ISAV(I,J)
  1995.       CALL BARPLT(XXX,M,N,1,IERR)
  1996.       CYCLE
  1997. 400   DO 410 J=1,376
  1998. 410   CPPL(J)=ISAV(I,J)
  1999.       CALL CONTUR(XXX,M,N,1,IERR,IZ)
  2000.       CYCLE
  2001. 500   DO 510 J=1,432
  2002. 510   POPL(J)=ISAV(I,J)
  2003.       CALL POLPLT(XXX,YYY,M,N,1,IERR,IZ)
  2004. 1000  CONTINUE
  2005.       RETURN
  2006.       END
  2007. C
  2008. C PLOT BUFFER CONTROL ROUTINE
  2009. C
  2010.       SUBROUTINE PLCTRL(XXX,YYY,M,N,IZ)
  2011.       INTEGER M,N
  2012.       DIMENSION XXX(M,N),YYY(M,N)
  2013. C
  2014.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2015.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2016.       INTEGER*4 DSPLY
  2017.       LOGICAL PLTST,SETBG,BNHERE
  2018. C
  2019. C THE GLOBAL PLOT COMMON
  2020. C
  2021.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2022. C
  2023. C PLOT SAVE VARIABLES
  2024. C
  2025.       INTEGER PLTCNT,PLTMAX
  2026.       CHARACTER*1 ISAV(10,720)
  2027.       CHARACTER*4 ICURS(2)
  2028. C
  2029. C THE PLTSAV COMMON
  2030. C
  2031.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  2032.  
  2033.       DATA (ICURS(I),I=1,2)/'CNTR','OL>>'/
  2034. 5     WRITE (WTE,10)COLOR1,ICURS,COLOR2
  2035.       DSPLY = 0
  2036.       CALL CHKEND
  2037.       IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
  2038. 10    FORMAT(1X,"PLEASE CHOOSE A PLOT BUFFER CONTROL OPTION:"/,
  2039.      1" [1] CLEAR THE BUFFER"/,
  2040.      2" [2] DELETE A PLOT"/,
  2041.      3" [3] SHOW THE PLOT BUFFER"/,
  2042.      4" [4] DISPLAY ONE OF THE SAVED PLOTS"/,
  2043.      4" [5] DISPLAY ALL SAVED PLOTS"/,
  2044.      5" [6] SAVE THE PLOT BUFFER"/,
  2045.      6" [7] RETURN TO THE MAIN MENU"/,4A4,$)
  2046.       CALL VALGET(0,IANS,'I')
  2047.       GOTO(100,200,200,600,300,400,500)IANS
  2048.       CALL MENUER(5)
  2049. 100   CONTINUE
  2050.       PLTMAX = 0
  2051.       PLTCNT = 0
  2052.       DO 120 I = 1,10
  2053. 120   IPLTYP(I)=0
  2054.       RETURN
  2055. 200   CONTINUE
  2056.       WRITE(WTE,210)
  2057.       IF(WIO .NE. 0) WRITE(WIO,210)
  2058. 210   FORMAT(1X,"THE FOLLOWING PLOTS ARE STORED IN THE BUFFER:"//,
  2059.      1 " BUFFER LOCATION   PLOT TYPE"/)
  2060.       DO 290 I=1,10
  2061.       GOTO(220,230,240,250,260)IPLTYP(I)
  2062.       CYCLE
  2063. 220   WRITE(WTE,225)I
  2064.       IF(WIO .NE. 0)WRITE(WIO,225)I
  2065. 225   FORMAT(10X,I2,7X,"3-D PLOT")
  2066.       CYCLE
  2067. 230   WRITE(WTE,235)I
  2068.       IF(WIO .NE. 0)WRITE(WIO,235)I
  2069. 235   FORMAT(10X,I2,7X,"X-Y PLOT")
  2070.       CYCLE
  2071. 240   WRITE(WTE,245)I
  2072.       IF(WIO .NE. 0) WRITE(WIO,245)I
  2073. 245   FORMAT(10X,I2,7X,"HISTOGRAM")
  2074.       CYCLE
  2075. 250   WRITE(WTE,255)I
  2076.       IF(WIO .NE. 0) WRITE(WIO,255)I
  2077. 255   FORMAT(10X,I2,7X,"CONTOUR PLOT")
  2078.       CYCLE
  2079. 260   WRITE(WTE,265)I
  2080.       IF(WIO .NE. 0) WRITE(WIO,255)I
  2081. 265   FORMAT(10X,I2,7X,"POLAR PLOT")
  2082. 290   CONTINUE
  2083.       IF (IANS .EQ. 2) THEN 
  2084.       WRITE(WTE,295)COLOR1,ICURS,COLOR2
  2085.       IF(WIO .NE. 0)WRITE(WIO,295)COLOR1,ICURS,COLOR2
  2086. 295   FORMAT("DELETE WHICH GRAPH?  ENTER THE BUFFER LOCATION."/,4A4,$)
  2087.       CALL VALGET(0,IANS,'I')
  2088.       IF(IANS .GE. 1 .AND. IANS .LE. 10) THEN
  2089.       IPLTYP(IANS)=0
  2090.       ENDIF
  2091.       ELSE
  2092.       WRITE(WTE,296)
  2093.       IF(WIO .NE. 0)WRITE(WIO,296)
  2094. 296   FORMAT(/)
  2095.       ENDIF      
  2096.       GOTO 5
  2097. 300   CONTINUE
  2098.       CALL PLREST(XXX,YYY,M,N,DSPLY,IERR,IZ)
  2099.       RETURN
  2100. 400   CALL SAVFIL
  2101.       RETURN
  2102. 600   WRITE(WTE,610)COLOR1,ICURS,COLOR2
  2103.       IF(WIO .NE. 0)WRITE(WIO,610)COLOR1,ICURS,COLOR2
  2104. 610   FORMAT(1X,"PLEASE ENTER THE PLOT BUFFER NUMBER TO BE DISPLAYED"/,
  2105.      1 4A4)
  2106.       CALL VALGET(0,DSPLY,'I')
  2107.       CALL PLREST(XXX,YYY,M,N,DSPLY,IERR,IZ)
  2108.       GOTO 5
  2109. 500   RETURN      
  2110.       END
  2111. C
  2112. C ROUTINE TO SAVE PLOT DEFINITIONS
  2113. C
  2114.       SUBROUTINE SAVFIL
  2115.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2116.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2117. C
  2118. C THE GLOBAL PLOT COMMON
  2119. C
  2120.       LOGICAL PPLTST,SETBG,BNHERE
  2121.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2122. C
  2123. C PLOT SAVE VARIABLES
  2124. C
  2125.       INTEGER PLTCNT,PLTMAX
  2126.       CHARACTER*1 ISAV(10,720)
  2127.       CHARACTER*4 ICURS(2),NAME(32)
  2128. C
  2129. C THE PLTSAV COMMON
  2130. C
  2131.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  2132.       DATA (ICURS(I),I=1,2)/'PLTS','AV>>'/
  2133. C
  2134.       IPL = 45
  2135.       WRITE(WTE,10)COLOR1,ICURS,COLOR2
  2136.       IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
  2137. 10    FORMAT(1X,"PLEASE ENTER THE SAVE FILE NAME."/,4A4,$)
  2138.       READ(RTE,15)NAME
  2139. 15    FORMAT(32A1)
  2140. 20    FORMAT(1X,32A1)
  2141.       CALL FILES(IPL,NAME)
  2142.       IF(FE .EQ. 0) THEN
  2143.       WRITE(IPL,25)PLTCNT,PLTMAX
  2144. 25    FORMAT(2I2)
  2145.       DO 50 J=1,10
  2146.       IF (IPLTYP(J) .GT. 0 .AND. IPLTYP(J) .LT. 10) THEN
  2147.         WRITE(IPL,30)IPLTYP(J)
  2148. 30      FORMAT(I1)
  2149.         WRITE(IPL,35)(ISAV(J,KK),KK=1,360)
  2150.         WRITE(IPL,35)(ISAV(J,KK),KK=361,720)
  2151. 35      FORMAT(360Z2)
  2152.       ENDIF
  2153. 50    CONTINUE
  2154.       CALL FILES(-1*IPL,NAME)
  2155.       ENDIF
  2156.       RETURN 
  2157.       END      
  2158. C
  2159. C ROUTINE TO LOAD PLOT DEFINITIONS
  2160. C
  2161.       SUBROUTINE LODFIL(XXX,YYY,M,N,NAME,INCTRL,IOCTRL,IZ)
  2162.       INTEGER M,N
  2163.       DIMENSION XXX(M,N),YYY(M,N)
  2164.       CHARACTER*4 NAME(32)
  2165.       INTEGER INCTRL,IOCTRL
  2166.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2167.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2168. C
  2169. C THE GLOBAL PLOT COMMON
  2170. C
  2171.       LOGICAL PLTST,SETBG,BNHERE
  2172.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2173. C
  2174. C PLOT SAVE VARIABLES
  2175. C
  2176.       INTEGER PLTCNT,PLTMAX
  2177.       CHARACTER*1 ISAV(10,720)
  2178.       CHARACTER*4 ICURS(2)
  2179.       LOGICAL GOTONE
  2180. C
  2181. C THE PLTSAV COMMON
  2182. C
  2183.       COMMON /SAV/ PLTCNT,IPLTYP(10),PLTMAX,ISAV
  2184.       DATA (ICURS(I),I=1,2)/'PLTL','OD>>'/
  2185. C
  2186.       IPL = 45
  2187.       GOTONE = .FALSE.
  2188. 5     CONTINUE
  2189.       IF(INCTRL .EQ. 0) THEN
  2190.        WRITE(WTE,10)COLOR1,ICURS,COLOR2
  2191.        IF(WIO .NE. 0)WRITE(WIO,10)COLOR1,ICURS,COLOR2
  2192.        CALL CHKEND
  2193. 10     FORMAT(1X,"PLEASE ENTER THE FILE NAME TO BE LOADED."/,4A4,$)
  2194.        READ(RTE,15)NAME
  2195. 15     FORMAT(32A1)
  2196.        IF(WIO .NE. 0)WRITE(WIO,20)NAME
  2197. 20     FORMAT(1X,32A1)
  2198.       ENDIF
  2199.       DO 22 I=1,10
  2200. 22    IPLTYP(I)=0
  2201.       CALL FILES(IPL,NAME)
  2202.       IF(FE .EQ. 0) THEN
  2203.       READ(IPL,25,END=55)PLTCNT,PLTMAX
  2204. 25    FORMAT(2I2)
  2205. C
  2206. C CHECK THE HEADER FOR VALIDITY
  2207. C
  2208.       IF(PLTCNT .GT. 10 .OR. PLTCNT .LT. 1 .OR. PLTMAX .GT. 10 .OR.
  2209.      1  PLTMAX .LT. 1) THEN
  2210.         WRITE(WTE,23)COLOR3,COLOR2
  2211.         IF(WIO .NE. 0) WRITE(WIO,23)COLOR3,COLOR2
  2212. 23      FORMAT(A4,"ERROR IN PLOT DEFINITION FILE"/,"NOT A VALID PLOT
  2213.      1 DEFINITION",A4)
  2214.         CALL FILES(-1*IPL,NAME)
  2215.         GOTO 5
  2216.       ENDIF
  2217. C
  2218. C READ IN THE DEFINITION
  2219. C
  2220.       DO 50 J=1,PLTMAX
  2221.         READ(IPL,30,END=55)IPLTYP(J)
  2222. 30      FORMAT(I1)
  2223.         READ(IPL,35,END=55)(ISAV(J,KK),KK=1,360)
  2224.         READ(IPL,35,END=55)(ISAV(J,KK),KK=361,720)
  2225. 35      FORMAT(360Z2)
  2226.         GOTONE=.TRUE.
  2227. 50    CONTINUE
  2228. 55    CONTINUE
  2229.       CALL FILES(-1*IPL,NAME)
  2230.       IF(GOTONE)CALL PLREST(XXX,YYY,M,N,0,IERR,IZ)
  2231.       ENDIF
  2232.       RETURN
  2233.       END
  2234. C
  2235. C ROUTINE TO END THE CURRENT PLOT
  2236. C
  2237.       SUBROUTINE CHKEND
  2238.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  2239.       LOGICAL PLTST,SETBG,BNHERE
  2240. C
  2241. C THE GLOBAL PLOT COMMON
  2242. C
  2243.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2244. C
  2245.       IF(PLTST) CALL GD13HI(13,X,Y)
  2246.       IF(X .NE. 0)PLTST = .FALSE.
  2247.       RETURN
  2248.       END
  2249. C
  2250. C THE CONTOUR PLOTTING ROUTINE
  2251. C
  2252.       SUBROUTINE CONTUR(XXX,M,N,INCTRL,IOCTRL,IZ)
  2253.       INTEGER M,N
  2254.       DIMENSION XXX(M,N)
  2255.       INTEGER INCTRL,IOCTRL
  2256.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2257.       INTEGER*4 COLOR1,COLOR2,COLOR3,CHOICE
  2258.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2259.  
  2260. C
  2261. C PLOT SPECIFIC VARIABLES
  2262. C
  2263.  
  2264.       CHARACTER*1 IZ(5000)
  2265.       LOGICAL PLTST,SETBG,BNHERE
  2266.       CHARACTER*4 ICURS(2)
  2267.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2268. C
  2269. C THE CONTOUR PLOT VARIABLES
  2270. C
  2271.       CHARACTER*1 XLABCP(80),YLABCP(80),LABCP(80)
  2272.       DIMENSION CNLCP(20)
  2273.       REAL LABECP,LBSZCP,XSTCP,YSTCP,XFRCCP,YFRCCP,X1CP,XMXCP,Y1CP
  2274.       REAL YMXCP
  2275.       INTEGER FGRPCP,IOPTCP,IOP2CP,ICNNCP
  2276.       COMMON /PLTCP/ XLABCP,YLABCP,LABCP,FGRPCP,XSTCP,YSTCP
  2277.      1 ,XFRCCP,YFRCCP,LABECP,X1CP,XMXCP,Y1CP,YMXCP,IOPTCP,IOP2CP
  2278.      2 ,ICNNCP,CNLCP,LBSZCP
  2279. C
  2280.       DATA (ICURS(I),I=1,2)/'Cont','or>>'/
  2281. C
  2282. C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
  2283. C
  2284.       IF(INCTRL .NE. 0) GOTO 900
  2285. C
  2286. C SET UP THE DEFAULTS
  2287. C
  2288.       DO 25 I=1,80
  2289.       XLABCP(I)=Z'20'
  2290.       YLABCP(I)=Z'20'
  2291. 25    LABCP(I)=Z'20'
  2292.       LABECP=0
  2293.       XSTCP=0
  2294.       YSTCP=0
  2295.       XFRCCP=100
  2296.       YFRCCP=100
  2297.       FGRPCP=1
  2298.       IOCTRL=0
  2299.       X1CP=0
  2300.       XMXCP=M
  2301.       Y1CP=0
  2302.       YMXCP=N
  2303.       IOPTCP=0
  2304.       IOP2CP=0
  2305.       ICNNCP=20
  2306.       XMAX = GSXLCM()
  2307.       YMAX = GSYLCM()
  2308.       MN=M*N
  2309.       CALL MINMAX(XXX,MN,ZMIN,ZMAX)
  2310.       DO 55 I = 1,20
  2311. 55    CNLCP(I)=ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
  2312. C
  2313. C DETERMINE THE CHOICES
  2314. C
  2315.        CALL CHKEND
  2316. 100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
  2317.       CALL CHKEND
  2318.       IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
  2319. 101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
  2320.      1 " [1]  CHOOSE PLOT LABELS"/,
  2321.      2 " [2]  CHOOSE PLOT VALUES"/,
  2322.      3 " [3]  CHOOSE NUMBER OF CONTOURS"/,
  2323.      4 " [4]  CHOOSE CONTOUR LEVELS"/,
  2324.      5 " [5]  SET THE BACKGROUND COLOR"/,
  2325.      5 " [6]  CHOOSE PLOT COLOR"/,
  2326.      6 " [7]  CHOOSE PLOT SIZE"/,
  2327.      7 " [8]  DO THE PLOT"/,
  2328.      8 " [9]  END THE CURRENT PLOT"/,
  2329.      8 " [10] EXIT CONTOUR PLOTS"/,
  2330.      94A4,$)
  2331.       CALL VALGET(0,CHOICE,'I')
  2332.       GOTO(200,300,400,500,600,700,800,900,899,990),CHOICE
  2333.       CALL MENUER(10)
  2334.       GOTO 100
  2335. C
  2336. C  SELECT THE LABELS
  2337. C
  2338. 200   CONTINUE
  2339.       CALL CHKEND
  2340.       WRITE(WTE,201)COLOR1,ICURS,COLOR2
  2341. 201   FORMAT(1X,//"ENTER THE X AXIS LABEL"/,4A4,$)
  2342.       IF(WIO .NE. 0)WRITE(WIO,201)COLOR1,ICURS,COLOR2
  2343.       CALL GETLAB(XLABCP)
  2344.       WRITE(WTE,202)COLOR1,ICURS,COLOR2
  2345.       IF(WIO .NE. 0)WRITE(WIO,202)COLOR1,ICURS,COLOR2
  2346. 202   FORMAT(1X,//"ENTER THE Y AXIS LABEL"/,4A4,$)
  2347.       CALL GETLAB(YLABCP)
  2348.       WRITE(WTE,203)COLOR1,ICURS,COLOR2
  2349.       IF(WIO .NE. 0)WRITE(WIO,203)COLOR1,ICURS,COLOR2
  2350. 203   FORMAT(1X,//"ENTER THE PLOT LABEL"/,4A4,$)
  2351.       CALL GETLAB(LABCP)
  2352.       WRITE(WTE,204)COLOR1,ICURS,COLOR2
  2353.       IF(WIO .NE. 0) WRITE(WIO,204)COLOR1,ICURS,COLOR2
  2354. 204   FORMAT(1X,//"ENTER THE SIZE OF THE LABELS (CM)"/,A4
  2355.      1 ,4A4,$)
  2356.       CALL VALGET(LABSIZ,0,'F')
  2357.       IF(LABSIZ .NE. 0) LABECP = LABSIZ
  2358.       GOTO 100
  2359. C
  2360. C SELECT THE DATA
  2361. C
  2362. 300   CONTINUE
  2363.       CALL CHKEND
  2364.       WRITE(WTE,301)COLOR1,ICURS,COLOR2
  2365. 301   FORMAT(1X,"ENTER THE MINIMUM VALUE OF X"/,4A4,$)
  2366.       IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
  2367.       CALL VALGET(X1CP,0,'F')
  2368.       WRITE(WTE,302)COLOR1,ICURS,COLOR2
  2369. 302   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF X"/,4A4,$)
  2370.       IF(WIO .NE. 0)WRITE(WIO,302)COLOR1,ICURS,COLOR2
  2371.       CALL VALGET(XMXCP,0,'F')
  2372.       WRITE(WTE,303)COLOR1,ICURS,COLOR2
  2373. 303   FORMAT(1X,"ENTER THE MINIMUM VALUE OF Y"/,4A4,$)
  2374.       IF(WIO .NE. 0)WRITE(WIO,303)COLOR1,ICURS,COLOR2
  2375.       CALL VALGET(Y1CP,0,'F')
  2376.       WRITE(WTE,304)COLOR1,ICURS,COLOR2
  2377. 304   FORMAT(1X,"ENTER THE MAXIMUM VALUE OF Y"/,4A4,$)
  2378.       IF(WIO .NE. 0)WRITE(WIO,304)COLOR1,ICURS,COLOR2
  2379.       CALL VALGET(YMXCP,0,'F')
  2380.       GOTO 100
  2381. C
  2382. C DEFINE THE NUMBER OF CONTOURS
  2383. C
  2384. 400   CONTINUE
  2385.       CALL CHKEND
  2386.       WRITE(WTE,425)COLOR1,ICURS,COLOR2
  2387.       IF(WIO .NE. 0)WRITE(WIO,425)COLOR1,ICURS,COLOR2
  2388. 425   FORMAT(1X,//"ENTER THE NUMBER OF CONTOURS TO BE MAPPED"/,4A4,$)
  2389.       CALL VALGET(0,ICNNCP,'I')
  2390.       IF(ICNNCP .GT. 20) ICNNCP = 20
  2391.       DO 455 I = 1,ICNNCP
  2392. 455   CNLCP(I)=ZMIN + (ZMAX-ZMIN)*(FLOAT(I)-1)/20
  2393.       GOTO 100
  2394. C
  2395. C CHOOSE THE CONTOUR LEVELS
  2396. C
  2397. 500   CONTINUE
  2398.       CALL CHKEND
  2399.       GOTO 100
  2400. C
  2401. C SET THE BACKGROUND COLOR
  2402. C
  2403. 600   CONTINUE
  2404.       CALL CHKEND
  2405.       CALL CHBACK(ICURS)
  2406.       GOTO 100
  2407. C
  2408. C SELECT THE PLOT COLOR
  2409. C
  2410. 700   CONTINUE
  2411.       CALL CHKEND
  2412.       CALL SETFG(FGRPCP,ICURS)
  2413.       GOTO 100
  2414. C
  2415. C SELECT THE PLOT SIZE
  2416. C
  2417. 800   CONTINUE
  2418. C
  2419.       CALL CHKEND
  2420.       CALL MAKSIZ(ICURS,XSTCP,XFRCCP,YSTCP,YFRCCP)
  2421.       XSTCP=XSTCP*100.
  2422.       YSTCP=YSTCP*100.
  2423.       XFRCCP=XFRCCP*100.+XSTCP
  2424.       YFRCCP=YFRCCP*100.+YSTCP
  2425.       GOTO 100
  2426. C
  2427. C END THE PLOT
  2428. C
  2429. 899   IF (PLTST) THEN
  2430.        PLTST = .FALSE.
  2431.        CALL PLTFIN
  2432.       ENDIF
  2433.       GOTO 100
  2434. C
  2435. C DO THE PLOT
  2436. C
  2437. 900   CONTINUE
  2438.       CALL CHKEND
  2439. C
  2440. C SAVE THE PLOT SETTINGS, UNLESS WE ARE WORKING FROM A SAVED FILE
  2441. C
  2442.       IF(INCTRL .EQ. 0) CALL SAVPLT(4)
  2443.       IF (.NOT. PLTST)THEN
  2444.        PLTST = .TRUE.
  2445.        CALL BGNPLT
  2446.       ENDIF
  2447.       IF(SETBG) THEN
  2448.        SETBG = .FALSE.
  2449.        CALL SETBAK(BGRP)
  2450.       ENDIF
  2451.       CALL GSCOLR(FGRPCP,IERR)
  2452.       CALL MAPSIZ(XSTCP,XFRCCP,YSTCP,YFRCCP,LABECP)
  2453.       CALL MAPIT(X1CP,XMXCP,Y1CP,YMXCP,XLABCP,YLABCP,LABCP,IOPTCP)
  2454.       CALL CONTOR(XXX,M,IZ,M,N,X1CP,XMXCP,Y1CP,YMXCP,ICNNCP,CNLCP)
  2455.       IF(INCTRL .NE. 0)RETURN
  2456.       GOTO 100
  2457. 990   CONTINUE
  2458.       RETURN
  2459.       END
  2460. C
  2461. C THE POLAR PLOTTING ROUTINE
  2462. C
  2463.       SUBROUTINE POLPLT(XXX,YYY,M,N,INCTRL,IOCTRL,IZ)
  2464.       INTEGER M,N
  2465.       DIMENSION XXX(M,N),YYY(M,N)
  2466.       INTEGER INCTRL,IOCTRL
  2467.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2468.       INTEGER*4 COLOR1,COLOR2,COLOR3,CHOICE
  2469.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2470.  
  2471. C
  2472. C PLOT SPECIFIC VARIABLES
  2473. C
  2474.  
  2475.       CHARACTER*1 IZ(5000)
  2476.       LOGICAL PLTST,SETBG,BNHERE
  2477.       CHARACTER*4 ICURS(2)
  2478.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2479. C
  2480. C THE POLAR PLOT VARIABLES
  2481. C
  2482.       DIMENSION X(10,500),Y(10,500),XPL(500),YPL(500)
  2483.       DIMENSION LINXPP(10),LINYPP(10),SMSZPP(10),NTSMPP(10),ISMNPP(10)
  2484.       DIMENSION LNSLPP(10)
  2485.       INTEGER*4 FGRPPP(10),BGRPPP,LABEPP
  2486.       CHARACTER*1 LABPP(80)
  2487.       CHARACTER*4 TAGPP,ROWTAG,COLTAG
  2488.       INTEGER*2 MODEPP(8)
  2489.       REAL XSTPP,YSTPP,XFRCPP,YFRCPP
  2490.       REAL RMAX
  2491.       INTEGER NPTSPP,NLINPP
  2492.       COMMON /PLTPP/ RMAX,LABPP,FGRPPP,XSTPP,YSTPP,LABEPP
  2493.      1 ,XFRCPP,YFRCPP,MODEPP,LINXPP,LINYPP,IDEFPP,SMSZPP,NTSMPP
  2494.      2 ,ISMNPP,LNSLPP,MODE1A,MODE1B,MODE2A,NPTSPP,BGRPPP,TAGPP,NLINPP
  2495. C
  2496.       DATA (ICURS(I),I=1,2)/'Pola','r >>'/,ROWTAG/' ROW'/,COLTAG/' COL'/
  2497. C
  2498. C FIGURE OUT WHO CALLED US AND IF SO INDICATED JUMP DIRECTLY TO THE PLOT
  2499. C
  2500.       IF(INCTRL .NE. 0) GOTO 900
  2501. C
  2502. C SET UP THE DEFAULTS
  2503. C
  2504.       DO 25 I=1,80
  2505. 25    LABPP(I)=CHAR(0)
  2506.       DO 10 I = 1,10
  2507.       SMSZPP(I) = 0
  2508.       NTSMPP(I) = 0
  2509.       ISMNPP(I) = 0
  2510.       LNSLPP(I) = 1
  2511.       LINXPP(I) = 0
  2512.       LINYPP(I) = 0
  2513. 10    FGRPPP(I) = I+1
  2514.       LABEPP = 0
  2515.       MODE1A = 1
  2516.       MODE1B = 0
  2517.       MODE2A = 1
  2518.       MODEPP(2)=1
  2519.       MODEPP(3)=0
  2520.       MODEPP(4)=1
  2521.       MODEPP(5)=-30
  2522.       MODEPP(7)=2
  2523.       XSTPP=0
  2524.       YSTPP=0
  2525.       XFRCPP=100
  2526.       YFRCPP=100
  2527.       BGRPPP = 1
  2528.       IOCTRL=0
  2529.       NLINPP = 0
  2530.       MN=M*N
  2531. C
  2532. C CHOOSE THE PLOT MODE 
  2533. C
  2534.       CALL CHKEND
  2535. 7     WRITE(WTE,3)COLOR1,ICURS,COLOR2
  2536.       IF(WIO .NE. 0)WRITE(WIO,3)COLOR1,ICURS,COLOR2
  2537. 3     FORMAT(1X,"PLEASE CHOOSE THE POLAR PLOT MODE:"/,
  2538.      1" [1] R-THETA PLOT (TYPE REAL)"/,
  2539.      2" [2] COMPLEX (X+IY) PLOT"/,4A4,$)
  2540.       CALL VALGET(0,IDEFPP,'I')
  2541.       GOTO(4,4),IDEFPP
  2542.       CALL MENUER(2)
  2543.       GOTO 7
  2544. 4     CONTINUE
  2545.       MODE1A = IDEFPP
  2546.       IDEFPP = IDEFPP + 2
  2547. C
  2548. C DETERMINE WHETHER TO PLOT ALONG ROWS OR COLUMNS
  2549. C
  2550.       CALL PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAGPP,NLINPP
  2551.      1,LINXPP,LINYPP,NPTSPP,IDEFPP)
  2552. C
  2553. C DETERMINE THE CHOICES
  2554. C
  2555. 100   WRITE(WTE,101)COLOR1,ICURS,COLOR2
  2556.       CALL CHKEND
  2557.       IF(WIO .NE. 0) WRITE(WIO,101)COLOR1,ICURS,COLOR2
  2558. 101   FORMAT(1X,//"PLEASE CHOOSE AN OPTION"/,
  2559.      1 " [1]  DEFINE THE PLOT LABEL"/,
  2560.      2 " [2]  CHOOSE PLOT AXIS TYPE"/,
  2561.      3 " [3]  CHOOSE LINE OPTIONS"/,
  2562.      4 " [4]  CHOOSE PLOT AXIS AND TICK MARK OPTIONS"/,
  2563.      5 " [5]  CHOOSE THE BACKGROUND COLOR"/,
  2564.      5 " [6]  CHOOSE PLOT COLOR"/,
  2565.      6 " [7]  CHOOSE PLOT SIZE"/,
  2566.      7 " [8]  DO THE PLOT"/,
  2567.      8 " [9]  END THE CURRENT PLOT"/,
  2568.      8 " [10] EXIT POLAR PLOTS"/,
  2569.      94A4,$)
  2570.       CALL VALGET(0,CHOICE,'I')
  2571.       GOTO(200,300,400,500,600,700,800,900,899,990),CHOICE
  2572.       CALL MENUER(10)
  2573.       GOTO 100
  2574. C
  2575. C  SELECT THE LABELS
  2576. C
  2577. 200   CONTINUE
  2578.       CALL CHKEND
  2579.       WRITE(WTE,203)COLOR1,ICURS,COLOR2
  2580.       IF(WIO .NE. 0)WRITE(WIO,203)COLOR1,ICURS,COLOR2
  2581. 203   FORMAT(1X,//"ENTER THE PLOT LABEL"/,4A4,$)
  2582.       CALL GETLAB(LABPP)
  2583.       GOTO 100
  2584. C
  2585. C SELECT THE DATA
  2586. C
  2587. 300   CONTINUE
  2588.       CALL CHKEND
  2589.       WRITE(WTE,301)COLOR1,ICURS,COLOR2
  2590.       IF(WIO .NE. 0)WRITE(WIO,301)COLOR1,ICURS,COLOR2
  2591. 301   FORMAT(1X,//"CHOOSE THE PLOT AXIS TYPE"/
  2592.      1," [1] LINEAR RADIUS PLOT"/
  2593.      2," [2] LOGARITHMIC RADIUS"/
  2594.      3," [3] RETURN TO MAIN MENU"/,4A4,$)
  2595.       CALL VALGET(0,ICHOICE,'I')
  2596.       GOTO (330,340,100),ICHOICE
  2597.       CALL MENUER(3)
  2598.       GOTO 300
  2599. 330   MODE2A = 1
  2600.       GOTO 300
  2601. 340   MODE2A = 2
  2602.       GOTO 300
  2603. C
  2604. C LINE OPTIONS
  2605. C
  2606. 400   CONTINUE
  2607.       WRITE(WTE,410)COLOR1,ICURS,COLOR2
  2608.       IF(WIO .NE. 0)WRITE(WIO,410)COLOR1,ICURS,COLOR2
  2609. 410   FORMAT(1X,"PLEASE CHOOSE A DATA LINE OPTION"/,
  2610.      1" [1] CHOOSE LINE COLOR"/,
  2611.      2" [2] CHOOSE LINE STYLE"/,
  2612.      3" [3] RETURN TO POLAR PLOT MENU"/,4A4,$)
  2613.       CALL VALGET(0,ICHOICE,'I')
  2614.       GOTO (420,443,100),ICHOICE
  2615.       CALL MENUER(3)
  2616.       GOTO 400
  2617. 420   CONTINUE
  2618.       DO 425 I = 1,NLINPP
  2619.       WRITE(WTE,421)I
  2620. 421   FORMAT(1X,"FOR LINE NUMBER ",I2)
  2621.       IF(WIO .NE. 0) WRITE(WIO,421)I
  2622.       CALL SETFG(FGRPPP(I),ICURS)
  2623. 425   CONTINUE
  2624.       GOTO 400
  2625. 443   CONTINUE
  2626.       CALL CHKEND
  2627.       CALL LNOPTS(NLINPP,SMSZPP,NTSMPP,ISMNPP,LNSLPP,ICURS)
  2628.       GOTO 400
  2629. C
  2630. C AXIS AND TICK MARK OPTIONS
  2631. C
  2632. 500   CONTINUE
  2633.       CALL CHKEND
  2634.       WRITE(WTE,505)COLOR1,ICURS,COLOR2 
  2635.       IF(WIO .NE. 0)WRITE(WIO,505)COLOR1,ICURS,COLOR2
  2636. 505   FORMAT(1X,"SELECT AXIS OR TICK MARK OPTIONS"/,
  2637.      1 " [1] NO AXIS, TICK MARKS, OR RANGE RINGS"/,
  2638.      2 " [2] DRAW AXIS ONLY"/,
  2639.      3 " [3] DRAW TICK MARKS"/,
  2640.      4 " [4] DRAW RANGE RINGS"/,
  2641.      5 " [5] RETURN TO MAIN MENU"/,4A4,$)
  2642.  
  2643.       CALL VALGET(0,ICHOICE,'I')
  2644.       GOTO(510,520,530,540,100),ICHOICE
  2645.       CALL MENUER(5)
  2646.       GOTO 500
  2647. 510   CONTINUE
  2648.       MODE1B = 2
  2649.       GOTO 500
  2650. 520   MODE1B = 0
  2651.       GOTO 500
  2652. 530   WRITE(WTE,535)COLOR1,ICURS,COLOR2
  2653.       IF(WIO .NE. 0)WRITE(WIO,535)COLOR1,ICURS,COLOR2
  2654. 535   FORMAT(1X,"ENTER THE NUMBER OF DEGREES BETWEEN EACH TICK MARK"/,
  2655.      1 4A4,$)
  2656.       CALL VALGET(0,ICHOICE,'I')
  2657.       MODEPP(5) = ICHOICE
  2658. 534   CONTINUE
  2659.       WRITE(WTE,536)COLOR1,ICURS,COLOR2
  2660.       IF(WIO .NE. 0)WRITE(WIO,536)COLOR1,ICURS,COLOR2
  2661. 536   FORMAT(1X,"PLEASE CHOOSE AN OPTION"/,
  2662.      1 "[1] INWARD POINTING TICK MARKS"/,
  2663.      2 "[2] OUTWARD POINTING TICK MARKS"/,4A4,$)
  2664.       CALL VALGET(0,ICHOICE,'I')
  2665.       GOTO (537,538),ICHOICE
  2666.       CALL MENUER(2)
  2667.       GOTO 534
  2668. 537   IF(MODEPP(5) .GT. 0)MODEPP(5) = -MODEPP(5)
  2669.       GOTO 500
  2670. 538   IF(MODEPP(5) .LT. 0)MODEPP(5) = -MODEPP(5)
  2671.       GOTO 500
  2672.  
  2673. 540   CONTINUE
  2674.       WRITE(WTE,542)COLOR1,ICURS,COLOR2
  2675.       IF(WIO .NE. 0)WRITE(WIO,542)COLOR1,ICURS,COLOR2
  2676. 542   FORMAT(1X,"PLEASE ENTER THE NUMBER OF RANGE RINGS TO PLOT"/,4A4,$)
  2677.       CALL VALGET(0,ICHOICE,'I')
  2678.       MODEPP(3) = ICHOICE
  2679. 543   CONTINUE
  2680.       WRITE(WTE,544)COLOR1,ICURS,COLOR2
  2681.       IF(WIO .NE. 0)WRITE(WIO,544)COLOR1,ICURS,COLOR2
  2682. 544   FORMAT(1X,"PLEASE CHOOSE A RANGE RING LINE OPTION"/,
  2683.      1" [1] SOLID LINE"/,
  2684.      2" [2] LONG DASHED LINE"/,
  2685.      3" [3] SHORT DASHED LINE"/,
  2686.      4" [4] DOT-DASH LINE"/,4A4,$)
  2687.       CALL VALGET(0,ICHOICE,'I')
  2688.       GOTO (546,546,546,546),ICHOICE
  2689.       CALL MENUER(4)
  2690.       GOTO 543
  2691. 546   MODEPP(4) = ICHOICE
  2692.       GOTO 500
  2693. C
  2694. C SET THE BACKGROUND COLOR
  2695. C
  2696. 600   CONTINUE
  2697.       CALL CHKEND
  2698.       CALL CHBACK(ICURS)
  2699.       GOTO 100
  2700. C
  2701. C SELECT THE PLOT COLOR
  2702. C
  2703. 700   CONTINUE
  2704.       CALL CHKEND
  2705.       CALL SETFG(BGRPPP,ICURS)
  2706.       GOTO 100
  2707. C
  2708. C SELECT THE PLOT SIZE
  2709. C
  2710. 800   CONTINUE
  2711. C
  2712.       CALL CHKEND
  2713.       CALL MAKSIZ(ICURS,XSTPP,XFRCPP,YSTPP,YFRCPP)
  2714.       XSTPP=XSTPP*100.
  2715.       YSTPP=YSTPP*100.
  2716.       XFRCPP=XFRCPP*100.+XSTPP
  2717.       YFRCPP=YFRCPP*100.+YSTPP
  2718.       GOTO 100
  2719. C
  2720. C END THE PLOT
  2721. C
  2722. 899   IF (PLTST) THEN
  2723.        PLTST = .FALSE.
  2724.        CALL PLTFIN
  2725.       ENDIF
  2726.       GOTO 100
  2727. C
  2728. C DO THE PLOT
  2729. C
  2730. 900   CONTINUE
  2731.       CALL CHKEND
  2732. C
  2733. C DETERMINE WHETHER THIS IS THE FIRST PLOT.
  2734. C
  2735.        IF(.NOT. PLTST) THEN 
  2736.          PLTST = .TRUE.
  2737.          CALL BGNPLT
  2738.        ENDIF
  2739.        IF(SETBG) THEN
  2740.          SETBG = .FALSE.
  2741.          CALL SETBAK(BGRP)
  2742.        ENDIF
  2743. C
  2744. C  IF THIS IS A BATCH JOB, DO THE FOLLOWING
  2745. C
  2746.       IF(INCTRL .NE. 0) THEN
  2747.        DO 840 J=1,NLINPP
  2748.         IF(TAGPP .EQ. ROWTAG) THEN
  2749.          DO 810 I = 1,N
  2750.           X(J,I)=XXX(LINXPP(J),I)
  2751. 810      CONTINUE
  2752.         ELSE
  2753.          DO 820 I=1,M
  2754.           X(J,I)=XXX(I,LINXPP(J))
  2755. 820      CONTINUE
  2756.         ENDIF
  2757.         IF(TAGPP .EQ. ROWTAG) THEN
  2758.          DO 830 I = 1,N
  2759.           IF(MODE1A .EQ. 1) THEN
  2760.            Y(J,I)=XXX(LINYPP(J),I)
  2761.           ELSE
  2762.            Y(J,I)=YYY(LINYPP(J),I)
  2763.           ENDIF
  2764. 830      CONTINUE
  2765.         ELSE
  2766.          DO 832 I=1,M
  2767.           IF(MODE1A .EQ. 1) THEN
  2768.            Y(J,I)=XXX(I,LINYPP(J))
  2769.           ELSE
  2770.            Y(J,I)=YYY(I,LINYPP(J))
  2771.           ENDIF
  2772. 832      CONTINUE
  2773.         ENDIF
  2774. 840    CONTINUE
  2775.       ENDIF
  2776. C
  2777. C FIND THE MAXIMUM RADIUS
  2778. C
  2779.       IF(INCTRL .EQ. 0) THEN
  2780.        RMAX = -1
  2781.        DO 905 I = 1,NLINPP
  2782.        DO 905 J = 1,NPTSPP
  2783. 905    RMAX = AMAX1(RMAX,X(I,J))
  2784.        IF(MODE1A .EQ. 2) THEN
  2785.          DO 906 I = 1,NLINPP
  2786.          DO 906 J = 1,NPTSPP
  2787. 906      RMAX = AMAX1(RMAX,Y(I,J))
  2788.        ENDIF
  2789.       ENDIF
  2790.  
  2791.       DO 920 J = 1,NPTSPP
  2792.       XPL(J) = X(1,J)
  2793.       YPL(J) = Y(1,J)
  2794. 920   CONTINUE
  2795.       IF(INCTRL .EQ. 0) THEN
  2796.        MODEPP(8) = LNSLPP(1)
  2797.        MODEPP(7) = FGRPPP(1)
  2798.        MODEPP(6) = BGRPPP
  2799.        MODEPP(1) = MODE1A + MODE1B
  2800.        MODEPP(2) = MODE2A
  2801.        CALL SAVPLT(5)
  2802.       ENDIF
  2803.  
  2804.       CALL MAPSIZ(XSTPP,XFRCPP,YSTPP,YFRCPP,LABEPP)
  2805.       CALL POLAR(RMAX,XPL,YPL,IZ,MODEPP,NPTSPP,ISMNPP(1),SMSZPP(1),
  2806.      1      NTSMPP(1),LABPP)
  2807.       IF(NLINPP .GT. 1) THEN
  2808.       WRITE(9,4554)
  2809. 4554  FORMAT("TAKING MULTI LINE BRANCH")
  2810.        MODEPP(1) = MODE1A+2
  2811.        MODEPP(3) = 0
  2812.        MODEPP(4) = 0
  2813.        MODEPP(5) = 0
  2814.        MODEPP(6) = 0
  2815.        DO 950 I = 2,NLINPP
  2816.        DO 940 J = 1,NPTSPP
  2817.        XPL(J) = X(I,J)
  2818.        YPL(J) = Y(I,J)
  2819. 940    CONTINUE
  2820.        MODEPP(7) = FGRPPP(I)
  2821.        MODEPP(8) = LNSLPP(I)
  2822.        CALL POLAR(RMAX,XPL,YPL,IZ,MODEPP,NPTSPP,ISMNPP(I),SMSZPP(I),
  2823.      1         NTSMPP(I),LABPP)
  2824. 950    CONTINUE
  2825.       ENDIF
  2826.       IF(INCTRL .NE. 0)RETURN
  2827.       GOTO 100
  2828. 990   CONTINUE
  2829.       RETURN
  2830.       END
  2831. C
  2832. C THIS ROUTINE DETERMINES THE ORDERING AND NUMBER OF LINES ON THE PLOTS
  2833. C
  2834. C THE VARIABLE IDEF IS A BRANCHING FLAG.  IDEF = 1 OR 2 INDICATES THE
  2835. C ROUTINE WAS CALLED FROM XYPLT.  IDEF = 1 INDICATES IMPLICIT X MODE,
  2836. C IDEF = 2 INDICATES EXPLICIT X MODE.  IDEF = 3 OR 4 INDICATES THE 
  2837. C ROUTINE WAS CALLED FROM POLPLT.  IDEF = 3 INDICATES THAT THE PLOT IS
  2838. C TYPE REAL (R-THETA).  IDEF = 4 INDICATES THE PLOT IS TYPE COMPLEX
  2839. C (X+IY).
  2840.  
  2841.       SUBROUTINE PLTPRP(X,Y,M,N,XXX,YYY,ICURS,TAG,NLINES
  2842.      1,LINX,LINY,NPTS,IDEF)
  2843.       DIMENSION X(10,500),Y(10,500)
  2844.       INTEGER M,N,NLINES,LINX(10),LINY(10),NPTS,IDEF
  2845.       DIMENSION XXX(M,N),YYY(M,N)
  2846.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  2847.       CHARACTER*1 ANS
  2848.       CHARACTER*4 ROWTAG,COLTAG,TAG,ICURS(2)
  2849.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  2850.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  2851. C
  2852. C PLOT SPECIFIC VARIABLES
  2853. C
  2854.       LOGICAL PLTST,SETBG,BNHERE
  2855.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  2856.       DATA ROWTAG /' ROW'/,COLTAG/' COL'/
  2857.  
  2858. 6     WRITE(WTE,10)M,N,COLOR1,ICURS,COLOR2
  2859.       CALL CHKEND
  2860. 10    FORMAT(1X,"PLOTTING FROM A",I4," ROW BY",I4," COLUMN ARRAY.",/,
  2861.      1"SHOULD WE PLOT ALONG ROWS OR COLUMNS?"/,4A4,$)
  2862.       IF(WIO .NE. 0)WRITE(WIO,10)M,N,COLOR1,ICURS,COLOR2
  2863.       READ(RTE,15)ANS
  2864. 15    FORMAT(A1)
  2865.       IF(WIO .NE. 0) WRITE(WIO,16)ANS
  2866. 16    FORMAT(1X,A1)
  2867.       IF(ANS .NE. 'R' .AND. ANS .NE. 'r' .AND. ANS .NE. 'C' .AND.
  2868.      1 ANS .NE. 'c') THEN
  2869.        WRITE(WTE,20)COLOR3,COLOR2
  2870. 20     FORMAT(1X,A4,"ERROR. PLEASE ANSWER WITH ROWS OR COLUMNS",A4)
  2871.        IF(WIO .NE. 0) WRITE(WIO,20)COLOR3,COLOR2
  2872.        GOTO 6
  2873.       ENDIF
  2874.       IF(ANS .EQ. 'R' .OR. ANS .EQ. 'r') THEN
  2875.        TAG = ROWTAG
  2876.        NPTS = N
  2877.       ELSE
  2878.        TAG = COLTAG
  2879.        NPTS = M
  2880.       ENDIF
  2881. C
  2882. C FIND OUT HOW MANY PLOTS TO PREPARE
  2883. C
  2884. 24    WRITE(WTE,25)COLOR1,ICURS,COLOR2
  2885.       IF(WIO .NE. 0) WRITE(WIO,25)COLOR1,ICURS,COLOR2
  2886. 25    FORMAT(1X,"HOW MANY LINES WILL BE ENTERED ON THIS PLOT?"/,
  2887.      14A4,$)
  2888.       CALL VALGET(0,NLINES,'I')
  2889.       IF(NLINES .GT. 10) THEN
  2890.        WRITE(WTE,27)COLOR3,COLOR2
  2891.        IF(WIO .NE. 0) WRITE(WIO,27)COLOR3,COLOR2
  2892. 27     FORMAT(1X,A4,"ERROR. MAXIMUM 10 LINES PER PLOT.",A4)
  2893.        GOTO 24
  2894.       ENDIF
  2895.  
  2896. C
  2897. C ASK ABOUT EACH SET OF PLOTS
  2898. C
  2899.       DO 100 INDEX = 1, NLINES
  2900.       IF(IDEF .EQ. 2 .OR. IDEF .EQ. 3 .OR. IDEF .EQ. 4) THEN
  2901. 26      CONTINUE
  2902.         IF(IDEF .EQ. 2) THEN
  2903.          WRITE(WTE,30)INDEX,TAG,COLOR1,ICURS,COLOR2
  2904. 30       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
  2905.      1   OF THE X COMPONENT"/,4A4,$)
  2906.          IF(WIO .NE. 0) WRITE(WIO,30)INDEX,TAG,COLOR1,ICURS,COLOR2
  2907.         ELSE IF(IDEF .EQ. 3) THEN
  2908.          WRITE(WTE,31)INDEX,TAG,COLOR1,ICURS,COLOR2
  2909. 31       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
  2910.      1   OF THE RADIAL COMPONENT"/,4A4,$)
  2911.          IF(WIO .NE. 0) WRITE(WIO,30)INDEX,TAG,COLOR1,ICURS,COLOR2
  2912.         ELSE IF(IDEF .EQ. 4) THEN
  2913.          WRITE(WTE,32)INDEX,TAG,COLOR1,ICURS,COLOR2
  2914. 32       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE ",A4," NUMBER
  2915.      1   OF THE COMPLEX VARIABLE"/,4A4,$)
  2916.         ENDIF
  2917.  
  2918.         CALL VALGET(0,INDEXX,'I')
  2919. 36      FORMAT(1X,I2)
  2920. 35      FORMAT(I2)
  2921.         IF(TAG .EQ. COLTAG .AND.(INDEXX .GT. N .OR. INDEXX .LT. 1))
  2922.      1             THEN
  2923.         CALL MENUER(N)
  2924.          GOTO 26
  2925.         ELSE IF(TAG .EQ. ROWTAG .AND.(INDEXX .GT. M .OR.
  2926.      1           INDEXX .LT. 1)) THEN
  2927.          CALL MENUER(M)
  2928.          GOTO 26
  2929.         ENDIF
  2930.         LINX(INDEX)=INDEXX
  2931.         IF(TAG .EQ. ROWTAG) THEN
  2932.          DO 50 I = 1,N
  2933. 50       X(INDEX,I)=XXX(INDEXX,I)
  2934.         ELSE
  2935.          DO 52 I=1,M
  2936. 52       X(INDEX,I)=XXX(I,INDEXX)
  2937.         ENDIF
  2938.       ELSE
  2939.         LINX(INDEX)=0
  2940.         IF(TAG .EQ. ROWTAG) THEN
  2941.          DO 53 I = 1,N
  2942. 53       X(INDEX,I)=FLOAT(I)
  2943.         ELSE
  2944.          DO 54 I=1,M
  2945. 54       X(INDEX,I)=FLOAT(I)
  2946.         ENDIF
  2947.       ENDIF
  2948.       IF(IDEF .EQ. 1 .OR. IDEF .EQ. 2 .OR. IDEF .EQ. 3)THEN
  2949. 56      CONTINUE
  2950.         IF(IDEF .EQ. 1 .OR. IDEF .EQ. 2) THEN
  2951.          WRITE(WTE,60)INDEX,TAG,COLOR1,ICURS,COLOR2
  2952. 60       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER
  2953.      1   OF THE Y COMPONENT"/,4A4,$)
  2954.          IF(WIO .NE. 0) WRITE(WIO,60)INDEX,TAG,COLOR1,ICURS,COLOR2
  2955.         ELSE
  2956.          WRITE(WTE,61)INDEX,TAG,COLOR1,ICURS,COLOR2
  2957. 61       FORMAT(1X,"FOR LINE NUMBER ",I2,/"ENTER THE",A4," NUMBER OF THE
  2958.      1   ANGULAR COMPONENT"/,4A4,$)
  2959.          IF(WIO .NE. 0) WRITE(WIO,61)INDEX,TAG,COLOR1,ICURS,COLOR2
  2960.         ENDIF
  2961.         CALL VALGET(0,INDEXY,'I')
  2962.         IF(TAG .EQ. COLTAG .AND.(INDEXY .GT. N .OR. INDEXY .LT. 1)) THEN
  2963.          CALL MENUER(N)
  2964.          GOTO 56
  2965.         ELSE IF(TAG .EQ. ROWTAG .AND. (INDEXY .GT. M .OR.
  2966.      1            INDEXY .LT. 1)) THEN
  2967.          CALL MENUER(M)
  2968.          GOTO 56
  2969.         ENDIF
  2970.       ENDIF
  2971.       LINY(INDEX)=INDEXY
  2972.       IF(IDEF .NE. 4) THEN
  2973.         IF(TAG .EQ. ROWTAG) THEN
  2974.          DO 80 I = 1,N
  2975. 80       Y(INDEX,I)=XXX(INDEXY,I)
  2976.         ELSE
  2977.          DO 82 I=1,M
  2978. 82       Y(INDEX,I)=XXX(I,INDEXY)
  2979.         ENDIF
  2980.       ELSE
  2981.         IF(TAG .EQ. ROWTAG) THEN
  2982.           DO 90 I = 1,N
  2983. 90        Y(INDEX,I) = YYY(INDEXY,I)
  2984.         ELSE
  2985.           DO 92 I = 1,M
  2986. 92        Y(INDEX,I) = YYY(I,INDEXY)
  2987.         ENDIF
  2988.       ENDIF
  2989. 100   CONTINUE
  2990.       RETURN
  2991.       END
  2992. C
  2993. C SET THE LINE SYMBOL OPTIONS
  2994. C
  2995.       SUBROUTINE LNOPTS(NLINES,SYMSIZ,INTSYM,ISYMNO,LINSYL,ICURS)
  2996.       DIMENSION SYMSIZ(10),INTSYM(10),ISYMNO(10),LINSYL(10)
  2997.       INTEGER NLINES
  2998.       INTEGER*4 COLOR1,COLOR2,COLOR3,BGRP
  2999.       CHARACTER*1 ANS
  3000.       CHARACTER*4 ICURS(2)
  3001.       INTEGER DDT,ERR,FMT,LCT(4),LIN(1024),LPT(6),HIO,RIO,WIO,RTE,WTE,FE
  3002.       COMMON /IOP/ DDT,ERR,FMT,LCT,LIN,LPT,HIO,RIO,WIO,RTE,WTE,FE
  3003. C
  3004. C PLOT SPECIFIC VARIABLES
  3005. C
  3006.       LOGICAL PLTST,SETBG,BNHERE
  3007.       COMMON /MATPLT/ COLOR1,COLOR2,COLOR3,BGRP,PLTST,SETBG,BNHERE
  3008.  
  3009. 620   CONTINUE
  3010.       WRITE(WTE,625)COLOR1,ICURS,COLOR2
  3011.       IF(WIO .NE. 0)WRITE(WIO,625)COLOR1,ICURS,COLOR2
  3012. 625   FORMAT(1X,"PLEASE SELECT A LINE OPTION"/,
  3013.      1" [1] CHOOSE LINE SYMBOL TYPE"/,
  3014.      2" [2] CHOOSE LINE PATTERN TYPE"/,
  3015.      3" [3] RETURN TO PREVIOUS MENU"/,4A4,$)
  3016.       CALL VALGET(0,IANS,'I')
  3017.       GOTO (460,660,900),IANS
  3018.       CALL MENUER(3)
  3019.       GOTO 620
  3020. 460   CONTINUE
  3021.       LSTART = 1
  3022.       LEND = 1
  3023.       IF(NLINES .GT. 1) THEN
  3024.        WRITE(WTE,462)COLOR1,ICURS,COLOR2
  3025.        IF(WIO .NE. 0)WRITE(WIO,462)COLOR1,ICURS,COLOR2
  3026.        CALL CHKEND
  3027. 462    FORMAT(1X,"CHOOSE SYMBOLS FOR ALL LINES?"/,4A4,$)
  3028.        READ(RTE,463)ANS
  3029. 463    FORMAT(A1)
  3030.        IF(WIO .NE. 0) WRITE(WIO,464)ANS
  3031. 464    FORMAT(1X,A1)
  3032.        IF(ANS .NE. 'Y' .AND. ANS .NE. 'y' .AND. ANS .NE. 'N' .AND.
  3033.      1 ANS .NE. 'n') THEN
  3034.         WRITE(WTE,465)COLOR3,COLOR2
  3035. 465     FORMAT(1X,A4,"ERROR. PLEASE ANSWER YES OR NO",A4)
  3036.         IF(WIO .NE. 0) WRITE(WIO,465)COLOR3,COLOR2
  3037.         GOTO 460
  3038.        ENDIF
  3039.        IF (ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
  3040.         LSTART=1
  3041.         LEND=NLINES
  3042.        ELSE
  3043. 466     WRITE(WTE,467)COLOR1,ICURS,COLOR2
  3044.         CALL CHKEND
  3045.         IF(WIO .NE. 0) WRITE(WIO,467)COLOR1,ICURS,COLOR2
  3046. 467     FORMAT(1X,"PLEASE CHOOSE THE LINE NUMBER"/,4A4,$)
  3047.         CALL VALGET(0,LINENO,'I')
  3048.         IF(LINENO .GT. NLINES) THEN
  3049.          CALL MENUER(NLINES)
  3050.          GOTO 466
  3051.         ENDIF
  3052.         LSTART = LINENO
  3053.         LEND = LINENO
  3054.        ENDIF
  3055.       ENDIF
  3056.       DO 476 I = LSTART,LEND
  3057. 468   CONTINUE
  3058.       WRITE(WTE,469)I,COLOR1,ICURS,COLOR2
  3059.       CALL CHKEND
  3060.       IF(WIO.NE.0) WRITE(WIO,469)I,COLOR1,ICURS,COLOR2
  3061. 469   FORMAT(1X,"FOR LINE NUMBER ",I2," PLEASE CHOOSE AN OPTION"/,
  3062.      1" [1] NO SYMBOL"/,
  3063.      2" [2] TRIANGLE"/,
  3064.      3" [3] BOX"/,
  3065.      4" [4] DIAMOND"/,
  3066.      5" [5] HOURGLASS"/,
  3067.      6" [6] RETURN TO LINE OPTIONS MENU"/,4A4,$)
  3068.       CALL VALGET(0,IANS,'I')
  3069.       GOTO (475,470,470,470,470,900),IANS
  3070.        CALL MENUER(6)
  3071.        GOTO 468
  3072. 470   ISYMNO(I)=IANS-1
  3073. 471   WRITE(WTE,472)COLOR1,ICURS,COLOR2
  3074.       CALL CHKEND
  3075.       IF(WIO .NE. 0) WRITE(WIO,472)COLOR1,ICURS,COLOR2
  3076. 472   FORMAT(1X,"ENTER THE SYMBOL SIZE IN CM
  3077.      1 (BLANK LINE = DEFAULT)"/,4A4,$)
  3078.       CALL VALGET(SYMSIZ(I),0,'F')
  3079.       WRITE(WTE,474)COLOR1,ICURS,COLOR2
  3080.       IF(WIO .NE. 0) WRITE(WIO,474)COLOR1,ICURS,COLOR2
  3081. 474   FORMAT(1X,"ENTER THE SYMBOL INTERVALS"/,4A4,$)
  3082.       CALL VALGET(0,INTSYM(I),'I')
  3083.       CYCLE
  3084. 475   ISYMNO(I) = IANS-1
  3085. 476   CONTINUE
  3086.       GOTO 620
  3087. 660   CONTINUE
  3088.       LSTART = 1
  3089.       LEND = 1
  3090.       IF(NLINES .GT. 1) THEN
  3091.        WRITE(WTE,662)COLOR1,ICURS,COLOR2
  3092.        CALL CHKEND
  3093.        IF(WIO .NE. 0)WRITE(WIO,662)COLOR1,ICURS,COLOR2
  3094. 662    FORMAT(1X,"CHOOSE LINE STYLES FOR ALL LINES?"/,4A4,$)
  3095.        READ(RTE,463)ANS
  3096.        IF(WIO .NE. 0) WRITE(WIO,464)ANS
  3097.        IF(ANS .NE. 'Y' .AND. ANS .NE. 'y' .AND. ANS .NE. 'N' .AND.
  3098.      1 ANS .NE. 'n') THEN
  3099.         WRITE(WTE,465)COLOR3,COLOR2
  3100.         IF(WIO .NE. 0) WRITE(WIO,465)COLOR3,COLOR2
  3101.         GOTO 660
  3102.        ENDIF
  3103.        IF(ANS .EQ. 'Y' .OR. ANS .EQ. 'y') THEN
  3104.         LSTART=1
  3105.         LEND=NLINES
  3106.        ELSE
  3107. 666     WRITE(WTE,467)COLOR1,ICURS,COLOR2
  3108.         CALL CHKEND
  3109.         IF(WIO .NE. 0) WRITE(WIO,467)COLOR1,ICURS,COLOR2
  3110.         CALL VALGET(0,LINENO,'I')
  3111.         IF(LINENO .GT. NLINES) THEN
  3112.          CALL MENUER(NLINES)
  3113.          GOTO 666
  3114.         ENDIF
  3115.         LSTART = LINENO
  3116.         LEND = LINENO
  3117.        ENDIF
  3118.       ENDIF
  3119.       DO 675 I = LSTART,LEND
  3120. 667   WRITE(WTE,668)I,COLOR1,ICURS,COLOR2
  3121.       CALL CHKEND
  3122.       IF(WIO .NE. 0) WRITE(WIO,668)I,COLOR1,ICURS,COLOR2
  3123. 668   FORMAT(1X,"FOR LINE NUMBER ",I2," PLEASE CHOOSE A LINE STYLE"/,
  3124.      1" [1] SOLID LINE"/,
  3125.      2" [2] LONG DASH"/,
  3126.      3" [3] SHORT DASH"/,
  3127.      4" [4] DOT DASH"/,
  3128.      5" [5] RETURN TO LINE OPTIONS MENU"/,4A4,$)
  3129.       CALL VALGET(0,IANS,'I')
  3130.       GOTO (670,670,670,670,620),IANS
  3131.       CALL MENUER(5)
  3132.       GOTO 667
  3133. 670   LINSYL(I)=IANS
  3134. 675   CONTINUE
  3135.       GOTO 620
  3136. 900   CONTINUE
  3137.       RETURN
  3138.       END
  3139.