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