C PROGRAM EXA4 C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. Main of Example 4 / C/ Date-written. Feb. 2nd 1984 / C/ File-name. EXA4.FOR / C/ Remarks. Example-4 Simulation of a Drive-in Bank / C/ Simulation with GASP page 146. / C/ / C//////////////////////////////////////////////////////////////// CHARACTER*12 FILE DIMENSION NSET(6,25) C C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C DATA XL,XMU,XBUZ,XISYS/0.4,1.0,1.0,1.0,1.0,6.0/ C C --- Set NCRDR equal to the Floppy drive number and C NPRNT to the printer number. C NCRDR = 10 C IDRIVE = 0 WRITE(1,90) 90 FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)' 1 /1H ,'Output Device number 1 or 4: ') READ(1,95) NPRNT 95 FORMAT(I1) WRITE(1,100) 100 FORMAT(1H0,'Input GASP data file name (max 12 characters):') READ(1,200) FILE 200 FORMAT(A0) WRITE(1,210) FILE 210 FORMAT(1H ,'Input GASP data file name : ',A0) IF (IOREAD(NCRDR,MODE,IDRIVE,FILE)) GO TO 300 C WRITE(1,1000) XL,XMU(1),XMU(2),XBUZ(1),XBUZ(2),XISYS 1000 FORMAT(1H ,6F10.2) C C --- Initailize number of customers balking (CBALK), total C customers arriving (TCUST), and time last departure C (TLD) at 0. C CBALK = 0.0 TCUST = 0.0 TLD = 0.0 CALL GASP(NSET) GO TO 500 300 WRITE(1,400) 'OPEN OR READ ERROR AT MAIN_PROGRAM ' 400 FORMAT(' ',A0) 500 CALL EXIT END C SUBROUTINE ARRVL(NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ARRVL / C/ Date-written. Jan. 24th 1984 / C/ File-name. ARRVL4.FOR / C/ Remarks. Subroutine ARRVL page 148 / 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/ This is for Example-4 version. / C/ / C//////////////////////////////////////////////////////////////// C DIMENSION NSET(6,25) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C C --- Cause next arrival to occur C CALL DRAND(ISEED,RNUM) ATRIB(1) = TNOW - XL * ALOG(RNUM) ATRIB(3) = ATRIB(1) ATRIB(2) = 1.0 CALL FILEM(1,NSET) C C --- Increment total customers arriving C TCUST = TCUST + 1.0 C C --- Test to see if system in full C IF (XISYS - 8.0) 2,1,1 C C --- System in full. increment number of balkers C 1 CBALK = CBALK + 1.0 RETURN 2 CALL TMST(XISYS,TNOW,3,NSET) C --- Increment number in system C XISYS = XISYS + 1.0 C C ---Set arrival time of this customer to TNOW C ATRIB(3) = TNOW C C --- Test to see if either server is free C IF (XBUZ(1)) 15,4,3 3 IF (XBUZ(2)) 15,5,7 4 J = 1 GO TO 6 5 J = 2 C C --- Assign arriving customer to free server. C 6 CALL DRAND(ISEED,RNUM) ATRIB(1) = TNOW - XMU(J) * ALOG(RNUM) ATRIB(2) = J + 1 CALL FILEM(1,NSET) CALL TMST(XBUZ(J),TNOW,J,NSET) C C --- Set assigned server to busy status C XBUZ(J) = 1.0 RETURN C C ---Both server are busy. Put customer in shorter queue. C 7 ATRIB(4) = TNOW IF (NQ(2) - NQ(3)) 8,8,9 8 CALL FILEM(2,NSET) GO TO 10 9 CALL FILEM(3,NSET) 10 RETURN 15 CALL ERROR(87,NSET) CALL EXIT END C SUBROUTINE EVNTS(IX,NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. EVNTS / C/ Date-written. Jan. 24th 1984 / C/ File-name. EVNTS4.FOR / C/ Remarks. Subroutine EVNTS page 146 / 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/ User subroutine for Example-4. / C/ / C//////////////////////////////////////////////////////////////// C DIMENSION NSET(6,25) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C C GO TO (1,2,2,3),IX 1 CALL ARRVL(NSET) RETURN 2 CALL ENDSV(NSET) RETURN 3 CALL ENDSM(NSET) RETURN END C SUBROUTINE ENDSM(NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ENDSM / C/ Date-written. Jan. 26th 1984 / C/ File-name. ENDSM4.FOR / C/ Remaeks. User defined subroutine, the completion / C/ of the simulation at a time specified / C/ by the programmer. / C/ page 152. / C/ This is for Example-4 version. / C/ / C//////////////////////////////////////////////////////////////// C DIMENSION NSET(6,25) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C C C --- Update time ststistics for last time segment C CALL TMST(XBUZ(1),TNOW,1,NSET) CALL TMST(XBUZ(2),TNOW,2,NSET) CALL TMST(XISYS,TNOW,3,NSET) MSTOP = -1 NORPT = 0 RETURN END C SUBROUTINE ENDSV(NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. ENDSV / C/ Date-written. Jan. 26th 1984 / C/ File-name. ENDSV4.FOR / C/ Remarks. Subroutine ENDSV page 151 / C/ In ENDSV(End_of_Service) it is first / C/ necessary to collect statiscal infor- / C/ mation about the item completing / C/ processing. / C/ This is for Examle-4 version. / C/ / C//////////////////////////////////////////////////////////////// C DIMENSION NSET(6,25) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C C C --- Service is completed. Decrement number in system. C Collect ststistics on customer time in system and C time between departure. C CALL TMST(XISYS,TNOW,3,NSET) XISYS = XISYS - 1.0 TISYS = TNOW - ATRIB(3) CALL COLCT(TISYS,1,NSET) TBD = TNOW - TLD TLD = TNOW CALL COLCT(TBD,2,NSET) C C --- J = number of queue of server with completed service. C M = server number, K = number of queue of the other server C J = JEVNT M = J - 1 IF (J - 2) 15,2,3 2 K = 3 GO TO 1 3 K = 2 1 IF (NQ(J)) 15,4,6 4 IF (NQ(K)) 15,5,9 5 CALL TMST(XBUZ(M),TNOW,M,NSET) XBUZ(M) = 0.0 RETURN C C --- Put first customer of queue J in service C 6 CALL RMOVE(MFE(J),J,NSET) C C --- Cause end of service event C 10 CALL DRAND(ISEED,RNUM) ATRIB(1) = TNOW - XMU(M) * ALOG(RNUM) ATRIB(2) = J CALL FILEM(1,NSET) C C --- Test difference in queue length to determine if C jockeying to take place C IF (NQ(K) - NQ(J) - 2) 7,8,8 7 RETURN 8 CALL RMOVE(MLE(K),K,NSET) ATRIB(4) = TNOW CALL FILEM(J,NSET) RETURN C C --- Since queue of server M is empty, last customer in queue C of other server is served by M C 9 CALL RMOVE(MLE(K),K,NSET) GO TO 10 15 CALL ERROR(86,NSET) CALL EXIT END C SUBROUTINE OTPUT(NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. OTPUT / C/ Date-written. Jan. 26th 1984 / C/ File-name. OTPUT4.FOR / C/ Remarks. Subroutine OTPUT.FOR page 152 / C/ Written by a programmer to perform / C/ calculations and provide additional / C/ output at the end of a simulation run. / C/ This is the version for Example-4. / C/ / C//////////////////////////////////////////////////////////////// C DIMENSION NSET(6,25) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD C C WRITE(NPRNT,10) XL,XMU(1),XMU(2) 10 FORMAT(/25X,'Mean time between arrivals = ',F5.2/25X, 1 'Mean service time for tellers = ',F5.2,2X,F5.2) YBALK = CBALK * 100.0 / TCUST WRITE(NPRNT,20) YBALK,CBALK,TCUST 20 FORMAT(25X,'Percent of customers balking = ',F6.2,' %'/, 1 25X,'Number of customers balking = ',F6.2/,25X, 2 'Total customers',14X,'= ',F6.2) RETURN END