home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / user4.f86 < prev   
Encoding:
Text File  |  1986-05-19  |  12.9 KB  |  358 lines
  1. C       PROGRAM EXA4
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     Main of Example 4                       /
  5. C/      Date-written.   Feb. 2nd 1984                           /
  6. C/      File-name.      EXA4.FOR                                /
  7. C/      Remarks.        Example-4 Simulation of a Drive-in Bank /
  8. C/                      Simulation with GASP page 146.          /
  9. C/                                                              /
  10. C////////////////////////////////////////////////////////////////
  11.         CHARACTER*12    FILE
  12.         DIMENSION       NSET(6,25)
  13. C       
  14. C
  15.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  16.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  17.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  18. C
  19.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  20.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  21.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  22.      3         NDAY,NYR,JCLR
  23. C
  24.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  25. C
  26.  
  27.       DATA    XL,XMU,XBUZ,XISYS/0.4,1.0,1.0,1.0,1.0,6.0/
  28. C
  29. C       --- Set NCRDR equal to the Floppy drive number and
  30. C           NPRNT to the printer number.
  31. C
  32.         NCRDR = 10
  33. C
  34.         IDRIVE = 0
  35.         WRITE(1,90)
  36.    90   FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)'
  37.      1         /1H ,'Output Device number 1 or 4: ')  
  38.         READ(1,95) NPRNT
  39.    95      FORMAT(I1)
  40.         WRITE(1,100)
  41.   100     FORMAT(1H0,'Input GASP data file name (max 12 characters):')
  42.         READ(1,200) FILE
  43.   200     FORMAT(A0)
  44.         WRITE(1,210) FILE
  45.   210     FORMAT(1H ,'Input GASP data file name : ',A0)
  46.         IF (IOREAD(NCRDR,MODE,IDRIVE,FILE)) GO TO 300
  47. C
  48.         WRITE(1,1000) XL,XMU(1),XMU(2),XBUZ(1),XBUZ(2),XISYS
  49.  1000     FORMAT(1H ,6F10.2)
  50. C
  51. C       --- Initailize number of customers balking (CBALK), total
  52. C           customers arriving (TCUST), and time last departure
  53. C           (TLD) at 0.
  54. C
  55.         CBALK = 0.0
  56.         TCUST = 0.0
  57.         TLD = 0.0
  58.         CALL    GASP(NSET)
  59.                         GO TO 500
  60.   300   WRITE(1,400) 'OPEN OR READ ERROR AT MAIN_PROGRAM '
  61.   400     FORMAT(' ',A0)
  62.   500   CALL    EXIT
  63.         END
  64. C
  65.         SUBROUTINE      ARRVL(NSET)
  66. C////////////////////////////////////////////////////////////////
  67. C/                                                              /
  68. C/      Program-id.     ARRVL                                   /
  69. C/      Date-written.   Jan. 24th 1984                          /
  70. C/      File-name.      ARRVL4.FOR                              /
  71. C/      Remarks.        Subroutine ARRVL page 148               /
  72. C/                      The arrival of items to the system is   /
  73. C/                      described in terms of the time between  /
  74. C/                      the arrivals, every arrival event must  /
  75. C/                      cause the next arrival event to occur.  /
  76. C/                      This is for Example-4 version.          /
  77. C/                                                              /
  78. C////////////////////////////////////////////////////////////////
  79. C
  80.         DIMENSION       NSET(6,25)
  81.        
  82. C
  83.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  84.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  85.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  86. C
  87.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  88.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  89.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  90.      3         NDAY,NYR,JCLR
  91. C
  92.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  93. C
  94. C       --- Cause next arrival to occur
  95. C
  96.         CALL    DRAND(ISEED,RNUM)
  97.         ATRIB(1) = TNOW - XL * ALOG(RNUM)
  98.         ATRIB(3) = ATRIB(1)
  99.         ATRIB(2) = 1.0
  100.         CALL    FILEM(1,NSET)
  101. C
  102. C       --- Increment total customers arriving
  103. C
  104.         TCUST = TCUST + 1.0
  105. C
  106. C       --- Test to see if system in full
  107. C
  108.         IF (XISYS - 8.0) 2,1,1
  109. C
  110. C       --- System in full. increment number of balkers
  111. C
  112.     1   CBALK = CBALK + 1.0
  113.         RETURN
  114.     2   CALL    TMST(XISYS,TNOW,3,NSET)
  115. C       --- Increment number in system
  116. C
  117.         XISYS = XISYS + 1.0
  118. C
  119. C       ---Set arrival time of this customer to TNOW
  120. C
  121.         ATRIB(3) = TNOW
  122. C
  123. C       --- Test to see if either server is free
  124. C
  125.         IF (XBUZ(1)) 15,4,3
  126.     3   IF (XBUZ(2)) 15,5,7
  127.     4   J = 1
  128.                         GO TO 6
  129.     5   J = 2
  130. C
  131. C       --- Assign arriving customer to free server.
  132. C
  133.    6    CALL    DRAND(ISEED,RNUM)
  134.         ATRIB(1) = TNOW - XMU(J) * ALOG(RNUM)
  135.         ATRIB(2) = J + 1
  136.         CALL    FILEM(1,NSET)
  137.         CALL    TMST(XBUZ(J),TNOW,J,NSET)
  138. C
  139. C       --- Set assigned server to busy status
  140. C
  141.         XBUZ(J) = 1.0
  142.         RETURN
  143. C
  144. C       ---Both server are busy. Put customer in shorter queue.
  145. C
  146.     7   ATRIB(4) = TNOW
  147.         IF (NQ(2) - NQ(3)) 8,8,9
  148.     8   CALL    FILEM(2,NSET)
  149.                         GO TO 10
  150.     9   CALL    FILEM(3,NSET)
  151.    10   RETURN
  152.    15   CALL    ERROR(87,NSET)
  153.         CALL    EXIT
  154.         END
  155. C
  156.         SUBROUTINE      EVNTS(IX,NSET)
  157. C////////////////////////////////////////////////////////////////
  158. C/                                                              /
  159. C/      Program-id.     EVNTS                                   /
  160. C/      Date-written.   Jan. 24th 1984                          /
  161. C/      File-name.      EVNTS4.FOR                              /
  162. C/      Remarks.        Subroutine EVNTS page 146               /
  163. C/                      Event code 1 siginifires an arrival     /
  164. C/                      event; event code 2 signifires an end   /
  165. C/                      of service event;                       /
  166. C/                      and event code 3 signifires an end of   /
  167. C/                      simulation event.                       /
  168. C/                      User subroutine for Example-4.          /
  169. C/                                                              /
  170. C////////////////////////////////////////////////////////////////
  171. C
  172.         DIMENSION       NSET(6,25)
  173.        
  174. C
  175.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  176.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  177.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  178. C
  179.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  180.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  181.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  182.      3         NDAY,NYR,JCLR
  183. C
  184.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  185. C
  186. C
  187.         GO TO (1,2,2,3),IX
  188.     1   CALL    ARRVL(NSET)
  189.         RETURN
  190.     2   CALL    ENDSV(NSET)
  191.         RETURN
  192.     3   CALL    ENDSM(NSET)
  193.         RETURN
  194.         END
  195. C
  196.         SUBROUTINE      ENDSM(NSET)
  197. C////////////////////////////////////////////////////////////////
  198. C/                                                              /
  199. C/      Program-id.     ENDSM                                   /
  200. C/      Date-written.   Jan. 26th 1984                          /
  201. C/      File-name.      ENDSM4.FOR                              /
  202. C/      Remaeks.        User defined subroutine, the completion /
  203. C/                      of the simulation at a time specified   /
  204. C/                      by the programmer.                      /
  205. C/                      page 152.                               /
  206. C/                      This is for Example-4 version.          /
  207. C/                                                              /
  208. C////////////////////////////////////////////////////////////////
  209. C
  210.         DIMENSION       NSET(6,25)
  211. C
  212.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  213.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  214.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  215. C
  216.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  217.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  218.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  219.      3         NDAY,NYR,JCLR
  220. C
  221.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  222. C
  223. C
  224. C       --- Update time ststistics for last time segment
  225. C
  226.         CALL    TMST(XBUZ(1),TNOW,1,NSET)
  227.         CALL    TMST(XBUZ(2),TNOW,2,NSET)
  228.         CALL    TMST(XISYS,TNOW,3,NSET)
  229.         MSTOP = -1
  230.         NORPT = 0
  231.         RETURN
  232.         END
  233. C
  234.         SUBROUTINE      ENDSV(NSET)
  235. C////////////////////////////////////////////////////////////////
  236. C/                                                              /
  237. C/      Program-id.     ENDSV                                   /
  238. C/      Date-written.   Jan. 26th 1984                          /
  239. C/      File-name.      ENDSV4.FOR                              /
  240. C/      Remarks.        Subroutine ENDSV page 151               /
  241. C/                      In ENDSV(End_of_Service) it is first    /
  242. C/                      necessary to collect statiscal infor-   /
  243. C/                      mation about the item completing        /
  244. C/                      processing.                             /
  245. C/                      This is for Examle-4 version.           /
  246. C/                                                              /
  247. C////////////////////////////////////////////////////////////////
  248. C
  249.         DIMENSION       NSET(6,25)
  250. C
  251.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  252.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  253.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  254. C
  255.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  256.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  257.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  258.      3         NDAY,NYR,JCLR
  259. C
  260.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  261. C
  262. C
  263. C       --- Service is completed. Decrement number in system.
  264. C           Collect ststistics on customer time in system and 
  265. C           time between departure.
  266. C
  267.         CALL    TMST(XISYS,TNOW,3,NSET)
  268.         XISYS = XISYS - 1.0
  269.         TISYS = TNOW - ATRIB(3)
  270.         CALL    COLCT(TISYS,1,NSET)
  271.         TBD = TNOW - TLD
  272.         TLD = TNOW
  273.         CALL    COLCT(TBD,2,NSET)
  274. C
  275. C       --- J = number of queue of server with completed service.
  276. C           M = server number, K = number of queue of the other server
  277. C
  278.         J = JEVNT
  279.         M = J - 1
  280.         IF (J - 2) 15,2,3
  281.     2   K = 3
  282.                         GO TO 1
  283.     3   K = 2
  284.     1   IF (NQ(J)) 15,4,6
  285.     4   IF (NQ(K)) 15,5,9
  286.     5   CALL    TMST(XBUZ(M),TNOW,M,NSET)
  287.         XBUZ(M) = 0.0
  288.         RETURN
  289. C
  290. C       --- Put first customer of queue J in service
  291. C
  292.     6   CALL    RMOVE(MFE(J),J,NSET)
  293. C
  294. C       --- Cause end of service event
  295. C
  296.    10   CALL    DRAND(ISEED,RNUM)
  297.         ATRIB(1) = TNOW - XMU(M) * ALOG(RNUM)
  298.         ATRIB(2) = J
  299.         CALL    FILEM(1,NSET)
  300. C
  301. C       --- Test difference in queue length to determine if 
  302. C           jockeying to take place
  303. C
  304.         IF (NQ(K) - NQ(J) - 2) 7,8,8
  305.     7   RETURN
  306.     8   CALL    RMOVE(MLE(K),K,NSET)
  307.         ATRIB(4) = TNOW
  308.         CALL    FILEM(J,NSET)
  309.         RETURN
  310. C
  311. C       --- Since queue of server M is empty, last customer in queue
  312. C           of other server is served by M
  313. C
  314.     9   CALL    RMOVE(MLE(K),K,NSET)
  315.                         GO TO 10
  316.    15   CALL    ERROR(86,NSET)
  317.         CALL    EXIT
  318.         END
  319. C
  320.         SUBROUTINE      OTPUT(NSET)
  321. C////////////////////////////////////////////////////////////////
  322. C/                                                              /
  323. C/      Program-id.     OTPUT                                   /
  324. C/      Date-written.   Jan. 26th 1984                          /
  325. C/      File-name.      OTPUT4.FOR                              /
  326. C/      Remarks.        Subroutine OTPUT.FOR page 152           /
  327. C/                      Written by a programmer to perform      /
  328. C/                      calculations and provide additional     /
  329. C/                      output at the end of a simulation run.  /
  330. C/                      This is the version for Example-4.    /
  331. C/                                                              /
  332. C////////////////////////////////////////////////////////////////
  333. C
  334.         DIMENSION       NSET(6,25)
  335. C       
  336.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  337.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  338.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  339. C
  340.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  341.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  342.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  343.      3         NDAY,NYR,JCLR
  344. C
  345.       COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  346. C
  347. C
  348.         WRITE(NPRNT,10) XL,XMU(1),XMU(2)
  349.    10     FORMAT(/25X,'Mean time between arrivals  =  ',F5.2/25X,
  350.      1      'Mean service time for tellers = ',F5.2,2X,F5.2)
  351.         YBALK = CBALK * 100.0 / TCUST
  352.         WRITE(NPRNT,20) YBALK,CBALK,TCUST
  353.    20     FORMAT(25X,'Percent of customers balking = ',F6.2,' %'/,
  354.      1           25X,'Number of customers balking =  ',F6.2/,25X,
  355.      2          'Total customers',14X,'= ',F6.2)
  356.         RETURN
  357.         END
  358.