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