home *** CD-ROM | disk | FTP | other *** search
- C [USER11X.FOR of JUGPDS Vol.10]
- C
- PROGRAM EXA11
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. Example_11x, Information System /
- C/ Date-written. Feb. 11th 1984 /
- C/ Remarks. A main program of Information service /
- C/ system, from page 269. /
- C/ This program uses GASP IIex version. /
- C/ /
- C////////////////////////////////////////////////////////////////
- C
- INTEGER*1 FLNAME(11)
- DIMENSION NSET(120), QSET(30)
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- DATA FLNAME/'G','A','S','P',4*' ','D','A','T'/
- C
- C --- Start of Main program of Information System.
- C
- NCRDR = 6
- C
- IDRIVE = 0
- WRITE(1,90)
- 90 FORMAT(1H0,'Output GASP data file to Display(3) or Printer(2)'
- 1 ,/1H ,'Enter Output Device number 2 or 3 : ')
- READ(1,95) NPRNT
- 95 FORMAT(I1)
- WRITE(1,100)
- 100 FORMAT(1H0,'Input GASPex data file name (max 8 characters):')
- READ(1,200) (FLNAME(I),I=1,8)
- WRITE(1,210) (FLNAME(I),I=1,11)
- 200 FORMAT(8A1)
- 210 FORMAT(1H ,'Input GASPex data file name: ',11A1)
- CALL OPEN(NCRDR,FLNAME,IDRIVE)
- C
- C --- Initial conditions for he simulation are no customers in
- C the system. the scanner is at position (1), the buffer sto-
- C rage is not blocked, all stations have no customers in them
- C and all lines are free.
- C
- NARC = 0
- NSCAN = 1
- JBUFF = 0
- DO 10 I=1,10
- NSTA(I) = 0
- 10 JRPLY(I) = 1
- C
- CALL GASP(NSET,QSET)
- CALL EXIT
- END
- C
- SUBROUTINE EVNTS(I,NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. EVNTS.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. The user defined events routine for /
- C/ Information system, from page 270 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C
- C --- SET INITIAL USER VARIABLES.
- C
- NTER = PARAM(1,1)
- IBUFF = PARAM(1,2)
- XL = PARAM(1,3)
- CDIAL(1) = PARAM(2,1)
- CDIAL(2) = PARAM(2,2)
- CREAD(1) = PARAM(3,1)
- CREAD(2) = PARAM(3,2)
- SRTIM = PARAM(4,1)
- SCTIM = PARAM(4,2)
- TRTIM = PARAM(5,1)
- DLTIM = PARAM(5,2)
- COMTIM(1) = PARAM(6,1)
- COMTIM(2) = PARAM(6,2)
- C
- GO TO (1,2,3,4,5),I
- 1 CALL ARRVL(NSET,QSET)
- RETURN
- 2 CALL RQEST(NSET,QSET)
- RETURN
- 3 CALL SCAN(NSET,QSET)
- RETURN
- 4 CALL ANSER(NSET,QSET)
- RETURN
- 5 CALL ENDSV(NSET,QSET)
- RETURN
- END
- C
- SUBROUTINE OTPUT(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. OTPUT.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. User optinal output routine for /
- C/ Information system from page 270 /
- C/ /
- C////////////////////////////////////////////////////////////////
- C
- INTEGER*1 DOT(90)
- DIMENSION NSET(1),QSET(1),DIST(22)
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C
- SIMTIM = TFIN - TBEG
- EFECT = FLOAT(NARC) / SIMTIM
- WRITE(NPRNT,290) NPROJ,NAME,MON,NDAY,NYR,SIMTIM
- 290 FORMAT(1H1,'Simulation Project no.',I4,2X,'on',2X,6A2,
- $ //,' Date',I3,'/',I3,'/',I5,5X,'Simulation time : ',F5.0,
- $ ' min ')
- WRITE(NPRNT,380) NTER,IBUFF,XL,CDIAL(1),CDIAL(2),CREAD(1),
- $ CREAD(2),SRTIM,SCTIM,TRTIM,DLTIM,COMTIM(1),COMTIM(2)
- 380 FORMAT(1H ,'Numbers of stations : ',I2/
- $ 1H ,'Max size of buffer : ',I2/
- $ 1H ,'Mean time between arrivals of customers : ',F4.1,
- $ /1H ,'Customers dialing time range : ',F4.1,2X,F4.1,
- $ /1H ,'Customers reading time range : ',F4.1,2X,F4.1,
- $ /1H ,'Scanner rotation time and scanning time : ',F7.4,2X,F7.4,
- $ /1H ,'Scanner transfer time and delay time : ',F7.4,2X,F7.4,
- $ /1H ,'Computing time range : ',F6.3,2X,F6.3)
- WRITE(NPRNT,385)
- 385 FORMAT(1H ,'------------------------------------------------',
- $ '---------------------------')
- WRITE(NPRNT,901) NARC
- 901 FORMAT(1H ,'Total customers served is : ',I6,' persons ')
- WRITE(NPRNT,902) EFECT
- 902 FORMAT(1H ,'Customers served / Simulation time : ',F7.4,
- $ ' persons/min ')
- WRITE(NPRNT,905) (NSTA(I),I=1,NTER)
- 905 FORMAT(1H ,'Number of customers waiting at station at end : ',/
- $ 1H ,10(I5,2X))
- C
- C --- Define user output
- C
- SUMT = SRTIM + SCTIM + TRTIM + DLTIM
- DELT = (COMTIM(2) - COMTIM(1) + SUMT) / 20.0
- SUMH = 0
- NCL = NCELS(1) + 2
- DO 910 I=1,NCL
- 910 SUMH = SUMH + JCELS(1,I)
- DO 920 I=1,NCL
- 920 DIST(I) = FLOAT(JCELS(1,I)) / SUMH * 100.0
- WRITE(NPRNT,925)
- 925 FORMAT(1H ,'Average time to obtain a display Distribution : ')
- WRITE(NPRNT,930)
- 930 FORMAT(1H ,'Upper Limit Observations Percentage ')
- DO 940 I=1,NCL
- DO 950 J=1,90
- DOT(J) = ' '
- 950 CONTINUE
- DOT(1) = ':'
- K = IFIX((DIST(I) + 0.5) * 0.9)
- IF (K.LE.0) GO TO 960
- DO 980 M=1,K
- 980 DOT(M) = '@'
- 960 IF (NPRNT.NE.2) GO TO 975
- WRITE(NPRNT,970) SUMT,JCELS(1,I),DIST(I),(DOT(L),L=1,90)
- GO TO 976
- 975 WRITE(NPRNT,977) SUMT,JCELS(1,I),DIST(I)
- 977 FORMAT(3X,F6.3,8X,I3,9X,F6.2)
- 976 CONTINUE
- 970 FORMAT(3X,F6.3,8X,I3,9X,F6.2,3X,90A1)
- SUMT = SUMT + DELT
- 940 CONTINUE
- WRITE(NPRNT,1000)
- 1000 FORMAT(1H1)
- RETURN
- END
- SUBROUTINE ARRVL(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. ARRVL.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. Subroutine ARRVL is called each time /
- C/ a new customer arrives to the system /
- C/ from page 272 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C --- Determine the station number that the arriving customer
- C will go to by sampling from a uniform distribution.
- C Collect statistics on number of customers at the station
- C to which the new arrival is going.
- C
- NARC = NARC + 1
- J = 1
- ICHEK = NSTA(1)
- DO 10 I=2,NTER
- IF(ICHEK.LE.NSTA(I)) GO TO 10
- ICHEK = NSTA(I)
- J = I
- 10 CONTINUE
- X = NSTA(J)
- CALL TMST(X,TNOW,J,NSET,QSET)
- C
- C --- Allow customer to make his request immediately since
- C station was idle.
- C
- IF (NSTA(J)) 2,2,3
- 2 ATRIB(1) = TNOW + UNFRM(CDIAL(1),CDIAL(2))
- JTRIB(1) = 2
- JTRIB(2) = J
- CALL FILEM(1,NSET,QSET)
- C
- C --- Increment number of customer at station J by one
- C
- 3 NSTA(J) = NSTA(J) + 1
- C
- C --- Schedule next customer arrival at current time olus a
- C sample from an exponential distribution.
- C Customers request is completed. Store request in file
- C of calls requested but not in buffer.
- C
- CALL DRAND(ISEED,RNUM)
- ATRIB(1) = TNOW - XL*ALOG(RNUM)
- JTRIB(1) = 1
- CALL FILEM(1,NSET,QSET)
- RETURN
- END
- SUBROUTINE RQEST(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. RQEST.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. Placement of request for information /
- C/ from page 273 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- J = JTRIB(2)
- JTRIB(1) = 20
- CALL FILEM(2,NSET,QSET)
- JRPLY(J) = 2
- RETURN
- END
- SUBROUTINE SCAN(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. SCAN.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. Subroutine SCAN controls the scanner /
- C/ and is called each time the scanner /
- C/ can intettogate a scan point. /
- C/ From page 274 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C --- Test to see if scan point has a request which is to be
- C transferred to the buffer.
- C
- K = JRPLY(NSCAN)
- GO TO (4,1,4,4),K
- C
- C --- Test to see if buffer is full. If buffer is full, stop
- C scanner and set buffer index to full ststus and return
- C
- 1 IF (NQ(3) - IBUFF) 3,2,2
- 2 JBUFF = 1
- RETURN
- C
- C --- If buffer is not full, find the request at the scan point
- C and transfer it to the buffer.
- C
- 3 CALL FINDN(NSCAN,5,2,2,KCOL,NSET,QSET)
- CALL RMOVE(KCOL,2,NSET,QSET)
- JTRIB(1) = 30
- CALL FILEM(3,NSET,QSET)
- C
- C --- File request in file 3, the file of calls in buffer.
- C Schedule arrival of answer to the request to occur at
- C current time plus the transfer time from the scanner to
- C the buffer and from the buffer to the station plus
- C the computer computation time.
- C
- JRPLY(NSCAN) = 3
- ADDTIM = TRTIM + DLTIM
- ATRIB(1) = TNOW + ADDTIM + UNFRM(COMTIM(1),COMTIM(2))
- JTRIB(1) = 4
- CALL FILEM(1,NSET,QSET)
- C
- C --- Set scanner delay time as the sum of the transfer time plus
- C scan time plus movement time.
- C
- SUMTIM = SRTIM + SCTIM + TRTIM
- ATRIB(1) = TNOW + SUMTIM
- GO TO 5
- C
- C --- Set scan time delay equal to scan time plus movement time
- C
- 4 SUMTIM = SRTIM + SCTIM
- ATRIB(1) = TNOW + SUMTIM
- C
- C --- Move scanner to next position and schedule another scan
- C
- 5 IF(NSCAN - NTER) 7,6,6
- 6 NSCAN = 0
- 7 JTRIB(1) = 3
- CALL FILEM(1,NSET,QSET)
- NSCAN = NSCAN + 1
- RETURN
- END
- C
- SUBROUTINE ANSER(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id. ANSER.FOR /
- C/ Date-written. 11th,Feb,1984 /
- C/ Remarks. Subroutine ANSER ia called whenever an /
- C/ answer to request is ready. /
- C/ From page 275 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C --- Find request for which an answer has been determined
- C and remove it from the file of calls requested and stored
- C in the buffer.
- C
- J = JTRIB(2)
- CALL FINDN(J,5,3,2,KCOL,NSET,QSET)
- CALL RMOVE(KCOL,3,NSET,QSET)
- TI = TNOW - ATRIB(1)
- CALL COLCT(TI,1,NSET,QSET)
- SUMT = SRTIM + SCTIM + TRTIM + DLTIM
- DELT = (COMTIM(2) - COMTIM(1) + SUMT) / 20.0
- CALL HISTO(TI,SUMT,DELT,1)
- JRPLY(J) = 4
- C
- C --- Schedule an end of service event for the customer to
- C occur at current time plus customer's reading time
- C
- ATRIB(1) = TNOW + UNFRM(CREAD(1),CREAD(2))
- JTRIB(1) = 5
- CALL FILEM(1,NSET,QSET)
- C
- C --- Determine if buffer was full
- C
- IF (JBUF.LE.0) RETURN
- C
- C --- If buffer was full, set it to nonfull status and call
- C subroutine SCAN to start the scanner moving again.
- C
- JBUFF = 0
- CALL SCAN(NSET,QSET)
- RETURN
- END
- C
- SUBROUTINE ENDSV(NSET,QSET)
- C////////////////////////////////////////////////////////////////
- C/ /
- C/ Program-id ENDSV.FOR /
- C/ Date-written. Feb. 11th 1984 /
- C/ Remarks. Subroutine ENDSV is called eack time /
- C/ a customer is finished with the answer /
- C/ to his request. /
- C/ From page 276 /
- 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)
- COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
- COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
- $ TRTIM,DLTIM,COMTIM(2)
- C
- C --- Collect statistics on number of customers at station J
- C
- J = JTRIB(2)
- X = NSTA(J)
- CALL TMST(X,TNOW,J,NSET,QSET)
- C
- C --- Decrement number of customers at station J by one
- C
- NSTA(J) = NSTA(J) - 1
- JRPLY(J) = 1
- C
- C --- Set line from station J to free status
- C
- IF (NSTA(J).LE.0) RETURN
- C
- C --- If a customer is waitting for station J, schedule a
- C plavement of request event at station J
- C
- ATRIB(1) = TNOW + UNFRM(CDIAL(1),CDIAL(2))
- JTRIB(1) = 2
- JTRIB(2) = J
- CALL FILEM(1,NSET,QSET)
- RETURN
- END
-