C PROGRAM EXA11 for FORTRAN-86 C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. Example_11x,cInformation System / C/ Date-written. 11th,Feb,1984 / C/ Date-updadted. 17th,Feb,1984 for FORTRAN-86 / C/ Remarks. A main program of Information service / C/ system, from page 269. / C/ This program uses GASP IIex version. / C/ / C//////////////////////////////////////////////////////////////// C CHARACTER*12 FILE 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) C C --- Start of Main program of Information System. C NCRDR = 6 C MODE = 2 IDRIVE = 0 WRITE( 1,90 ) 90 FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)' $ ,/1H ,'Enter Output Device number 1 or 4 : '$ READ( 1,95 ) NPRNT 95 FORMAT( I1 ) WRITE( 1,100 ) 100 FORMAT(1H ,'Input GASPex data file name ( max 12 characters ):'$ READ( 1,200 ) FILE WRITE( 1,210 ) FILE 200 FORMAT( A0 ) 210 FORMAT( 1H ,'Input GASPex Data file name : ',A0 ) C IF ( IOREAD( NCRDR,MODE,IDRIVE,FILE ) ) GO TO 300 C 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 ) GO TO 500 300 WRITE( 1,400 ) 'Open or Read error on file at main_pgm' 400 FORMAT( ' ',A0 ) 500 CALL EXIT END 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//////////////////////////////////////////////////////////////// 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 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.4 ) 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 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 ( JBUFF ) 2,2,1 C C --- If buffer was full, set it to nonfull status and call C subroutine SCAN to start the scanner moving again. C 1 JBUFF = 0 CALL SCAN( NSET,QSET ) 2 RETURN END SUBROUTINE ENDSV( NSET,QSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id ENDSV.FOR / C/ Date-written. 11th,Feb,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) ) 3,3,2 C C --- If a customer is waitting for station J, schedule a C plavement of request event at station J C 2 ATRIB( 1 ) = TNOW + UNFRM( CDIAL(1),CDIAL(2) ) JTRIB( 1 ) = 2 JTRIB( 2 ) = J CALL FILEM( 1,NSET,QSET ) 3 RETURN END