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