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