C COPYRIGHT (C) 1983 GLENN EVERHART
c all rights reserved
C G H A S P   - Generalized Histogram And Scatter Plot
C REQUIREMENTS:
C COMMONS /EXTRA/ AND /PLOTS/ MUST EXIST, AND ARRAY MA'S DIMENSION (AS 4
C BYTE INTEGERS) MUST BE PLACED INTO NDLTY.
C NPLTS IS THE NUMBER OF PLOTS TO BE GENERATED; THEY ARE ALLOCATED OUT OF
C ARRAY MA DYNAMICALLY.
C THE VARIABLES IN THE /PLOTS/ COMMON HAVE THE FOLLOWING MEANINGS:
C NDIM IS THE NUMBER OF DIMENSIONS. 1 IS HISTOGRAM, 2 IS SCATTER PLOT
C XMIN,YMIN ARE X,Y MIN COORDS IN THE HISTOGRAM
C DX,DY ARE BIN SIZES
C NBINX,NBINY ARE NUMBER OF BINS IN X AND Y (NOTE GHASP WILL INDICATE NUMBER
C	OF OVERFLOWS)
C TITLE IS AN ARRAY OF CHARACTERS USED TO PRINT OUT THE TITLE FOR THE PLOT.
C THE SUBROUTINE INTERFACE IS TO CALL THE SUBROUTINE PLOT.
C
C CALL:
C   CALL PLOT(XVAL,YVAL,IFUNCT,NPLT)
C  WHERE XVAL AND YVAL ARE X,Y COORDINATES FOR THE PLOT IF SCATTERPLOT, OR
C X IS THE COORDINATE AND Y THE WEIGHT IF A HISTOGRAM.
C IFUNCT IS -1, 0, 1, OR 2.
C	-1 MEANS INITIALIZE; CALL PLOT ONCE THIS WAY TO SET UP THE NUMBER
C		OF HISTOGRAMS AND INITIALIZE ITS SCRATCH VARIABLES.
C	0 MEANS INITIALIZE VARIABLES FOR A GIVEN PLOT NUMBER. THIS EXPECTS
C		YOU HAVE SET THE PLOTS COMMON VARIABLES UP BEFORE THE
C		CALL. SET XVAL TO 4H/ DIM/ AT THIS CALL TO PRINT SOME
C		INFORMATION ABOUT HOW MUCH OF THE PLOT ARRAY IS USED UP;
C		THIS WILL ALLOW YOU TO CHANGE THE SIZE OF MA TO WHAT
C		IS REALLY NEEDED.
C	1 MEANS ENTER A POINT IN THE HISTOGRAM/SCATTER PLOT, USING THE X AND
C		Y VALUES. NOTICE THAT THE COMMON /PLOTS/ VARIABLES ARE NOT
C		NECESSARILY THE SAME AS AT IFUNCT=0 TIME; ONCE THE PLOT IS
C		INITIALIZED YOU JUST ADD POINTS AND PLOT.
C	2 MEANS PLOT THE HISTOGRAM OR SCATTER PLOT. THE XVAL ARGUMENT IS
C		IMPORTANT AT THIS TIME; PLOT NUMBER MUST BE GIVEN.
C
C A VARIETY OF OPTIONS FOR PLOT FORMAT EXIST AND ARE ENCODED BY THE LETTER
C USED IN THE XVAL ARGUMENT OF PLOT AT THE TIME YOU CALL IT WITH THE IFUNCT
C ARGUMENT OF 2. TWO OF THESE ARE THAT THE PLOT CAN BE MADE AS HIGH AS IT
C NEEDS TO BE TO PLOT THE DATA. THIS IS THE VARY COMMAND AND IS ENCODED AS
C 4H/   V/ (SEE EXAMPLE CALLER PROGRAM). ANOTHER OPTION IS THE HACK OPTION,
C CUTTING OFF THE PLOT AT ONE PAGE. THIS USES THE VALUE 4H/   H/. ONE CAN
C ALSO SCALE THE PLOT TO FIT ON A PAGE; 4H/   S/ WILL DO
C THIS. THERE ARE SOME DENSITY PLOTS AVAILABLE ALSO FOR SCATTER PLOTS;
C THE NORMAL PLOTS ARE 2 DIGIT NUMBERS (6 BITS ARE USED, PACKED 5 BINS TO
C A WORD, FOR COUNTING NUMBERS PER BIN).
C USE 4H/   Q/ FOR SHADED SCATTER PLOTS; DENSITY WILL BE APPROXIMATE ONLY
C BUT GHASP WILL ATTEMPT TO PLOT A SCATTER PLOT SHADED. NOTE A PLOT CAN
C BE PRINTED OUT MORE THAN ONCE, IN DIFFERENT FORMATS, SO A PLOT MAY BE
C PLOTTED NUMERICALLY WITH 4H/   V/ AND IN SHADED MODE AS WELL.
C
C COPYRIGHT (C) 1983, 1984 GLENN AND MARY EVERHART
C ALL RIGHTS RESERVED
C	PCC GRAF
C  NOTE: REQUIRES LUN 4 FOR TERMINAL OUTPUT AND LUN 5 FOR
C  TERMINAL INPUT.
C (GHASP USES 6 FOR LP:)
C
C GRAPHICS INTERFACE AND OUTPUT FROM PCC SPREADSHEET
C
C  GLENN EVERHART, 23-JAN-83
C
C SYNTAX AND USAGE:
C
C  This program is designed to allow an interactive user to enter
C a single command line to the program which it will parse (using
C the special version of VARSCN in GVARSCN) and allow graphic output
C from PortaCalc saved spread sheets. The assumption made is that
C the sheet has been saved with the PPN or PDN command. The filename
C must appear in the command line and variables in the file (named as
C though the cursor had been in cell A1 when the PPN / PDN was done)
C may be histogrammed or scatterplotted against each other.
C
C The GHASP routine (a FORTRAN plot package for ordinary printers)
C will be used for this version.
C
C Input syntax:
C  NN or LL filename.ext V1:V2 c V3:V4 +switches
C
C  where
C
C  an L in columns 1 or 2 takes log of 1st or 2nd range numbers (base 10),
C
C  filename appears at the start of the command line after a space
C  and with a space following it and is a valid RSX or VMS file spec.
C
C  V1:V2 and V3:V4 are ranges. V3:V4 is optional and its presence implies
C  a scatter plot. These ranges must be either a row or a column or part
C  of them. If only range V1:V2 is present, a histogram will be done using
C  the Scale option of GHASP to fit the plot onto a page. The plot will be
C  set up for 100 bins horizontal, 50 vertical.
C    If the V3:V4 range exists, the character Q in the c position (the
C  are required) will result in a "density" plot in which the program will
C  attempt to print darker in filled bins. This is crude and the default is
C  to use a 2 digit number. Again, plot size will be scaled to 50 by 50
C  bins.
C
	CHARACTER*1 LINE(128),KLET,LLET
	INTEGER*4 NDLTY,NPLTS,MA(1000)
	INTEGER*4 NDIM,TITLE(19)
	CHARACTER*1 LTITL(76)
	CHARACTER*1 LLA,LLB
	EQUIVALENCE(TITLE(1),LTITL(1))
	INTEGER*4 IXTR
	COMMON/IXTR/IXTR
	INTEGER*4 NBINX,NBINY
	REAL*4 XMIN,YMIN,DX,DY
	INTEGER*4 KK,LS1,LS2,LQ
	REAL*4 VEC1(300),VEC2(300)
	CHARACTER*1 IONM(50)
	COMMON/EXTRA/NDLTY,NPLTS,MA
	EXTERNAL INDX
	COMMON/PLOTS/NDIM,XMIN,YMIN,DX,DY,NBINX,NBINY,TITLE
	REAL*4 RS,RV,RQ,RH
	CHARACTER*4 RRS,RRV,RRQ,RRH
	EQUIVALENCE(RS,RRS),(RV,RRV),(RQ,RRQ),(RH,RRH)
	DATA RRS/'   S'/
	DATA RRV/'   V'/
	DATA RRQ/'   Q'/
	DATA RRH/'   H'/
100	NDLTY=1000
	NPLTS=1
C	CALL ASSIGN(4,'TI:')
C	CALL ASSIGN(5,'TI:')
C	CALL ASSIGN(6,'LP:')
	IXTR=0
	DO 1982 N=1,128
1982	LINE(N)=0
	WRITE(*,8000)
8000	FORMAT(' Give Output Dataset Name>',\)
	read(*,2)ionm
	DO 8222 N=1,50
	NNN=51-N
	IF(ICHAR(IONM(NNN)).GT.32)GOTO 8223
	IONM(NNN)=0
8222	CONTINUE
8223	CONTINUE
C	IDL=NNN+1
	CALL WASSIG(6,IONM)
	ITTFG=0
	IF((IONM(1).EQ.'C'.OR.IONM(1).EQ.'c').AND.IONM(4).EQ.':')
     1  ITTFG=1
C ALSO MAKE TTY IMAGES IF 1ST 2 CHARS ARE TT
	IF(IONM(1).EQ.'T'.AND.IONM(2).EQ.'T')ITTFG=1
	IF(ITTFG.EQ.1)IXTR=1
C TOGGLE FOR PLOT ROUTINE...
	WRITE(*,1)
1	FORMAT(' Enter plot command>',\)
	READ(*,2)LINE
2	FORMAT(128A1)
C FIND END OF LINE ENTERED BY LOOKING FOR 1ST CHAR BIGGER THAN SPACE IN ASCII.
	DO 1980 N=1,128
	NN=129-N
	IF(ICHAR(LINE(NN)).GT.32)GOTO 1981
1980	CONTINUE
1981	LQ=NN+1
	LOGF1=0
	LOGF2=0
	NBFG1=0
	IF(LINE(1).EQ.'P')NBFG1=1
C NBFG1 MAKES YMIN=0. THUS IF CMD STARTS WITH PP PLOT IS POSITIVE
C DITTO NBFG2
	NBFG2=0
	IF(LINE(2).EQ.'P')NBFG2=1
	IF(LINE(1).EQ.'L')LOGF1=1
	IF(LINE(2).EQ.'L')LOGF2=1
	LLA=LINE(1)
	LLB=LINE(2)
C 1ST 2 CHARS SAY LOG OR LOGLOG (IF 2DIM GRAPH)
C LOGF1 WILL TAKE LOG OF VEC1 AND LOGF2 WILL TAKE LOG OF VEC2
C IF SET.
C NOTE THAT THIS ALSO TAKES ABS OF NUMBER.
	LQ=LQ+1
	LQ=MIN0(128,LQ)
	LINE(127)=0
	LINE(128)=0
	LINE(LQ)=0
c
c process switches.
c switches are after trailing + sign
c
c +hnnn = set height
c +wnnn = set width
	nhov=0
	nwov=0
	KK=INDX(LINE,'+')
	IF(KK.GT.50)GOTO 6000
C SKIP THIS AREA IF NO SWITCHES ARE FLAGGED
	LINE(KK)=CHAR(0)
C SKIP SWITCHES IN LATER PROCESSING.
c since we look for a number, first try to decode the number as a
c 3 digit one...
	kkk=kk+2
	lend1=kkk+30
	call gn(kkk,lend1,num1,line)
c num1 can be h or w depending on line(kk+1)
	if(line(kk+1).eq.'h'.or.line(kk+1).eq.'H')nhov=num1
	if(line(kk+1).eq.'w'.or.line(kk+1).eq.'W')nwov=num1
C GN RETURNS ITS LAST CHAR AFTER THE # IN ITS 1ST ARG.
	IKK=INDX(LINE(KK+1),'+')
	IF(IKK.GT.30)GOTO 6000
	KKK=IKK+KK
c 2nd + sign flags 2nd switch...
	kk=kkk+2
	lend1=kk+30
	call gn(kk,lend1,num1,line)
	if(line(kkk+1).eq.'h'.or.line(kkk+1).eq.'H')nhov=num1
	if(line(kkk+1).eq.'w'.or.line(kkk+1).eq.'W')nwov=num1
c that should do it...
6000	CONTINUE
	LS1=INDX(LINE,CHAR(32))
C CALL OUR PORTACALC INDEX FCN
	KK=LS1+1
	LS2=INDX(LINE(KK),CHAR(32))
	IF(LS1.GT.40.OR.LS2.GT.40)WRITE(*,25)LS1,LS2,LQ
25	FORMAT(' Spaces not seen. Find spaces at ',3I6,
     1  /,' Usage: ACG file V1:V2 C V3:V4 +HNNN+WNNN')
	IF (LS1.GT.40.OR.LS2.GT.40)GOTO 100
	LINE(LS2+LS1)=0
	CALL RASSIG(1,LINE(LS1+1))
C SET UP FILE 1 TO READ SAVED FILE FROM SHEET
	LINE(LS2+LS1)=32
	LX=LS1+LS2+1
C SCAN THE REST STARTING AT LX
C GRAB OFF OUR ARGUMENTS FIRST, THEN GET ON WITH THE PLOTS.
	CALL PLOT(0.,0.,-1,0)
C HOWEVER INITIALIZE PLOT ARRAY EARLY ON.
	K1=LX
	K2=110
	CALL GVSCAN(LINE,K1,K2,LSTCHR,ID1,ID2,IVLD)
	IF (IVLD.NE.0)GOTO 150
	WRITE(*,3)
3	FORMAT(' First variable invalid. Try again.')
	GOTO 100
150	CONTINUE
	IF(LINE(LSTCHR).EQ.':')GOTO 160
	WRITE(*,4)
4	FORMAT(' Colon missing in first range.')
	GOTO 100
160	CONTINUE
	K1=LSTCHR+1
	K2=110
	CALL GVSCAN(LINE,K1,K2,LSTCR,ID1B,ID2B,IVLD)
	IF (IVLD.NE.0)GOTO 164
	WRITE(*,5)
5	FORMAT(' 2nd variable in 1st range invalid.')
	GOTO 100
164	CONTINUE
	IF(ID1.NE.ID1B.AND.ID2.NE.ID2B)GOTO 166
	GOTO 167
166	WRITE(*,6)
6	FORMAT(' Variable pair not in a row or column together')
	GOTO 100
167	CONTINUE
	KCR=1
C : CHECK FOR '' OLD VERSION..........
	IF(LINE(LSTCR).EQ.'[')GOTO 170
	LSTCR=LSTCR+1
	IF(LINE(LSTCR).EQ.'[')GOTO 170
169	WRITE(*,7)KCR
7	FORMAT(' Invalid format of [c] character ',I5)
	GOTO 100
170	LSTCR=LSTCR+1
	KCR=2
	IF(LINE(LSTCR).EQ.']')GOTO 169
	KLET=LINE(LSTCR)
	LSTCR=LSTCR+1
C SCAN OVER NEXT ']' NOW
	KCR=3
	IF(LINE(LSTCR).NE.']')GOTO 169
	LSTCR=LSTCR+1
C IF WE PICK UP A VALID VARIABLE HERE, ALL'S WELL. OTHERWISE WE HAVE
C A HISTOGRAM AND WE'RE DONE (FOR THIS VERSION ANYHOW)
	K1=LSTCR
	K2=110
	NDIM=1
	CALL GVSCAN(LINE,K1,K2,LSTT,ID1C,ID2C,IVLD)
	IF(IVLD.EQ.0)GOTO 200
C IF HERE, THERE HAS TO BE 1 MORE VARIABLE DECODED AND TESTED.
	IF(LINE(LSTT).EQ.':')GOTO 175
	WRITE(*,8)
8	FORMAT(' Invalid second variable range.')
	GOTO 100
175	CONTINUE
	K1=LSTT+1
	K2=110
	CALL GVSCAN(LINE,K1,K2,LSTCC,ID1D,ID2D,IVLD)
	IF(IVLD.NE.0)GOTO 180
	WRITE(*,9)
9	FORMAT(' Invalid 2nd variable of 2nd range')
	GOTO 100
180	CONTINUE
C NOW ALL DECODED.
	NDIM=2
C NOW WE HAVE SET UP THE DIMENSION OF OUR PLOT.
200	CONTINUE
C NOW IT'S POSSIBLE TO READ IN THE FILE ONCE TO NORMALIZE IT, THEN
C REWIND AND READ AGAIN TO PLOT IT.
	XMIN=99.E10
	YMIN=99.E10
	IF(NBFG1.NE.0)YMIN=0.
	IF(NBFG2.NE.0)XMIN=0.
C SET TERRIBLY LARGE X,Y MINS UNLESS POSITIVE PLOT, THEN START AT 0.
C (WE'LL FIX THEM UP!)
	XMAX=-99.E10
	YMAX=-99.E10
C SET UP MAXIMA ALSO IN BOGUS WAY. THIS ENSURES WHATEVER WE GET
C WILL BE BETTER THAN OUR "FIRST GUESS".
C  INSERT TITLE AS OUR COMMAND LINE, FOR INTERNAL DOCUMENTATION.
C (LX THRU END)
	DO 11 N=1,78
11	LTITL(N)=CHAR(32)
	LX=LS1
C INCLUDE FILENAME TOO.
	DO 12 N=1,50
	LTITL(N)=LINE(LX)
	IF(LX.GT.76)GOTO 13
12	LX=LX+1
C FLAG LOG SCALE FLAGS IN TITLE
	IF (LLA.EQ.'L')TITLE(18)='LOGX'
	IF (LLB.EQ.'L')TITLE(19)='LOGY'
13	READ(1,10)LINE
10	FORMAT(128A1)
	IF(NDIM.EQ.2)GOTO 17
	XMIN=0.
	XMIN2=0.
	ICNT=0
17	CONTINUE
C IGNORE TITLE, JUST READ IT IN, THEN FORGET IT.
	IV1=1
	IV2=1
220	CONTINUE
C NOTE WE READ IN THE NUMBER IN NUMERIC FORMAT. EASIER THAT WAY.
	irrw=0
	iccl=0
	READ(1,14,END=250,ERR=224)LET1,IRRW,ICCL,XYVAL
224	continue
14	FORMAT(A1,I5,1X,I5,1X,E50.35)
	READ(1,15,END=250,ERR=225)LFVLD,(LINE(IV),IV=120,128),KKTYP
225	continue
15	FORMAT(I3,1X,9A1,1X,I5)
C READS IN AN ENTRY OF SAVED SHEET. TEST IF IN OUR RANGE.
	IF(IRRW.GE.ID1.AND.IRRW.LE.ID1B.AND.ICCL.GE.ID2.AND.ICCL
     1  .LE.ID2B)GOTO 221
	IF(NDIM.NE.2)GOTO 223
	IF(IRRW.GE.ID1C.AND.IRRW.LE.ID1D.AND.ICCL.GE.ID2C
     1  .AND.ICCL.LE.ID2D)GOTO 222
	GOTO 223
221	CONTINUE
C NUMBER IS IN FIRST RANGE TO PLOT. FIGURE IT OUT.
	IF(LOGF1.NE.0.AND.XYVAL.NE.0)XYVAL=ALOG10(ABS(XYVAL))
	VEC1(IV1)=XYVAL
	IV1=IV1+1
	IF(NDIM.EQ.1)ICNT=ICNT+1
	IF(NDIM.EQ.1)XMAX=ICNT
	IF(NDIM.EQ.1)GOTO 18
	IF(XYVAL.LT.XMIN)XMIN=XYVAL
	IF(XYVAL.GT.XMAX)XMAX=XYVAL
	GOTO 223
18	CONTINUE
	IF(XYVAL.LT.YMIN)YMIN=XYVAL
	IF(XYVAL.GT.YMAX)YMAX=XYVAL
	VEC2(IV2)=FLOAT(ICNT)
	IV2=IV2+1
	GOTO 223
222	CONTINUE
	IF(NDIM.EQ.1)GOTO 223
	IF(LOGF2.NE.0.AND.XYVAL.NE.0)XYVAL=ALOG10(ABS(XYVAL))
C NUMBER IS IN SECOND RANGE SELECTED.
C KNOW IT'S A Y COORD HERE.
	VEC2(IV2)=XYVAL
	IV2=IV2+1
	IF(XYVAL.LT.YMIN)YMIN=XYVAL
	IF(XYVAL.GT.YMAX)YMAX=XYVAL
223	CONTINUE
	GOTO 220
250	CONTINUE
C NOW MINIMA,MAXIMA ALL SET UP.
	IF(XMIN.GE.XMAX.OR.YMIN.GE.YMAX)STOP
C EXIT IF NOTHING IS THERE TO GRAPH.
	XRANGE=XMAX-XMIN
	YRANGE=YMAX-YMIN
C
	IF(XRANGE.LE.0)XRANGE=60.
	IF(YRANGE.LE.0)YRANGE=20.
C	XNUM=100.
	AMXRG=100.
	AMYRG=50.
	IF(ITTFG.EQ.1)AMXRG=60.
	IF(ITTFG.EQ.1)AMYRG=20.
	XNUM=AMXRG
	IF(NDIM.EQ.1.AND.(XRANGE.LT.100.))XNUM=XRANGE
	YNUM=AMYRG
	IF(NDIM.EQ.2)XNUM=AMYRG
C HANDLE SWITCHES THAT OVERRIDE HEIGHT AND WIDTH TO USE.
	IF(NHOV.NE.0)YNUM=NHOV
	IF(NWOV.NE.0)XNUM=NWOV
	DX=XRANGE/XNUM
	DY=YRANGE/YNUM
	IF(.NOT.(NDIM.EQ.1.AND.DX.LT.1))GOTO 19
	IF(NWOV.EQ.0)DX=1.
19	NBINX=XNUM
	NBINY=YNUM
	CALL PLOT(RV,0.,0,1)
C INITIALIZE PLOT
C NDIM, MINIMA, MAXIMA ALL SET UP NOW.
C
C WE SAVED VALUES IN VEC1,VEC2 AND PLOT THAT WAY.
C  ALSO NOTE BOTH ALWAYS EXIST.
C
	LENGTH=MIN0(IV1,IV2)
C SAME IF NDIM=1
	DO 20 N=1,LENGTH
	IF(NDIM.EQ.1)CALL PLOT(VEC2(N),VEC1(N),1,1)
	IF(NDIM.NE.1)CALL PLOT(VEC1(N),VEC2(N),1,1)
20	CONTINUE
C PLOT IT OUT NOW
C CHOOSE OPTION FOR FORMAT (SCALE, VARY HEIGHT, SHADE)
	X=RS
	IF(KLET.EQ.'V')X=RV
	IF(KLET.EQ.'Q')X=RQ
	IF(KLET.EQ.'H')X=RH
	CALL PLOT(X,0,2,1)
	STOP
	END
	SUBROUTINE GN(LAST,LEND,NUM,LINE)
	IMPLICIT INTEGER*4(A-Z)
C	PARAMETER 1=1,14=14
	DIMENSION LINE(110)
	CHARACTER*1 LINE
	EXTERNAL INDX
	CHARACTER*1 NCH
	INTEGER*4 CH,SFG
	NUM=0
	JSSF=0
	ISSF=0
	CH=0
	SFG=1
	NCH=0
	DO 1 N=LAST,LEND
	M=N
	NCH=LINE(N)
	CH=ICHAR(NCH)
	IF(CH.EQ.0)GOTO 2
	IF(CH.EQ.45)SFG=-1
C SFG=SIGN FLAG
C 43 IS ASCII FOR +; 45 IS ASCII FOR - SIGN.
C IGNORE + SIGNS
	IF(CH.GT.32)ISSF=ISSF+1
	IF(ISSF.EQ.0.AND.CH.EQ.32)GOTO 1
C IGNORE SPACES TOO, PROVIDED THEY ARE LEADING SPACES.
C (OTHERS MAY BE DELIMITERS.)
	IF(CH.EQ.43.OR.CH.EQ.45)JSSF=JSSF+1
	IF(JSSF.GT.1.AND.(CH.EQ.43.OR.CH.EQ.45))GOTO 2
C IF WE HAVEN'T SEEN A +/- PROCESS IT HERE.
	IF(CH.EQ.43)GOTO 1
	IF(CH.EQ.45)GOTO 1
	IF(CH.LT.48.OR.CH.GT.57)GOTO 2
C TERMINATE ON ANY NON NUMERIC. SHOULD ALLOW TERMINATE ON SECOND #.
	IF(NUM.LT.3100)NUM=10*NUM+(CH-48)
1	CONTINUE
C NEXT LINE WAS MAX0...
2	LAST=MIN0(M,LEND)
	NUM=NUM*SFG
C ACCOUNTED FOR SIGN; NOW RETURN
	RETURN
	END
	SUBROUTINE GVSCAN(LINE,IBGN,LEND,LSTCHR,ID1,ID2,IVALID)
C COPYRIGHT (C) 1983 GLENN EVERHART
C ALL RIGHTS RESERVED
C VARSCN - SCAN COMMAND LINE FOR VARIABLE NAMES.
C DUMMY GRAPHICS VERSION
C (NO FUNNY ADDRESS MODES ETC.; FOR USE ON SAVED SHEETS.)
C
C	SCANS FOR VARIABLE NAMES OF FORM AAANNN WHERE AAA = LETTERS
C BETWEEN A AND Z UP TO NON-ALPHA, CORRESPONDING TO ROW, FOLLOWED BY
C NUMBERS IN THE 0-9 RANGE MAKING A DECIMAL COLUMN NUMBER.
C   THIS VERSION IS FOR USE WITH A GRAPHICS PROGRAM AND WILL NOT DECODE
C   FORMS OF TYPE P## OR D## AS WILL THE ONE IN PORTACALC. ALSO IT WILL
C   NOT MAKE CHECKS ON LIMITS OF VARIABLES SAVE FOR VERY CRUDE CHECKS OF
C   REASONABLENESS.
C
C THE LETTERS ARE FORMED BY
C A-Z ALONE GIVE ROW 1-26, COL 1. % IS ROW 27,COL1
C A1-Z1 GIVE ROW 1-26, COL 2
C AA1-ZZ1 ARE ROW 27-52, COL 2
	IMPLICIT INTEGER*4 (A-Z)
	INTEGER*4 RRW,RCL,CUP,NEL,RRCL
C	PARAMETER RRW=1000
C	PARAMETER RCL=1000
C RRCL IS USED AS A GUARD TO ENSURE AGAINST OVERFLOWS. VAX COMPLAINS OF
C INTEGER OVERFLOWS (PAIN).
C	PARAMETER RRCL=1100
C	PARAMETER CUP=1,NEL=14
C NOTE COL 1 IS DUMMY. DISPLAY THE SHEET SIDEWAYS SO WE GET USUAL VISUAL
C ROWS, COLS., AND ACCUMULATORS A-Z,% JUST APPEAR AS A FICTITIOUS ROW 0
C ON DISPLAY, INSTEAD OF REAL COLUMN 1 HERE.
	DIMENSION LINE(LEND)
	CHARACTER*1 LINE
C
	INTEGER*4 RSM,CSM,AFG,ASM,VCF,CH
	DATA RRW/1000/,RCL/1000/,RRCL/1200/,CUP/1/,NEL/14/
C ZERO OUR VARIABLES
	LPFG=0
C ! FLAG WE GOT A LOGICAL/PHYSICAL # FORM AND TYPE
	AFG=0
C ! FLAG WE SAW AN ALPHA
	ASM=0
C ! SUM OF ALPHAS HASHCODED (ACCUMULATOR)
	NSM=0
C ! ACCUMULATOR FOR NUMERICS
	NFG=0
C ! FLAG WE SAW A NUMERIC
	RSM=0
C ! AC FOR ROWS IN # FORMS
	CSM=0
C ! AC FOR COLS IN # FORMS
	ISPC=0
C ! COUNTER FOR NONSPACES SEEN (USED TO STOP ON TRAILING SPACES)
	IF(LINE(IBGN).NE.'%')GOTO 2000
	ID1=27
	ID2=1
	IVALID=1
	LSTCHR=IBGN+1
C SPECIAL CASE FOR % = AC #27
	RETURN
2000	CONTINUE
	DO 1 N=IBGN,LEND
	VCF=0
	LSTCHR=N
	CH=ICHAR(LINE(N))
C IGNORE SPACES AND TABS IF LEADING
	IF(CH.GT.32)ISPC=ISPC+1
	IF(CH.GT.0.AND.CH.LE.32.AND.ISPC.EQ.0)GOTO 1
C GET CHARACTER VALUE IN.
C MUST BE UPPERCASE.
	IF(.NOT.(CH.GE.65.AND.CH.LE.91)) GOTO 100
C CH IS AN ALPHA, RANGE A-Z
	VCF=1
C ! VALID CHAR SEEN
	AFG=1
C !SAW THE ALPHA
	IF(ASM.LT.RRCL)ASM=(CH-64)+26*ASM
	IF(CH.EQ.80)LPFG=1
C ! FLAG WE GOT PHYS. FORM MAYBE
	IF(CH.EQ.68)LPFG=2
C ! FLAG WE GOT DISPLAY FORM MAYBE
100	CONTINUE
C NEXT TEST NUMERICS
	IF(.NOT.(CH.GE.48.AND.CH.LE.57))GOTO 101
C CH IS A NUMERIC, RANGE 0-9
	VCF=1
C ! VALID CHAR SEEN
	NFG=1
C ! FLAG WE SAW NUMERIC
	IF(AFG.EQ.0)GOTO 103
102	CONTINUE
	IF(NSM.LT.RRCL)NSM=(CH-48)+10*NSM
C ! CONVERT CHARS TO BINARY AS SEEN
101	CONTINUE
	IF(VCF.EQ.0)GOTO 2
C !END ON ANY INVALID CHARACTER
1	CONTINUE
	GOTO 2
103	CONTINUE
C INVALID ... NUMERIC AND NO PRIOR ALPHA. FLAG BAD NAME AND EXIT.
	IVALID=0
	RETURN
2	CONTINUE
	IF(AFG.EQ.0)GOTO 103
	ID1=ASM
C HERE WE MAKE ID2 JUST NSM, NOT 1+NSM.
	ID2=NSM
C FLAG PURE ALPHAS NOT VALID FOR PLOTTING HERE. (THEY AREN'T SAVED ANYHOW)
	IF(NSM.LE.0)GOTO 103
	IF(ID1.GT.RRW.OR.ID1.LE.0)GOTO 103
	IF(ID2.GT.RCL.OR.ID2.LE.0)GOTO 103
	IVALID=1
C ALL IS WELL
	RETURN
	END
      SUBROUTINE HIHDIG(X,ID,IS)
      XT=X
      ID=0
      IS=0
      IF (ABS(X).EQ.0.0) RETURN
      IF (ABS(X).LT.1.) GO TO 20
      IF (ABS(X).GE.10.) GO TO 30
      ID=X
      RETURN
   20 XT=XT*10.
      IS=IS-1
      IF (ABS(XT).LT.1.) GO TO 20
      GO TO 40
   30 XT=XT/10.
      IS=IS+1
      IF (ABS(XT).GE.10.) GO TO 30
   40 ID=XT
      RETURN
      END
      INTEGER FUNCTION INDX ( STR, C )
C
      CHARACTER * 1 C, STR ( 1 )
C
C LIMIT RANGE OF SEARCH TO 256 BYTES. THIS IS ARBITRARY BUT I DOUBT
C ANALYTICALC WILL EVER DEAL IN LONGER STRINGS THAN THIS AND
C SEARCHES ALL OVER THE CREATION ARE TO BE AVOIDED.
      DO 20019  I = 1, 256
      IF (.NOT.( STR ( I ) .EQ. 0 )) GOTO 20021
C RETURN INDX AS EITHER THE LOCATION OF THE CHARACTER OR OF THE
C END OF THE STRING FOR ANALYTICALC. NOTE THAT THIS DIFFERS
C FROM USUAL RATFOR VERSION.
      INDX=I
      RETURN
20021 CONTINUE
      IF (.NOT.( STR ( I ) .EQ. C )) GOTO 20023
      INDX = ( I )
      RETURN
20023 CONTINUE
20022 CONTINUE
C
20019 CONTINUE
20020 CONTINUE
      END
      INTEGER FUNCTION ISGN(IARG)
      INTEGER*4 IARG
      IF(IARG.EQ.0)ISGN=0
      IF(IARG.GT.0)ISGN=1
      IF(IARG.LT.0)ISGN=-1
      RETURN
      END
C THE FOLLOWING ROUTINES ARE NEEDED FOR GHASP AND IMPLEMENTED CORRECTLY
C IN DEC FORTRAN AND SOME OTHERS; NOT NECESSARILY CORRECT IN IBM FORTRAN.
C MODIFIED FOR MICROSOFT FORTRAN (WHICH IS MORE FUSSY ABOUT LOGICAL TYPES)
C GCE 7/84
	FUNCTION MAND(IK,JK)
	INTEGER*4 MAND,KMAND,IK,JK
	INTEGER*4 IA,IB
	IA=IK
	IB=JK
	KMAND=IA.AND.IB
	MAND=KMAND
	RETURN
	END
C THE FOLLOWING ROUTINES ARE NEEDED FOR GHASP AND IMPLEMENTED CORRECTLY
C IN DEC FORTRAN AND SOME OTHERS; NOT NECESSARILY CORRECT IN IBM FORTRAN.
C MODIFIED FOR MICROSOFT FORTRAN (WHICH IS MORE FUSSY ABOUT LOGICAL TYPES)
C GCE 7/84
	FUNCTION MOR(IK,JK)
	INTEGER*4 MOR,IK,JK
	MOR=IK.OR.JK
	RETURN
	END
            SUBROUTINE NORM (TOT, IPLT)
         DIMENSION XM(1),INDEXV(8)
       COMMON/EXTRA/ NDLTY, NPLTS, MA(1)
            EQUIVALENCE(MA(1),XM(1)),(INDEXV(1),NDM),(INDEXV(2),IST),
     1 (INDEXV(7),NBX)
          IF(1.GT.IPLT.OR.IPLT.GT.NPLTS) RETURN
         DO 1 I=1,8
         J = (I-1)*NPLTS + IPLT
1         INDEXV(I) = MA(J)
         IF ( NDM .NE. 1) RETURN
         NE =NBX + 2
          WT =0.000000001
         DO 2 I=1,NE
           J =IST + I
2        WT = XM(J) + WT
         ADJ = TOT/WT
           DO 3 I=1,NE
        J = IST + I
3         XM(J)= ADJ*XM(J)
          RETURN
          END
           SUBROUTINE PLOT(X,Y,IENT,IPLT)
      DIMENSION JA1(110),JA2(110),JA3(110),KA1(110),KA2(110)
	INTEGER*4 IENT,IPLT
       DIMENSION KA3(110), KA4(110)
      DIMENSION IPNCH(120)
          DIMENSION  XM(1),        XLABL(2), YLABL(2)
       DIMENSION LINE(119),IICH(32),ICH(32),INDEXV(8),AIND(8)
     1 , XL(12),  IBT(6), IZB(6)
	CHARACTER*1 IICH
      COMMON/PLOTS/ ND, XMIN,YMIN,
     1 DX,    DY,   NBINX,    NBINY, TITLE(19)
               COMMON/EXTRA/NDIM, NPLTS, MA(1)
      EQUIVALENCE (XLABL(1),TITLE(16)),(YLABL(1),TITLE(18))
         EQUIVALENCE(INDEXV(1),AIND(1))
      EQUIVALENCE (MA(1),XM(1)),(LINE(1),XL(1)),(INDEXV(1),NDM),
     1 (INDEXV(2),IST),(AIND(3),XMN),(AIND(4),YMN),(AIND(5),DEX),
     2 (AIND(6),DEY),(INDEXV(7),NBX),(INDEXV(8),NBY)
	INTEGER*4 IXTR
	COMMON/IXTR/IXTR
C IXTR=1 SWITCHES OFF EXTRA STUFF AT BOTTOM OF PLOT
	CHARACTER*4 PPNCH
	REAL*4 PNC
	EQUIVALENCE(PPNCH,PNC)
	REAL*4 BLANK
	CHARACTER*4 BBLANK
	EQUIVALENCE(BLANK,BBLANK)
	INTEGER*4 IXXPPP,IPPPPP,IXXBBB,ICHX,ICHP
	CHARACTER*4 XXPPP,PPPPP,XXBBB
	CHARACTER*1 CHX,CHP
	EQUIVALENCE(IXXPPP,XXPPP),(IXXBBB,XXBBB)
	CHARACTER*4 RRDIM,RRV,RRH,RRS
	REAL*4 RDIM,RV,RH,RS
	EQUIVALENCE(RRDIM,RDIM),(RRV,RV),(RRH,RH),(RS,RRS)
      DATA PPNCH/'PNCH'/
      DATA IICH/   ' ',   '1',  '2',    '3',
     1       '4',        '5',        '6',        '7',         '8',
     2      '9',         'A',        'B',         'C',       'D',
     3       'E',       'F',       'G',         'H',        'I',
     4      'J',       'K',       'L',       'M',       'N',
     5       'O',      'P',     'Q',     'R',   'S',
     6       'T',       'U',        '*'/
      DATA RRS/'   S'/
               DATA RRDIM/' DIM'/
       DATA RRV/'   V'/
              DATA RRH/'   H'/
C VALUES BELOW ASSUME 32 BIT 2S COMPLEMENT INTEGERS...
      DATA IBT/33554432, 1048576, 32768, 1024, 32, 1 /
      DATA IZB /-1040187393, -32505857, -1015809, -31745, -993, -32  /
         DATA         BBLANK/   '    '/,       XXPPP/    'XX++'/,
     1        PPPPP/  '++++'/,        XXBBB/ 'XX  '/,
     2         CHX/        'X'/,         CHP/       '+'/,
     3             IHK/             31/,                 NBT/     6/,
     4          LINWDS/        110/,          NOUT/       6/
            DATA INIT/        0/
	ICHX=ICHAR(CHX)
	ICHP=ICHAR(CHP)
	DO 6670 IV=1,32
6670	ICH(IV)=ICHAR(IICH(IV))
      IF(IENT.EQ. 1) GO TO 15
           IF(IENT.EQ.-1)      GO TO 1
      IF(IENT.EQ. 0)     GO TO 4
         IF(IENT.EQ. 2)      GO TO 19
         WRITE(NOUT,57)    IENT
           GO TO 56
1     INIT=1
          DO 2 I=1,NDIM
2     MA(I)=0
        ISTART=8*NPLTS*NBT
        DO 3 I=1,19
3          TITLE(I) = BLANK
          IF(IENT.EQ.-1)     GO TO 56
4          IF(INIT.EQ.0)    GO TO 1
      IF(1.LE.IPLT.AND.IPLT.LE.NPLTS) GO TO 5
      WRITE(NOUT,58)    IPLT
        GO TO 56
5      IF(DX.NE.0.0)  GO TO 6
       WRITE(NOUT,59) IPLT
       GO TO 56
6     IF(NBINX.LE.0) NBINX=100
      IF(NBINX.GT.LINWDS) NBINX=LINWDS
      NBINX=((NBINX-1)/10)*10+10
      IF(ND.EQ.1)    GO TO 7
           IF(ND.EQ.2) GO TO 11
           WRITE(NOUT,60) IPLT
        GO TO 56
7     IST=(ISTART-1)/NBT +1
       ITEST= IST+ NBINX+  2
        IF(ITEST.LE.NDIM)  GO TO 8
       MA(IPLT) =0
        WRITE(NOUT,61) IPLT
          GO TO 56
8         ISTART =ITEST*NBT
      IF(NBINY.LE.0) NBINY=100
       NBINY=((NBINY-1)/10)*10+10
         NDM=1
           XMN=XMIN
         YMN=YMIN
         DEX=DX
            DEY=DY
           NBX=NBINX
          NBY=NBINY
         DO 9 I=1,8
           J=(I-1)*NPLTS +IPLT
9      MA(J)=INDEXV(I)
      J=IST+1
          DO 10 I=J,ITEST
10       XM(I)=0.0
            IF(X.EQ.RDIM)      WRITE(NOUT,75) ITEST,IPLT
         GO TO 56
11        IF(DY.NE.0.0)   GO TO 12
          WRITE(NOUT,59) IPLT
          GO TO 56
12          IF(NBINY.LE.0) NBINY=50
          NBINY= ((NBINY-1)/10)*10+10
          NBTS=(NBINX+2)*(NBINY+2)
      IF(ISTART+NBTS.LE.NDIM*NBT)  GO TO 13
          MA(IPLT)=0
           WRITE(NOUT,61) IPLT
         GO TO 56
13       IST=ISTART
          ISTART=ISTART+NBTS
         NDM=ND
             XMN=XMIN
              YMN=YMIN
          DEX=DX
           DEY=DY
                 NBX=NBINX
                NBY=NBINY
       DO 14 I=1,8
         J=(I-1)*NPLTS+IPLT
14          MA(J)=INDEXV(I)
         IST=(ISTART-1)/NBT  +1
            IF(X.EQ.RDIM)      WRITE(NOUT,75) IST,IPLT
         GO TO 56
15     IF(1.GT.IPLT.OR.IPLT.GT.NPLTS) GO TO 56
         DO 16 I=1,8
        J=(I-1)*NPLTS+IPLT
16       INDEXV(I)=MA(J)
          IF(NDM.EQ.1) GO TO 17
           IF(NDM.GE.2)    GO TO 18
          GO TO 56
17       IX= IFIX((X-XMN)/DEX+2.)
         IF(IX.LT.1)    IX=1
            IF(IX.GT. NBX+2)   IX=NBX+ 2
          IWD=IST+ IX
         XM(IWD) =XM(IWD) + Y
         GO TO 56
18      IX= IFIX((X-XMN)/DEX+2.)
          IY= IFIX((Y-YMN)/DEY+2.)
          IF(IX.LT.1)  IX=1
           IF(IY.LT.1)  IY=1
           IF(IX.GT.NBX+2) IX=NBX+2
          IF(IY.GT.NBY+2) IY=NBY+2
            ILOC=(IY-1)*(NBX+2) + (IX+ IST -1)
           IWD=ILOC/NBT +1
            JBT=MOD(ILOC,NBT) +1
        NOO1=MA(IWD)/IBT(JBT)
          NO=MAND(NOO1,IHK)
            MAA1=MA(IWD)
               MAA2=IZB(JBT)
               MA(IWD)=MAND(MAA1,MAA2)
          IF(NO.LT.31) NO=NO+1
              MAA3=MA(IWD)
               MAA4=NO*IBT(JBT)
               MA(IWD)=MOR(MAA3,MAA4)
         MA(IPLT) = MA(IPLT) + 1
          GO TO 56
19        IF(1 .LE.IPLT.AND.IPLT.LE.NPLTS) GO TO 20
          WRITE(NOUT,58) IPLT
           GO TO 56
20          DO 21 I=1,8
          J= (I-1)*NPLTS + IPLT
21         INDEXV(I) = MA(J)
           IF(NDM.EQ.1) GO TO 22
          IF(NDM.GE.2)  GO TO 39
          WRITE(NOUT,72) IPLT
          GO TO 56
22          WRITE(NOUT,62) IPLT, (TITLE(I), I=1,15)
            IYMN =IFIX(YMN+.5)
               IDEY = IFIX(DEY + .5)
             IF(IDEY .LE. 0) IDEY = 1
      NE=NBX+1
C     CODE ADDED TO SCALE PLOTS IF DESIRED AND REQUIRED
      IF (X.NE.RS) GO TO 2005
      MAXY=-1
      DO 2010 I=2,NE
      J=IST+I
      K=IFIX(XM(J)+.5)-IYMN
      IF (K.GT.MAXY) MAXY=K
 2010 CONTINUE
      K=MAXY
      IF (K.LE.NBY*IDEY) GO TO 2005
C     MUST INCREASE IDEY TO MAKE PLOT FIT
      IDEY=K/NBY+1
      DEY=10*IDEY
      CALL HIHDIG(DEY,ID,IS)
      IF (DEY.EQ.10.*IS) GO TO 2016
      ID=ID+1
 2016 IDEY=ID*10.**IS
      IDEY=IDEY/10
      DEY=IDEY
 2005 CONTINUE
             WT = 0.0
           MAXY= 10*IDEY
      AVG=0.
      WAG=0.
      AGG=-.5
      DO 23 I=2,NE
           J= IST + I
      ZXM=XM(J)
      WT=WT+ZXM
      AGG=AGG+1.
      WAG=WAG+AGG*ZXM
           K = IFIX(XM(J) + .5) - IYMN
           IF(K.GT.MAXY) MAXY=K
            K= K - NBY*IDEY
          IF(K.GT.31)  K = 31
      IF(K.LT.0.OR.X.EQ.RV) K=1
      IF(X.EQ.PNC) K=1
23         LINE(I)=ICH(K)
      WAG1=WAG/WT
      AVG=(WAG1*DEX)
      AGG=-.5
      STD=0.
      DO 232 I=2,NE
      J=IST+I
      ZXM=XM(J)
      AGG=AGG+1.
           STDIF=ZXM*(AGG-WAG1)*(AGG-WAG1)
         STD=STD+STDIF
 232  CONTINUE
      STDEV=DEX*SQRT(STD/WT)
      AVG=AVG+XMN
           MAXY= ((MAXY-1)/(10*IDEY))*10 +10
        IF((MAXY.LT.NBY.AND.X.EQ.RH).OR.X.EQ.RV)  NBY=MAXY
      IF(X.EQ.PNC) NBY=MAXY
      WRITE(NOUT,63) (LINE(L),L=2,NE)
C          WRITE(NOUT,64)
          N = NE/5 -1
      INEE=NBX+2
      DO 25 I=1,NBX
      KNBX=I/10
      LNBX=10*KNBX
      MNBX=I-LNBX
      LINE(I)=ICHP
      IF(MNBX.EQ.1) LINE(I)=ICHX
      IF(MNBX.EQ.2) LINE(I)=ICHX
 25   CONTINUE
      LINE(NBX+1)=ICHX
      LINE(NBX+2)=ICHX
      WRITE(NOUT,765) YLABL,(LINE(L),L=1,INEE)
           N = NBY - 9
           I = N
133        IY = (I+9)*IDEY + IYMN
          ILOW = IY - IDEY
      DO 26 J=2,NE
         K = IST + J
           L = IFIX(XM(K) + .5) - ILOW
            LINE(J)=ICH(1)
            IF (L.LE.0)  GO TO 26
          LINE(J) = ICHX
             IF(L .GE. IDEY) GO TO 26
            IF(L.GT.31) L=31
           LINE(J)=ICH(L+1)
26       CONTINUE
      NEEE=NE+1
      LINE(NEEE)=ICHX
      ME=NE+1
      WRITE(NOUT,66) IY,ICHX, (LINE(L),L=2,ME)
              J = 9
130       ILOW= (I-2 +J)*IDEY + IYMN
      DO 28 K=2,NE
           M  = IST + K
          NO = IFIX(XM(M) + .5) - ILOW
         LINE(K) = ICH(1)
           IF(NO.LE.0)  GO TO 28
             LINE(K) = ICHX
          IF(NO.GE.IDEY) GO TO 28
             IF(NO.GT.31) NO=31
                 LINE(K) = ICH(NO+1)
28        CONTINUE
      NEEE=NE+1
      LINE(NEEE)=ICHP
      ME=NE+1
30    WRITE(NOUT,67) ICHP,(LINE(L),L=2,ME)
               J = J - 1
               IF(J .GE. 2) GO TO 130
         ILOW=(I-1)*IDEY + IYMN
           DO 31 J=1,NE
         K = IST + J
          NO = IFIX(XM(K) + .5) -ILOW
            LINE(J)=ICH(1)
          IF(NO.LE.0)  GO TO 31
          LINE(J) = ICHX
         IF(NO .GE.IDEY) GO TO 31
           IF(NO.GT.31) NO=31
               LINE(J)=ICH(NO+1)
31         CONTINUE
      NEEE=NE+1
      LINE(NEEE)=ICHX
      ME=NE+1
33    WRITE(NOUT,67) ICHX, (LINE(L),L=2,ME  )
             I = I- 10
            IF(I .GE. 1) GO TO 133
         N =NE/5 -1
      INEE=NBX+2
      DO 34 I=1,NBX
      KNBX=I/10
      LNBX=10*KNBX
      MNBX=I-LNBX
      LINE(I)=ICHP
      IF(MNBX.EQ.1) LINE(I)=ICHX
      IF(MNBX.EQ.2) LINE(I)=ICHX
 34   CONTINUE
      LINE(NBX+1)=ICHX
      LINE(NBX+2)=ICHX
      WRITE(NOUT,768) IYMN,(LINE(L),L=1,INEE)
           N=NE/10 +1
          DO 35 I=1,N
35       XL(I) = FLOAT(I-1)*DEX*10.0 + XMN
           WRITE(NOUT,69) (XL(L),L=1,N)
C          WRITE(NOUT,64)
      DO 36 I=2,NE
           J=IST + I
            NO = IFIX(XM(J) + .5) - IYMN
             LINE(I) =ICH(1)
           IF(NO.GE.0) GO TO 36
            NO =-NO
            IF (NO.GT.31) NO=31
            LINE(I) = ICH(NO+1)
36       CONTINUE
      WRITE(NOUT,63) (LINE(L),L=2,NE)
      J=IST+1
      JUND=IFIX(XM(J)+.5) - IYMN
      J=IST+NBX+2
      JOVR=IFIX(XM(J)+.5) - IYMN
C      WRITE(NOUT,64)
      LNX=0
      DO 1907 I=2,NE
      J=IST+I
      JA1(1)=ICH(1)
      KA1(1)=ICH(1)
      MNX=IFIX(XM(J)+.5)
      IPNCH(I-1)=MNX
 7777 FORMAT(20I4)
      LNX=LNX+MNX
      J1=MNX/100
      K1=(MNX-100*J1)/10
      L1=MNX-100*J1-10*K1
      IF(J1.GT.30) J1=31
      IF((MNX.GE.100).AND.(K1.EQ.0)) K1=24
      IF((MNX.GE. 10).AND.(L1.EQ.0)) L1=24
      JA1(I)=ICH(J1+1)
      JA2(I)=ICH(K1+1)
      JA3(I)=ICH(L1+1)
      J1=LNX/1000
      K1=(LNX-1000*J1)/100
      L1=(LNX-1000*J1-100*K1)/10
      M1=LNX-1000*J1-100*K1-10*L1
      IF(J1.GT.30) J1=31
      IF((LNX.GE.1000).AND.(K1.EQ.0))K1=24
      IF((LNX.GE. 100).AND.(L1.EQ.0))L1=24
      IF((LNX.GE.  10).AND.(M1.EQ.0))M1=24
      KA1(I)=ICH(J1+1)
      KA2(I)=ICH(K1+1)
      KA3(I)=ICH(L1+1)
      KA4(I)=ICH(M1+1)
 1907 CONTINUE
      IWTA=WT
	IF(IXTR.GE.1)GOTO 8200
C PUT OUT CRUDE OVER/UNDERFLOW AND STATISTICS. SKIP IF
C IXTR=1 SO TERMINAL GRAPHS WILL FIT.
      WRITE(6,76) JUND,IWTA,XLABL,JOVR,AVG,STDEV
 76   FORMAT(5X,'UNDERFLOW =',I4,2X,'TOTAL IN PLOT =',I5,4X,2A4,4X,
     1 'OVERFLOW =',I4,4X,'AVERAGE = ',1PE10.3,2X,'STAND. DEV = ',
     2 1PE10.3 /)
      IF(X.EQ.PNC)WRITE(7,7777) (IPNCH(L),L=1,NBX)
      WRITE(6,1743)
      WRITE(6,1744) (JA1(L),L=2,NE)
      WRITE(6,1744) (JA2(L),L=2,NE)
      WRITE(6,1744) (JA3(L),L=2,NE)
      WRITE(6,1745)
      WRITE(6,1744) (KA1(L),L=2,NE)
      WRITE(6,1744) (KA2(L),L=2,NE)
      WRITE(6,1744) (KA3(L),L=2,NE)
      WRITE(6,1744) (KA4(L),L=2,NE)
 1743 FORMAT(50X,'EVENTS PER BIN')
 1745 FORMAT(50X,'INTEGRAL OF EVENTS')
 1744 FORMAT(15X,115A1)
8200	CONTINUE
           DO 38 I=1,19
38         TITLE(I) = BLANK
         GO TO 56
39      WRITE(NOUT,62) IPLT,(TITLE(I),I=1,15)
           NE = NBX +2
            DO 40 I=1,NE
           ILOC = IST + (NBY+1)*NE +I -1
          IWD = ILOC/NBT +1
           JBT = MOD(ILOC,NBT) + 1
              NOO1=MA(IWD)/IBT(JBT)
               NO=MAND(NOO1,IHK)
40          LINE(I) = ICH(NO+1)
        ITEMP = LINE(NE)
          DO 41 I=1,6
             MMME=NE+I-1
41         LINE(MMME)=ICH(1)
         LINE(NE+6) = ITEMP
            ME = NE +6
               WRITE(NOUT,63) (LINE(L),L=1,ME)
C          WRITE(NOUT,64)
           N = NE/5 -1
      INEE=NBX+2
      DO 42 I=1,NBX
      KNBX=I/10
      LNBX=10*KNBX
      MNBX=I-LNBX
      LINE(I)=ICHP
      IF(MNBX.EQ.1) LINE(I)=ICHX
      IF(MNBX.EQ.2) LINE(I)=ICHX
 42   CONTINUE
      LINE(NBX+1)=ICHX
      LINE(NBX+2)=ICHX
       WRITE(NOUT,8799) YLABL,(LINE(L),L=1,INEE)
            MN=N+2
          N = NBY -9
              I = N
150         YL = FLOAT(I+9)*DEY+YMN
          DO 43 J=1,NE
         ILOC = IST + (I+9)*NE +J -1
            IWD = ILOC/NBT + 1
            JBT = MOD(ILOC,NBT) +1
            NOO1=MA(IWD)/IBT(JBT)
             NO=MAND(NOO1,IHK)
43          LINE(J) = ICH(NO+1)
        ITEMP = LINE(NE)
           LINE(NE) = ICHX
         DO 44 J=1,5
44          LINE(NE+J) = ICH(1)
          LINE(NE+6) = ITEMP
           ME =NE +6
      CALL SHADER (LINE,NE,X)
         WRITE(NOUT,70) LINE(1),YL,ICHX,(LINE(L),L=2,ME)
      CALL RESHD(X)
                  J = 9
147           IY = IST + (I + J -1)*NE - 1
         DO 45 K =1,NE
         ILOC = IY + K
          IWD = ILOC/NBT + 1
            JBT = MOD(ILOC,NBT) +1
                  NOO1=MA(IWD)/IBT(JBT)
            NO=MAND(NOO1,IHK)
45           LINE(K) = ICH(NO+1)
        ITEMP = LINE(NE)
         LINE(NE) = ICHP
            MME=NE+1
             MMME=NE+5
           DO 46 K=MME,MMME
46            LINE(K) = ICH(1)
           LINE(NE+6) = ITEMP
            ME =NE+6
   47 CALL SHADER(LINE,NE,X)
      WRITE (6,767) LINE(1),ICHP,(LINE(L),L=2,ME)
      CALL RESHD(X)
                J = J-1
               IF(J .GE. 2) GO TO 147
           IY =IST + I*NE -1
            DO 48  J=1,NE
          ILOC = IY + J
           IWD = ILOC/NBT + 1
               JBT = MOD(ILOC,NBT) + 1
                NOO1=MA(IWD)/IBT(JBT)
              NO=MAND(NOO1,IHK)
48             LINE(J)=ICH(NO+1)
          ITEMP = LINE(NE)
            LINE(NE)=ICHX
           KKE=NE+1
            KKKE=NE+5
           DO 49  J=KKE,KKKE
49         LINE(J) = ICH(1)
           LINE(NE+6) = ITEMP
            ME = NE +6
   50 CALL SHADER(LINE,NE,X)
      WRITE (6,767) LINE(1),ICHX,(LINE(L),L=2,ME)
      CALL RESHD(X)
                I = I - 10
                  IF(I .GE. 1) GO TO 150
            N =NE/5 -1
      INEE=NBX+2
      DO 51 I=1,NBX
      KNBX=I/10
      LNBX=10*KNBX
      MNBX=I-LNBX
      LINE(I)=ICHP
      IF(MNBX.EQ.1) LINE(I)=ICHX
      IF(MNBX.EQ.2) LINE(I)=ICHX
 51   CONTINUE
      LINE(NBX+1)=ICHX
      LINE(NBX+2)=ICHX
      WRITE(NOUT,771) YMN,(LINE(L),L=1,INEE)
           N =NE/10 +1
          DO 52 I=1,N
52       XL(I) = FLOAT(I-1)*DEX*10. +XMN
            WRITE(NOUT,69)  (XL(L),L=1,N)
C             WRITE(NOUT,64)
           IY=IST-1
          DO 53 I=1,NE
           ILOC=IY+I
            IWD =ILOC/NBT + 1
              JBT = MOD(ILOC,NBT) + 1
               NOO1=MA(IWD)/IBT(JBT)
             NO=MAND(NOO1,IHK)
53           LINE(I) = ICH(NO+1)
           ITEMP = LINE(NE)
           KLE=NE+5
        DO 54 I=NE,KLE
54         LINE(I) = ICH(1)
        LINE(NE+6)=ITEMP
           ME = NE +6
          WRITE(NOUT,63) (LINE(L),L=1,ME)
             NO = MA(IPLT) - 2
          WRITE(NOUT,74) NO,XLABL
                DO 55 I=1,19
55         TITLE(I) = BLANK
56          RETURN
57       FORMAT(' ILLEGAL ENTRY NO.',I8)
58        FORMAT(' ILLEGAL PLOT NO.', I8)
59        FORMAT(' ZERO BIN WIDTH ON PLOT',I5)
60     FORMAT('ILLEGAL DIMENSIONALITY FOR PLOT',I5)
61         FORMAT(' NOT ENOUGH MEMORY LEFT FOR PLOT',I5)
62      FORMAT('1',10X,'PLOT NUMBER',I5,10X,15A4)
63    FORMAT(15X,117A1)
C64        FORMAT()
 65     FORMAT(1X,2A4,4X,23A5)
66    FORMAT(2X,I11,1X,118A1)
67    FORMAT(14X,118A1)
 68   FORMAT(1X,I11,1X,23A5)
69        FORMAT(9X,12(1PE10.2))
70       FORMAT(2X,A1,1PE11.2,1X,118A1)
71      FORMAT(2X,1PE11.2,1X,23A5)
72      FORMAT(' PLOT NUMBER',I5,' NOT SUCCESSFULLY INITIATED.')
73      FORMAT(' TOTAL WEIGHT OF EVENTS PLOTTED =',F10.1,10X,2A4)
74         FORMAT(' NUMBER OF EVENTS PLOTTED =',I8,'.',10X,2A4)
75         FORMAT(1X,I5,' WORDS OF PLOTTING AREA USED,'
     1 ' INCLUDING PLOT',I4,'.')
C 76  FORMAT(20X,'UNDERFLOW = ',I5,10X,'OVERFLOW = ',I5,10X,'AVERAGE = '
C    1 ,1PE10.3,5X,'ST. DEV = ',1PE10.3)
 165   FORMAT(2X,2A4,4X,23A5)
 8799   FORMAT(2X,2A4,5X,114A1)
 771    FORMAT(2X,1PE11.2,2X,114A1)
 765   FORMAT(2X,2A4,4X,114A1)
 768    FORMAT(2X,I11,1X,114A1)
 767    FORMAT(2X,A1,12X,114A1)
         END
	SUBROUTINE RASSIG(IUNIT,NAME)
C
	CHARACTER*1 NAME(50)
	INTEGER*4 IUNIT
	CHARACTER*20 WK
	CHARACTER*1 WK1(20)
	EQUIVALENCE(WK,WK1(1))
C JUST TRY AND NULL FILL A NAME TO USE.
	DO 1 N=1,20
	WK1(N)=' '
1	CONTINUE
	DO 2 N=1,20
	II=ICHAR(NAME(N))
	IF(II.LT.32)GOTO 3
	WK1(N)=CHAR(II)
C1	CONTINUE
2	CONTINUE
3	OPEN(IUNIT,FILE=WK,STATUS='OLD',ACCESS='SEQUENTIAL',
     1  FORM='FORMATTED')
	RETURN
	END
      SUBROUTINE RESHD(X)
      IMPLICIT INTEGER (A-Z)
      DIMENSION HLINE(120),OLINE(120)
	COMMON/HLNNN/HLINE,OLINE,M
	CHARACTER*1 IICH,IJCH
	DIMENSION IICH(32),IJCH(32)
      DIMENSION ICH(32),JCH(32)
	INTEGER*4 RQ,BL
	CHARACTER*4 CRQ,CBL
	EQUIVALENCE(CRQ,RQ),(CBL,BL)
      DATA CRQ/'   Q'/
      DATA CBL/'    '/
      DATA IICH/' ','1','2','3','4','5','6','7','8','9','A','B',
     1   'C','D','E','F','G','H','I','J','K','L','M','N','O','P',
     1   'Q','R','S','T','U','*'/
      DATA IJCH/'+','=',' ','=',' ','*',' ',' ',' ','X',' ',' ',' ',
     1   ' ','A',' ','B',' ',' ',' ','E',' ',' ',' ','H',' ','Q',
     1   ' ','Z','I','O','0'/
	DATA INIT/0/
	IF(INIT.NE.0)GOTO 7009
	INIT=1
	DO 7109 N=1,32
	ICH(N)=ICHAR(IICH(N))
	JCH(N)=ICHAR(IJCH(N))
	BL=32
7109	CONTINUE
7009	CONTINUE
      IF (X.NE.RQ) RETURN
      M=M-1
      DO 155 I=1,M
      DO 15 J=1,32
      IF (HLINE(I).EQ.ICH(J)) GO TO 155
   15 CONTINUE
      J=1
  155 HLINE(I)=J
      DO 1600 I=1,32
      IF (JCH(I).EQ.BL) GO TO 1600
      IP=0
      DO 1560 J=1,M
      OLINE(J)=BL
      IF (HLINE(J).LE.I) GO TO 1560
      OLINE(J)=JCH(I)
      IP=1
 1560 CONTINUE
      IF (IP.EQ.0) RETURN
      WRITE (6,1605) (OLINE(J),J=1,M)
 1600 CONTINUE
 1605 FORMAT ('+',15X,120A1)
      RETURN
      END
      SUBROUTINE SHADER(LINE,ME,X)
      IMPLICIT INTEGER (A-Z)
      DIMENSION LINE(ME),HLINE(120),OLINE(120)
	COMMON/HLNNN/HLINE,OLINE,M
C      DIMENSION ICH(32),JCH(32)
	CHARACTER*4 CRQ
	INTEGER*4 RQ
	EQUIVALENCE(CRQ,RQ)
      DATA CRQ/'   Q'/
      DATA BL/32/
C      DATA ICH/' ','1','2','3','4','5','6','7','8','9','A','B',
C     1   'C','D','E','F','G','H','I','J','K','L','M','N','O','P',
C     1   'Q','R','S','T','U','*'/
C      DATA JCH/'+','=',' ','=',' ','*',' ',' ',' ','X',' ',' ',' ',
C     1   ' ','A',' ','B',' ',' ',' ','E',' ',' ',' ','H',' ','Q',
C     1   ' ','Z','I','O','0'/
      IF (X.NE.RQ) RETURN
      IF (ME.GT.120) RETURN
      M=ME-1
      DO 10 I=2,M
      HLINE(I-1)=LINE(I)
      LINE(I)=BL
   10 CONTINUE
      RETURN
	END
	SUBROUTINE WASSIG(IUNIT,NAME)
C
	CHARACTER*1 NAME(50)
	INTEGER*4 IUNIT
	CHARACTER*20 WK
	CHARACTER*1 WK1(20)
	EQUIVALENCE(WK,WK1(1))
C JUST TRY AND NULL FILL A NAME TO USE.
	DO 1 N=1,20
	WK1(N)=' '
1	CONTINUE
	DO 2 N=1,20
	II=ICHAR(NAME(N))
	IF(II.LT.32)GOTO 3
	WK1(N)=CHAR(II)
C1	CONTINUE
2	CONTINUE
3	OPEN(IUNIT,FILE=WK,STATUS='NEW',ACCESS='SEQUENTIAL',
     1  FORM='FORMATTED')
	RETURN
	END
