C		SUBROUTINE GASP		
C
C
      SUBROUTINE GASP(NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      NOT = 0
1	CALL DATIN(NSET)
C*****PRINT OUT FILING ARRAY
      JEVNT = 101
      CALL MONTR (NSET)
      WRITE (NPRNT,403)
  403 FORMAT(1H1, 24H**INTERMEDIATE RESULTS**//)
C*****OBTAIN NEXT EVENT WHICH IS FIRST ENTRY IN FILE 1. ATRIB(1) IS EVE
C*****TIME, ATRIB(2) IS EVENT CODE
   10 CALL RMOVE(MFE(1),1,NSET)
      TNOW = ATRIB(1)
      JEVNT = ATRIB(2)
C*****TEST TO SEE IF THIS EVENT IS A MONITOR EVENT
      IF(JEVNT - 100)13,12,6
   13 I = JEVNT
C*****CALL PROGRAMMERS EVENT ROUTINES
      CALL EVNTS (I,NSET)
C*****TEST METHOD FOR STOPPING
      IF (MSTOP) 40,8,20
   40 MSTOP = 0
C*****TEST FOR NO SUMMARY REPORT
      IF (NORPT) 14,22,42
   20 IF(TNOW-TFIN)8,22,22
   22 CALL SUMRY(NSET)
	CALL OTPUT(NPRNT,NSET)
C*****TEST NUMBER OF RUNS REMAINING
   42 IF(NRUNS-1)14,9,23
   23 NRUNS = NRUNS - 1
      NRUN = NRUN + 1
      GO TO 1
   14 CALL ERROR(93,NSET)
    6 CALL MONTR(NSET)
      GO TO 10
C*****RESET JMNIT
   12 IF(JMNIT)14,30,31
   30 JMNIT = 1
      GO TO 10
   31 JMNIT = 0
      GO TO 10
C*****TEST TO SEE IF EVENT INFORMATION IS TO BE PRINTED
    8 IF(JMNIT)14,10,32
   32 ATRIB(2) = JEVNT
      JEVNT = 100
      CALL MONTR(NSET)
      GO TO 10
C*****IF ALL RUNS ARE COMPLETED RETURN TO MAIN PROGRAM FOR INSTRUCTIONS
    9 RETURN
      END
C		SUBROUTINE DATIN		
C
C
      SUBROUTINE DATIN(NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      IF (NOT)23,1,2
C
C*****NEP IS A CONTROL VARIABLE FOR DETERMINING THE STARTING CARD
C*****TYPE FOR MULTIPLE RUN PROBLEMS.  THE VALUE OF NEP SPECIFIES THE
C*****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)
    1 NOT = 1
      NRUN = 1
C
C*****DATA CARD TYPE ONE
C
      READ (NCRDR,101) NAME,NPROJ,MON,NDAY,NYR,NRUNS
  101 FORMAT (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,SCALE
  803 FORMAT (8I5,F10.2)
      IF (NHIST) 41,41,6
C
C*****DATA CARD TYPE THREE IS USED ONLY IF NHIST IS GREATER THAN ZERO
C*****SPECIFY NUMBER OF CELLS IN HISTOGRAMS NOT INCLUDING END CELLS
C
    6 READ (NCRDR,103) (NCELS(I),I=1,NHIST)
  103 FORMAT (10I5)
C
C*****DATA CARD TYPE FOUR
C*****SPECIFY KRANK=RANKING ROW
C
   41 READ (NCRDR,103) (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)
      IF (NPRMS) 23,43,8
    8 DO 9 I = 1,NPRMS
C
C*****DATA CARD TYPE SIX IS USED ONLY IF NPRMS IS GREATER THAN ZERO
C
      READ (NCRDR,106) (PARAM(I,J),J=1,4)
  106 FORMAT(4F10.4)
    9 CONTINUE
C
C*****DATA CARD TYPE SEVEN.  THE NEP VALUE IS FOR THE NEXT RUN.  SET
C*****JSEED GREATER THAN ZERO TO SET TNOW EQUAL TO TBEG.
C
   43 READ (NCRDR, 104) MSTOP,JCLR,NORPT,NEP,TBEG,TFIN,JSEED
  104 FORMAT (4I5,2F10.3,I4)
      IF (JSEED) 27,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 BY JQ EQUAL TO A NEGATIVE VALUE ON FIRST EVENT
C*****CARD
C*****READ IN INITIAL EVENTS.  END INITIAL EVENTS AND ENTITIES WITH JQ
C*****EQUAL TO ZERO
C
      READ (NCRDR,1110)JQ,(ATRIB(JK),JK=1,IM)
 1110 FORMAT(I10,(7F10.4))
      IF(JQ) 44,15,320
   44 INIT=1
      CALL SET(1,NSET)
      GO TO 300
  320 CALL FILEM(JQ,NSET)
  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
C
C
C*****PRINT OUT PROGRAM IDENTIFICATION INFORMATION
   20 WRITE (NPRNT,102) NPROJ,NAME,MON,NDAY,NYR,NRUN
  102 FORMAT (1H1,1X,22HSIMULATION PROJECT NO.,I4,2X,2HBY,2X,
     1 6A2//,1X,4HDATE,I3,1H/,I3,1H/,I5,12X,10HRUN NUMBER,I5//)
C*****PRINT PARAMETER VALUES AND SCALE
      IF(NPRMS ) 60,60,62
   62 DO 64 I=1,NPRMS
   64 WRITE (NPRNT,107) I,(PARAM(I,J),J=1,4)
  107 FORMAT(1X,14H PARAMETER NO.,I5,4F12.4)
   60 WRITE (NPRNT,1107) SCALE
 1107 FORMAT (//1X,8H SCALE =F10.4)
      RETURN
      END
C		SUBROUTINE FILEM	
C
C
      SUBROUTINE FILEM (JQ,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
C
C*****TEST TO SEE IF THERE IS AN AVAILABLE 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)
C
C*****PUT ATTRIBUTE VALUES IN FILE
C
    2 DO 1 I = 1,IM
      DEL =.000001
      IF (ATRIB(I)) 5,1,1
    5 DEL = -.000001
    1 NSET(I,MFA)=SCALE*(ATRIB(I)+DEL)
C
C*****CALL SET TO PUT NEW ENTRY IN PROPER PLACE IN NSET
C
      CALL SET (JQ,NSET)
      RETURN
      END
C		SUBROUTINE RMOVE		
C
C
      SUBROUTINE RMOVE  (KCOLL,JQ,NSET)
      DIMENSION NSET(6,1),KCOLL(1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      KCOL=KCOLL(1)
      IF (KCOL) 16,16,2
   16 CALL ERROR(97,NSET)
    2 MLC(JQ) = KCOL
C
C*****PUT VALUES OF KCOL IN ATTRIB
C
      DO 3 I = 1,IM
      ATRIB (I) = NSET(I,KCOL)
    3 ATRIB (I) = ATRIB(I)/SCALE
C
C*****SET OUT=1 AND CALL SET TO REMOVE ENTRY FROM NSET
C
      OUT = 1.
      CALL SET (JQ,NSET)
      RETURN
      END
C		SUBROUTINE SET		
C
C
      SUBROUTINE SET(JQ,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
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)****INN(JQ)=1 IS FIFO**INN(JQ)=2 IS LIFO
C
   28 KOL = 7777
      KOF = 8888
      KLE = 9999
      MX = IM+1
      MXX = IM+2
C
C*****INITIALIZE POINTING CELLS OF NSET AND ZERO OTHER CELLS OF NSET
C
      DO 1 I = 1,ID
      DO 2 J = 1,IM
    2 NSET(J,I) = 0
      NSET(MXX,I) = I-1
    1 NSET(MX,I) = I + 1
      NSET(MX,ID) = 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.
    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 WITH ITEM
C*****TO BE INSERTED
C
   27 MFEX = MFE(JQ)
C
C*****KNT IS A CHECK CODE TO INDICATE THAT NO COMPARISONS HAVE BEEN MADE
C
      KNT = 2
C
C*****KS IS THE ROW ON WHICH ITEMS OF FILE JQ ARE RANKED
      KS = KRANK(JQ)
C*****TEST FOR PUTTING VALUE IN OR OUT
C*****IF OUT EQUALS ONE AN ITEM IS TO BE REMOVED FROM FILE JQ.  IF OUT
C*****IS LESS THAN ONE AN ITEM IS TO BE INSERTED IN FILE JQ
C
      IF (OUT-1.0) 8,5,100
C
C*****PUTTING AN ENTRY IN FILE JQ
C*****NXFA IS THE SUCCESSOR COLUMN OF THE FIRST AVAILABLE COLUMN FOR
C*****STORING INFORMATION
C*****THE ITEM TO BE INSERTED WILL BE PUT IN COLUMN MFA
C
    8 NXFA = NSET(MX,MFA)
C
C*****IF INN(JQ) EQUALS TWO THE FILE IS A HVF FILE. IF INN(JQ) IS
C*****ONE THE FILE IS A LVF FILE. FOR LVF FILES TRY TO INSERT
C*****STARTING AT END OF FILE.  MLEX IS LAST ENTRY IN FILE WHICH HAS
C*****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 ONLY
C*****ITEM IN FILE.
C
      IF (MLEX) 100,10,11
   10 NSET(MXX,MFA)=KLE
      MFE(JQ) = MFA
C
C*****THERE IS NO SUCCESSOR OF ITEM INSERTED.  SINCE ITEM WAS INSERTED
C*****IN COLUMN MFA THE LAST ENTRY OF FILE JQ IS IN COLUMN MFA.
C
   17 NSET(MX,MFA) = KOL
      MLE(JQ) = MFA
C
C*****SET NEW MFA EQUAL TO SUCCESSOR OF OLD MFA.  THAT IS NXFA.  THE
C*****NEW MFA HAS NO PREDECESSOR SINCE IT IS THE FIRST AVAILABLE COLUMN
C*****FOR STORAGE.
C
   14 MFA = NXFA
      IF (MFA-KOF) 237,238,238
  237 NSET(MXX,MFA) = 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 IN COLUMN
C*****MLEX
C
   11 IF(NSET(KS,MFA)-NSET(KS,MLEX))12,13,13
C
C*****INSERT ITEM AFTER COLUMN MLEX.  LET SUCCESSOR OF MLEX BE MSU.
C
   13 MSU = NSET(MX,MLEX)
      NSET(MX,MLEX) = MFA
      NSET(MXX,MFA) = MLEX
      GO TO (18,17),KNT
C
C*****SINCE KNT EQUALS ONE A COMPARISON WAS MADE AND THERE IS A
C*****SUCCESSOR TO MLEX, I.E., MSU IS NOT EQUAL TO KOL.  POINT COLUMN
C*****MFA TO MSU AND VICE VERSA.
C
   18 NSET(MX,MFA) = MSU
      NSET(MXX,MSU) = 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 MLEX EQUAL
C*****PREDECESSOR OF MLEX.
C
      MLEX = NSET(MXX,MLEX)
      IF(MLEX-KLE) 11,16,11
C
C*****IF MLEX HAD NO PREDECESSOR MFA IS FIRST IN FILE.
C
   16 NSET(MXX,MFA) = KLE
      MFE(JQ) = MFA
C
C*****SUCCESSOR OF MFA IS MFEX AND PREDECESSOR OF MFEX IS MFA. (NOTE AT
C*****THIS POINT MLEX = MFEX IF LVF WAS USED).
C
   26 NSET(MX,MFA) = MFEX
      NSET(MXX,MFEX) = MFA
      GO TO 14
C
C***** FOR HVF OPERATION TRY TO INSERT ITEM STARTING AT BEGINNING OF
C*****FILE JQ.
C*****IF MFEX IS 0, NO ENTRIES ARE IN FILE JQ.  THIS CASE WAS CONSIDERED
C*****PREVIOUSLY AT STATEMENT 10.
C
    6 IF (MFEX) 100,10,19
C
C*****TEST RANKING VALUE OF NEW ITEM AGAINST VALUE OF ITEM IN COLUMN
C*****MFEX.
C
   19 IF(NSET(KS,MFA)-NSET(KS,MFEX))20,21,21
C
C*****IF NEW VALUE IF LOWER, MFA MUST BE COMPARED AGAINST SUCCESSOR OF
C*****MFEX.
C
   20 KNT = 1
C
C*****LET MPRE = MFEX AND LET MFEX BE THE SUCCESSOR OF MFEX.
C
      MPRE = MFEX
      MFEX = NSET(MX,MFEX)
      IF (MFEX-KOL) 19,24,19
C
C*****IF NEW VALUE IS HIGHER, IT SHOULD BE INSERTED BETWEEN MFEX AND ITS
C*****PREDECESSOR.
C*****IF KNT = 2, MFEX HAS NO PREDECESSOR,  GO TO STATEMENT 16.  IF KNT
C*****= 1, A COMPARISON WAS MADE AND A VALUE OF MPRE HAS ALREADY BEEN
C*****OBTAINED ON THE PREVIOUS ITERATION.  SET KNT = 2 TO INDICATE THIS.
C
   21 GO TO (22,16),KNT
   22 KNT = 2
C
C*****MFA IS TO BE INSERTED AFTER MPRE.  MAKE MPRE THE PREDECESSOR OF
C*****MFA AND MFA THE SUCCESSOR OF MPRE.
C
   24 NSET(MXX,MFA) = MPRE
      NSET(MX,MPRE) = MFA
C
C*****IF KNT WAS NOT RESET TO 2, THERE IS NO SUCCESSOR OF MFA.  POINTERS
C*****ARE UPDATED AT STATEMENT 17.  IF KNT = 2, IT WAS RESET AND THE
C*****SUCCESSOR OF MFA IS MFEX.
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).  COLUMN
C*****REMOVED IS ALWAYS SET TO MLC(JQ) BY SUBROUTINE RMOVE.
C
      MMLC = MLC(JQ)
C
C*****RESET OUT TO 0 AND CLEAR COLUMN REMOVED.  LET JL EQUAL SUCCESSOR
C*****OF COLUMN REMOVED AND JK EQUAL PREDECESSOR OF COLUMN REMOVED.
C*****IF JL = KOL, MLC WAS LAST ENTRY.  IF JK = KLE, MLC WAS FIRST ENTRY
C*****MLC WAS NOT FIRST OR LAST ENTRY.  UPDATE POINTERS SO THAT JL IS
C*****SUCCESSOR OF JK AND JK IS PREDECESSOR OF JL.
C
      DO 32 I=1,IM
   32 NSET(I,MMLC) = 0
      JL = NSET(MX,MMLC)
      JK= NSET(MXX,MMLC)
      IF (JL-KOL) 33,34,33
   33 IF (JK-KLE) 35,36,35
   35 NSET(MX,JK) = JL
      NSET(MXX,JL) = JK
C
C*****UPDATE POINTERS.
C
   37 NSET(MX,MMLC) =MFA
      NSET(MXX,MMLC) = KLE
      IF (MFA-KOF) 234,235,235
  234 NSET(MXX,MFA) = MMLC
  235 MFA= MLC(JQ)
      MLC(JQ) = MFE(JQ)
C
C*****UPDATING FILE STATISTICS
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 NSET(MXX,JL) = 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 NSET(MX,JK) = KOL
      MLE(JQ) = JK
      GO TO 37
C
C*****MLC WAS BOTH THE LAST AND FIRST ENTRY, THEREFORE, IT IS THE ONLY
C*****ENTRY.
C
   39 MFE(JQ) = 0
      MLE(JQ) = 0
      GO TO 37
  100 CALL ERROR(88,NSET)
      STOP
      END
C		SUBROUTINE COLCT	
C
C
      SUBROUTINE COLCT (X,N,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      IF (N) 2,2,1
    2 CALL ERROR(90,NSET)
    1 IF (N- NCLCT) 3,3,2
    3 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 TMST		
C
C
      SUBROUTINE TMST  (X,T,N,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      IF (N) 2,2,1
    2 CALL ERROR(91,NSET)
    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 FIND		
C
C
      SUBROUTINE FIND (XVAL,MCODE,JQ,JATT,KCOL,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),M
     1FE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA
     2(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
C
C*****CHANGE VALUE TO FIXED POINT WHEN SEARCHING NSET
C
      NVAL=XVAL*SCALE
C
C*****THE COLUMN WHICH IS THE BEST CANDIDATE IS KBEST
C
      KBEST=0
C
C*****THE NEXT COLUMN TO BE CONSIDERED AS A CANDIDATE IS NEXTK
C
      NEXTK=MFE(JQ)
      IF(NEXTK) 16,1,2
   16 CALL ERROR(89,NSET)
    1 KCOL=KBEST
      RETURN
C
C*****MGRNV IS +1 FOR GREATER THAN SEARCH AND -1 FOR LESS THAN SEARCH
C*****NMAMN IS +1 FOR MAXIMUM AND -1 FOR MINIMUM
C*****FOR SEARCH FOR EQUALITY THE SIGN OF MGRNV AND NMAMN ARE NOT USED
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 IF(MGRNV*(NSET(JATT,NEXTK)-NVAL)) 4,21,66
C
C*****WHEN EQUALITY IS OBTAINED TEST FOR MCODE=5, THE SEARCH FOR A
C*****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(JATT,NEXTK)-NSET(JATT,KBEST))) 4,4,8
    8 KBEST=NEXTK
    4 NEXTK=NSET(MX,NEXTK)
      IF(NEXTK-7777)20,1,1
   15 KCOL=NEXTK
      RETURN
      END
C		FUNCTION SUMQ		
C
C
      FUNCTION SUMQ (JATT,JQ,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      SUMQ = 0
      IF (JQ-NOQ) 17,17,18
   18 CALL ERROR(85,NSET)
   17 IF (NQ( JQ )) 19,19,20
   19 RETURN
   20 MTEM = MFE(JQ)
   23 VSET = NSET(JATT,MTEM)
      SUMQ = SUMQ + VSET/SCALE
      IF (NSET(MX,MTEM)-7777) 21,22,21
   21 MTEM = NSET(MX,MTEM)
      GO TO 23
   22 RETURN
      END
C		FUNCTION PRODQ		
C
C
      FUNCTION PRODQ (JATT,JQ,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      PRODQ = 1.
      IF (JQ-NOQ) 17,17,18
   18 CALL ERROR(84,NSET)
   17 IF (NQ( JQ )) 19,19,20
   19 PRODQ=0.
      RETURN
   20 MTEM=MFE(JQ)
   23 VSET=NSET(JATT,MTEM)
      PRODQ = PRODQ*VSET/SCALE
      IF (NSET(MX,MTEM) -7777) 21,22,21
   21 MTEM= NSET(MX,MTEM)
      GO TO 23
   22 RETURN
      END
C		SUBROUTINE ERROR	
C
C
      SUBROUTINE ERROR(J,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      WRITE(NPRNT,100) J
      JEVNT=101
C
C*****PRINT FILING ARRAY NSET
C
      CALL MONTR(NSET)
      WRITE(NPRNT,101)
C
C*****PRINT NEXT EVENT FILE
C
      CALL PRNTQ(1,NSET)
C
C*****PRINT SUMMARY REPORT UP TO PRESENT
C
      CALL SUMRY(NSET)
  100 FORMAT(///1X16HERROR EXIT, TYPE,I3,7H ERROR.)
  101 FORMAT(1H1,1X16HSCHEDULED EVENTS//)
      NFOOL=0
      IF(NFOOL)3,4,3
    3 RETURN
    4 STOP
      END
C		SUBROUTINE SUMRY	
C
C
      SUBROUTINE SUMRY (NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      WRITE (NPRNT,21)
   21 FORMAT (1H1, 23H**GASP SUMMARY REPORT**/)
      WRITE (NPRNT,102) NPROJ,NAME,MON,NDAY,NYR,NRUN
  102 FORMAT     (1X,22HSIMULATION PROJECT NO.,I4,2X,2HBY,2X,
     1 6A2//,1X,4HDATE,I3,1H/,I3,1H/,I5,12X,10HRUN 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( 14H PARAMETER NO.,I5,4F12.4)
  147 IF(NCLCT)5,60,66
    5 WRITE (NPRNT,199)
  199 FORMAT(///1X26HERROR EXIT, TYPE 98 ERROR.)
      CALL EXIT
   66 WRITE (NPRNT,23)
   23 FORMAT (// 18H**GENERATED DATA** /1X,4HCODE,4X,4HMEAN,6X,8HSTD
     1.DEV.,5X,4HMIN.,7X,4HMAX.,5X,4HOBS./)
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(1X,I3,10X18HNO 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)))**.5
      N = XN
      WRITE (NPRNT,24) I,AVG,STD,SUMA(I,4),SUMA(I,5),N
   24 FORMAT (1X,I3,4F11.4,I7)
    2 CONTINUE
   60 IF(NSTAT)5,67,4
    4 WRITE (NPRNT,29)
   29 FORMAT ( /1X23H**TIME GENERATED DATA** /1X,4HCODE,4X,4HMEAN,6X,
     18HSTD.DEV.,5X,4HMIN.,7X,4HMAX.,3X,10HTOTAL 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)**.5
      WRITE (NPRNT,30) I,AVG,STD,SSUMA(I,4),SSUMA(I,5),XT
   30 FORMAT (1X,I3,5F11.4)
    6 CONTINUE
   67 IF(NHIST)5,75,9
    9 WRITE (NPRNT,25)
   25 FORMAT   (/ 37H**GENERATED FREQUENCY DISTRIBUTIONS** /1X,4HCOD
     1E,20X,10HHISTOGRAMS)
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(/1X,I3,5X,11I4/(9X,11I4))
C
C*****PRINT FILES AND FILE STATISTICS
C
   75 DO 15 I = 1,NOQ
   15 CALL PRNTQ (I,NSET)
      RETURN
      END
C		SUBROUTINE HISTO	
C
C
      SUBROUTINE HISTO (X1,A,W,N)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      IF (N-NHIST) 11,11,2
    2 WRITE (NPRNT,250) N
  250 FORMAT(19H ERROR IN HISTOGRAM,I4//)
      CALL EXIT
   11 IF(N)2,2,3
C
C*****TRANSLATE X1 BY SUBTRACTING A IF X.LE.A THEN ADD 1 TO FIRST CELL
C
    3 X = X1 - A
      IF (X)6,7,7
    6 IC = 1
      GO TO 8
C
C*****DETERMINE CELL NUMBER IC. ADD 1 FOR LOWER LIMIT CELL AND 1 FOR
C*****TRUNCATION
C
    7 IC = X/W + 2.
      IF (IC - NCELS(N) - 1) 8,8,9
    9 IC = NCELS(N)+2
    8 JCELS(N,IC) = JCELS(N,IC) + 1
      RETURN
      END
C		SUBROUTINE MONTR	
C
C
      SUBROUTINE MONTR(NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
C
C*****IF JEVNT .GE. 101, PRINT NSET
C
      IF (JEVNT - 101) 9,7,9
    7 WRITE (NPRNT,100) TNOW
      DO 1000 I=1,ID
  100 FORMAT(1H1,10X31H**GASP JOB STORAGE AREA DUMP AT,F10.4,
     1 2X,12HTIME UNITS**//)
 1000 WRITE (NPRNT,101) I,(NSET(J,I),J=1,MXX)
  101 FORMAT(I5,12I9)
      RETURN
    9 IF(MFE(1))3,6,1
C
C*****IF JMNIT = 1,PRINT TNOQ,CURRENT EVENT CODE, AND ALL ATTRIBUTES OF
C*****THE NEXT EVENT
C
    1 IF (JMNIT - 1) 5,4,3
    3 WRITE (NPRNT,199)
  199 FORMAT(/// 26H ERROR EXIT,TYPE 99 ERROR.)
      CALL EXIT
    4 MMFE =MFE(1)
      WRITE (NPRNT,103) TNOW,ATRIB(2),(NSET(I,MMFE),I=1,MXX)
  103 FORMAT (/10X23HCURRENT EVENT....TIME =,F8.2,5X7HEVENT =,F7.2,
     1/10X,17HNEXT EVENT......./(10X,12I9)//)
    5 RETURN
    6 WRITE (NPRNT,104) TNOW
  104 FORMAT (10X,19H FILE 1 IS EMPTY AT,F10.2)
      GO TO 5
      END
C		SUBROUTINE NPOSN	
C
C
      SUBROUTINE NPOSN(J,NPSSN)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      NPSSN = 0
      P = PARAM (J,1)
    1 IF (P-6.0) 2,2,4
    2 Y = EXP (-P)
      X = 1.0
    3 CALL DRAND(ISEED,RNUM)
      X=X*RNUM
      IF (X-Y) 6,8,8
    8 NPSSN = NPSSN+1
      GO TO 3
    4 TEMP=PARAM (J,4)
      PARAM(J,4) = (PARAM(J,1))**.5
      NPSSN=RNORM(J)+.5
      PARAM (J,4)=TEMP
      IF(NPSSN)4,6,6
    6 KK=PARAM (J,2)
      KKK=PARAM (J,3)
      NPSSN=KK+NPSSN
      IF(NPSSN-KKK)7,7,9
    9 NPSSN = PARAM (J,3)
    7 RETURN
      END
C		SUBROUTINE PRNTQ	
C
C
      SUBROUTINE PRNTQ (JQ,NSET)
      DIMENSION NSET(6,1)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      WRITE (NPRNT,100) JQ
      IF (TNOW - TBEG) 12,12,13
   12 WRITE (NPRNT,105)
  105 FORMAT(/1X25H NO PRINTOUT TNOW = TBEG //)
      GO TO 2
C
C*****COMPUTE EXPECT NO. IN FILE JQ UP TO PRESENT THIS MAY BE USEFUL
C*****IN SETTING THE VALUE OF ID
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)**0.5
      WRITE (NPRNT,104) X,STD,MAXNQ(JQ)
C
C*****PRINT FILE IN PROPER ORDER REQUIRES TRACING THROUGH THE POINTERS
C*****OF THE FILE
C
      LINE = MFE(JQ)
      IF (LINE-1) 4,1,1
    4 WRITE (NPRNT,102)
    2 RETURN
    1 WRITE (NPRNT,101)
    6 DO 77 I=1,IM
      ATRIB  (I) = NSET(I,LINE)
   77 ATRIB (I)=ATRIB (I)/SCALE
      WRITE (NPRNT,103) (ATRIB(I),I=1,IM)
      LINE = NSET(MX,LINE)
      IF (LINE-7777) 6,2,5
    5 WRITE (NPRNT,199)
  199 FORMAT(///1X26HERROR EXIT, TYPE 94 ERROR.)
  100 FORMAT(//1X25H FILE PRINTOUT, FILE  NO.,I3)
  101 FORMAT (/1X14H FILE CONTENTS/)
  102 FORMAT(/1X18HTHE FILE  IS EMPTY)
  103 FORMAT(1X,10F10.4)
  104 FORMAT(/1X27HAVERAGE NUMBER IN FILE  WAS,F10.4,/1X,9HSTD. DEV.,
     1 18X,F10.4,/1X,7HMAXIMUM,24X,I4)
      STOP
	END
C		FUNCTION RLOGN		
C
C
      FUNCTION RLOGN (J)
C
C*****THE PARAMETERS USED WITH RLOGN ARE THE MEAN AND STANDARD DEVIATION
C*****OF A NORMAL DISTRIBUTION
C
      VA= RNORM (J)
      RLOGN=EXP(VA)
      RETURN
      END
C		FUNCTION ERLNG	
C
C
      FUNCTION ERLNG (J)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      K = PARAM(J,4)
      IF(K-1) 8,10,10
    8 WRITE (NPRNT,20) J
   20 FORMAT(/16HK = 0 FOR ERLNG,I7)
      CALL EXIT
   10 R=1
      DO 2 I=1,K
      CALL DRAND (ISEED,RNUM)
    2 R=R*RNUM
      ERLNG = -PARAM(J,1)*ALOG(R)
      IF(ERLNG-PARAM(J,2))7,5,6
    7 ERLNG  = PARAM (J,2)
    5 RETURN
    6 IF(ERLNG  - PARAM (J,3))5,5,4
    4 ERLNG  = PARAM (J,3)
      RETURN
      END
C		FUNCTION RNORM		
C
C
      FUNCTION RNORM (J)
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      CALL DRAND(ISEED,RA)
      CALL DRAND(ISEED,RB)
      V=(-2.0*ALOG(RA))**0.5*COS (6.283*RB)
      RNORM  = V*PARAM (J,4) + PARAM (J,1)
      IF (RNORM -PARAM (J,2)) 6,7,8
    6 RNORM  = PARAM (J,2)
    7 RETURN
    8 IF (RNORM -PARAM (J,3)) 7,7,9
    9 RNORM  = PARAM (J,3)
      RETURN
      END
C		FUNCTION UNFRM		
C
C
      FUNCTION UNFRM (A,B)
C*****THIS CARD IS TO MAINTAIN THE PROPER SEQUENCING
      COMMON ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
     1NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW,
     2TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
      COMMON ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),MFE(4)
     1,MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),QTIME(4),SSUMA(10,5),
     2SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,JCLR
      CALL DRAND (ISEED,RNUM)
      UNFRM  = A+(B-A)*RNUM
      RETURN
      END
C		SUBROUTINE DRAND	
C
C
C	MODIFIED FOR SANDERS PDP-10
C
      SUBROUTINE DRAND(ISEED,RNUM)
	DATA  K/0/
	IF (K .NE. 0 ) GO TO 10
	K=1
	CALL IRAN(ISEED)
10	CALL RANDOM(RNUM)
      RETURN
      END
C		SUBROUTINE OTPUT	
C
C
	SUBROUTINE OTPUT(NPRNT,NSET)
      DIMENSION NSET(6,1)
      WRITE(NPRNT,10)
   10 FORMAT(///10X,'NO ADDITIONAL OUTPUT REQUESTED')
      RETURN
      END