C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
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       SUBROUTINE GAUSS(T,U)
C       DATA PI/3.14159/
C       DATA PI2/6.23818/
C      PHI=PI2*RANN(DUM)
C      X=COS(PHI)
C      Y=SQRT(1.-X*X)
C      IF(PHI.GT.PI) Y=-Y
C      R=SQRT(-2.*ALOG(RANN(DUM)))
C      T=X*R
C        U=Y*R
C      RETURN
C      END
CC	THE FOLLOWING IS A SAMPLE CALLING PROGRAM
C      COMMON /EXTRA/ NDLTY,NPLTS,MA(5000)
C      COMMON/PLOTS/NDIM,XMIN,YMIN,
C     1 DX,    DY,   NBINX,    NBINY, TITLE(19)
C      DATA RDIM/4H DIM/
C      DATA RV /4H   V/
C      DATA ISETQ,ISETR/Z74567899,ZA4567899/
C      NPLTS=3
C      NDLTY=5000
C      CALL PLOT(0.,0.,-1,0)
C      X=RDIM
C      DY=5.
C       DX=.1
C      NBINX=100
C      NBINY=50
C      NDIM=1
C      XMIN=-5.
C      YMIN=0.
C      CALL PLOT(X,0.,0,1)
C      CALL PLOT(X,0.,0,2)
C      NBINX=50
C      DX=.08
C      DY=DX
C      XMIN=-2.
C      YMIN=XMIN
C      NDIM=2
C      CALL PLOT(X,0.,0,3)
C      DO 50 I=1,5000
C      CALL GAUSS(X,Y)
C      CALL PLOT(X,1.,1,1)
C      CALL PLOT(Y,1.,1,2)
C      CALL PLOT(X,Y,1,3)
C 50   CONTINUE
C      X=RV
C      CALL PLOT(X,0,2,1)
C      CALL PLOT(X,0,2,2)
C      CALL PLOT(X,0,2,3)
C      STOP
C      END
C
C THE FOLLOWING ROUTINES ARE NEEDED FOR GHASP AND IMPLEMENTED CORRECTLY
C IN DEC FORTRAN AND SOME OTHERS; NOT NECESSARILY CORRECT IN IBM FORTRAN.
	FUNCTION MAND(I,J)
	INTEGER*4 I,J,MAND
	MAND=I.AND.J
	RETURN
	END
	FUNCTION MOR(I,J)
	INTEGER*4 I,J,MOR
	MOR=I.OR.J
	RETURN
	END
C
C THE REST IS STANDARD GHASP.
      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
      SUBROUTINE SHADER(LINE,ME,X)
      IMPLICIT INTEGER (A-Z)
      DIMENSION LINE(ME),HLINE(120),OLINE(120)
      DIMENSION ICH(32),JCH(32)
      DATA RQ/'   Q'/
      DATA BL/'    '/
      DATA ICH/' ','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 JCH/'+','=',' ','=',' ','*',' ',' ',' ','X',' ',' ',' ',
     1   ' ','A',' ','B',' ',' ',' ','E',' ',' ',' ','H',' ','Q',
     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
      ENTRY RESHD(X)
      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 PLOT(X,Y,IENT,IPLT)
      DIMENSION JA1(110),JA2(110),JA3(110),KA1(110),KA2(110)
       DIMENSION KA3(110), KA4(110)
      DIMENSION IPNCH(120)
          DIMENSION  XM(1),        XLABL(2), YLABL(2)
       DIMENSION LINE(119),ICH(32),INDEX(8),AIND(8)
     1 , XL(12),  IBT(6), IZB(6)
	INTEGER*2 IXTR
	COMMON/IXTR/IXTR
C IXTR=1 SWITCHES OFF EXTRA STUFF AT BOTTOM OF PLOT
      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(INDEX(1),AIND(1))
      EQUIVALENCE (MA(1),XM(1)),(LINE(1),XL(1)),(INDEX(1),NDM),
     1 (INDEX(2),IST),(AIND(3),XMN),(AIND(4),YMN),(AIND(5),DEX),
     2 (AIND(6),DEY),(INDEX(7),NBX),(INDEX(8),NBY)
      DATA PNC/4HPNCH/
      DATA ICH/   1H ,   1H1,  1H2,    1H3,
     1       1H4,        1H5,        1H6,        1H7,         1H8,
     2      1H9,         1HA,        1HB,         1HC,       1HD,
     3       1HE,       1HF,       1HG,         1HH,        1HI,
     4      1HJ,       1HK,       1HL,       1HM,         1HN,
     5       1HO,         1HP,         1HQ,         1HR,        1HS,
     6       1HT,       1HU,        1H*/
               DATA RDIM/4H DIM/
       DATA RV/4H   V/
              DATA RH/4H   H/
      DATA IBT/33554432, 1048576, 32768, 1024, 32, 1 /
      DATA IZB /-1040187393, -32505857, -1015809, -31745, -993, -32  /
         DATA         BLANK/   4H    /,       IXXPPP/    4HXX++/,
     1        IPPPPP/  4H++++/,        IXXBBB/ 4HXX  /,
     2         ICHX/        1HX/,         ICHP/       1H+/,
     3             IHK/             31/,                 NBT/     6/,
     4          LINWDS/        110/,          NOUT/       6/
            DATA INIT/        0/
      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
C MAKE A MULTIPLE OF 10 BINS HORIZONTALLY
      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
C MAKE A MULTIPLE OF 10 BINS VERTICALLY
       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)=INDEX(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)=INDEX(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       INDEX(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         INDEX(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
      DATA RS/'   S'/
      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
C ACCUMULATE CRUDE STD DEVIATION FOR PLOTTED NUMBERS.
C ALSO CRUDE AVERAGE.
      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 OVERFLOW/UNDERFLOW/STATS ON GRAPH. SKIP IF
C IXTR=1 SO WE CAN PUT GRAPHS OUT ON TERMINALS WITHOUT ALL
C THE EXTRA LINES OF STUFF.
      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(1H1,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 NORM (TOT, IPLT)
         DIMENSION XM(1),INDEX(8)
       COMMON/EXTRA/ NDLTY, NPLTS, MA(1)
            EQUIVALENCE(MA(1),XM(1)),(INDEX(1),NDM),(INDEX(2),IST),
     1 (INDEX(7),NBX)
          IF(1.GT.IPLT.OR.IPLT.GT.NPLTS) RETURN
         DO 1 I=1,8
         J = (I-1)*NPLTS + IPLT
1         INDEX(I) = MA(J)
      IF ( NDM .NE. 1) RETURN
         NE =NBX + 2
          WT =0.0
        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