home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / user3.f86 < prev    next >
Encoding:
Text File  |  1986-05-19  |  17.1 KB  |  440 lines
  1. C    [USER3.F86 of JUGPDS Vol.8]
  2. C
  3.         PROGRAM EXA3
  4. C////////////////////////////////////////////////////////////////
  5. C/                                                              /
  6. C/      Program-id.     Main of Exmple 3                        /
  7. C/      Date-written.   Jan. 21st 1984                          /
  8. C/      File-name.      EXA3.FOR                                /
  9. C/      Remarks.        A single-channel queueing situation.    /
  10. C/                      Simulation with GASP page 140.          /
  11. C/                                                              /
  12. C////////////////////////////////////////////////////////////////
  13. C
  14.         CHARACTER*12       FILE
  15.         DIMENSION       NSET(6,25)
  16. C
  17.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  18.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  19.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  20. C
  21.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  22.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  23.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  24.      3         NDAY,NYR,JCLR
  25. C
  26.       COMMON /C3/ XISYS,BUS
  27. C
  28. C       --- Set NCRDR equal to the Floppy drive number and
  29. C           NPRNT to the printer number.
  30. C
  31.         NCRDR = 10
  32. C
  33.         MODE = 2
  34.         WRITE(1,90)
  35.    90   FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)',
  36.      1         /1H ,'Output Device number 1 or 4: ')
  37.         READ(1,95) NPRNT
  38.    95      FORMAT(I1)
  39.         WRITE(1,100)
  40.   100     FORMAT(1H0,'Input GASP data file name (max 12 characters):')
  41.         READ(1,200) FILE
  42.         WRITE(1,210) FILE
  43.   210     FORMAT(1H ,'Input GASP data file name: ',A0)
  44.   200     FORMAT(A0)
  45.         IF (IOREAD(NCRDR,MODE,IDRIVE,FILE)) GO TO 300
  46. C
  47.         CALL    GASP(NSET)
  48.                         GO TO 500
  49.   300   WRITE(1,400) 'OPEN OR READ ERROR AT MAIN_PROGRAM '
  50.   400     FORMAT(' ',A0)
  51.   500   CALL    EXIT
  52.         END
  53. C
  54.         SUBROUTINE      ARRVL(NSET)
  55. C////////////////////////////////////////////////////////////////
  56. C/                                                              /
  57. C/      Program-id.     ARRVL                                   /
  58. C/      Date-written.   23th,Jan,1984                           /
  59. C/      File-name.      ARRVL3.FOR                              /
  60. C/      Remarks.        Subroutine ARRVL page 123               /
  61. C/                      The arrival of items to the system is   /
  62. C/                      described in terms of the time between  /
  63. C/                      the arrivals, every arrival event must  /
  64. C/                      cause the next arrival event to occur.  /
  65. C/                      This is for Example-3 version.          /
  66. C/                                                              /
  67. C////////////////////////////////////////////////////////////////
  68. C
  69.         DIMENSION       NSET(6,1)
  70. C
  71.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  72.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  73.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  74. C
  75.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  76.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  77.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  78.      3         NDAY,NYR,JCLR
  79. C
  80.       COMMON /C3/ XISYS,BUS
  81.  
  82. C
  83. C       --- Since ARRVL is an endogenous event schedule the next 
  84. C           arrival. At TNOW plus number drawn from an exponential
  85. C           distribution. The arrival time is stored in ATRIB(1).
  86. C           The event code for an ARRVL is 1. Set ATRIB(2)
  87. C           equal to 1.
  88. C
  89.         CALL    DRAND(ISEED,RNUM)
  90.         ATRIB(1) = TNOW - PARAM(1,1) * ALOG(RNUM)
  91.         ATRIB(2) = 1.0
  92.         CALL FILEM(1,NSET)
  93. C
  94. C       --- Collect the statistics on the number in the system since
  95. C           an arrival causes number in the system to change.
  96. C
  97.         CALL    TMST(XISYS,TNOW,1,NSET)
  98.         IF (XISYS) 7,8,9
  99.     7   CALL    ERROR(31,NSET)
  100.         RETURN
  101. C
  102. C       --- Increment the number in the system. Since the number in
  103. C           the system was zero the server was not busy.
  104. C           The server status will change due to the new arrival
  105. C           therefore statistics on the time the server was busy
  106. C           must be collected.
  107. C
  108.     8   XISYS = XISYS + 1.0
  109.         CALL    TMST(BUS,TNOW,2,NSET)
  110. C
  111. C       --- Change the status of the server to busy. Collect 
  112. C           statistics on the waitting time of current arrival which
  113. C           is zero since the server was not busy at his time of 
  114. C           arrival.
  115. C
  116.         BUS = 1.0
  117.         CALL    COLCT(0.0,2,NSET)
  118. C
  119. C       --- Since the new arrival goes directly into service cause an 
  120. C           end of service event. Set ATRIB(2) equal to indicate an end
  121. C           of service event. Set ATRIB(3) equal to TNOW the arrival
  122. C           time of the customer.
  123. C
  124.         CALL    DRAND(ISEED,RNUM)
  125.         ATRIB(1) = TNOW - PARAM(2,1) * ALOG(RNUM)
  126.         ATRIB(2) = 2.0
  127.         ATRIB(3) = TNOW
  128.         CALL    FILEM(1,NSET)
  129.         RETURN
  130. C
  131. C       --- Increment the number in the system.
  132. C
  133.     9   XISYS = XISYS + 1.0
  134. C
  135. C       --- Put new arrival in the queue waiting for the server to 
  136. C           become free. Set ATRIB(3) equal to the arrival time of
  137. C           the customer.
  138. C
  139.         ATRIB(3) = TNOW
  140.         CALL    FILEM(2,NSET)
  141.         RETURN
  142.         END
  143. C
  144.         SUBROUTINE      ENDSM(NSET)
  145. C////////////////////////////////////////////////////////////////
  146. C/                                                              /
  147. C/      Program-id.     ENDSM                                   /
  148. C/      Date-written.   23th,Jan,1984                           /
  149. C/      File-name.      ENDSM3.FOR                              /
  150. C/      Remaeks.        User defined subroutine, the completion /
  151. C/                      of the simulation at a time specified   /
  152. C/                      by the programmer.                      /
  153. C/                      page 128.                               /
  154. C/                      This is for Example-3 version.          /
  155. C/                                                              /
  156. C////////////////////////////////////////////////////////////////
  157. C
  158.         DIMENSION       NSET(6,1)
  159. C
  160.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  161.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  162.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  163. C
  164.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  165.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  166.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  167.      3         NDAY,NYR,JCLR
  168. C
  169.       COMMON /C3/ XISYS,BUS
  170. C
  171.    20   IF (NQ(1)) 7,8,9
  172.     7   CALL    ERROR(3,NSET)
  173. C
  174. C       --- Update statistics on number in system and status of server 
  175. C           to end of simulation time. Set control variable to stop
  176. C           simulation and to yield final report.
  177. C
  178.     8   CALL    TMST(XISYS,TNOW,1,NSET)
  179.         CALL    TMST(BUS,TNOW,2,NSET)
  180.         MSTOP = -1
  181.         NORPT = 0
  182.         RETURN
  183. C
  184. C       --- Remove all events from event file so that all customers
  185. C           arriving before end of simulation time are included in
  186. C           simulation statistics. Only end of service event need be 
  187. C           processed. If items are in the queue of the server they
  188. C           will be removed in the end of service event where another
  189. C           end of service event will be created.
  190. C
  191.     9   CALL    RMOVE(MFE(1),1,NSET)
  192.         TNOW = ATRIB(1)
  193.         IF (ATRIB(2) - 2.0) 20,21,20
  194.    21   CALL    ENDSV(NSET)
  195.                         GO TO 20
  196.         END
  197. C
  198.         SUBROUTINE      ENDSV(NSET)
  199. C////////////////////////////////////////////////////////////////
  200. C/                                                              /
  201. C/      Program-id.     ENDSV                                   /
  202. C/      Date-written.   23th,Jan,1984                           /
  203. C/      File-name.      ENDSV3.FOR                              /
  204. C/      Remarks.        Subroutine ENDSV page 126               /
  205. C/                      In ENDSV(End_of_Service) it is first    /
  206. C/                      necessary to collect statiscal infor-   /
  207. C/                      mation about the item completing        /
  208. C/                      processing.                             /
  209. C/                      This is for Examle-3 version.           /
  210. C/                                                              /
  211. C////////////////////////////////////////////////////////////////
  212. C
  213.         DIMENSION       NSET(6,1)
  214. C
  215.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  216.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  217.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  218. C
  219.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  220.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  221.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  222.      3         NDAY,NYR,JCLR
  223. C
  224.       COMMON /C3/ XISYS,BUS
  225. C
  226. C       --- Compute time in system equal to current time minus arrival
  227. C           time of customer finishing service. Cmpute statistics on
  228. C           in system.
  229. C
  230.         TISYS = TNOW - ATRIB(3)
  231.         CALL    COLCT(TISYS,1,NSET)
  232.         CALL    HISTO(TISYS,2.0,1.0,1)
  233. C
  234. C       --- Since a customer will depart from the system due to the
  235. C           end of service collect ststistics on number in system
  236. C           and decrement the number in the system by one.
  237. C
  238.         CALL    TMST(XISYS,TNOW,1,NSET)
  239.         XISYS = XISYS - 1.0
  240. C
  241. C       --- Test to see if customer are waiting for service. If none
  242. C           collect statistics on the busy time of the server and set
  243. C           his status to idle by making bus equal zero.
  244. C           If customer are waiting for service remove first customer
  245. C           from the queue of the server which is file two.
  246. C
  247.         IF (NQ(2)) 7,8,9
  248.     7   CALL    ERROR(41,NSET)
  249.         RETURN
  250.     8   CALL    TMST(BUS,TNOW,2,NSET)
  251.         BUS = 0.0
  252.         RETURN
  253.     9   CALL    RMOVE(MFE(2),2,NSET)
  254. C
  255. C       --- Compute waiting time of customer and collect statistics
  256. C           on waiting time. Put customer in service by scheduling
  257. C           and end of service event for the customer.
  258. C
  259.         WT = TNOW - ATRIB(3)
  260.         CALL    COLCT(WT,2,NSET)
  261.         CALL    DRAND(ISEED,RNUM)
  262.         ATRIB(1) = TNOW - PARAM(2,1) * ALOG(RNUM)
  263.         ATRIB(2) = 2.0
  264.         CALL    FILEM(1,NSET)
  265.         RETURN
  266.         END
  267. C
  268.         SUBROUTINE      EVNTS(IX,NSET)
  269. C////////////////////////////////////////////////////////////////
  270. C/                                                              /
  271. C/      Program-id.     EVNTS                                   /
  272. C/      Date-written.   Jan. 21st 1984                          /
  273. C/      File-name.      EVNTS3.FOR                              /
  274. C/      Remarks.        Subroutine EVNTS page 121               /
  275. C/                      Event code 1 siginifires an arrival     /
  276. C/                      event; event code 2 signifires an end   /
  277. C/                      of service event;                       /
  278. C/                      and event code 3 signifires an end of   /
  279. C/                      simulation event.                       /
  280. C/                      User subroutine for Example-3.          /
  281. C/                                                              /
  282. C////////////////////////////////////////////////////////////////
  283. C
  284.         DIMENSION       NSET(6,1)
  285. C
  286.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  287.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  288.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  289. C
  290.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  291.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  292.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  293.      3         NDAY,NYR,JCLR
  294. C
  295.       COMMON /C3/ XISYS,BUS
  296. C
  297.         GO TO (1,2,3,4),IX
  298.     1       CALL    ARRVL(NSET)
  299.         RETURN
  300.     2       CALL    ENDSV(NSET)
  301.         RETURN
  302.     3       CALL    ENDSM(NSET)
  303.         RETURN
  304.     4       CALL    STTUP(NSET)
  305.         RETURN
  306.         END
  307. C
  308.         SUBROUTINE      OTPUT(NSET)
  309. C////////////////////////////////////////////////////////////////
  310. C/                                                              /
  311. C/      Program-id.     OTPUT                                   /
  312. C/      Date-written.   23th,Jan,1984                           /
  313. C/      File-name.      OTPUT3.FOR                              /
  314. C/      Remarks.        Subroutine OTPUT.FOR page 130           /
  315. C/                      Written by a programmer to perform      /
  316. C/                      calculations and provide additional     /
  317. C/                      output at the end of a simulation run.  /
  318. C/                      This is for Example-3 version.          /
  319. C/                                                              /
  320. C////////////////////////////////////////////////////////////////
  321. C
  322.         DIMENSION       NSET(6,1)
  323. C
  324.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  325.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  326.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  327. C
  328.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  329.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  330.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  331.      3         NDAY,NYR,JCLR
  332. C
  333.       COMMON /C3/ XISYS,BUS
  334. C
  335. C
  336. C       --- Compute theoretical and simulation values of performance
  337. C           measures for the queuing system.
  338. C
  339.         ETISS = SUMA(1,1) / SUMA(1,3)
  340.         EIDTS = (SSUMA(2,1) - SSUMA(2,2)) / (SUMA(1,3) - 1.0)
  341.         EWTS = SUMA(2,1) / SUMA(2,3)
  342.         EIDTC = PARAM(1,1) - PARAM(2,1)
  343.         EWTC = (1.0/PARAM(1,1)) / ((1.0/PARAM(2,1)) * (1.0/
  344.      $  PARAM(2,1) - 1.0/PARAM(1,1)))
  345.         ETISC = 1.0/(1.0/PARAM(2,1) - 1.0/PARAM(1,1))
  346.         YA = ETISS / (SSUMA(1,2) / SSUMA(1,1))
  347.         YS = ETISS - EWTS
  348.         WRITE(NPRNT,85)
  349.    85     FORMAT(1H1,35X,'Simulated Value',4X,'Theoretical Value'/)
  350.         WRITE(NPRNT,90) EIDTS,EIDTC
  351.    90     FORMAT(10X,'Expected idle time',11X,F8.3,12X,F8.3)
  352.         WRITE(NPRNT,95) EWTS,EWTC
  353.    95     FORMAT(10X,'Expected waiting time',8X,F8.3,12X,F8.3)
  354.         WRITE(NPRNT,96) ETISS,ETISC
  355.    96     FORMAT(10X,'Expected time in system',6X,F8.3,12X,F8.3)
  356.         WRITE(NPRNT,97) YA,PARAM(1,1)
  357.    97     FORMAT(10X,'Expected arrival time',8X,F8.3,12X,F8.3)
  358.         WRITE(NPRNT,98) YS,PARAM(2,1)
  359.    98     FORMAT(10X,'Expected service time',8X,F8.3,12X,F8.3)
  360.         WRITE(NPRNT,99)
  361.    99     FORMAT(1H0)
  362.         RETURN
  363.         END
  364. C
  365.         SUBROUTINE      STTUP(NSET)
  366. C////////////////////////////////////////////////////////////////
  367. C/                                                              /
  368. C/      Program-id.     STTUP                                   /
  369. C/      Date-written.   Jan. 21st 1984                          /
  370. C/      File-name.      STTUP.FOR                               /
  371. C/      Remarks.        Subroutine STTUP.FOR page 139           /
  372. C/                      Subroutine STTUP for Reinitializing     /
  373. C/                      values for multiple runs.               /
  374. C/                      User subroutine for Example-3           /
  375. C/                                                              /
  376. C////////////////////////////////////////////////////////////////
  377. C
  378.         DIMENSION       NSET(6,1)
  379. C
  380.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  381.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  382.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  383. C
  384.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  385.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  386.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  387.      3         NDAY,NYR,JCLR
  388. C
  389.       COMMON /C3/ XISYS,BUS
  390. C       
  391. C       --- Comment cards for starter subroutine
  392. C           Initialize statiscal storage areas for each fiule used
  393. C           in the simulation. This is required since the files are
  394. C           not initilized by subroutine SET
  395. C
  396.         DO 17 K=1,NOQ
  397.         ENQ(K) = 0.0
  398.         VNQ(K) = 0.0
  399.         MAXNQ(K) = NQ(K)
  400.    17   QTIME(K) = TNOW
  401. C
  402. C       --- Test to see if the event file is empty. If event file is 
  403. C           empty start up events are to be used. If event file is not
  404. C           empty read in the number in the system and the status
  405. C           of the server.
  406. C
  407.         IF (NQ(1)) 19,19,25
  408.    25   READ(NCRDR,91) XISYS,BUS
  409.    91     FORMAT(2F5.0)
  410.         WRITE(1,291) XISYS,BUS
  411.   291     FORMAT(1H ,2F5.0)
  412. 8       RETURN
  413. C
  414. C       --- If start events is to be used the number in the system is 
  415. C           equal to the number of starter events minus the end of 
  416. C           simulation event and the arrival event.
  417. C           If monitor events are used these must also be subtracted
  418. C
  419.    19   XISYS = NQ(3) - 2
  420. C
  421. C       --- If number in system is greater than zero the server
  422. C           status should be set to busy. Let nine equal the 
  423. C           number of initial entries.
  424. C
  425.         BUS = 1.0
  426.         IF (XISYS) 18,18,7
  427.    18   BUS = 0.0
  428.     7   NINE = NQ(3)
  429.         NC = 1
  430.    11   CALL    RMOVE(MFE(3),3,NSET)
  431.         J = 1
  432.         IF (ATRIB(2) - 0.1) 20,20,21
  433.    20   J = 2
  434.    21   CALL    FILEM(J,NSET)
  435.         CALL    FILEM(3,NSET)
  436.         IF (NC - NINE) 9,8,8
  437.     9   NC = NC + 1
  438.                         GO TO 11
  439.         END
  440.