Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0008/gasp.for
There is 1 other file named gasp.for in the archive. Click here to see a list.
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