PROGRAM EXA2 C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. Main of example 2 / C/ Date-written. 16th,Jan,1984 / C/ File-name. EXA2.FOR / C/ Remarks. a single-channel queueing situation. / C/ Simulation with GASP page 118. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGER C *LIST SOURCE PROGRAM C *IOCS PRINTER PC-8023C, CARD PC-8031 2W FLOPPY DRIVE INTEGER*1 FLNAME( 11 ) INTEGER*4 NSET( 6,25 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU DATA FLNAME(1),FLNAME(2),FLNAME(3),FLNAME(4),FLNAME(5), $ FLNAME(6),FLNAME(7),FLNAME(8),FLNAME(9),FLNAME(10),FLNAME(11) $ /'G','A','S','P',' ',' ',' ',' ','D','A','T'/ C C --- Set NCRDR equal to the Floppy drive number and C NPRNT to the printer number. C NCRDR = 6 C IDRIVE = 0 WRITE(1,90) 90 FORMAT(1H0,'Output GASP data file to Display(3) or Printer(2)' $ ,/1H ,'Output Device number 3 or 2 : ' ) READ( 1,95 ) NPRNT 95 FORMAT( I1 ) WRITE(1,100) 100 FORMAT(1H0,'Input GASP data file name ( max 8 characters ) : ') READ(1,200) ( FLNAME( I ),I=1,8 ) WRITE( 3,210 ) ( FLNAME(I),I=1,11 ) 210 FORMAT(1H ,'Input GASP data file name : ',11A1 ) 200 FORMAT( 8A1 ) CALL OPEN( NCRDR,FLNAME,IDRIVE ) C XISYS = 1. BUS = 1. XL = 10. XMU = 6. CALL GASP( NSET ) CALL EXIT END SUBROUTINE EVNTS( IX,NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. EVNTS / C/ Date-written. 16th,Jan,1984 / C/ File-name. EVNTS.FOR / C/ Remarks. Subroutine EVNTS page 121 / C/ Event code 1 siginifires an arrival / C/ event; event code 2 signifires an end / C/ of service event; / C/ and event code 3 signifires an end of / C/ simulation event. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGERS C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU C GO TO (1,2,3),IX 1 CALL ARRVL( NSET ) RETURN 2 CALL ENDSV( NSET ) RETURN 3 CALL ENDSM( NSET ) RETURN END SUBROUTINE ARRVL( NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ARRVL / C/ Date-written. 16th,Jan,1984 / C/ File-name. ARRVL.FOR / C/ Remarks. Subroutine ARRVL page 123 / C/ The arrival of items to the system is / C/ described in terms of the time between / C/ the arrivals, every arrival event must / C/ cause the next arrival event to occur. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGERS C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU C C --- Since ARRVL is an endogenous event schedule the next C arrival. At TNOW plus number drawn from an exponential C distribution. The arrival time is stored in ATRIB(1). C The event code for an ARRVL is 1. Set ATRIB(2) C equal to 1. C CALL DRAND( ISEED,RNUM ) ATRIB(1) = TNOW - XL * ALOG( RNUM ) ATRIB(2) = 1.0 CALL FILEM( 1,NSET ) C C --- Collect the statistics on the number in the system since C an arrival causes number in the system to change. C CALL TMST( XISYS,TNOW,1,NSET ) IF ( XISYS ) 7,8,9 7 CALL ERROR(31,NSET) RETURN C C --- Increment the number in the system. Since the number in C the system was zero the server was not busy. C The server status will change due to the new arrival C therefore statistics on the time the server was busy C must be collected. C 8 XISYS = XISYS + 1.0 CALL TMST( BUS,TNOW,2,NSET ) C C --- Change the status of the server to busy. Collect C statistics on the waitting time of current arrival which C is zero since the server was not busy at his time of C arrival. C BUS = 1.0 CALL COLCT( 0.0,2,NSET ) C C --- Since the new arrival goes directly into service cause an C end of service event. Set ATRIB(2) equal to indicate an end C of service event. Set ATRIB(3) equal to TNOW the arrival C time of the customer. C CALL DRAND( ISEED,RNUM ) ATRIB(1) = TNOW - XMU * ALOG( RNUM ) ATRIB(2) = 2.0 ATRIB(3) = TNOW CALL FILEM( 1,NSET ) RETURN C C --- Increment the number in the system. C 9 XISYS = XISYS + 1.0 C C --- Put new arrival in the queue waiting for the server to C become free. Set ATRIB(3) equal to the arrival time of C the customer. C ATRIB(3) = TNOW CALL FILEM( 2,NSET ) RETURN END SUBROUTINE ENDSV( NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ENDSV / C/ Date-written. 16th,Jan,1984 / C/ File-name. ENDSV.FOR / C/ Remarks. Subroutine ENDSV page 126 / C/ In ENDSV( End_of_Service ) it is first / C/ necessary to collect statiscal infor- / C/ mation about the item completing / C/ processing. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGERS C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU C C --- Compute time in system equal to current time minus arrival C time of customer finishing service. Cmpute statistics on C in system. C TISYS = TNOW - ATRIB(3) CALL COLCT( TISYS,1,NSET ) CALL HISTO( TISYS,2.0,1.0,1 ) C C --- Since a customer will depart from the system due to the C end of service collect ststistics on number in system C and decrement the number in the system by one. C CALL TMST( XISYS,TNOW,1,NSET ) XISYS = XISYS - 1.0 C C --- Test to see if customer are waiting for service. If none C collect statistics on the busy time of the server and set C his status to idle by making bus equal zero. C If customer are waiting for service remove first customer C from the queue of the server which is file two. C IF( NQ(2) ) 7,8,9 7 CALL ERROR( 41,NSET ) RETURN 8 CALL TMST( BUS,TNOW,2,NSET ) BUS = 0.0 RETURN 9 CALL RMOVE( MFE(2),2,NSET ) C C --- Compute waiting time of customer and collect statistics C on waiting time. Put customer in service by scheduling C and end of service event for the customer. C WT = TNOW - ATRIB(3) CALL COLCT( WT,2,NSET ) CALL DRAND( ISEED,RNUM ) ATRIB( 1 ) = TNOW - XMU * ALOG( RNUM ) ATRIB( 2 ) = 2.0 CALL FILEM( 1,NSET ) RETURN END SUBROUTINE ENDSM( NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ENDSM / C/ Date-written. 16th,Jan,1984 / C/ File-name. ENDSM.FOR / C/ Remaeks. User defined subroutine, the completion / C/ of the simulation at a time specified / C/ by the programmer. / C/ page 128. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGERS C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU 20 IF( NQ(1) ) 7,8,9 7 CALL ERROR( 3,NSET ) C C --- Update statistics on number in system and status of server C to end of simulation time. Set control variable to stop C simulation and to yield final report. C 8 CALL TMST( XISYS,TNOW,1,NSET ) CALL TMST( BUS,TNOW,2,NSET ) MSTOP = -1 NORPT = 0 RETURN C C --- Remove all events from event file so that all customers C arriving before end of simulation time are included in C simulation statistics. Only end of service event need be C processed. If items are in the queue of the server they C will be removed in the end of service event where another C end of service event will be created. C 9 CALL RMOVE( MFE(1),1,NSET ) TNOW = ATRIB(1) IF( ATRIB(2) - 2.0 ) 20,21,20 21 CALL ENDSV( NSET ) GO TO 20 END SUBROUTINE OTPUT( NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. OTPUT / C/ Date-written. 16th,Jan,1984 / C/ File-name. OTPUT.FOR / C/ Remarks. Subroutine OTPUT.FOR page 130 / C/ Written by a programmer to perform / C/ calculations and provide additional / C/ output at the end of a simulation run. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGERS C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 COMMON /C3/ XISYS,BUS,XL,XMU C C --- Compute theoretical and simulation values of performance C measures for the queuing system. C ETISS = SUMA(1,1) / SUMA(1,3) EIDTS = ( SSUMA(2,1) - SSUMA(2,2) ) / ( SUMA(1,3) - 1.0 ) EWTS = SUMA(2,1) / SUMA(2,3) EIDTC = XL - XMU EWTC = ( 1.0 / XL ) / (( 1.0 / XMU ) * ( 1.0/XMU - 1.0/XL )) ETISC = 1.0/( 1.0/XMU - 1.0/XL ) YA = ETISS / ( SSUMA(1,2) / SSUMA(1,1) ) YS = ETISS - EWTS WRITE( NPRNT,85 ) 85 FORMAT(/36X,'Simulated Value',4X,'Theoretical Value'/) WRITE( NPRNT,90 ) EIDTS,EIDTC 90 FORMAT(10X,'Expected idle time',11X,F8.3,12X,F8.3 ) WRITE( NPRNT,95 ) EWTS,EWTC 95 FORMAT(10X,'Expected waiting time',8X,F8.3,12X,F8.3 ) WRITE( NPRNT,96 ) ETISS,ETISC 96 FORMAT(10X,'Expected time in system',6X,F8.3,12X,F8.3 ) WRITE( NPRNT,97 ) YA,XL 97 FORMAT(10X,'Expected arrival time',8X,F8.3,12X,F8.3 ) WRITE( NPRNT,98 ) YS,XMU 98 FORMAT(10X,'Expected service time',8X,F8.3,12X,F8.3 ) RETURN END SUBROUTINE MONTR( NSET ) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. MONTR / C/ Date-written. 16th,Jan,1984 / C/ File-name. MONTR.FOR / C/ Remarks. Subroutine MONTR.FOR page 134 / C/ The monitoring of events as they / C/ occur. / C/ Revised version of MONTR. / C/ / C//////////////////////////////////////////////////////////////// C //FOR C *ONE WORD INTEGER C *LIST SOURCE PROGRAM INTEGER*4 NSET( 6,1 ) COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, $ NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,TNOW, $ TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) COMMON /C2/ATRIB(4),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 C COMMON /C3/ XISYS,BUS,XL,XMU C C C --- IF JEVNT .GE. 101 Print NSET C IF (JEVNT - 101) 9,7,9 7 WRITE( NPRNT,100 ) TNOW C IF ( TNOW - 0.05 ) 22,22,23 23 ATRIB(1) = ATRIB(1) + 1000.0 CALL FILEM( 1,NSET ) 22 DO 1000 I=1,ID 100 FORMAT(1H1,10X,'** GASP Job Storage area dump at',F10.4, $ 2X,'Time units **'// ) 1000 WRITE( NPRNT,101 ) I,( NSET(J,I),J=1,MXX ) 101 FORMAT( 12I10 ) RETURN 9 IF ( MFE(1) ) 3,6,1 C C --- IF JMNIT = 1 Print TNOQ, 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 MMFE = MFE(1) WRITE( NPRNT,103 ) TNOW,ATRIB(2),(NSET(I,MMFE),I=1,MXX ) 103 FORMAT(/10X,'Current event.... Time =',F8.2,5X,'Event =',F7.2, $ /10X,'Next event.......',(6I8) ) C 105 FORMAT(/10X,'BUS =',F4.0,5X,'No. in System =',F4.0/ ) WRITE( NPRNT,105 ) BUS,XISYS 5 RETURN 6 WRITE( NPRNT,104 ) TNOW 104 FORMAT(10X,' File 1 is empty at',F10.2 ) GO TO 5 END