home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / arrvl4.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  2.7 KB  |  90 lines
  1.         SUBROUTINE      ARRVL(NSET)
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     ARRVL                                   /
  5. C/      Date-written.   Jan. 24th 1984                /
  6. C/      File-name.      ARRVL4.FOR                              /
  7. C/      Remarks.        Subroutine ARRVL page 148               /
  8. C/                      The arrival of items to the system is   /
  9. C/                      described in terms of the time between  /
  10. C/                      the arrivals, every arrival event must  /
  11. C/                      cause the next arrival event to occur.  /
  12. C/                      This is the version for Example 4.    /
  13. C/                                                              /
  14. C////////////////////////////////////////////////////////////////
  15. C
  16. C    * Default size of INTEGER = 2 bytes in F80
  17. C       
  18.         INTEGER*4       NSET(6,1)
  19. C
  20.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  21.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  22.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  23. C
  24.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  25.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  26.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  27.      3         NDAY,NYR,JCLR
  28. C
  29. C       --- Cause next arrival to occur
  30. C
  31.         CALL    DRAND(ISEED,RNUM)
  32.         ATRIB(1) = TNOW - XL * ALOG(RNUM)
  33.         ATRIB(3) = ATRIB(1)
  34.         ATRIB(2) = 1.0
  35.         CALL    FILEM(1,NSET)
  36. C
  37. C       --- Increment total customers arriving
  38. C
  39.         TCUST = TCUST + 1.0
  40. C
  41. C       --- Test to see if system in full
  42. C
  43.         IF (XISYS - 8.0) 2,1,1
  44. C
  45. C       --- System in full. increment number of balkers
  46. C
  47.     1   CBALK = CBALK + 1.0
  48.         RETURN
  49.     2   CALL    TMST(XISYS,TNOW,3,NSET)
  50. C       --- Increment number in system
  51. C
  52.         XISYS = XISYS + 1.0
  53. C
  54. C       ---Set arrival time of this customer to TNOW
  55. C
  56.         ATRIB(3) = TNOW
  57. C
  58. C       --- Test to see if either server is free
  59. C
  60.         IF (XBUZ(1)) 15,4,3
  61.     3   IF (XBUZ(2)) 15,5,7
  62.     4   J = 1
  63.                             GO TO 6
  64.     5   J = 2
  65. C
  66. C       --- Assign arriving customer to free server.
  67. C
  68.     6   CALL    DRAND(ISEED,RNUM)
  69.         ATRIB(1) = TNOW - XMU(J) * ALOG(RNUM)
  70.         ATRIB(2) = J + 1
  71.         CALL    FILEM(1,NSET)
  72.         CALL    TMST(XBUZ(J),TNOW,J,NSET)
  73. C
  74. C       --- Set assigned server to busy status
  75. C
  76.         XBUZ(J) = 1.0
  77.         RETURN
  78. C
  79. C       ---Both server are busy. Put customer in shorter queue.
  80. C
  81.     7   ATRIB(4) = TNOW
  82.         IF (NQ(2) - NQ(3)) 8,8,9
  83.     8   CALL    FILEM(2,NSET)
  84.                         GO TO 10
  85.     9   CALL    FILEM(3,NSET)
  86.    10   RETURN
  87.    15   CALL    ERROR(87,NSET)
  88.         CALL    EXIT
  89.         END
  90.