home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol268 / user11x.f86 < prev    next >
Encoding:
Text File  |  1986-05-22  |  18.8 KB  |  475 lines
  1. C       PROGRAM EXA11 for FORTRAN-86
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     Example_11x,cInformation System         /
  5. C/      Date-written.   11th,Feb,1984                           /
  6. C/      Date-updadted.  17th,Feb,1984 for FORTRAN-86            /
  7. C/      Remarks.        A main program of Information service   /
  8. C/                      system, from page 269.                  /
  9. C/                      This program uses GASP IIex version.    /
  10. C/                                                              /
  11. C////////////////////////////////////////////////////////////////
  12. C
  13.         CHARACTER*12    FILE
  14.         DIMENSION       NSET( 120 ), QSET( 30 )
  15.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  16.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  17.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  18.         COMMON/C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  19.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  20.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  21.      $  JCLR,JTRIB(12)
  22.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  23.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  24.      $  TRTIM,DLTIM,COMTIM(2)
  25. C
  26. C       --- Start of Main program of Information System.
  27. C
  28.         NCRDR = 6
  29. C
  30.         MODE = 2
  31.         IDRIVE = 0
  32.         WRITE( 1,90 )
  33. 90      FORMAT(1H0,'Output GASP data file to Display(1) or Printer(4)'
  34.      $  ,/1H ,'Enter Output Device number 1 or 4 : '$ 
  35.         READ( 1,95 ) NPRNT
  36. 95      FORMAT( I1 )
  37.         WRITE( 1,100 )
  38. 100     FORMAT(1H ,'Input GASPex data file name ( max 12 characters ):'$
  39.         READ( 1,200 ) FILE
  40.         WRITE( 1,210 ) FILE
  41. 200     FORMAT( A0 )
  42. 210     FORMAT( 1H ,'Input GASPex Data file name : ',A0 )
  43. C
  44.         IF ( IOREAD( NCRDR,MODE,IDRIVE,FILE ) ) GO TO 300
  45. C
  46. C
  47. C       --- Initial conditions for he simulation are no customers in
  48. C           the system. the scanner is at position (1), the buffer sto-
  49. C           rage is not blocked, all stations have no customers in them
  50. C           and all lines are free.
  51. C
  52.         NARC = 0
  53.         NSCAN = 1
  54.         JBUFF = 0
  55.         DO 10 I=1,10
  56.         NSTA( I ) = 0
  57. 10      JRPLY( I ) = 1
  58. C
  59.         CALL    GASP( NSET,QSET )
  60.         GO TO 500
  61. 300     WRITE( 1,400 ) 'Open or Read error on file at main_pgm'
  62. 400     FORMAT( ' ',A0 )
  63. 500     CALL    EXIT
  64.         END
  65.         SUBROUTINE      EVNTS( I,NSET,QSET )
  66. C////////////////////////////////////////////////////////////////
  67. C/                                                              /
  68. C/      Program-id.     EVNTS.FOR                               /
  69. C/      Date-written.   11th,Feb,1984                           /
  70. C/      Remarks.        The user defined events routine for     /
  71. C/                      Information system, from page 270       /
  72. C/                                                              /
  73. C////////////////////////////////////////////////////////////////
  74.         DIMENSION       NSET(1),QSET(1)
  75.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  76.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  77.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  78.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  79.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  80.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  81.      $  JCLR,JTRIB(12)
  82.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  83.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  84.      $  TRTIM,DLTIM,COMTIM(2)
  85. C
  86. C
  87. C       --- SET INITIAL USER VARIABLES.
  88. C
  89.         NTER = PARAM( 1,1 )
  90.         IBUFF = PARAM( 1,2 )
  91.         XL = PARAM( 1,3 )
  92.         CDIAL(1) = PARAM( 2,1 )
  93.         CDIAL(2) = PARAM( 2,2 )
  94.         CREAD(1) = PARAM( 3,1 )
  95.         CREAD(2) = PARAM( 3,2 )
  96.         SRTIM = PARAM( 4,1 )
  97.         SCTIM = PARAM( 4,2 )
  98.         TRTIM = PARAM( 5,1 )
  99.         DLTIM = PARAM( 5,2 )
  100.         COMTIM(1) = PARAM( 6,1 )
  101.         COMTIM(2) = PARAM( 6,2 )
  102. C
  103.         GO TO (1,2,3,4,5),I
  104. 1       CALL    ARRVL( NSET,QSET )
  105.         RETURN
  106. 2       CALL    RQEST( NSET,QSET )
  107.         RETURN
  108. 3       CALL    SCAN( NSET,QSET )
  109.         RETURN
  110. 4       CALL    ANSER( NSET,QSET )
  111.         RETURN
  112. 5       CALL    ENDSV( NSET,QSET )
  113.         RETURN
  114.         END
  115.         SUBROUTINE      OTPUT( NSET,QSET )
  116. C////////////////////////////////////////////////////////////////
  117. C/                                                              /
  118. C/      Program-id.     OTPUT.FOR                               /
  119. C/      Date-written.   11th,Feb,1984                           /
  120. C/      Remarks.        User optinal output routine for         /
  121. C/                      Information system from page 270        /
  122. C/                                                              /
  123. C////////////////////////////////////////////////////////////////
  124. C
  125.         INTEGER*1       DOT( 90 )
  126.         DIMENSION       NSET(1),QSET(1),DIST(22)
  127.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  128.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  129.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  130.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  131.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  132.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  133.      $  JCLR,JTRIB(12)
  134.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  135.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  136.      $  TRTIM,DLTIM,COMTIM(2)
  137. C
  138. C
  139.         SIMTIM = TFIN - TBEG
  140.         EFECT  = FLOAT( NARC ) / SIMTIM
  141.         WRITE( NPRNT,290 ) NPROJ,NAME,MON,NDAY,NYR,SIMTIM
  142. 290     FORMAT( 1H1,'Simulation Project no.',I4,2X,'on',2X,6A2,
  143.      $  //,' Date',I3,'/',I3,'/',I5,5X,'Simulation time : ',F5.0,
  144.      $  ' min ' )
  145.         WRITE(NPRNT,380 ) NTER,IBUFF,XL,CDIAL(1),CDIAL(2),CREAD(1),
  146.      $  CREAD(2),SRTIM,SCTIM,TRTIM,DLTIM,COMTIM(1),COMTIM(2)
  147. 380     FORMAT(1H ,'Numbers of stations : ',I2/
  148.      $  1H ,'Max size of buffer         : ',I2/
  149.      $  1H ,'Mean time between arrivals of customers : ',F4.1,
  150.      $  /1H ,'Customers dialing time range : ',F4.1,2X,F4.1,
  151.      $  /1H ,'Customers reading time range : ',F4.1,2X,F4.1,
  152.      $  /1H ,'Scanner rotation time and scanning time : ',F7.4,2X,F7.4,
  153.      $  /1H ,'Scanner transfer time and delay time    : ',F7.4,2X,F7.4,
  154.      $  /1H ,'Computing time range : ',F6.3,2X,F6.3 )
  155.         WRITE( NPRNT,385 )
  156. 385     FORMAT(1H ,'------------------------------------------------',
  157.      $  '---------------------------' )
  158.         WRITE( NPRNT,901 ) NARC
  159. 901     FORMAT( 1H ,'Total customers served is : ',I6,' persons ' )
  160.         WRITE( NPRNT,902 ) EFECT
  161. 902     FORMAT( 1H ,'Customers served / Simulation time : ',F7.4,
  162.      $  ' persons/min ' )
  163.         WRITE( NPRNT,905 ) ( NSTA(I),I=1,NTER )
  164. 905     FORMAT(1H ,'Number of customers waiting at station at end : ',/
  165.      $  1H ,10(I5,2X) )
  166. C
  167. C       --- Define user output
  168. C
  169.         SUMT = SRTIM + SCTIM + TRTIM + DLTIM
  170.         DELT = ( COMTIM(2) - COMTIM(1) + SUMT ) / 20.0
  171.         SUMH = 0
  172.         NCL = NCELS( 1 ) + 2
  173.         DO 910 I=1,NCL
  174. 910     SUMH = SUMH + JCELS( 1,I )
  175.         DO 920 I=1,NCL
  176. 920     DIST( I ) = FLOAT( JCELS( 1,I ) ) / SUMH * 100.0
  177.         WRITE( NPRNT,925 )
  178. 925     FORMAT(1H ,'Average time to obtain a display Distribution : ' )
  179.         WRITE( NPRNT,930 )
  180. 930     FORMAT(1H ,'Upper Limit  Observations  Percentage ' )
  181.         DO 940 I=1,NCL
  182.         DO 950 J=1,90
  183.         DOT( J ) = ' '
  184. 950     CONTINUE
  185.         DOT( 1 ) = '|'
  186.         K = IFIX( ( DIST( I ) + 0.5 ) * 0.9 )
  187.         IF ( K.LE.0 ) GO TO 960
  188.         DO  980  M=1,K
  189. 980     DOT( M ) = '@'
  190. 960     IF ( NPRNT.NE.4 ) GO TO 975
  191.         WRITE( NPRNT,970 ) SUMT,JCELS(1,I),DIST(I),( DOT(L),L=1,90 )
  192.         GO TO 976
  193. 975     WRITE( NPRNT,977 ) SUMT,JCELS(1,I),DIST(I)
  194. 977     FORMAT(3X,F6.3,8X,I3,9X,F6.2 )
  195. 976     CONTINUE
  196. 970     FORMAT(3X,F6.3,8X,I3,9X,F6.2,3X,90A1 )
  197.         SUMT = SUMT + DELT
  198. 940     CONTINUE
  199.         WRITE( NPRNT,1000 )
  200. 1000    FORMAT( 1H1 )
  201.         RETURN
  202.         END
  203.         SUBROUTINE      ARRVL( NSET,QSET )
  204. C////////////////////////////////////////////////////////////////
  205. C/                                                              /
  206. C/      Program-id.     ARRVL.FOR                               /
  207. C/      Date-written.   11th,Feb,1984                           /
  208. C/      Remarks.        Subroutine ARRVL is called each time    /
  209. C/                      a new customer arrives to the system    /
  210. C/                      from page 272                           /
  211. C/                                                              /
  212. C////////////////////////////////////////////////////////////////
  213. C
  214.         DIMENSION       NSET(1),QSET(1)
  215.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  216.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  217.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  218.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  219.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  220.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  221.      $  JCLR,JTRIB(12)
  222.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  223.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  224.      $  TRTIM,DLTIM,COMTIM(2)
  225. C
  226. C       --- Determine the station number that the arriving customer
  227. C           will go to by sampling from a uniform distribution.
  228. C           Collect statistics on number of customers at the station
  229. C           to which the new arrival is going.
  230. C
  231.         NARC = NARC + 1
  232.         J = 1
  233.         ICHEK = NSTA( 1 )
  234.         DO 10 I=2,NTER
  235.         IF( ICHEK.LE.NSTA( I ) ) GO TO 10
  236.         ICHEK = NSTA( I )
  237.         J = I
  238. 10      CONTINUE
  239.         X = NSTA( J )
  240.         CALL    TMST( X,TNOW,J,NSET,QSET )
  241. C
  242. C       --- Allow customer to make his request immediately since 
  243. C           station was idle.
  244. C
  245.         IF ( NSTA(J) ) 2,2,3
  246. 2       ATRIB(1) = TNOW + UNFRM( CDIAL(1),CDIAL(2) )
  247.         JTRIB(1) = 2
  248.         JTRIB(2) = J
  249.         CALL    FILEM( 1,NSET,QSET )
  250. C
  251. C       --- Increment number of customer at station J by one
  252. C
  253. 3       NSTA( J ) = NSTA( J ) + 1
  254. C
  255. C       --- Schedule next customer arrival at current time olus a
  256. C           sample from an exponential distribution.
  257. C           Customers request is completed. Store request in file 
  258. C           of calls requested but not in buffer. 
  259. C
  260.         CALL    DRAND( ISEED,RNUM )
  261.         ATRIB(1) = TNOW - XL*ALOG( RNUM )
  262.         JTRIB(1) = 1
  263.         CALL    FILEM( 1,NSET,QSET )
  264.         RETURN
  265.         END
  266.         SUBROUTINE      RQEST( NSET,QSET )
  267. C////////////////////////////////////////////////////////////////
  268. C/                                                              /
  269. C/      Program-id.     RQEST.FOR                               /
  270. C/      Date-written.   11th,Feb,1984                           /
  271. C/      Remarks.        Placement of request for information    /
  272. C/                      from page 273                           /
  273. C/                                                              /
  274. C////////////////////////////////////////////////////////////////
  275. C
  276.         DIMENSION       NSET(1),QSET(1)
  277.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  278.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  279.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  280.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  281.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  282.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  283.      $  JCLR,JTRIB(12)
  284.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  285.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  286.      $  TRTIM,DLTIM,COMTIM(2)
  287. C
  288.         J = JTRIB( 2 )
  289.         JTRIB( 1 ) = 20
  290.         CALL    FILEM( 2,NSET,QSET )
  291.         JRPLY( J ) = 2
  292.         RETURN
  293.         END
  294.         SUBROUTINE      SCAN( NSET,QSET )
  295. C////////////////////////////////////////////////////////////////
  296. C/                                                              /
  297. C/      Program-id.     SCAN.FOR                                /
  298. C/      Date-written.   11th,Feb,1984                           /
  299. C/      Remarks.        Subroutine SCAN controls the scanner    /
  300. C/                      and is called each time the scanner     /
  301. C/                      can intettogate a scan point.           /
  302. C/                      From page 274                           /
  303. C/                                                              /
  304. C////////////////////////////////////////////////////////////////
  305. C
  306.         DIMENSION       NSET(1),QSET(1)
  307.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  308.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  309.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  310.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  311.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  312.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  313.      $  JCLR,JTRIB(12)
  314.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  315.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  316.      $  TRTIM,DLTIM,COMTIM(2)
  317. C
  318. C       --- Test to see if scan point has a request which is to be 
  319. C           transferred to the buffer.
  320. C
  321.         K = JRPLY( NSCAN )
  322.         GO TO (4,1,4,4),K
  323. C
  324. C       --- Test to see if buffer is full. If buffer is full, stop 
  325. C           scanner and set buffer index to full ststus and return
  326. C
  327. 1       IF ( NQ(3) - IBUFF ) 3,2,2
  328. 2       JBUFF = 1
  329.         RETURN
  330. C
  331. C       --- If buffer is not full, find the request at the scan point
  332. C           and transfer it to the buffer.
  333. C
  334. 3       CALL    FINDN( NSCAN,5,2,2,KCOL,NSET,QSET )
  335.         CALL    RMOVE( KCOL,2,NSET,QSET )
  336.         JTRIB(1) = 30
  337.         CALL    FILEM( 3,NSET,QSET )
  338. C
  339. C       --- File request in file 3, the file of calls in buffer.
  340. C           Schedule arrival of answer to the request to occur at
  341. C           current time plus the transfer time from the scanner to 
  342. C           the buffer and from the buffer to the station plus 
  343. C           the computer computation time.
  344. C
  345.         JRPLY( NSCAN ) = 3
  346.         ADDTIM = TRTIM + DLTIM
  347.         ATRIB( 1 ) = TNOW + ADDTIM + UNFRM( COMTIM(1),COMTIM(2) )
  348.         JTRIB( 1 ) = 4
  349.         CALL    FILEM( 1,NSET,QSET )
  350. C
  351. C       --- Set scanner delay time as the sum of the transfer time plus
  352. C           scan time plus movement time.
  353. C
  354.         SUMTIM = SRTIM + SCTIM + TRTIM
  355.         ATRIB( 1 ) = TNOW + SUMTIM
  356.         GO TO 5
  357. C
  358. C       --- Set scan time delay equal to scan time plus movement time
  359. C
  360. 4       SUMTIM = SRTIM + SCTIM
  361.         ATRIB( 1 ) = TNOW + SUMTIM
  362. C
  363. C       --- Move scanner to next position and schedule another scan
  364. C
  365. 5       IF( NSCAN - NTER ) 7,6,6
  366. 6       NSCAN = 0
  367. 7       JTRIB( 1 ) = 3
  368.         CALL    FILEM( 1,NSET,QSET )
  369.         NSCAN = NSCAN + 1
  370.         RETURN
  371.         END
  372.         SUBROUTINE      ANSER( NSET,QSET )
  373. C////////////////////////////////////////////////////////////////
  374. C/                                                              /
  375. C/      Program-id.     ANSER.FOR                               /
  376. C/      Date-written.   11th,Feb,1984                           /
  377. C/      Remarks.        Subroutine ANSER ia called whenever an  /
  378. C/                      answer to request is ready.             /
  379. C/                      From page 275                           /
  380. C/                                                              /
  381. C////////////////////////////////////////////////////////////////
  382. C
  383.         DIMENSION       NSET(1),QSET(1)
  384.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  385.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  386.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  387.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  388.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  389.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  390.      $  JCLR,JTRIB(12)
  391.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  392.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  393.      $  TRTIM,DLTIM,COMTIM(2)
  394. C
  395. C       --- Find request for which an answer has been determined
  396. C           and remove it from the file of calls requested and stored 
  397. C           in the buffer.
  398. C
  399.         J  = JTRIB( 2 )
  400.         CALL    FINDN( J,5,3,2,KCOL,NSET,QSET )
  401.         CALL    RMOVE( KCOL,3,NSET,QSET )
  402.         TI = TNOW - ATRIB( 1 )
  403.         CALL    COLCT( TI,1,NSET,QSET )
  404.         SUMT = SRTIM + SCTIM + TRTIM + DLTIM
  405.         DELT = ( COMTIM(2) - COMTIM(1) + SUMT ) / 20.0
  406.         CALL    HISTO( TI,SUMT,DELT,1 )
  407.         JRPLY( J ) = 4
  408. C
  409. C       --- Schedule an end of service event for the customer to
  410. C           occur at current time plus customer's reading time
  411. C
  412.         ATRIB(1) = TNOW + UNFRM( CREAD(1),CREAD(2) )
  413.         JTRIB(1) = 5
  414.         CALL    FILEM(1,NSET,QSET)
  415. C
  416. C       --- Determine if buffer was full 
  417. C
  418.         IF ( JBUFF ) 2,2,1
  419. C
  420. C       --- If buffer was full, set it to nonfull status and call 
  421. C           subroutine SCAN to start the scanner moving again.
  422. C
  423. 1       JBUFF = 0
  424.         CALL    SCAN( NSET,QSET )
  425. 2       RETURN
  426.         END
  427.         SUBROUTINE      ENDSV( NSET,QSET )
  428. C////////////////////////////////////////////////////////////////
  429. C/                                                              /
  430. C/      Program-id      ENDSV.FOR                               /
  431. C/      Date-written.   11th,Feb,1984                           /
  432. C/      Remarks.        Subroutine ENDSV is called eack time    /
  433. C/                      a customer is finished with the answer  /
  434. C/                      to his request.                         /
  435. C/                      From page 276                           /
  436. C/                                                              /
  437. C////////////////////////////////////////////////////////////////
  438. C
  439.         DIMENSION       NSET(1),QSET(1)
  440.         COMMON/C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  441.      $  NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,ISEED,TNOW,
  442.      $  TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4),IMM,MAXQS,MAXNS
  443.         COMMON /C2/ATRIB(10),ENQ(4),INN(4),JCELS(5,22),KRANK(4),
  444.      $  MAXNQ(4),MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  445.      $  QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,NDAY,NYR,
  446.      $  JCLR,JTRIB(12)
  447.         COMMON /U1/ NARC,NSCAN,JBUFF,NSTA(10),JRPLY(10)
  448.         COMMON /U2/ XL,NTER,IBUFF,CDIAL(2),CREAD(2),SRTIM,SCTIM,
  449.      $  TRTIM,DLTIM,COMTIM(2)
  450. C
  451. C       --- Collect statistics on number of customers at station J
  452. C
  453.         J = JTRIB( 2 )
  454.         X = NSTA( J )
  455.         CALL    TMST( X,TNOW,J,NSET,QSET )
  456. C
  457. C       --- Decrement number of customers at station J by one
  458. C
  459.         NSTA( J ) = NSTA(J ) - 1
  460.         JRPLY( J ) = 1
  461. C
  462. C       --- Set line from station J to free status
  463. C
  464.         IF ( NSTA(J) ) 3,3,2
  465. C
  466. C       --- If a customer is waitting for station J, schedule a 
  467. C           plavement of request event at station J
  468. C
  469. 2       ATRIB( 1 ) = TNOW + UNFRM( CDIAL(1),CDIAL(2) )
  470.         JTRIB( 1 ) = 2
  471.         JTRIB( 2 ) = J
  472.         CALL    FILEM( 1,NSET,QSET )
  473. 3       RETURN
  474.         END
  475.