home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 100-199 / ff144.lzh / AnalytiCalc / AnalyUtilSrc.Arc / ACGraf.For next >
Text File  |  1987-10-15  |  40KB  |  1,346 lines
  1. C COPYRIGHT (C) 1983 GLENN EVERHART
  2. c all rights reserved
  3. C G H A S P   - Generalized Histogram And Scatter Plot
  4. C REQUIREMENTS:
  5. C COMMONS /EXTRA/ AND /PLOTS/ MUST EXIST, AND ARRAY MA'S DIMENSION (AS 4
  6. C BYTE INTEGERS) MUST BE PLACED INTO NDLTY.
  7. C NPLTS IS THE NUMBER OF PLOTS TO BE GENERATED; THEY ARE ALLOCATED OUT OF
  8. C ARRAY MA DYNAMICALLY.
  9. C THE VARIABLES IN THE /PLOTS/ COMMON HAVE THE FOLLOWING MEANINGS:
  10. C NDIM IS THE NUMBER OF DIMENSIONS. 1 IS HISTOGRAM, 2 IS SCATTER PLOT
  11. C XMIN,YMIN ARE X,Y MIN COORDS IN THE HISTOGRAM
  12. C DX,DY ARE BIN SIZES
  13. C NBINX,NBINY ARE NUMBER OF BINS IN X AND Y (NOTE GHASP WILL INDICATE NUMBER
  14. C    OF OVERFLOWS)
  15. C TITLE IS AN ARRAY OF CHARACTERS USED TO PRINT OUT THE TITLE FOR THE PLOT.
  16. C THE SUBROUTINE INTERFACE IS TO CALL THE SUBROUTINE PLOT.
  17. C
  18. C CALL:
  19. C   CALL PLOT(XVAL,YVAL,IFUNCT,NPLT)
  20. C  WHERE XVAL AND YVAL ARE X,Y COORDINATES FOR THE PLOT IF SCATTERPLOT, OR
  21. C X IS THE COORDINATE AND Y THE WEIGHT IF A HISTOGRAM.
  22. C IFUNCT IS -1, 0, 1, OR 2.
  23. C    -1 MEANS INITIALIZE; CALL PLOT ONCE THIS WAY TO SET UP THE NUMBER
  24. C        OF HISTOGRAMS AND INITIALIZE ITS SCRATCH VARIABLES.
  25. C    0 MEANS INITIALIZE VARIABLES FOR A GIVEN PLOT NUMBER. THIS EXPECTS
  26. C        YOU HAVE SET THE PLOTS COMMON VARIABLES UP BEFORE THE
  27. C        CALL. SET XVAL TO 4H/ DIM/ AT THIS CALL TO PRINT SOME
  28. C        INFORMATION ABOUT HOW MUCH OF THE PLOT ARRAY IS USED UP;
  29. C        THIS WILL ALLOW YOU TO CHANGE THE SIZE OF MA TO WHAT
  30. C        IS REALLY NEEDED.
  31. C    1 MEANS ENTER A POINT IN THE HISTOGRAM/SCATTER PLOT, USING THE X AND
  32. C        Y VALUES. NOTICE THAT THE COMMON /PLOTS/ VARIABLES ARE NOT
  33. C        NECESSARILY THE SAME AS AT IFUNCT=0 TIME; ONCE THE PLOT IS
  34. C        INITIALIZED YOU JUST ADD POINTS AND PLOT.
  35. C    2 MEANS PLOT THE HISTOGRAM OR SCATTER PLOT. THE XVAL ARGUMENT IS
  36. C        IMPORTANT AT THIS TIME; PLOT NUMBER MUST BE GIVEN.
  37. C
  38. C A VARIETY OF OPTIONS FOR PLOT FORMAT EXIST AND ARE ENCODED BY THE LETTER
  39. C USED IN THE XVAL ARGUMENT OF PLOT AT THE TIME YOU CALL IT WITH THE IFUNCT
  40. C ARGUMENT OF 2. TWO OF THESE ARE THAT THE PLOT CAN BE MADE AS HIGH AS IT
  41. C NEEDS TO BE TO PLOT THE DATA. THIS IS THE VARY COMMAND AND IS ENCODED AS
  42. C 4H/   V/ (SEE EXAMPLE CALLER PROGRAM). ANOTHER OPTION IS THE HACK OPTION,
  43. C CUTTING OFF THE PLOT AT ONE PAGE. THIS USES THE VALUE 4H/   H/. ONE CAN
  44. C ALSO SCALE THE PLOT TO FIT ON A PAGE; 4H/   S/ WILL DO
  45. C THIS. THERE ARE SOME DENSITY PLOTS AVAILABLE ALSO FOR SCATTER PLOTS;
  46. C THE NORMAL PLOTS ARE 2 DIGIT NUMBERS (6 BITS ARE USED, PACKED 5 BINS TO
  47. C A WORD, FOR COUNTING NUMBERS PER BIN).
  48. C USE 4H/   Q/ FOR SHADED SCATTER PLOTS; DENSITY WILL BE APPROXIMATE ONLY
  49. C BUT GHASP WILL ATTEMPT TO PLOT A SCATTER PLOT SHADED. NOTE A PLOT CAN
  50. C BE PRINTED OUT MORE THAN ONCE, IN DIFFERENT FORMATS, SO A PLOT MAY BE
  51. C PLOTTED NUMERICALLY WITH 4H/   V/ AND IN SHADED MODE AS WELL.
  52. C
  53. C COPYRIGHT (C) 1983, 1984 GLENN AND MARY EVERHART
  54. C ALL RIGHTS RESERVED
  55. C    PCC GRAF
  56. C  NOTE: REQUIRES LUN 4 FOR TERMINAL OUTPUT AND LUN 5 FOR
  57. C  TERMINAL INPUT.
  58. C (GHASP USES 6 FOR LP:)
  59. C
  60. C GRAPHICS INTERFACE AND OUTPUT FROM PCC SPREADSHEET
  61. C
  62. C  GLENN EVERHART, 23-JAN-83
  63. C
  64. C SYNTAX AND USAGE:
  65. C
  66. C  This program is designed to allow an interactive user to enter
  67. C a single command line to the program which it will parse (using
  68. C the special version of VARSCN in GVARSCN) and allow graphic output
  69. C from PortaCalc saved spread sheets. The assumption made is that
  70. C the sheet has been saved with the PPN or PDN command. The filename
  71. C must appear in the command line and variables in the file (named as
  72. C though the cursor had been in cell A1 when the PPN / PDN was done)
  73. C may be histogrammed or scatterplotted against each other.
  74. C
  75. C The GHASP routine (a FORTRAN plot package for ordinary printers)
  76. C will be used for this version.
  77. C
  78. C Input syntax:
  79. C  NN or LL filename.ext V1:V2 c V3:V4 +switches
  80. C
  81. C  where
  82. C
  83. C  an L in columns 1 or 2 takes log of 1st or 2nd range numbers (base 10),
  84. C
  85. C  filename appears at the start of the command line after a space
  86. C  and with a space following it and is a valid RSX or VMS file spec.
  87. C
  88. C  V1:V2 and V3:V4 are ranges. V3:V4 is optional and its presence implies
  89. C  a scatter plot. These ranges must be either a row or a column or part
  90. C  of them. If only range V1:V2 is present, a histogram will be done using
  91. C  the Scale option of GHASP to fit the plot onto a page. The plot will be
  92. C  set up for 100 bins horizontal, 50 vertical.
  93. C    If the V3:V4 range exists, the character Q in the c position (the
  94. C  are required) will result in a "density" plot in which the program will
  95. C  attempt to print darker in filled bins. This is crude and the default is
  96. C  to use a 2 digit number. Again, plot size will be scaled to 50 by 50
  97. C  bins.
  98. C
  99.     CHARACTER*1 LINE(128),KLET,LLET
  100.     INTEGER*4 NDLTY,NPLTS,MA(1000)
  101.     INTEGER*4 NDIM,TITLE(19)
  102.     CHARACTER*1 LTITL(76)
  103.     CHARACTER*1 LLA,LLB
  104.     EQUIVALENCE(TITLE(1),LTITL(1))
  105.     INTEGER*4 IXTR
  106.     COMMON/IXTR/IXTR
  107.     INTEGER*4 NBINX,NBINY
  108.     REAL*4 XMIN,YMIN,DX,DY
  109.     INTEGER*4 KK,LS1,LS2,LQ
  110.     REAL*4 VEC1(300),VEC2(300)
  111.     CHARACTER*1 IONM(50)
  112.     COMMON/EXTRA/NDLTY,NPLTS,MA
  113.     EXTERNAL INDX
  114.     COMMON/PLOTS/NDIM,XMIN,YMIN,DX,DY,NBINX,NBINY,TITLE
  115.     REAL*4 RS,RV,RQ,RH
  116.     CHARACTER*4 RRS,RRV,RRQ,RRH
  117.     EQUIVALENCE(RS,RRS),(RV,RRV),(RQ,RRQ),(RH,RRH)
  118.     DATA RRS/'   S'/
  119.     DATA RRV/'   V'/
  120.     DATA RRQ/'   Q'/
  121.     DATA RRH/'   H'/
  122. 100    NDLTY=1000
  123.     NPLTS=1
  124. C    CALL ASSIGN(4,'TI:')
  125. C    CALL ASSIGN(5,'TI:')
  126. C    CALL ASSIGN(6,'LP:')
  127.     IXTR=0
  128.     DO 1982 N=1,128
  129. 1982    LINE(N)=0
  130.     WRITE(*,8000)
  131. 8000    FORMAT(' Give Output Dataset Name>',\)
  132.     read(*,2)ionm
  133.     DO 8222 N=1,50
  134.     NNN=51-N
  135.     IF(ICHAR(IONM(NNN)).GT.32)GOTO 8223
  136.     IONM(NNN)=0
  137. 8222    CONTINUE
  138. 8223    CONTINUE
  139. C    IDL=NNN+1
  140.     CALL WASSIG(6,IONM)
  141.     ITTFG=0
  142.     IF((IONM(1).EQ.'C'.OR.IONM(1).EQ.'c').AND.IONM(4).EQ.':')
  143.      1  ITTFG=1
  144. C ALSO MAKE TTY IMAGES IF 1ST 2 CHARS ARE TT
  145.     IF(IONM(1).EQ.'T'.AND.IONM(2).EQ.'T')ITTFG=1
  146.     IF(ITTFG.EQ.1)IXTR=1
  147. C TOGGLE FOR PLOT ROUTINE...
  148.     WRITE(*,1)
  149. 1    FORMAT(' Enter plot command>',\)
  150.     READ(*,2)LINE
  151. 2    FORMAT(128A1)
  152. C FIND END OF LINE ENTERED BY LOOKING FOR 1ST CHAR BIGGER THAN SPACE IN ASCII.
  153.     DO 1980 N=1,128
  154.     NN=129-N
  155.     IF(ICHAR(LINE(NN)).GT.32)GOTO 1981
  156. 1980    CONTINUE
  157. 1981    LQ=NN+1
  158.     LOGF1=0
  159.     LOGF2=0
  160.     NBFG1=0
  161.     IF(LINE(1).EQ.'P')NBFG1=1
  162. C NBFG1 MAKES YMIN=0. THUS IF CMD STARTS WITH PP PLOT IS POSITIVE
  163. C DITTO NBFG2
  164.     NBFG2=0
  165.     IF(LINE(2).EQ.'P')NBFG2=1
  166.     IF(LINE(1).EQ.'L')LOGF1=1
  167.     IF(LINE(2).EQ.'L')LOGF2=1
  168.     LLA=LINE(1)
  169.     LLB=LINE(2)
  170. C 1ST 2 CHARS SAY LOG OR LOGLOG (IF 2DIM GRAPH)
  171. C LOGF1 WILL TAKE LOG OF VEC1 AND LOGF2 WILL TAKE LOG OF VEC2
  172. C IF SET.
  173. C NOTE THAT THIS ALSO TAKES ABS OF NUMBER.
  174.     LQ=LQ+1
  175.     LQ=MIN0(128,LQ)
  176.     LINE(127)=0
  177.     LINE(128)=0
  178.     LINE(LQ)=0
  179. c
  180. c process switches.
  181. c switches are after trailing + sign
  182. c
  183. c +hnnn = set height
  184. c +wnnn = set width
  185.     nhov=0
  186.     nwov=0
  187.     KK=INDX(LINE,'+')
  188.     IF(KK.GT.50)GOTO 6000
  189. C SKIP THIS AREA IF NO SWITCHES ARE FLAGGED
  190.     LINE(KK)=CHAR(0)
  191. C SKIP SWITCHES IN LATER PROCESSING.
  192. c since we look for a number, first try to decode the number as a
  193. c 3 digit one...
  194.     kkk=kk+2
  195.     lend1=kkk+30
  196.     call gn(kkk,lend1,num1,line)
  197. c num1 can be h or w depending on line(kk+1)
  198.     if(line(kk+1).eq.'h'.or.line(kk+1).eq.'H')nhov=num1
  199.     if(line(kk+1).eq.'w'.or.line(kk+1).eq.'W')nwov=num1
  200. C GN RETURNS ITS LAST CHAR AFTER THE # IN ITS 1ST ARG.
  201.     IKK=INDX(LINE(KK+1),'+')
  202.     IF(IKK.GT.30)GOTO 6000
  203.     KKK=IKK+KK
  204. c 2nd + sign flags 2nd switch...
  205.     kk=kkk+2
  206.     lend1=kk+30
  207.     call gn(kk,lend1,num1,line)
  208.     if(line(kkk+1).eq.'h'.or.line(kkk+1).eq.'H')nhov=num1
  209.     if(line(kkk+1).eq.'w'.or.line(kkk+1).eq.'W')nwov=num1
  210. c that should do it...
  211. 6000    CONTINUE
  212.     LS1=INDX(LINE,CHAR(32))
  213. C CALL OUR PORTACALC INDEX FCN
  214.     KK=LS1+1
  215.     LS2=INDX(LINE(KK),CHAR(32))
  216.     IF(LS1.GT.40.OR.LS2.GT.40)WRITE(*,25)LS1,LS2,LQ
  217. 25    FORMAT(' Spaces not seen. Find spaces at ',3I6,
  218.      1  /,' Usage: ACG file V1:V2 C V3:V4 +HNNN+WNNN')
  219.     IF (LS1.GT.40.OR.LS2.GT.40)GOTO 100
  220.     LINE(LS2+LS1)=0
  221.     CALL RASSIG(1,LINE(LS1+1))
  222. C SET UP FILE 1 TO READ SAVED FILE FROM SHEET
  223.     LINE(LS2+LS1)=32
  224.     LX=LS1+LS2+1
  225. C SCAN THE REST STARTING AT LX
  226. C GRAB OFF OUR ARGUMENTS FIRST, THEN GET ON WITH THE PLOTS.
  227.     CALL PLOT(0.,0.,-1,0)
  228. C HOWEVER INITIALIZE PLOT ARRAY EARLY ON.
  229.     K1=LX
  230.     K2=110
  231.     CALL GVSCAN(LINE,K1,K2,LSTCHR,ID1,ID2,IVLD)
  232.     IF (IVLD.NE.0)GOTO 150
  233.     WRITE(*,3)
  234. 3    FORMAT(' First variable invalid. Try again.')
  235.     GOTO 100
  236. 150    CONTINUE
  237.     IF(LINE(LSTCHR).EQ.':')GOTO 160
  238.     WRITE(*,4)
  239. 4    FORMAT(' Colon missing in first range.')
  240.     GOTO 100
  241. 160    CONTINUE
  242.     K1=LSTCHR+1
  243.     K2=110
  244.     CALL GVSCAN(LINE,K1,K2,LSTCR,ID1B,ID2B,IVLD)
  245.     IF (IVLD.NE.0)GOTO 164
  246.     WRITE(*,5)
  247. 5    FORMAT(' 2nd variable in 1st range invalid.')
  248.     GOTO 100
  249. 164    CONTINUE
  250.     IF(ID1.NE.ID1B.AND.ID2.NE.ID2B)GOTO 166
  251.     GOTO 167
  252. 166    WRITE(*,6)
  253. 6    FORMAT(' Variable pair not in a row or column together')
  254.     GOTO 100
  255. 167    CONTINUE
  256.     KCR=1
  257. C : CHECK FOR '' OLD VERSION..........
  258.     IF(LINE(LSTCR).EQ.'[')GOTO 170
  259.     LSTCR=LSTCR+1
  260.     IF(LINE(LSTCR).EQ.'[')GOTO 170
  261. 169    WRITE(*,7)KCR
  262. 7    FORMAT(' Invalid format of [c] character ',I5)
  263.     GOTO 100
  264. 170    LSTCR=LSTCR+1
  265.     KCR=2
  266.     IF(LINE(LSTCR).EQ.']')GOTO 169
  267.     KLET=LINE(LSTCR)
  268.     LSTCR=LSTCR+1
  269. C SCAN OVER NEXT ']' NOW
  270.     KCR=3
  271.     IF(LINE(LSTCR).NE.']')GOTO 169
  272.     LSTCR=LSTCR+1
  273. C IF WE PICK UP A VALID VARIABLE HERE, ALL'S WELL. OTHERWISE WE HAVE
  274. C A HISTOGRAM AND WE'RE DONE (FOR THIS VERSION ANYHOW)
  275.     K1=LSTCR
  276.     K2=110
  277.     NDIM=1
  278.     CALL GVSCAN(LINE,K1,K2,LSTT,ID1C,ID2C,IVLD)
  279.     IF(IVLD.EQ.0)GOTO 200
  280. C IF HERE, THERE HAS TO BE 1 MORE VARIABLE DECODED AND TESTED.
  281.     IF(LINE(LSTT).EQ.':')GOTO 175
  282.     WRITE(*,8)
  283. 8    FORMAT(' Invalid second variable range.')
  284.     GOTO 100
  285. 175    CONTINUE
  286.     K1=LSTT+1
  287.     K2=110
  288.     CALL GVSCAN(LINE,K1,K2,LSTCC,ID1D,ID2D,IVLD)
  289.     IF(IVLD.NE.0)GOTO 180
  290.     WRITE(*,9)
  291. 9    FORMAT(' Invalid 2nd variable of 2nd range')
  292.     GOTO 100
  293. 180    CONTINUE
  294. C NOW ALL DECODED.
  295.     NDIM=2
  296. C NOW WE HAVE SET UP THE DIMENSION OF OUR PLOT.
  297. 200    CONTINUE
  298. C NOW IT'S POSSIBLE TO READ IN THE FILE ONCE TO NORMALIZE IT, THEN
  299. C REWIND AND READ AGAIN TO PLOT IT.
  300.     XMIN=99.E10
  301.     YMIN=99.E10
  302.     IF(NBFG1.NE.0)YMIN=0.
  303.     IF(NBFG2.NE.0)XMIN=0.
  304. C SET TERRIBLY LARGE X,Y MINS UNLESS POSITIVE PLOT, THEN START AT 0.
  305. C (WE'LL FIX THEM UP!)
  306.     XMAX=-99.E10
  307.     YMAX=-99.E10
  308. C SET UP MAXIMA ALSO IN BOGUS WAY. THIS ENSURES WHATEVER WE GET
  309. C WILL BE BETTER THAN OUR "FIRST GUESS".
  310. C  INSERT TITLE AS OUR COMMAND LINE, FOR INTERNAL DOCUMENTATION.
  311. C (LX THRU END)
  312.     DO 11 N=1,78
  313. 11    LTITL(N)=CHAR(32)
  314.     LX=LS1
  315. C INCLUDE FILENAME TOO.
  316.     DO 12 N=1,50
  317.     LTITL(N)=LINE(LX)
  318.     IF(LX.GT.76)GOTO 13
  319. 12    LX=LX+1
  320. C FLAG LOG SCALE FLAGS IN TITLE
  321.     IF (LLA.EQ.'L')TITLE(18)='LOGX'
  322.     IF (LLB.EQ.'L')TITLE(19)='LOGY'
  323. 13    READ(1,10)LINE
  324. 10    FORMAT(128A1)
  325.     IF(NDIM.EQ.2)GOTO 17
  326.     XMIN=0.
  327.     XMIN2=0.
  328.     ICNT=0
  329. 17    CONTINUE
  330. C IGNORE TITLE, JUST READ IT IN, THEN FORGET IT.
  331.     IV1=1
  332.     IV2=1
  333. 220    CONTINUE
  334. C NOTE WE READ IN THE NUMBER IN NUMERIC FORMAT. EASIER THAT WAY.
  335.     irrw=0
  336.     iccl=0
  337.     READ(1,14,END=250,ERR=224)LET1,IRRW,ICCL,XYVAL
  338. 224    continue
  339. 14    FORMAT(A1,I5,1X,I5,1X,E50.35)
  340.     READ(1,15,END=250,ERR=225)LFVLD,(LINE(IV),IV=120,128),KKTYP
  341. 225    continue
  342. 15    FORMAT(I3,1X,9A1,1X,I5)
  343. C READS IN AN ENTRY OF SAVED SHEET. TEST IF IN OUR RANGE.
  344.     IF(IRRW.GE.ID1.AND.IRRW.LE.ID1B.AND.ICCL.GE.ID2.AND.ICCL
  345.      1  .LE.ID2B)GOTO 221
  346.     IF(NDIM.NE.2)GOTO 223
  347.     IF(IRRW.GE.ID1C.AND.IRRW.LE.ID1D.AND.ICCL.GE.ID2C
  348.      1  .AND.ICCL.LE.ID2D)GOTO 222
  349.     GOTO 223
  350. 221    CONTINUE
  351. C NUMBER IS IN FIRST RANGE TO PLOT. FIGURE IT OUT.
  352.     IF(LOGF1.NE.0.AND.XYVAL.NE.0)XYVAL=ALOG10(ABS(XYVAL))
  353.     VEC1(IV1)=XYVAL
  354.     IV1=IV1+1
  355.     IF(NDIM.EQ.1)ICNT=ICNT+1
  356.     IF(NDIM.EQ.1)XMAX=ICNT
  357.     IF(NDIM.EQ.1)GOTO 18
  358.     IF(XYVAL.LT.XMIN)XMIN=XYVAL
  359.     IF(XYVAL.GT.XMAX)XMAX=XYVAL
  360.     GOTO 223
  361. 18    CONTINUE
  362.     IF(XYVAL.LT.YMIN)YMIN=XYVAL
  363.     IF(XYVAL.GT.YMAX)YMAX=XYVAL
  364.     VEC2(IV2)=FLOAT(ICNT)
  365.     IV2=IV2+1
  366.     GOTO 223
  367. 222    CONTINUE
  368.     IF(NDIM.EQ.1)GOTO 223
  369.     IF(LOGF2.NE.0.AND.XYVAL.NE.0)XYVAL=ALOG10(ABS(XYVAL))
  370. C NUMBER IS IN SECOND RANGE SELECTED.
  371. C KNOW IT'S A Y COORD HERE.
  372.     VEC2(IV2)=XYVAL
  373.     IV2=IV2+1
  374.     IF(XYVAL.LT.YMIN)YMIN=XYVAL
  375.     IF(XYVAL.GT.YMAX)YMAX=XYVAL
  376. 223    CONTINUE
  377.     GOTO 220
  378. 250    CONTINUE
  379. C NOW MINIMA,MAXIMA ALL SET UP.
  380.     IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX)STOP
  381. C EXIT IF NOTHING IS THERE TO GRAPH.
  382.     XRANGE=XMAX-XMIN
  383.     YRANGE=YMAX-YMIN
  384. C
  385.     IF(XRANGE.LE.0)XRANGE=60.
  386.     IF(YRANGE.LE.0)YRANGE=20.
  387. C    XNUM=100.
  388.     AMXRG=100.
  389.     AMYRG=50.
  390.     IF(ITTFG.EQ.1)AMXRG=60.
  391.     IF(ITTFG.EQ.1)AMYRG=20.
  392.     XNUM=AMXRG
  393.     IF(NDIM.EQ.1.AND.(XRANGE.LT.100.))XNUM=XRANGE
  394.     YNUM=AMYRG
  395.     IF(NDIM.EQ.2)XNUM=AMYRG
  396. C HANDLE SWITCHES THAT OVERRIDE HEIGHT AND WIDTH TO USE.
  397.     IF(NHOV.NE.0)YNUM=NHOV
  398.     IF(NWOV.NE.0)XNUM=NWOV
  399.     DX=XRANGE/XNUM
  400.     DY=YRANGE/YNUM
  401.     IF(.NOT.(NDIM.EQ.1.AND.DX.LT.1))GOTO 19
  402.     IF(NWOV.EQ.0)DX=1.
  403. 19    NBINX=XNUM
  404.     NBINY=YNUM
  405.     CALL PLOT(RV,0.,0,1)
  406. C INITIALIZE PLOT
  407. C NDIM, MINIMA, MAXIMA ALL SET UP NOW.
  408. C
  409. C WE SAVED VALUES IN VEC1,VEC2 AND PLOT THAT WAY.
  410. C  ALSO NOTE BOTH ALWAYS EXIST.
  411. C
  412.     LENGTH=MIN0(IV1,IV2)
  413. C SAME IF NDIM=1
  414.     DO 20 N=1,LENGTH
  415.     IF(NDIM.EQ.1)CALL PLOT(VEC2(N),VEC1(N),1,1)
  416.     IF(NDIM.NE.1)CALL PLOT(VEC1(N),VEC2(N),1,1)
  417. 20    CONTINUE
  418. C PLOT IT OUT NOW
  419. C CHOOSE OPTION FOR FORMAT (SCALE, VARY HEIGHT, SHADE)
  420.     X=RS
  421.     IF(KLET.EQ.'V')X=RV
  422.     IF(KLET.EQ.'Q')X=RQ
  423.     IF(KLET.EQ.'H')X=RH
  424.     CALL PLOT(X,0,2,1)
  425.     STOP
  426.     END
  427.     SUBROUTINE GN(LAST,LEND,NUM,LINE)
  428.     IMPLICIT INTEGER*4(A-Z)
  429. C    PARAMETER 1=1,14=14
  430.     DIMENSION LINE(110)
  431.     CHARACTER*1 LINE
  432.     EXTERNAL INDX
  433.     CHARACTER*1 NCH
  434.     INTEGER*4 CH,SFG
  435.     NUM=0
  436.     JSSF=0
  437.     ISSF=0
  438.     CH=0
  439.     SFG=1
  440.     NCH=0
  441.     DO 1 N=LAST,LEND
  442.     M=N
  443.     NCH=LINE(N)
  444.     CH=ICHAR(NCH)
  445.     IF(CH.EQ.0)GOTO 2
  446.     IF(CH.EQ.45)SFG=-1
  447. C SFG=SIGN FLAG
  448. C 43 IS ASCII FOR +; 45 IS ASCII FOR - SIGN.
  449. C IGNORE + SIGNS
  450.     IF(CH.GT.32)ISSF=ISSF+1
  451.     IF(ISSF.EQ.0.AND.CH.EQ.32)GOTO 1
  452. C IGNORE SPACES TOO, PROVIDED THEY ARE LEADING SPACES.
  453. C (OTHERS MAY BE DELIMITERS.)
  454.     IF(CH.EQ.43.OR.CH.EQ.45)JSSF=JSSF+1
  455.     IF(JSSF.GT.1.AND.(CH.EQ.43.OR.CH.EQ.45))GOTO 2
  456. C IF WE HAVEN'T SEEN A +/- PROCESS IT HERE.
  457.     IF(CH.EQ.43)GOTO 1
  458.     IF(CH.EQ.45)GOTO 1
  459.     IF(CH.LT.48.OR.CH.GT.57)GOTO 2
  460. C TERMINATE ON ANY NON NUMERIC. SHOULD ALLOW TERMINATE ON SECOND #.
  461.     IF(NUM.LT.3100)NUM=10*NUM+(CH-48)
  462. 1    CONTINUE
  463. C NEXT LINE WAS MAX0...
  464. 2    LAST=MIN0(M,LEND)
  465.     NUM=NUM*SFG
  466. C ACCOUNTED FOR SIGN; NOW RETURN
  467.     RETURN
  468.     END
  469.     SUBROUTINE GVSCAN(LINE,IBGN,LEND,LSTCHR,ID1,ID2,IVALID)
  470. C COPYRIGHT (C) 1983 GLENN EVERHART
  471. C ALL RIGHTS RESERVED
  472. C VARSCN - SCAN COMMAND LINE FOR VARIABLE NAMES.
  473. C DUMMY GRAPHICS VERSION
  474. C (NO FUNNY ADDRESS MODES ETC.; FOR USE ON SAVED SHEETS.)
  475. C
  476. C    SCANS FOR VARIABLE NAMES OF FORM AAANNN WHERE AAA = LETTERS
  477. C BETWEEN A AND Z UP TO NON-ALPHA, CORRESPONDING TO ROW, FOLLOWED BY
  478. C NUMBERS IN THE 0-9 RANGE MAKING A DECIMAL COLUMN NUMBER.
  479. C   THIS VERSION IS FOR USE WITH A GRAPHICS PROGRAM AND WILL NOT DECODE
  480. C   FORMS OF TYPE P## OR D## AS WILL THE ONE IN PORTACALC. ALSO IT WILL
  481. C   NOT MAKE CHECKS ON LIMITS OF VARIABLES SAVE FOR VERY CRUDE CHECKS OF
  482. C   REASONABLENESS.
  483. C
  484. C THE LETTERS ARE FORMED BY
  485. C A-Z ALONE GIVE ROW 1-26, COL 1. % IS ROW 27,COL1
  486. C A1-Z1 GIVE ROW 1-26, COL 2
  487. C AA1-ZZ1 ARE ROW 27-52, COL 2
  488.     IMPLICIT INTEGER*4 (A-Z)
  489.     INTEGER*4 RRW,RCL,CUP,NEL,RRCL
  490. C    PARAMETER RRW=1000
  491. C    PARAMETER RCL=1000
  492. C RRCL IS USED AS A GUARD TO ENSURE AGAINST OVERFLOWS. VAX COMPLAINS OF
  493. C INTEGER OVERFLOWS (PAIN).
  494. C    PARAMETER RRCL=1100
  495. C    PARAMETER CUP=1,NEL=14
  496. C NOTE COL 1 IS DUMMY. DISPLAY THE SHEET SIDEWAYS SO WE GET USUAL VISUAL
  497. C ROWS, COLS., AND ACCUMULATORS A-Z,% JUST APPEAR AS A FICTITIOUS ROW 0
  498. C ON DISPLAY, INSTEAD OF REAL COLUMN 1 HERE.
  499.     DIMENSION LINE(LEND)
  500.     CHARACTER*1 LINE
  501. C
  502.     INTEGER*4 RSM,CSM,AFG,ASM,VCF,CH
  503.     DATA RRW/1000/,RCL/1000/,RRCL/1200/,CUP/1/,NEL/14/
  504. C ZERO OUR VARIABLES
  505.     LPFG=0
  506. C ! FLAG WE GOT A LOGICAL/PHYSICAL # FORM AND TYPE
  507.     AFG=0
  508. C ! FLAG WE SAW AN ALPHA
  509.     ASM=0
  510. C ! SUM OF ALPHAS HASHCODED (ACCUMULATOR)
  511.     NSM=0
  512. C ! ACCUMULATOR FOR NUMERICS
  513.     NFG=0
  514. C ! FLAG WE SAW A NUMERIC
  515.     RSM=0
  516. C ! AC FOR ROWS IN # FORMS
  517.     CSM=0
  518. C ! AC FOR COLS IN # FORMS
  519.     ISPC=0
  520. C ! COUNTER FOR NONSPACES SEEN (USED TO STOP ON TRAILING SPACES)
  521.     IF(LINE(IBGN).NE.'%')GOTO 2000
  522.     ID1=27
  523.     ID2=1
  524.     IVALID=1
  525.     LSTCHR=IBGN+1
  526. C SPECIAL CASE FOR % = AC #27
  527.     RETURN
  528. 2000    CONTINUE
  529.     DO 1 N=IBGN,LEND
  530.     VCF=0
  531.     LSTCHR=N
  532.     CH=ICHAR(LINE(N))
  533. C IGNORE SPACES AND TABS IF LEADING
  534.     IF(CH.GT.32)ISPC=ISPC+1
  535.     IF(CH.GT.0.AND.CH.LE.32.AND.ISPC.EQ.0)GOTO 1
  536. C GET CHARACTER VALUE IN.
  537. C MUST BE UPPERCASE.
  538.     IF(.NOT.(CH.GE.65.AND.CH.LE.91)) GOTO 100
  539. C CH IS AN ALPHA, RANGE A-Z
  540.     VCF=1
  541. C ! VALID CHAR SEEN
  542.     AFG=1
  543. C !SAW THE ALPHA
  544.     IF(ASM.LT.RRCL)ASM=(CH-64)+26*ASM
  545.     IF(CH.EQ.80)LPFG=1
  546. C ! FLAG WE GOT PHYS. FORM MAYBE
  547.     IF(CH.EQ.68)LPFG=2
  548. C ! FLAG WE GOT DISPLAY FORM MAYBE
  549. 100    CONTINUE
  550. C NEXT TEST NUMERICS
  551.     IF(.NOT.(CH.GE.48.AND.CH.LE.57))GOTO 101
  552. C CH IS A NUMERIC, RANGE 0-9
  553.     VCF=1
  554. C ! VALID CHAR SEEN
  555.     NFG=1
  556. C ! FLAG WE SAW NUMERIC
  557.     IF(AFG.EQ.0)GOTO 103
  558. 102    CONTINUE
  559.     IF(NSM.LT.RRCL)NSM=(CH-48)+10*NSM
  560. C ! CONVERT CHARS TO BINARY AS SEEN
  561. 101    CONTINUE
  562.     IF(VCF.EQ.0)GOTO 2
  563. C !END ON ANY INVALID CHARACTER
  564. 1    CONTINUE
  565.     GOTO 2
  566. 103    CONTINUE
  567. C INVALID ... NUMERIC AND NO PRIOR ALPHA. FLAG BAD NAME AND EXIT.
  568.     IVALID=0
  569.     RETURN
  570. 2    CONTINUE
  571.     IF(AFG.EQ.0)GOTO 103
  572.     ID1=ASM
  573. C HERE WE MAKE ID2 JUST NSM, NOT 1+NSM.
  574.     ID2=NSM
  575. C FLAG PURE ALPHAS NOT VALID FOR PLOTTING HERE. (THEY AREN'T SAVED ANYHOW)
  576.     IF(NSM.LE.0)GOTO 103
  577.     IF(ID1.GT.RRW.OR.ID1.LE.0)GOTO 103
  578.     IF(ID2.GT.RCL.OR.ID2.LE.0)GOTO 103
  579.     IVALID=1
  580. C ALL IS WELL
  581.     RETURN
  582.     END
  583.       SUBROUTINE HIHDIG(X,ID,IS)
  584.       XT=X
  585.       ID=0
  586.       IS=0
  587.       IF (ABS(X).EQ.0.0) RETURN
  588.       IF (ABS(X).LT.1.) GO TO 20
  589.       IF (ABS(X).GE.10.) GO TO 30
  590.       ID=X
  591.       RETURN
  592.    20 XT=XT*10.
  593.       IS=IS-1
  594.       IF (ABS(XT).LT.1.) GO TO 20
  595.       GO TO 40
  596.    30 XT=XT/10.
  597.       IS=IS+1
  598.       IF (ABS(XT).GE.10.) GO TO 30
  599.    40 ID=XT
  600.       RETURN
  601.       END
  602.       INTEGER FUNCTION INDX ( STR, C )
  603. C
  604.       CHARACTER * 1 C, STR ( 1 )
  605. C
  606. C LIMIT RANGE OF SEARCH TO 256 BYTES. THIS IS ARBITRARY BUT I DOUBT
  607. C ANALYTICALC WILL EVER DEAL IN LONGER STRINGS THAN THIS AND
  608. C SEARCHES ALL OVER THE CREATION ARE TO BE AVOIDED.
  609.       DO 20019  I = 1, 256
  610.       IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20021
  611. C RETURN INDX AS EITHER THE LOCATION OF THE CHARACTER OR OF THE
  612. C END OF THE STRING FOR ANALYTICALC. NOTE THAT THIS DIFFERS
  613. C FROM USUAL RATFOR VERSION.
  614.       INDX=I
  615.       RETURN
  616. 20021 CONTINUE
  617.       IF (.NOT.( STR ( I ) .EQ. C )) GOTO 20023
  618.       INDX = ( I )
  619.       RETURN
  620. 20023 CONTINUE
  621. 20022 CONTINUE
  622. C
  623. 20019 CONTINUE
  624. 20020 CONTINUE
  625.       END
  626.       INTEGER FUNCTION ISGN(IARG)
  627.       INTEGER*4 IARG
  628.       IF(IARG.EQ.0)ISGN=0
  629.       IF(IARG.GT.0)ISGN=1
  630.       IF(IARG.LT.0)ISGN=-1
  631.       RETURN
  632.       END
  633. C THE FOLLOWING ROUTINES ARE NEEDED FOR GHASP AND IMPLEMENTED CORRECTLY
  634. C IN DEC FORTRAN AND SOME OTHERS; NOT NECESSARILY CORRECT IN IBM FORTRAN.
  635. C MODIFIED FOR MICROSOFT FORTRAN (WHICH IS MORE FUSSY ABOUT LOGICAL TYPES)
  636. C GCE 7/84
  637.     FUNCTION MAND(IK,JK)
  638.     INTEGER*4 MAND,KMAND,IK,JK
  639.     INTEGER*4 IA,IB
  640.     IA=IK
  641.     IB=JK
  642.     KMAND=IA.AND.IB
  643.     MAND=KMAND
  644.     RETURN
  645.     END
  646. C THE FOLLOWING ROUTINES ARE NEEDED FOR GHASP AND IMPLEMENTED CORRECTLY
  647. C IN DEC FORTRAN AND SOME OTHERS; NOT NECESSARILY CORRECT IN IBM FORTRAN.
  648. C MODIFIED FOR MICROSOFT FORTRAN (WHICH IS MORE FUSSY ABOUT LOGICAL TYPES)
  649. C GCE 7/84
  650.     FUNCTION MOR(IK,JK)
  651.     INTEGER*4 MOR,IK,JK
  652.     MOR=IK.OR.JK
  653.     RETURN
  654.     END
  655.             SUBROUTINE NORM (TOT, IPLT)
  656.          DIMENSION XM(1),INDEXV(8)
  657.        COMMON/EXTRA/ NDLTY, NPLTS, MA(1)
  658.             EQUIVALENCE(MA(1),XM(1)),(INDEXV(1),NDM),(INDEXV(2),IST),
  659.      1 (INDEXV(7),NBX)
  660.           IF(1.GT.IPLT.OR.IPLT.GT.NPLTS) RETURN
  661.          DO 1 I=1,8
  662.          J = (I-1)*NPLTS + IPLT
  663. 1         INDEXV(I) = MA(J)
  664.          IF ( NDM .NE. 1) RETURN
  665.          NE =NBX + 2
  666.           WT =0.000000001
  667.          DO 2 I=1,NE
  668.            J =IST + I
  669. 2        WT = XM(J) + WT
  670.          ADJ = TOT/WT
  671.            DO 3 I=1,NE
  672.         J = IST + I
  673. 3         XM(J)= ADJ*XM(J)
  674.           RETURN
  675.           END
  676.            SUBROUTINE PLOT(X,Y,IENT,IPLT)
  677.       DIMENSION JA1(110),JA2(110),JA3(110),KA1(110),KA2(110)
  678.     INTEGER*4 IENT,IPLT
  679.        DIMENSION KA3(110), KA4(110)
  680.       DIMENSION IPNCH(120)
  681.           DIMENSION  XM(1),        XLABL(2), YLABL(2)
  682.        DIMENSION LINE(119),IICH(32),ICH(32),INDEXV(8),AIND(8)
  683.      1 , XL(12),  IBT(6), IZB(6)
  684.     CHARACTER*1 IICH
  685.       COMMON/PLOTS/ ND, XMIN,YMIN,
  686.      1 DX,    DY,   NBINX,    NBINY, TITLE(19)
  687.                COMMON/EXTRA/NDIM, NPLTS, MA(1)
  688.       EQUIVALENCE (XLABL(1),TITLE(16)),(YLABL(1),TITLE(18))
  689.          EQUIVALENCE(INDEXV(1),AIND(1))
  690.       EQUIVALENCE (MA(1),XM(1)),(LINE(1),XL(1)),(INDEXV(1),NDM),
  691.      1 (INDEXV(2),IST),(AIND(3),XMN),(AIND(4),YMN),(AIND(5),DEX),
  692.      2 (AIND(6),DEY),(INDEXV(7),NBX),(INDEXV(8),NBY)
  693.     INTEGER*4 IXTR
  694.     COMMON/IXTR/IXTR
  695. C IXTR=1 SWITCHES OFF EXTRA STUFF AT BOTTOM OF PLOT
  696.     CHARACTER*4 PPNCH
  697.     REAL*4 PNC
  698.     EQUIVALENCE(PPNCH,PNC)
  699.     REAL*4 BLANK
  700.     CHARACTER*4 BBLANK
  701.     EQUIVALENCE(BLANK,BBLANK)
  702.     INTEGER*4 IXXPPP,IPPPPP,IXXBBB,ICHX,ICHP
  703.     CHARACTER*4 XXPPP,PPPPP,XXBBB
  704.     CHARACTER*1 CHX,CHP
  705.     EQUIVALENCE(IXXPPP,XXPPP),(IXXBBB,XXBBB)
  706.     CHARACTER*4 RRDIM,RRV,RRH,RRS
  707.     REAL*4 RDIM,RV,RH,RS
  708.     EQUIVALENCE(RRDIM,RDIM),(RRV,RV),(RRH,RH),(RS,RRS)
  709.       DATA PPNCH/'PNCH'/
  710.       DATA IICH/   ' ',   '1',  '2',    '3',
  711.      1       '4',        '5',        '6',        '7',         '8',
  712.      2      '9',         'A',        'B',         'C',       'D',
  713.      3       'E',       'F',       'G',         'H',        'I',
  714.      4      'J',       'K',       'L',       'M',       'N',
  715.      5       'O',      'P',     'Q',     'R',   'S',
  716.      6       'T',       'U',        '*'/
  717.       DATA RRS/'   S'/
  718.                DATA RRDIM/' DIM'/
  719.        DATA RRV/'   V'/
  720.               DATA RRH/'   H'/
  721. C VALUES BELOW ASSUME 32 BIT 2S COMPLEMENT INTEGERS...
  722.       DATA IBT/33554432, 1048576, 32768, 1024, 32, 1 /
  723.       DATA IZB /-1040187393, -32505857, -1015809, -31745, -993, -32  /
  724.          DATA         BBLANK/   '    '/,       XXPPP/    'XX++'/,
  725.      1        PPPPP/  '++++'/,        XXBBB/ 'XX  '/,
  726.      2         CHX/        'X'/,         CHP/       '+'/,
  727.      3             IHK/             31/,                 NBT/     6/,
  728.      4          LINWDS/        110/,          NOUT/       6/
  729.             DATA INIT/        0/
  730.     ICHX=ICHAR(CHX)
  731.     ICHP=ICHAR(CHP)
  732.     DO 6670 IV=1,32
  733. 6670    ICH(IV)=ICHAR(IICH(IV))
  734.       IF(IENT.EQ. 1) GO TO 15
  735.            IF(IENT.EQ.-1)      GO TO 1
  736.       IF(IENT.EQ. 0)     GO TO 4
  737.          IF(IENT.EQ. 2)      GO TO 19
  738.          WRITE(NOUT,57)    IENT
  739.            GO TO 56
  740. 1     INIT=1
  741.           DO 2 I=1,NDIM
  742. 2     MA(I)=0
  743.         ISTART=8*NPLTS*NBT
  744.         DO 3 I=1,19
  745. 3          TITLE(I) = BLANK
  746.           IF(IENT.EQ.-1)     GO TO 56
  747. 4          IF(INIT.EQ.0)    GO TO 1
  748.       IF(1.LE.IPLT.AND.IPLT.LE.NPLTS) GO TO 5
  749.       WRITE(NOUT,58)    IPLT
  750.         GO TO 56
  751. 5      IF(DX.NE.0.0)  GO TO 6
  752.        WRITE(NOUT,59) IPLT
  753.        GO TO 56
  754. 6     IF(NBINX.LE.0) NBINX=100
  755.       IF(NBINX.GT.LINWDS) NBINX=LINWDS
  756.       NBINX=((NBINX-1)/10)*10+10
  757.       IF(ND.EQ.1)    GO TO 7
  758.            IF(ND.EQ.2) GO TO 11
  759.            WRITE(NOUT,60) IPLT
  760.         GO TO 56
  761. 7     IST=(ISTART-1)/NBT +1
  762.        ITEST= IST+ NBINX+  2
  763.         IF(ITEST.LE.NDIM)  GO TO 8
  764.        MA(IPLT) =0
  765.         WRITE(NOUT,61) IPLT
  766.           GO TO 56
  767. 8         ISTART =ITEST*NBT
  768.       IF(NBINY.LE.0) NBINY=100
  769.        NBINY=((NBINY-1)/10)*10+10
  770.          NDM=1
  771.            XMN=XMIN
  772.          YMN=YMIN
  773.          DEX=DX
  774.             DEY=DY
  775.            NBX=NBINX
  776.           NBY=NBINY
  777.          DO 9 I=1,8
  778.            J=(I-1)*NPLTS +IPLT
  779. 9      MA(J)=INDEXV(I)
  780.       J=IST+1
  781.           DO 10 I=J,ITEST
  782. 10       XM(I)=0.0
  783.             IF(X.EQ.RDIM)      WRITE(NOUT,75) ITEST,IPLT
  784.          GO TO 56
  785. 11        IF(DY.NE.0.0)   GO TO 12
  786.           WRITE(NOUT,59) IPLT
  787.           GO TO 56
  788. 12          IF(NBINY.LE.0) NBINY=50
  789.           NBINY= ((NBINY-1)/10)*10+10
  790.           NBTS=(NBINX+2)*(NBINY+2)
  791.       IF(ISTART+NBTS.LE.NDIM*NBT)  GO TO 13
  792.           MA(IPLT)=0
  793.            WRITE(NOUT,61) IPLT
  794.          GO TO 56
  795. 13       IST=ISTART
  796.           ISTART=ISTART+NBTS
  797.          NDM=ND
  798.              XMN=XMIN
  799.               YMN=YMIN
  800.           DEX=DX
  801.            DEY=DY
  802.                  NBX=NBINX
  803.                 NBY=NBINY
  804.        DO 14 I=1,8
  805.          J=(I-1)*NPLTS+IPLT
  806. 14          MA(J)=INDEXV(I)
  807.          IST=(ISTART-1)/NBT  +1
  808.             IF(X.EQ.RDIM)      WRITE(NOUT,75) IST,IPLT
  809.          GO TO 56
  810. 15     IF(1.GT.IPLT.OR.IPLT.GT.NPLTS) GO TO 56
  811.          DO 16 I=1,8
  812.         J=(I-1)*NPLTS+IPLT
  813. 16       INDEXV(I)=MA(J)
  814.           IF(NDM.EQ.1) GO TO 17
  815.            IF(NDM.GE.2)    GO TO 18
  816.           GO TO 56
  817. 17       IX= IFIX((X-XMN)/DEX+2.)
  818.          IF(IX.LT.1)    IX=1
  819.             IF(IX.GT. NBX+2)   IX=NBX+ 2
  820.           IWD=IST+ IX
  821.          XM(IWD) =XM(IWD) + Y
  822.          GO TO 56
  823. 18      IX= IFIX((X-XMN)/DEX+2.)
  824.           IY= IFIX((Y-YMN)/DEY+2.)
  825.           IF(IX.LT.1)  IX=1
  826.            IF(IY.LT.1)  IY=1
  827.            IF(IX.GT.NBX+2) IX=NBX+2
  828.           IF(IY.GT.NBY+2) IY=NBY+2
  829.             ILOC=(IY-1)*(NBX+2) + (IX+ IST -1)
  830.            IWD=ILOC/NBT +1
  831.             JBT=MOD(ILOC,NBT) +1
  832.         NOO1=MA(IWD)/IBT(JBT)
  833.           NO=MAND(NOO1,IHK)
  834.             MAA1=MA(IWD)
  835.                MAA2=IZB(JBT)
  836.                MA(IWD)=MAND(MAA1,MAA2)
  837.           IF(NO.LT.31) NO=NO+1
  838.               MAA3=MA(IWD)
  839.                MAA4=NO*IBT(JBT)
  840.                MA(IWD)=MOR(MAA3,MAA4)
  841.          MA(IPLT) = MA(IPLT) + 1
  842.           GO TO 56
  843. 19        IF(1 .LE.IPLT.AND.IPLT.LE.NPLTS) GO TO 20
  844.           WRITE(NOUT,58) IPLT
  845.            GO TO 56
  846. 20          DO 21 I=1,8
  847.           J= (I-1)*NPLTS + IPLT
  848. 21         INDEXV(I) = MA(J)
  849.            IF(NDM.EQ.1) GO TO 22
  850.           IF(NDM.GE.2)  GO TO 39
  851.           WRITE(NOUT,72) IPLT
  852.           GO TO 56
  853. 22          WRITE(NOUT,62) IPLT, (TITLE(I), I=1,15)
  854.             IYMN =IFIX(YMN+.5)
  855.                IDEY = IFIX(DEY + .5)
  856.              IF(IDEY .LE. 0) IDEY = 1
  857.       NE=NBX+1
  858. C     CODE ADDED TO SCALE PLOTS IF DESIRED AND REQUIRED
  859.       IF (X.NE.RS) GO TO 2005
  860.       MAXY=-1
  861.       DO 2010 I=2,NE
  862.       J=IST+I
  863.       K=IFIX(XM(J)+.5)-IYMN
  864.       IF (K.GT.MAXY) MAXY=K
  865.  2010 CONTINUE
  866.       K=MAXY
  867.       IF (K.LE.NBY*IDEY) GO TO 2005
  868. C     MUST INCREASE IDEY TO MAKE PLOT FIT
  869.       IDEY=K/NBY+1
  870.       DEY=10*IDEY
  871.       CALL HIHDIG(DEY,ID,IS)
  872.       IF (DEY.EQ.10.*IS) GO TO 2016
  873.       ID=ID+1
  874.  2016 IDEY=ID*10.**IS
  875.       IDEY=IDEY/10
  876.       DEY=IDEY
  877.  2005 CONTINUE
  878.              WT = 0.0
  879.            MAXY= 10*IDEY
  880.       AVG=0.
  881.       WAG=0.
  882.       AGG=-.5
  883.       DO 23 I=2,NE
  884.            J= IST + I
  885.       ZXM=XM(J)
  886.       WT=WT+ZXM
  887.       AGG=AGG+1.
  888.       WAG=WAG+AGG*ZXM
  889.            K = IFIX(XM(J) + .5) - IYMN
  890.            IF(K.GT.MAXY) MAXY=K
  891.             K= K - NBY*IDEY
  892.           IF(K.GT.31)  K = 31
  893.       IF(K.LT.0.OR.X.EQ.RV) K=1
  894.       IF(X.EQ.PNC) K=1
  895. 23         LINE(I)=ICH(K)
  896.       WAG1=WAG/WT
  897.       AVG=(WAG1*DEX)
  898.       AGG=-.5
  899.       STD=0.
  900.       DO 232 I=2,NE
  901.       J=IST+I
  902.       ZXM=XM(J)
  903.       AGG=AGG+1.
  904.            STDIF=ZXM*(AGG-WAG1)*(AGG-WAG1)
  905.          STD=STD+STDIF
  906.  232  CONTINUE
  907.       STDEV=DEX*SQRT(STD/WT)
  908.       AVG=AVG+XMN
  909.            MAXY= ((MAXY-1)/(10*IDEY))*10 +10
  910.         IF((MAXY.LT.NBY.AND.X.EQ.RH).OR.X.EQ.RV)  NBY=MAXY
  911.       IF(X.EQ.PNC) NBY=MAXY
  912.       WRITE(NOUT,63) (LINE(L),L=2,NE)
  913. C          WRITE(NOUT,64)
  914.           N = NE/5 -1
  915.       INEE=NBX+2
  916.       DO 25 I=1,NBX
  917.       KNBX=I/10
  918.       LNBX=10*KNBX
  919.       MNBX=I-LNBX
  920.       LINE(I)=ICHP
  921.       IF(MNBX.EQ.1) LINE(I)=ICHX
  922.       IF(MNBX.EQ.2) LINE(I)=ICHX
  923.  25   CONTINUE
  924.       LINE(NBX+1)=ICHX
  925.       LINE(NBX+2)=ICHX
  926.       WRITE(NOUT,765) YLABL,(LINE(L),L=1,INEE)
  927.            N = NBY - 9
  928.            I = N
  929. 133        IY = (I+9)*IDEY + IYMN
  930.           ILOW = IY - IDEY
  931.       DO 26 J=2,NE
  932.          K = IST + J
  933.            L = IFIX(XM(K) + .5) - ILOW
  934.             LINE(J)=ICH(1)
  935.             IF (L.LE.0)  GO TO 26
  936.           LINE(J) = ICHX
  937.              IF(L .GE. IDEY) GO TO 26
  938.             IF(L.GT.31) L=31
  939.            LINE(J)=ICH(L+1)
  940. 26       CONTINUE
  941.       NEEE=NE+1
  942.       LINE(NEEE)=ICHX
  943.       ME=NE+1
  944.       WRITE(NOUT,66) IY,ICHX, (LINE(L),L=2,ME)
  945.               J = 9
  946. 130       ILOW= (I-2 +J)*IDEY + IYMN
  947.       DO 28 K=2,NE
  948.            M  = IST + K
  949.           NO = IFIX(XM(M) + .5) - ILOW
  950.          LINE(K) = ICH(1)
  951.            IF(NO.LE.0)  GO TO 28
  952.              LINE(K) = ICHX
  953.           IF(NO.GE.IDEY) GO TO 28
  954.              IF(NO.GT.31) NO=31
  955.                  LINE(K) = ICH(NO+1)
  956. 28        CONTINUE
  957.       NEEE=NE+1
  958.       LINE(NEEE)=ICHP
  959.       ME=NE+1
  960. 30    WRITE(NOUT,67) ICHP,(LINE(L),L=2,ME)
  961.                J = J - 1
  962.                IF(J .GE. 2) GO TO 130
  963.          ILOW=(I-1)*IDEY + IYMN
  964.            DO 31 J=1,NE
  965.          K = IST + J
  966.           NO = IFIX(XM(K) + .5) -ILOW
  967.             LINE(J)=ICH(1)
  968.           IF(NO.LE.0)  GO TO 31
  969.           LINE(J) = ICHX
  970.          IF(NO .GE.IDEY) GO TO 31
  971.            IF(NO.GT.31) NO=31
  972.                LINE(J)=ICH(NO+1)
  973. 31         CONTINUE
  974.       NEEE=NE+1
  975.       LINE(NEEE)=ICHX
  976.       ME=NE+1
  977. 33    WRITE(NOUT,67) ICHX, (LINE(L),L=2,ME  )
  978.              I = I- 10
  979.             IF(I .GE. 1) GO TO 133
  980.          N =NE/5 -1
  981.       INEE=NBX+2
  982.       DO 34 I=1,NBX
  983.       KNBX=I/10
  984.       LNBX=10*KNBX
  985.       MNBX=I-LNBX
  986.       LINE(I)=ICHP
  987.       IF(MNBX.EQ.1) LINE(I)=ICHX
  988.       IF(MNBX.EQ.2) LINE(I)=ICHX
  989.  34   CONTINUE
  990.       LINE(NBX+1)=ICHX
  991.       LINE(NBX+2)=ICHX
  992.       WRITE(NOUT,768) IYMN,(LINE(L),L=1,INEE)
  993.            N=NE/10 +1
  994.           DO 35 I=1,N
  995. 35       XL(I) = FLOAT(I-1)*DEX*10.0 + XMN
  996.            WRITE(NOUT,69) (XL(L),L=1,N)
  997. C          WRITE(NOUT,64)
  998.       DO 36 I=2,NE
  999.            J=IST + I
  1000.             NO = IFIX(XM(J) + .5) - IYMN
  1001.              LINE(I) =ICH(1)
  1002.            IF(NO.GE.0) GO TO 36
  1003.             NO =-NO
  1004.             IF (NO.GT.31) NO=31
  1005.             LINE(I) = ICH(NO+1)
  1006. 36       CONTINUE
  1007.       WRITE(NOUT,63) (LINE(L),L=2,NE)
  1008.       J=IST+1
  1009.       JUND=IFIX(XM(J)+.5) - IYMN
  1010.       J=IST+NBX+2
  1011.       JOVR=IFIX(XM(J)+.5) - IYMN
  1012. C      WRITE(NOUT,64)
  1013.       LNX=0
  1014.       DO 1907 I=2,NE
  1015.       J=IST+I
  1016.       JA1(1)=ICH(1)
  1017.       KA1(1)=ICH(1)
  1018.       MNX=IFIX(XM(J)+.5)
  1019.       IPNCH(I-1)=MNX
  1020.  7777 FORMAT(20I4)
  1021.       LNX=LNX+MNX
  1022.       J1=MNX/100
  1023.       K1=(MNX-100*J1)/10
  1024.       L1=MNX-100*J1-10*K1
  1025.       IF(J1.GT.30) J1=31
  1026.       IF((MNX.GE.100).AND.(K1.EQ.0)) K1=24
  1027.       IF((MNX.GE. 10).AND.(L1.EQ.0)) L1=24
  1028.       JA1(I)=ICH(J1+1)
  1029.       JA2(I)=ICH(K1+1)
  1030.       JA3(I)=ICH(L1+1)
  1031.       J1=LNX/1000
  1032.       K1=(LNX-1000*J1)/100
  1033.       L1=(LNX-1000*J1-100*K1)/10
  1034.       M1=LNX-1000*J1-100*K1-10*L1
  1035.       IF(J1.GT.30) J1=31
  1036.       IF((LNX.GE.1000).AND.(K1.EQ.0))K1=24
  1037.       IF((LNX.GE. 100).AND.(L1.EQ.0))L1=24
  1038.       IF((LNX.GE.  10).AND.(M1.EQ.0))M1=24
  1039.       KA1(I)=ICH(J1+1)
  1040.       KA2(I)=ICH(K1+1)
  1041.       KA3(I)=ICH(L1+1)
  1042.       KA4(I)=ICH(M1+1)
  1043.  1907 CONTINUE
  1044.       IWTA=WT
  1045.     IF(IXTR.GE.1)GOTO 8200
  1046. C PUT OUT CRUDE OVER/UNDERFLOW AND STATISTICS. SKIP IF
  1047. C IXTR=1 SO TERMINAL GRAPHS WILL FIT.
  1048.       WRITE(6,76) JUND,IWTA,XLABL,JOVR,AVG,STDEV
  1049.  76   FORMAT(5X,'UNDERFLOW =',I4,2X,'TOTAL IN PLOT =',I5,4X,2A4,4X,
  1050.      1 'OVERFLOW =',I4,4X,'AVERAGE = ',1PE10.3,2X,'STAND. DEV = ',
  1051.      2 1PE10.3 /)
  1052.       IF(X.EQ.PNC)WRITE(7,7777) (IPNCH(L),L=1,NBX)
  1053.       WRITE(6,1743)
  1054.       WRITE(6,1744) (JA1(L),L=2,NE)
  1055.       WRITE(6,1744) (JA2(L),L=2,NE)
  1056.       WRITE(6,1744) (JA3(L),L=2,NE)
  1057.       WRITE(6,1745)
  1058.       WRITE(6,1744) (KA1(L),L=2,NE)
  1059.       WRITE(6,1744) (KA2(L),L=2,NE)
  1060.       WRITE(6,1744) (KA3(L),L=2,NE)
  1061.       WRITE(6,1744) (KA4(L),L=2,NE)
  1062.  1743 FORMAT(50X,'EVENTS PER BIN')
  1063.  1745 FORMAT(50X,'INTEGRAL OF EVENTS')
  1064.  1744 FORMAT(15X,115A1)
  1065. 8200    CONTINUE
  1066.            DO 38 I=1,19
  1067. 38         TITLE(I) = BLANK
  1068.          GO TO 56
  1069. 39      WRITE(NOUT,62) IPLT,(TITLE(I),I=1,15)
  1070.            NE = NBX +2
  1071.             DO 40 I=1,NE
  1072.            ILOC = IST + (NBY+1)*NE +I -1
  1073.           IWD = ILOC/NBT +1
  1074.            JBT = MOD(ILOC,NBT) + 1
  1075.               NOO1=MA(IWD)/IBT(JBT)
  1076.                NO=MAND(NOO1,IHK)
  1077. 40          LINE(I) = ICH(NO+1)
  1078.         ITEMP = LINE(NE)
  1079.           DO 41 I=1,6
  1080.              MMME=NE+I-1
  1081. 41         LINE(MMME)=ICH(1)
  1082.          LINE(NE+6) = ITEMP
  1083.             ME = NE +6
  1084.                WRITE(NOUT,63) (LINE(L),L=1,ME)
  1085. C          WRITE(NOUT,64)
  1086.            N = NE/5 -1
  1087.       INEE=NBX+2
  1088.       DO 42 I=1,NBX
  1089.       KNBX=I/10
  1090.       LNBX=10*KNBX
  1091.       MNBX=I-LNBX
  1092.       LINE(I)=ICHP
  1093.       IF(MNBX.EQ.1) LINE(I)=ICHX
  1094.       IF(MNBX.EQ.2) LINE(I)=ICHX
  1095.  42   CONTINUE
  1096.       LINE(NBX+1)=ICHX
  1097.       LINE(NBX+2)=ICHX
  1098.        WRITE(NOUT,8799) YLABL,(LINE(L),L=1,INEE)
  1099.             MN=N+2
  1100.           N = NBY -9
  1101.               I = N
  1102. 150         YL = FLOAT(I+9)*DEY+YMN
  1103.           DO 43 J=1,NE
  1104.          ILOC = IST + (I+9)*NE +J -1
  1105.             IWD = ILOC/NBT + 1
  1106.             JBT = MOD(ILOC,NBT) +1
  1107.             NOO1=MA(IWD)/IBT(JBT)
  1108.              NO=MAND(NOO1,IHK)
  1109. 43          LINE(J) = ICH(NO+1)
  1110.         ITEMP = LINE(NE)
  1111.            LINE(NE) = ICHX
  1112.          DO 44 J=1,5
  1113. 44          LINE(NE+J) = ICH(1)
  1114.           LINE(NE+6) = ITEMP
  1115.            ME =NE +6
  1116.       CALL SHADER (LINE,NE,X)
  1117.          WRITE(NOUT,70) LINE(1),YL,ICHX,(LINE(L),L=2,ME)
  1118.       CALL RESHD(X)
  1119.                   J = 9
  1120. 147           IY = IST + (I + J -1)*NE - 1
  1121.          DO 45 K =1,NE
  1122.          ILOC = IY + K
  1123.           IWD = ILOC/NBT + 1
  1124.             JBT = MOD(ILOC,NBT) +1
  1125.                   NOO1=MA(IWD)/IBT(JBT)
  1126.             NO=MAND(NOO1,IHK)
  1127. 45           LINE(K) = ICH(NO+1)
  1128.         ITEMP = LINE(NE)
  1129.          LINE(NE) = ICHP
  1130.             MME=NE+1
  1131.              MMME=NE+5
  1132.            DO 46 K=MME,MMME
  1133. 46            LINE(K) = ICH(1)
  1134.            LINE(NE+6) = ITEMP
  1135.             ME =NE+6
  1136.    47 CALL SHADER(LINE,NE,X)
  1137.       WRITE (6,767) LINE(1),ICHP,(LINE(L),L=2,ME)
  1138.       CALL RESHD(X)
  1139.                 J = J-1
  1140.                IF(J .GE. 2) GO TO 147
  1141.            IY =IST + I*NE -1
  1142.             DO 48  J=1,NE
  1143.           ILOC = IY + J
  1144.            IWD = ILOC/NBT + 1
  1145.                JBT = MOD(ILOC,NBT) + 1
  1146.                 NOO1=MA(IWD)/IBT(JBT)
  1147.               NO=MAND(NOO1,IHK)
  1148. 48             LINE(J)=ICH(NO+1)
  1149.           ITEMP = LINE(NE)
  1150.             LINE(NE)=ICHX
  1151.            KKE=NE+1
  1152.             KKKE=NE+5
  1153.            DO 49  J=KKE,KKKE
  1154. 49         LINE(J) = ICH(1)
  1155.            LINE(NE+6) = ITEMP
  1156.             ME = NE +6
  1157.    50 CALL SHADER(LINE,NE,X)
  1158.       WRITE (6,767) LINE(1),ICHX,(LINE(L),L=2,ME)
  1159.       CALL RESHD(X)
  1160.                 I = I - 10
  1161.                   IF(I .GE. 1) GO TO 150
  1162.             N =NE/5 -1
  1163.       INEE=NBX+2
  1164.       DO 51 I=1,NBX
  1165.       KNBX=I/10
  1166.       LNBX=10*KNBX
  1167.       MNBX=I-LNBX
  1168.       LINE(I)=ICHP
  1169.       IF(MNBX.EQ.1) LINE(I)=ICHX
  1170.       IF(MNBX.EQ.2) LINE(I)=ICHX
  1171.  51   CONTINUE
  1172.       LINE(NBX+1)=ICHX
  1173.       LINE(NBX+2)=ICHX
  1174.       WRITE(NOUT,771) YMN,(LINE(L),L=1,INEE)
  1175.            N =NE/10 +1
  1176.           DO 52 I=1,N
  1177. 52       XL(I) = FLOAT(I-1)*DEX*10. +XMN
  1178.             WRITE(NOUT,69)  (XL(L),L=1,N)
  1179. C             WRITE(NOUT,64)
  1180.            IY=IST-1
  1181.           DO 53 I=1,NE
  1182.            ILOC=IY+I
  1183.             IWD =ILOC/NBT + 1
  1184.               JBT = MOD(ILOC,NBT) + 1
  1185.                NOO1=MA(IWD)/IBT(JBT)
  1186.              NO=MAND(NOO1,IHK)
  1187. 53           LINE(I) = ICH(NO+1)
  1188.            ITEMP = LINE(NE)
  1189.            KLE=NE+5
  1190.         DO 54 I=NE,KLE
  1191. 54         LINE(I) = ICH(1)
  1192.         LINE(NE+6)=ITEMP
  1193.            ME = NE +6
  1194.           WRITE(NOUT,63) (LINE(L),L=1,ME)
  1195.              NO = MA(IPLT) - 2
  1196.           WRITE(NOUT,74) NO,XLABL
  1197.                 DO 55 I=1,19
  1198. 55         TITLE(I) = BLANK
  1199. 56          RETURN
  1200. 57       FORMAT(' ILLEGAL ENTRY NO.',I8)
  1201. 58        FORMAT(' ILLEGAL PLOT NO.', I8)
  1202. 59        FORMAT(' ZERO BIN WIDTH ON PLOT',I5)
  1203. 60     FORMAT('ILLEGAL DIMENSIONALITY FOR PLOT',I5)
  1204. 61         FORMAT(' NOT ENOUGH MEMORY LEFT FOR PLOT',I5)
  1205. 62      FORMAT('1',10X,'PLOT NUMBER',I5,10X,15A4)
  1206. 63    FORMAT(15X,117A1)
  1207. C64        FORMAT()
  1208.  65     FORMAT(1X,2A4,4X,23A5)
  1209. 66    FORMAT(2X,I11,1X,118A1)
  1210. 67    FORMAT(14X,118A1)
  1211.  68   FORMAT(1X,I11,1X,23A5)
  1212. 69        FORMAT(9X,12(1PE10.2))
  1213. 70       FORMAT(2X,A1,1PE11.2,1X,118A1)
  1214. 71      FORMAT(2X,1PE11.2,1X,23A5)
  1215. 72      FORMAT(' PLOT NUMBER',I5,' NOT SUCCESSFULLY INITIATED.')
  1216. 73      FORMAT(' TOTAL WEIGHT OF EVENTS PLOTTED =',F10.1,10X,2A4)
  1217. 74         FORMAT(' NUMBER OF EVENTS PLOTTED =',I8,'.',10X,2A4)
  1218. 75         FORMAT(1X,I5,' WORDS OF PLOTTING AREA USED,'
  1219.      1 ' INCLUDING PLOT',I4,'.')
  1220. C 76  FORMAT(20X,'UNDERFLOW = ',I5,10X,'OVERFLOW = ',I5,10X,'AVERAGE = '
  1221. C    1 ,1PE10.3,5X,'ST. DEV = ',1PE10.3)
  1222.  165   FORMAT(2X,2A4,4X,23A5)
  1223.  8799   FORMAT(2X,2A4,5X,114A1)
  1224.  771    FORMAT(2X,1PE11.2,2X,114A1)
  1225.  765   FORMAT(2X,2A4,4X,114A1)
  1226.  768    FORMAT(2X,I11,1X,114A1)
  1227.  767    FORMAT(2X,A1,12X,114A1)
  1228.          END
  1229.     SUBROUTINE RASSIG(IUNIT,NAME)
  1230. C
  1231.     CHARACTER*1 NAME(50)
  1232.     INTEGER*4 IUNIT
  1233.     CHARACTER*20 WK
  1234.     CHARACTER*1 WK1(20)
  1235.     EQUIVALENCE(WK,WK1(1))
  1236. C JUST TRY AND NULL FILL A NAME TO USE.
  1237.     DO 1 N=1,20
  1238.     WK1(N)=' '
  1239. 1    CONTINUE
  1240.     DO 2 N=1,20
  1241.     II=ICHAR(NAME(N))
  1242.     IF(II.LT.32)GOTO 3
  1243.     WK1(N)=CHAR(II)
  1244. C1    CONTINUE
  1245. 2    CONTINUE
  1246. 3    OPEN(IUNIT,FILE=WK,STATUS='OLD',ACCESS='SEQUENTIAL',
  1247.      1  FORM='FORMATTED')
  1248.     RETURN
  1249.     END
  1250.       SUBROUTINE RESHD(X)
  1251.       IMPLICIT INTEGER (A-Z)
  1252.       DIMENSION HLINE(120),OLINE(120)
  1253.     COMMON/HLNNN/HLINE,OLINE,M
  1254.     CHARACTER*1 IICH,IJCH
  1255.     DIMENSION IICH(32),IJCH(32)
  1256.       DIMENSION ICH(32),JCH(32)
  1257.     INTEGER*4 RQ,BL
  1258.     CHARACTER*4 CRQ,CBL
  1259.     EQUIVALENCE(CRQ,RQ),(CBL,BL)
  1260.       DATA CRQ/'   Q'/
  1261.       DATA CBL/'    '/
  1262.       DATA IICH/' ','1','2','3','4','5','6','7','8','9','A','B',
  1263.      1   'C','D','E','F','G','H','I','J','K','L','M','N','O','P',
  1264.      1   'Q','R','S','T','U','*'/
  1265.       DATA IJCH/'+','=',' ','=',' ','*',' ',' ',' ','X',' ',' ',' ',
  1266.      1   ' ','A',' ','B',' ',' ',' ','E',' ',' ',' ','H',' ','Q',
  1267.      1   ' ','Z','I','O','0'/
  1268.     DATA INIT/0/
  1269.     IF(INIT.NE.0)GOTO 7009
  1270.     INIT=1
  1271.     DO 7109 N=1,32
  1272.     ICH(N)=ICHAR(IICH(N))
  1273.     JCH(N)=ICHAR(IJCH(N))
  1274.     BL=32
  1275. 7109    CONTINUE
  1276. 7009    CONTINUE
  1277.       IF (X.NE.RQ) RETURN
  1278.       M=M-1
  1279.       DO 155 I=1,M
  1280.       DO 15 J=1,32
  1281.       IF (HLINE(I).EQ.ICH(J)) GO TO 155
  1282.    15 CONTINUE
  1283.       J=1
  1284.   155 HLINE(I)=J
  1285.       DO 1600 I=1,32
  1286.       IF (JCH(I).EQ.BL) GO TO 1600
  1287.       IP=0
  1288.       DO 1560 J=1,M
  1289.       OLINE(J)=BL
  1290.       IF (HLINE(J).LE.I) GO TO 1560
  1291.       OLINE(J)=JCH(I)
  1292.       IP=1
  1293.  1560 CONTINUE
  1294.       IF (IP.EQ.0) RETURN
  1295.       WRITE (6,1605) (OLINE(J),J=1,M)
  1296.  1600 CONTINUE
  1297.  1605 FORMAT ('+',15X,120A1)
  1298.       RETURN
  1299.       END
  1300.       SUBROUTINE SHADER(LINE,ME,X)
  1301.       IMPLICIT INTEGER (A-Z)
  1302.       DIMENSION LINE(ME),HLINE(120),OLINE(120)
  1303.     COMMON/HLNNN/HLINE,OLINE,M
  1304. C      DIMENSION ICH(32),JCH(32)
  1305.     CHARACTER*4 CRQ
  1306.     INTEGER*4 RQ
  1307.     EQUIVALENCE(CRQ,RQ)
  1308.       DATA CRQ/'   Q'/
  1309.       DATA BL/32/
  1310. C      DATA ICH/' ','1','2','3','4','5','6','7','8','9','A','B',
  1311. C     1   'C','D','E','F','G','H','I','J','K','L','M','N','O','P',
  1312. C     1   'Q','R','S','T','U','*'/
  1313. C      DATA JCH/'+','=',' ','=',' ','*',' ',' ',' ','X',' ',' ',' ',
  1314. C     1   ' ','A',' ','B',' ',' ',' ','E',' ',' ',' ','H',' ','Q',
  1315. C     1   ' ','Z','I','O','0'/
  1316.       IF (X.NE.RQ) RETURN
  1317.       IF (ME.GT.120) RETURN
  1318.       M=ME-1
  1319.       DO 10 I=2,M
  1320.       HLINE(I-1)=LINE(I)
  1321.       LINE(I)=BL
  1322.    10 CONTINUE
  1323.       RETURN
  1324.     END
  1325.     SUBROUTINE WASSIG(IUNIT,NAME)
  1326. C
  1327.     CHARACTER*1 NAME(50)
  1328.     INTEGER*4 IUNIT
  1329.     CHARACTER*20 WK
  1330.     CHARACTER*1 WK1(20)
  1331.     EQUIVALENCE(WK,WK1(1))
  1332. C JUST TRY AND NULL FILL A NAME TO USE.
  1333.     DO 1 N=1,20
  1334.     WK1(N)=' '
  1335. 1    CONTINUE
  1336.     DO 2 N=1,20
  1337.     II=ICHAR(NAME(N))
  1338.     IF(II.LT.32)GOTO 3
  1339.     WK1(N)=CHAR(II)
  1340. C1    CONTINUE
  1341. 2    CONTINUE
  1342. 3    OPEN(IUNIT,FILE=WK,STATUS='NEW',ACCESS='SEQUENTIAL',
  1343.      1  FORM='FORMATTED')
  1344.     RETURN
  1345.     END
  1346.