C	[GASLIBX.F86 of JUGPDS Vol.10]
C
        SUBROUTINE      GASP(NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     GASPX                                   /
C/      Date-updated.   Feb. 17th 1984 for FORTRAN-86           /
C/      Date-written.   Feb. 4th 1984                           /
C/      File-name.      GASPX.FOR                               /
C/      Remarks.        Subroutine GASPX page 307               /
C/                      GASPX is the master control routine and /
C/                      is referred to as the GASPX executive.  /
C/      Source.         The present version of extended GASP II /
C/			is based on the book "Simulation with   /
C/			GASP" by A. Alan, B.Pritsker &  P. J.   /
C/                      Kiviat (1969)         			/
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        NOT = 0
    1   CALL    DATAN(NSET,QSET)
C
C       --- Print out filing array.
C
        JEVNT = 101
        CALL    MONTR(NSET,QSET)
        WRITE(1,403)
  403     FORMAT(1H0,28X,'** Intermediate Results **'//)
C
C       --- Obtain next event which is first entry in file 1.
C           ATRIB(1) is event time, ATRIB(2) is event code.
C
   10   CALL    RMOVE(MFE(1),1,NSET,QSET)
        TNOW = ATRIB(1)
        JEVNT = JTRIB(1)
C
C       --- Test to see if this event is a moitor event.
C
        IF (JEVNT - 100)13,12,6
   13   I = JEVNT
C
C       --- Call programmers event routines.
C
        CALL    EVNTS(I, NSET,QSET)
C
C       --- Test methode for stopping
C
        IF (MSTOP) 40,8,20
   40   MSTOP = 0
C
C       --- Test for no summary report.
C
        IF (NORPT) 14,22,42
   20   IF (TNOW - TFIN) 8,22,22
   22   CALL    SUMRY(NSET,QSET)
        CALL    OTPUT(NSET,QSET)
C
C       --- Test number of runs remaining
C
   42   IF (NRUNS - 1) 14,9,23
   23   NRUNS = NRUNS - 1
        NRUN = NRUN + 1
        				GO TO 1
   14   CALL    ERROR(93,NSET,QSET)
    6   CALL    MONTR(NSET,QSET)
        				GO TO 10
C
C       --- Reset JMNIT
C
   12   IF (JMNIT) 14,30,31
   30   JMNIT = 1
        				GO TO 10
   31   JMNIT = 0
        				GO TO 10
C
C       --- Test to see if event information is to be printed.
C
    8   IF (JMNIT) 14,10,32
   32   JTRIB(1) = JEVNT
        JEVNT = 100
        CALL    MONTR(NSET,QSET)
        				GO TO 10
C
C       --- If all runs are completed return to main program 
C           for instructions.
C
    9   RETURN
        END
C
        SUBROUTINE      COLCT(X,N,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     COLCTX                                  /
C/      Date-written.   Feb. 4th 1984                           /
C/      File-name.      COLCT.FOR                               /
C/      Remarks.        Subroutine COLCTX.FOR page 74.          /
C/                      This subroutine collects sample data on /
C/                      the value of a variable.                /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        IF (N.GT.0) GO TO 20
   10   CALL    ERROR(90,NSET,QSET)
   20   IF (N .GT. NCLCT) GO TO 10
        SUMA(N,1) = SUMA(N,1) + X
        SUMA(N,2) = SUMA(N,2) + X*X
        SUMA(N,3) = SUMA(N,3) + 1.0
        SUMA(N,4) = AMIN1(SUMA(N,4),X)
        SUMA(N,5) = AMAX1(SUMA(N,5),X)
        RETURN
        END
C
        SUBROUTINE      DATAN(NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     DATANX                                  /
C/      Date-written.    3rd,Feb,1984                           /
C/      File-name.      DATANX.FOR                              /
C/      Remarks.        Subroutine DATANX.FOR page 301.         /
C/                      Initialize GASP variables to permit the /
C/                      starting of the Simulation.             /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        IF (NOT) 23,1,2
C
C       --- NEP is a control variable for determining the starting
C           card type for multiple run problems.        
C           the value of NEP specifies the starting card type.
C
2       NT = NEP
        GO TO (1,5,6,41,42,8,43,299,15,20),NT
23      CALL    ERROR(95,NSET,QSET)
1       NOT = 1
        NRUN = 1
C
C       --- Data card type one
C
        WRITE(1,200)
200     FORMAT(1H0,9X,'1',9X,'2',9X,'3',9X,'4',9X,'5',9X,'6',9X,'7' /
     $  1H ,'123456789',1H0,'123456789',1H0,'123456789',1H0,'123456789'
     $  ,1H0,'123456789',1H0,'123456789',1H0,'1234567890')
        READ(NCRDR,101) NAME,NPROJ,MON,NDAY,NYR,NRUNS
        WRITE(1,201) NAME,NPROJ,MON,NDAY,NYR,NRUNS
101     FORMAT(6A2,I4,I2,I2,I4,I4)
201     FORMAT(1H ,6A2,I4,I2,I2,I4,I4)
        IF (NRUNS) 30,30,5
30      CALL    EXIT
C
C       --- Data card type two
C
5       READ(NCRDR,803) NPRMS,NHIST,NCLCT,NSTAT,ID,IM,NOQ,MXC,IMM
        WRITE(1,804) NPRMS,NHIST,NCLCT,NSTAT,ID,IM,NOQ,MXC,IMM
803     FORMAT(9I5)
804     FORMAT(1H ,9I5)
        IF (NHIST) 41,41,6
C
C       --- Data card type three is used only if NHIST is greater
C           than zero. Specify number of cells in histograms not
C           including end cells.
C
6       READ(NCRDR,103) (NCELS(I),I=1,NHIST)
        WRITE(1,203) (NCELS(I),I=1,NHIST)
103     FORMAT(10I5)
203     FORMAT(1H ,10I5)
C
C       --- Data card type four
C           Specify KRANK = Ranking row.
C
41      READ(NCRDR,103) (KRANK(I),I=1,NOQ)
        WRITE(1,203) (KRANK(I),I=1,NOQ)
C
C       --- Data card type five
C           Specify INN=1 for LVF, INN=2 for HVF
C
42      READ(NCRDR,103) (INN(I),I=1,NOQ)
        WRITE(1,203) (INN(I),I=1,NOQ)
        IF (NPRMS) 23,43,8
    8 DO 9 I=1,NPRMS
C       
C       --- Data card type six used only if NPRMS is greater than
C           zero.
C
        READ(NCRDR,106) (PARAM(I,J),J =1,4)
        WRITE(1,206) (PARAM(I,J),J=1,4)
  106     FORMAT(4F10.4)
  206     FORMAT(1H ,4F10.4)
    9 CONTINUE
C
C       ---Data card type seven.
C          The NEP value is for the next run.
C          Set JSEED greater than zero to set tnow equal to TBEG
C
43      READ(NCRDR,104) MSTOP,JCLR,NORPT,NEP,TBEG,TFIN,JSEED
        WRITE(1,204) MSTOP,JCLR,NORPT,NEP,TBEG,TFIN,JSEED
104     FORMAT(4I5,2F10.3,I4)
204     FORMAT(1H ,4I5,2F10.3,I4)
        IF (JSEED) 26,26,27
27      ISEED = JSEED
        CALL    DRAND(ISEED,RNUM)
        TNOW = TBEG
        DO 142 J=1,NOQ
142     QTIME(J) = TNOW
26      JMNIT = 0
C
C       --- Initialize nset
C           Specify inputs for next run
C           Read in initial events
C
  299   DO 300 JS = 1,ID
C
C       --- Data card type 8
C           Initialize NSET,QSET by JQ equal to a negative value on
C           first event card.
C           Read in intial vents. End initial events and entities
C           with JQ equal to zero.
C
        READ(NCRDR,1110) JQ,(JTRIB(JK),JK=1,IM)
1110    FORMAT(7I10)
        WRITE(1,2110) JQ,(JTRIB(JK),JK=1,IM)
2110    FORMAT(1H ,7I10)
        IF (JQ) 44,15,320
44      INIT = 1
        CALL    SET(1,NSET,QSET)
        GO TO 300
320     READ(NCRDR,1120) (ATRIB(JK),JK=1,IMM)
1120    FORMAT(7F10.4)
        WRITE(1,2120) (ATRIB(JK),JK=1,IMM)
2120    FORMAT(1H ,7F10.4)
        CALL    FILEM(JQ,NSET,QSET)
300     CONTINUE
C
C       --- JCLR be positive for initialization of storage arrays.
C
15      IF (JCLR) 20,20,10
10      IF (NCLCT) 23,110,116
116     DO 18 I = 1,NCLCT
        DO 17 J = 1,3
17      SUMA(I,J) = 0.
        SUMA(I,4) = 1.0E20
18      SUMA(I,5) = -1.0E20
110     IF (NSTAT) 23,111,117
117     DO 360 I=1,NSTAT
        SSUMA(I,1) = TNOW
        DO 370 J =2,3
370     SSUMA(I,J) = 0.
        SSUMA(I,4) = 1.0E20
360     SSUMA(I,5) = -1.0E20
111     IF (NHIST) 23,20,118
118     DO 380 K = 1,NHIST
        DO 380 L = 1,MXC
380     JCELS(K,L) = 0
C
C       --- Print out program identification information.
C
20      WRITE(1,102) NPROJ,NAME,MON,NDAY,NYR,NRUN
102     FORMAT(1H1,19X,'Simulation Project No.',I4,2X,'on',2X,
     $ 6A2//,20X,'Date',I3,'/',I3,'/',I5,12X,'Run number',I5//)
C
C       --- Print parameter values and scale.
C
        IF (NPRMS) 60,60,62
62      DO 64 I=1,NPRMS
64      WRITE(1,107) I,(PARAM(I,J),J=1,4)
107     FORMAT(10X,' Parameter No.',I5,4F12.4)
60      RETURN
        END
C
        SUBROUTINE      DRAND  (ISEED,RNUM)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     DRAND                                   /
C/      Date-written.   Jan. 16th 1984                          /
C/      File-name.      DRAND.FOR                               /
C/      Remarks.        Subroutine DRAND.FOR page 96.           /
C/                      this subroutine generates a uniformly   /
C/                      distributed random variable in the      /
C/                      interval 0 to 1, a pseudo-random number /
C/                      DRAND is a modefied IBM 1130 subroutine /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        CALL    RANDU(ISEED,RNUM)
        RETURN
        END
C
        SUBROUTINE      ERROR(J,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     ERRORX                                  /
C/      Date-written.    4th,Feb,1984                           /
C/      File-name.      ERRORX.FOR ver2.0                       /
C/      Remarks.        Subroutine ERRORX.FOR page 303.         /
C/                      Subroutine ERROR is called when an e    /
C/                      error is detected in any GASP subroutine/
C/                      except PRNTQ,SUMRY, and MONTR, all of   /
C/                      which print their own message.          /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        WRITE(NPRNT,100) J,TNOW
100     FORMAT(//26X,'Error exit, Type',I3,' Error.'//,26X,
     $  ' File status at time',F10.4/)
        WRITE(NPRNT,200)
200     FORMAT(20X,'NSET'/)
        DO  210 I=1,ID
        IL = (I-1) * MXX + 1
        IV = IL + MXX - 1
210     WRITE(NPRNT,90) I,(NSET(IJ),IJ=IL,IV)
90      FORMAT(3X,I5,5X,12I8)
        WRITE(NPRNT,202)
202     FORMAT(//20X,'QSET'/)
        DO 215 I=1,ID
        IL = (I-1) * IMM + 1
        IV = IL + IMM - 1
215     WRITE(NPRNT,95) I,(QSET(IJ),IJ=IL,IV)
95      FORMAT(3X,I5,4X,8(E12.6,2X))
        WRITE(NPRNT,99)
99      FORMAT(1H0)
        IF (NCLCT) 7,7,8
8       WRITE(NPRNT,98)
98      FORMAT(/1H ,'Array SUMA',/)
        DO  110  I=1,NCLCT
110     WRITE(NPRNT,80) I,(SUMA(I,K),K=1,5)
80      FORMAT(I10,5F10.4)
        WRITE(NPRNT,99)
7       IF (NSTAT) 9,9,10
10      WRITE(NPRNT,97)
97      FORMAT(/1H ,'Array SSUMA'/)
        DO 111  I=1,NSTAT
111     WRITE(NPRNT,80) I,(SSUMA(I,K),K=1,5)
        WRITE(NPRNT,99)
9       IF (NHIST) 11,11,12
12      WRITE(NPRNT,96)
96      FORMAT(/1H ,'Array JCELS' /)
        DO 112 I=1,NHIST
        NCL = NCELS(I) + 2
112     WRITE(NPRNT,26) I,(JCELS(I,K),K=1,NCL)
26      FORMAT(7X,I3,5X,23I4)
11      NFOOL = 0
        IF (NFOOL) 3,4,3
3       RETURN
4       CALL    EXIT
        END
        SUBROUTINE      FILEM(JQ,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     FILEMX                                  /
C/      Date-written.    4th,Feb,1984                           /
C/      File-name.      FILEMX.FOR                              /
C/      Remarks.        Subroutine FILEMX.FOR page 306.         /
C/                      FILEMX is called to file an entry in    /
C/                      file JQ of the array NSET,QSET.         /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
C       --- Test to see if there is an avilable column for storage.
C
        IF (MFA - ID) 2,2,3
3       WRITE(NPRNT,4)
4       FORMAT(//24H Overlap Set Given Below/)
        CALL    ERROR(87,NSET,QSET)
C
C       --- Put attribute value in file
C
2       INDX = (MFA - 1) * IMM
        DO  1 I=1,IMM
        INDX = INDX + 1
1       QSET(INDX) = ATRIB(I)
        INDX = (MFA - 1) * MXX
        DO 10 I=1,IM
        INDX = INDX + 1
10      NSET(INDX) = JTRIB(I)
        CALL    SET(JQ,NSET,QSET)
        RETURN
        END
        SUBROUTINE      HISTO(X1,A,W,N)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     HISTOX                                  /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      HISTO.FOR                               /
C/      Remarks.        Subroutine HISTOX.FOR page 79.          /
C/                      HISTO tabulates the number of times X1  /
C/                      is within the specified cell limits.    /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        IF (N- NHIST) 11,11,2
2       WRITE(NPRNT,250) N
250     FORMAT(' Error in histogram',I4,//)
        CALL    EXIT
11      IF (N) 2,2,3
C
C       --- Translate X1 by subtracing A if X.LE.A
C
3       X = X1 - A
        IF (X) 6,7,7
6       IC = 1
        GO TO 8
C
C       --- Determine cell number IC.
C
7       IC = X / W + 2.0
        IF (IC - NCELS(N) - 1) 8,8,9
9       IC = NCELS(N) + 2
8       JCELS(N,IC) = JCELS(N,IC) + 1
        RETURN
        END
        SUBROUTINE      MONTR(NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     MONTRX                                  /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      MONTRX.FOR                              /
C/      Remarks.        Subroutine MONTRX.FOR page 309.         /
C/                      The monitoring of events as they        /
C/                      occur.                                  /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGER
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
C       --- IF JEVNT .GE. 101   Print NSET,QSET
C
        IF (JEVNT - 101) 9,7,9
7       WRITE(1,100) TNOW
100     FORMAT(1H0,10X,'** GASP IIex JOB Storage area dump at',F10.4,
     $  2X,'Time units**'//)
        WRITE(1,200)
200     FORMAT(20X,'NSET'/)
        DO 210 I=1,ID
        IL = (I-1) * MXX + 1
        IV = IL + MXX - 1
210     WRITE(1,90) I,(NSET(IJ),IJ=IL,IV)
90      FORMAT(3X,I5,5X,12I8)
        WRITE(1,202)
202     FORMAT(//20X,'QSET' /)
        DO 215 I=1,ID
        IL = (I-1) * IMM + 1
        IV = IL + IMM - 1
215     WRITE(1,95) I,(QSET(IJ),IJ=IL,IV)
95      FORMAT(3X,I5,4X,8(E12.6,2X))
        RETURN
9       IF (MFE(1)) 3,6,1
C
C       --- IF JMNIT = 1,Print TNOW,Current event code, and all
C           attributes of the next event.
C
1       IF (JMNIT - 1) 5,4,3
3       WRITE(NPRNT,199)
199     FORMAT(///26X,' Error Exit,Type 99 Error. ')
        CALL    EXIT
4       INDX = MFE(1)
        IL = (INDX-1) * MXX + 1
        IV = IL + MXX - 1
        WRITE(NPRNT,103) TNOW,JTRIB(1),(NSET(I),I=IL,IV)
103     FORMAT(/10X,'Next Event(NSET).... ',(6I8))
        IL = (INDX - 1) * IMM + 1
        IV = IL + IMM - 1
        WRITE(NPRNT,120) (QSET(I) ,I=IL,IV)
120     FORMAT(/10X,'Next Event(QSET).... ',(6E12.4))
5       RETURN
6       WRITE(1,104) TNOW
104     FORMAT(10X,' File is Empty at ',F10.2)
        				GO TO 5
        END
C
        SUBROUTINE      PRNTQ(JQ,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     PRNTQX                                  /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      PRNTQX.FOR                              /
C/      Remarks.        Subroutine PRNTQX.FOR page 310.         /
C/                      PRNTQX computes and prints the time-    /
C/                      integrated average and standard of the  /
C/                      number of entries in particular file    /
C/                      file and the maximum number of entries  /
C/                      that  were in the file since the file   /
C/                      was last initialized.                   /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        WRITE(NPRNT,100) JQ
        IF (TNOW - TBEG) 12,12,13
12      WRITE(NPRNT,105)
105     FORMAT(/25X,'No Printout TNOW = TBEG '//)
        				GO TO 2
C
C       --- Compute expect no.
C
13      XNQ = NQ(JQ)
        X = (ENQ(JQ) + XNQ * (TNOW - QTIME(JQ)))/(TNOW - TBEG)
        STD = (VNQ(JQ)+XNQ*XNQ*(TNOW-QTIME(JQ)))/(TNOW-TBEG)-X*X
        IF (STD.GT.0.0) GO TO 130
        STD = 0.0
        				GO TO 140
130     STD = STD ** 0.5
140     WRITE(NPRNT,104) X,STD,MAXNQ(JQ)
        WRITE(NPRNT,101)
C
C       --- Print file in proper order requires tracing through the
C           pointers of the file
C
        NSQ = 1
        WRITE(NPRNT,200)
200     FORMAT(20X,'NSET'/)
230     LINE = MFE(JQ)
        IF (LINE - 1) 4,1,1
4       WRITE(NPRNT,102)
2       RETURN
1       L1 = LINE - 1
        GO TO (202,201),NSQ
202     INDX = L1 * MXX
        IB = INDX + 1
        IE = INDX + MXX
        WRITE(NPRNT,106) LINE,(NSET(I),I=IB,IE)
        				GO TO 210
201     INDX = L1 * IMM
        IB = INDX + 1
        IE = INDX + IMM
        WRITE(NPRNT,103) LINE,(QSET(I),I=IB,IE)
210     INDX = LINE * MXX - 1
        LINE = NSET(INDX)
        IF (LINE - 7777) 1,2220,5
2220    IF (NSQ - 2) 221,2,2
221     NSQ = NSQ + 1
        WRITE(NPRNT,205)
205     FORMAT(//20X,'QSET'/)
        				GO TO 230
    5   WRITE(NPRNT,199)
199     FORMAT(///26X,'Error Exit, Type 94 Error.')
100     FORMAT(1H1,29X,' File Printout, File  No.',I3)
101     FORMAT(/35X,' File Contents' //)
102     FORMAT(/33X,'The File  is Empty'//)
103     FORMAT(3X,I5,4X,8(E12.6,2X))
104     FORMAT(/25X,'Average Number in file  was',F10.4,/25X,
     $  'STD. DEV.',18X,F10.4,/25X,'Maximum',24X,I4)
106     FORMAT(3X,I5,5X,12I8)
        CALL    EXIT
        END
C
        SUBROUTINE      RANDU  (IY,YFL)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     RANDU                                   /
C/      Date-written.   16th,Jan,1984                           /
C/      File-name.      RANDU.FOR                               /
C/      Remarks.        Subroutine RANDU.FOR page 96.           /
C/                      RANDU is a modefied IBM 1130 subroutine /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        IY = IY * 899
        IF (IY.GE.0) GO TO 10
        IY = IY + 32767 + 1
   10   YFL = IY
        YFL = YFL / 32767.0
        RETURN
        END
C
        SUBROUTINE      RMOVE(KCOLL,JQ,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     RMOVEX                                  /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      RMOVEX.FOR                              /
C/      Remarks.        Subroutine RMOVEX.FOR page 312.         /
C/                      Subroutine RMOVEX is called to remove   /
C/                      an entry from file JQ of the array      /
C/                      NSET,QSET.                              /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1),KCOLL(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
C       --- The dummy array KCOLL is used as an argument to force
C           the call by name option on computer such as the IBM 360
C
        KCOL = KCOLL(1)
        IF (KCOL) 16,16,2
   16   CALL    ERROR(97,NSET,QSET)
    2   MLC(JQ) = KCOL
C
C       --- Put values of KCOL in attrib
C
        INDX = (KCOL - 1) * IMM
        DO 3 I=1,IMM
        INDX = INDX + 1
    3   ATRIB(I) = QSET(INDX)
        INDX = (KCOL - 1) * MXX
        DO 10 I=1,IM
        INDX = INDX + 1
   10   JTRIB(I) = NSET(INDX)
C
C       --- Set OUT=1 and call SET to remove entry from NSET
C
        OUT = 1.0
        CALL    SET(JQ,NSET,QSET)
        RETURN
        END
C
        SUBROUTINE      SET(JQ,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     SETX                                    /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      SETX  .FOR ver2.0                       /
C/      Remarks.        Subroutine SETX.FOR page 313.           /
C/                      Subroutine SETX is the heart of the     /
C/                      information storage and retrieval       /
C/                      system. SETX performs three functions:  /
C/                      1. Initialize the filing array NSET,    /
C/                      2. Updates the pointer system.          /
C/                      3. Maintain statistics on the number    /
C/                         of entries in each file.             /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
C       --- INIT should be one for initialization of file
C
        IF (INIT - 1) 27,28,27
C
C       --- Initialize file to zero. Set up pointers
C           must initialize KRANK(JQ)
C           must initialize INN(JQ)
C
   28   KOL = 7777
        KOF = 8888
        KLE = 9999
        MX = IM + 1
        MXX = IM + 2
        MAXQS = ID * IMM
        MAXNS = ID * MXX
C
C       --- Inirtialize pointing cells of NSET and zero other cells
C           of NSET
C
        DO 2 J=1,MAXQS
    2   QSET(J) = 0.0
        DO 4 J=1,MAXNS
    4   NSET(J) = 0
        DO 1 I=1,ID
        INDX = I * MXX
        NSET(INDX - 1) = I + 1
    1   NSET(INDX) = I - 1
        NSET(MAXNS - 1) = KOF
        DO 3 K=1,NOQ
        NQ(K) = 0
        MLC(K) = 0
        MFE(K) = 0
        MAXNQ(K) = 0
        MLE(K) = 0
        ENQ(K) = 0.0
        VNQ(K) = 0.0
    3   QTIME(K) = TNOW
C
C       --- First available column = 1
C
        MFA = 1
        INIT = 0
        OUT = 0.0
        RETURN
C
C       --- MFEX is first entry in file which has not been compared 
C           with ITEM to be inserted.
C
   27   MFEX = MFE(JQ)
C
C       --- KNT is a check code to indicate that no comparisons have
C           been made.
C
        KNT = 2
C
C       --- KS is the row on which items of file JQ are ranked.
C
        KS = KRANK(JQ)
        KSJ = 1
        IF (KS - 100) 1020,100,1000
 1000   KSJ = 2
        KS = KS - 100
C
C       --- Test for putting value in or out
C           if out equals one an item is to be removed from file JQ
C           If OUT is less than ONE an item is to be inserted in
C           file JQ
C
 1020   IF (OUT - 1.0) 8,5,100
C
C       --- Putting an entry in file JQ
C
    8   INDX = MFA * MXX - 1
        NXFA = NSET(INDX)
C
C       --- If INN(JQ) equals two the file is a HVF file. If INN(JQ)
C           is one the file is a LVF file. For LVF files try to insert
C           Stating at end of file. MLEX is last entry in file which
C           has not been compared with items to be inserted.
C
        IF (INN(JQ) - 1) 100,7,6
    7   MLEX = MLE(JQ)
C
C       --- If MLEX is zero file is empty. item to be inserted will be
C           only item in file.
C
        IF (MLEX) 100,10,11
   10   INDX = MFA * MXX
        NSET(INDX) = KLE
        MFE(JQ) = MFA
C
C       --- There is no successor of item inserted. Since item was 
C           inserted in column MFA the last entry of file JQ is in
C           column MFA.
C
   17   INDX = MFA * MXX - 1
        NSET(INDX) = KOL
        MLE(JQ) = MFA
C
C       --- Set new MFA equal to successor of old MFA. that is NXFA
C
   14   MFA = NXFA
        IF (MFA - KOF) 237,238,238
  237   INDX = NXFA * MXX
        NSET(INDX) = KLE
C
C       ---Update statistics of file JQ
C
  238   XNQ = NQ(JQ)
        ENQ(JQ) = ENQ(JQ) + XNQ * (TNOW - QTIME(JQ))
        VNQ(JQ) = VNQ(JQ) + XNQ * XNQ * (TNOW - QTIME(JQ))
        QTIME(JQ) = TNOW
        NQ(JQ) = NQ(JQ) + 1
        MAXNQ(JQ) = MAX0(MAXNQ(JQ),NQ(JQ))
        MLC(JQ) = MFE(JQ)
        RETURN
C
C       --- Test ranking value of new item against value of item
C           in column
C
   11   GO TO (1100,1120),KSJ
 1100   INDX1 = (MFA - 1) * IMM + KS
        INDX2 = (MLEX - 1) * IMM + KS
        IF (QSET(INDX1) - QSET(INDX2)) 12,13,13
 1120   INDX1 = (MFA - 1) * MXX + KS
        INDX2 = (MLEX - 1) * MXX + KS
C
C       --- Test ranking value of new item against value of
C           item in column MLEX
C
        IF (NSET(INDX1) - NSET(INDX2)) 12,13,13
C
C       --- Insert item after column MLEX.
C
   13   INDX = MLEX * MXX - 1
        MSU = NSET(INDX)
        NSET(INDX) = MFA
        INDX = MFA * MXX
        NSET(INDX) = MLEX
        GO TO (18,17),KNT
C
C       --- Since KNT equals one a comparison was made and there
C           is A.
C
18      INDX = MFA * MXX - 1
        NSET(INDX) = MSU
        INDX = MSU * MXX
        NSET(INDX) = MFA
        				GO TO 14
C
C       --- Set KNT to one since a comparison was made.
C
   12   KNT = 1
C
C       --- Test MFA against predecessor of MLEX by letting
C           MLEX equal predecessor of MLEX.
C
        INDX = MLEX * MXX
        MLEX = NSET(INDX)
        IF (MLEX-KLE) 11,16,11
C
C       --- If MLEX had no predecessor MFA is first in file
C
   16   INDX = MFA * MXX
        NSET(INDX) = KLE
        MFE(JQ) = MFA
C
C
C
   26   INDX = MFA * MXX - 1
        NSET(INDX) = MFEX
        INDX = MFEX * MXX
        NSET(INDX) = MFA
        				GO TO 14
C
C       --- FOR HVF OPERATION TRY TO INSERT ITEM STARTING AT BEGINNING
C           OF FILE JQ.
C
6       IF (MFEX) 100,10,19
C
C       --- Test ranking value of new item against value of
C           item in column MFEX.
C
   19   GO TO (1200,1220),KSJ
 1200   INDX1 = (MFA - 1) * IMM + KS
        INDX2 = (MFEX - 1) * IMM + KS
        IF (QSET(INDX1) - QSET(INDX2)) 20,21,21
 1220   INDX1 = (MFA - 1) * MXX + KS
        INDX2 = (MFEX - 1) * MXX + KS
        IF (NSET(INDX1) - NSET(INDX2)) 20,21,21
C
C       --- If new value if lower. MFA must be compared against 
C           successor of MFEX.
C
   20   KNT = 1
C
C       --- Let MPRE = MFEX and let MFEX be the successor of MFEX.
C
        MPRE = MFEX
        INDX = MFEX * MXX - 1
        MFEX = NSET(INDX)
        IF (MFEX-KOL) 19,24,19
C
C       --- If new value is higher, it should be inserted between
C           MFEX and ITS.
C
   21   GO TO (22,16),KNT
   22   KNT = 2
C
C       --- MFA is to be inserted after MPRE. Make MPRE the prdece
C           ssor of MFA and MFA the successor of MPRE.
C
   24   INDX = MFA * MXX
        NSET(INDX) = MPRE
        INDX = MPRE * MXX - 1
        NSET(INDX) = MFA
C
C       --- If KNT was not reset to 2, thre is no successor of MFA
C           pointers are updated at statement 17.
C
        GO TO (17,26), KNT
C
C       --- Removal of an item from file JQ.
C
    5   OUT = 0.0
C
C       --- Update pointing system to account for removal of MLC(JQ)
C
        INDX = (MLC(JQ) - 1) * IMM
        DO 32 I=1,IMM
        INDX = INDX + 1
   32   QSET(INDX) = 0.0
        INDX = (MLC(JQ) - 1) * MXX
        DO 1300 I=1,IM
        INDX = INDX + 1
 1300   NSET(INDX) = 0
        INDX = MLC(JQ) * MXX
        JL = NSET(INDX - 1)
        JK = NSET(INDX)
        IF (JL - KOL) 33,34,33
   33   IF (JK - KLE) 35,36,35
   35   INDX = JK * MXX - 1
        NSET(INDX) = JL
        INDX = JL * MXX
        NSET(INDX) = JK
C
C       --- Update pointers
C
   37   INDX = MLC(JQ) * MXX - 1
        NSET(INDX) = MFA
        NSET(INDX +1) = KLE
        IF (MFA - KOF) 234,235,235
  234   INDX = MFA * MXX
        NSET(INDX) =MLC(JQ)
  235   MFA = MLC(JQ)
        MLC(JQ) = MFE(JQ)
C
C       --- Update file statistaics
C
        XNQ = NQ(JQ)
        ENQ(JQ) = ENQ(JQ) + XNQ * (TNOW - QTIME(JQ))
        VNQ(JQ) = VNQ(JQ) + XNQ * XNQ * (TNOW - QTIME(JQ))
        QTIME(JQ) = TNOW
        NQ(JQ) = NQ(JQ) - 1
        RETURN
C
C       --- MLC was first entry but not last entry. update pointers.
C
   36   INDX = JL * MXX
        NSET(INDX) = KLE
        MFE(JQ) = JL
        				GO TO 37
   34   IF (JK - KLE) 38,39,38
C
C       --- MLC was last entry but not first entry. Update pointers.
C
   38   INDX = JK * MXX - 1
        NSET(INDX) = KOL
        MLE(JQ) = JK
        				GO TO 37
C
C       --- MLC was both the last and first entry, therefore, it is
C           the only entry.
C
   39   MFE(JQ) = 0
        MLE(JQ) = 0
        				GO TO 37
  100   CALL    ERROR(88,NSET,QSET)
        RETURN
        END
C
        SUBROUTINE      SUMRY(NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     SUMRYX                                  /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      SUMRY.FOR                               /
C/      Remarks.        Subroutine SUMRYX.FOR page 318.         /
C/                      Subroutine SUMRYX is the basic output   /
C/                      routine of GASP II. It processes the    /
C/                      the data collected in subroutine COLCT  /
C/                      TMST, and HISTO and prints out a data   /
C/                      summary.                                /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        WRITE(NPRNT,21)
21      FORMAT(1H1,29X,'** GASPex Summary Report ** '/)
        WRITE(NPRNT,102) NPROJ,NAME,MON,NDAY,NYR,NRUN
102     FORMAT(20X,'Simulation Project No.',I4,2X,'on',2X,
     $  6A2//,20X,'Date',I3,'/',I3,'/',I5,12X,'Run number',I5/)
        IF (NPRMS) 147,147,146
146     DO  64  I=1,NPRMS
64      WRITE(NPRNT,107) I,(PARAM(I,J),J=1,4)
107     FORMAT(10X,' Parameter No.',I5,4F12.4)
147     IF (NCLCT) 5,60,66
5       WRITE(NPRNT,199)
199     FORMAT(///26X,'Error Exit, Type 98 Error.')
        CALL    EXIT
66      WRITE(NPRNT,23)
23      FORMAT(//34X,'** Generated Data ** ',/17X,'Code',4X,'Mean',6X,
     $  'STD.DEV.',5X,'Min.',7X,'Max.',5X,'OBS.'/)
C
C       --- Compute and print statistics gathered by CLCT
C
        DO 2 I=1,NCLCT
        IF (SUMA(I,3)) 5,62,61
62      WRITE(NPRNT,63) I
63      FORMAT(17X,I3,10X,'No Values Recorded ')
        				GO TO 2
61      XS = SUMA(I,1)
        XSS = SUMA(I,2)
        XN = SUMA(I,3)
        AVG = XS / XN
        STD = (((XN * XSS) - (XS * XS))/(XN * (XN - 1.0)))**0.5
        N = XN
        WRITE(NPRNT,24) I,AVG,STD,SUMA(I,4),SUMA(I,5),N
24      FORMAT(17X,I3,4F11.4,I7)
2       CONTINUE
60      IF (NSTAT) 5,67,4
4       WRITE(NPRNT,29)
29      FORMAT(/34X,'** Time Generated Data **'/,17X,'Code',4X,'Mean',
     $  6X,'STD.DEV.',5X,'Min.',7X,'Max.',3X,'Total Time '/)
C
C       --- Compute and print statistics gathered by TMST
C
        DO 6 I=1,NSTAT
        IF (SSUMA(I,1)) 5,71,72
71      WRITE(NPRNT,63) I
        				GO TO 6
72      XT = SSUMA(I,1)
        XS = SSUMA(I,2)
        XSS = SSUMA(I,3)
        AVG = XS / XT
        STD = (XSS/XT - AVG*AVG) ** 0.5
        WRITE(NPRNT,30) I,AVG,STD,SSUMA(I,4),SSUMA(I,5),XT
30      FORMAT(17X,I3,5F11.4)
6       CONTINUE
67      IF (NHIST) 5,75,9
9       WRITE(NPRNT,25)
25      FORMAT(/27X,'** Generated Frequency Distributions **',/17X,
     $  'Code',20X,'Histograms')
C
C       --- Print histograms
C
        DO  12  I=1,NHIST
        NCL = NCELS(I) + 2
12      WRITE(NPRNT,26) I,(JCELS(I,J),J=1,NCL)
26      FORMAT(/17X,I3,5X,11I4,/(25X,11I4))
C
C       --- Print files and file statistics
C
75      DO  15  I=1,NOQ
15      CALL    PRNTQ(I,NSET,QSET)
        RETURN
        END
C
        SUBROUTINE      TMST(X,T,N,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     TMSTX                                   /
C/      Date-written.   4th,Feb,1984                            /
C/      File-name.      TMST.FOR                                /
C/      Remarks.        Subroutine TMSTX.FOR page 76.           /
C/                      This subroutine collects sample data    /
C/                      on observations of a variable made over /
C/                      a period of time.                       /
C/                                                              /
C////////////////////////////////////////////////////////////////
C       //FOR
C       *ONE WORD INTEGERS
C       *LIST SOURCE PROGRAM
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        IF (N) 2,2,1
    2   CALL    ERROR(91,NSET,QSET)
    1   IF (N - NSTAT) 3,3,2
    3   TT = T - SSUMA(N,1)
        SSUMA(N,1) = SSUMA(N,1) + TT
        SSUMA(N,2) = SSUMA(N,2) + X*TT
        SSUMA(N,3) = SSUMA(N,3) + X*X*TT
        SSUMA(N,4) = AMIN1(SSUMA(N,4),X)
        SSUMA(N,5) = AMAX1(SSUMA(N,5),X)
        RETURN
        END
C
        SUBROUTINE      FINDN(NVAL,MCODE,JQ,JATT,KCOL,NSET,QSET)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     FINDN.FOR                               /
C/      Date-written.   5th,Feb,1984                            /
C/      Remarks.        GASP IIex Library subroutine from       /
C/                      page 304                                /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        DIMENSION       NSET(1),QSET(1)
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
C       --- The column to be considered as a candidate is NEXTK
C
        KBEST = 0
        NEXTK = MFE(JQ)
        IF (NEXTK) 16,1,2
16      CALL    ERROR(89,NSET,QSET)
1       KCOL  = KBEST
        RETURN
C
C       --- MGRNV is +1 for greater than search and -1 for less than 
C           search NMAMN is +1 for maximum and -1 for minimum
C
2       GO TO (11,12,13,14,11),MCODE
11      MGRNV = 1
        NMAMN = 1
        				GO TO 20
12      MGRNV = 1
        NMAMN = -1
        GO TO 20
13      MGRNV = -1
        NMAMN = 1
        GO TO 20
14      MGRNV = -1
        NMAMN = -1
20      INDX = (NEXTK - 1) * MXX + JATT
        IF (MGRNV * (NSET(INDX) - NVAL)) 4,21,66
C
C       --- When equality is obtatined test for MCODE=5, the search for
C           a specified value
C
21      IF (MCODE - 5) 4,15,4
66      IF (MCODE - 5) 6,4,6
6       IF (KBEST) 16,8,7
7       IF (NMAMN*(NSET(INDX)-NSET(KINDX))) 4,4,8
8       KBEST = NEXTK
        KINDX = INDX
4       INDS = (NEXTK)*MXX - 1
        NEXTK = NSET(INDS)
        IF (NEXTK - 7777) 20,1,1
15      KCOL=NEXTK
        RETURN
        END
C
        FUNCTION        UNFRM (A,B)
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     Function UNFRM                          /
C/      Date-written.   5th,Feb,1984                            /
C/      Remarks.        The function RNORM generates a deviate  /
C/                      from a normal distribution .            /
C/                      From page 97                            /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
     $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
        COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
     $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
     $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
     $  JCLR,JTRIB(12)
C
        CALL    DRAND (ISEED,RNUM)
        UNFRM = A + (B-A) * RNUM
        RETURN
        END
C
        SUBROUTINE      EXIT
C////////////////////////////////////////////////////////////////
C/                                                              /
C/      Program-id.     EXIT.FOR                                /
C/      Date-written.   17th,Feb,1984                           /
C/      Remarks.        This sub_program is for FORTRAN-86.     /
C/                                                              /
C////////////////////////////////////////////////////////////////
C
        WRITE(1,1000)
 1000     FORMAT(1H0,'FORTRAN-86 Exit. ')
        STOP
        RETURN
        END