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