home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / endsv4.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  2.9 KB  |  87 lines
  1.         SUBROUTINE      ENDSV(NSET)
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     ENDSV                                   /
  5. C/      Date-written.   Jan. 26th 1984                          /
  6. C/      File-name.      ENDSV4.FOR                              /
  7. C/      Remarks.        Subroutine ENDSV page 151               /
  8. C/                      In ENDSV (END of SerVice) it is first   /
  9. C/                      necessary to collect statiscal infor-   /
  10. C/                      mation about the item completing        /
  11. C/                      processing.                             /
  12. C/                      This is the version for Examle 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.         COMMON /C3/ XL,XMU(2),XBUZ(2),XISYS,CBALK,TCUST,TLD
  30. C
  31. C       --- Service is completed. Decrement number in system.
  32. C           Collect ststistics on customer time in system and 
  33. C           time between departure.
  34. C
  35.         CALL    TMST(XISYS,TNOW,3,NSET)
  36.         XISYS = XISYS - 1.0
  37.         TISYS = TNOW - ATRIB(3)
  38.         CALL    COLCT(TISYS,1,NSET)
  39.         TBD = TNOW - TLD
  40.         TLD = TNOW
  41.         CALL    COLCT(TBD,2,NSET)
  42. C
  43. C       --- J = number of queue of server with completed service.
  44. C           M = server number, K = number of queue of the other server
  45. C
  46.         J = JEVNT
  47.         M = J - 1
  48.         IF (J - 2) 15,2,3
  49.     2   K = 3
  50.                          GO TO 1
  51.     3   K = 2
  52.     1   IF (NQ(J)) 15,4,6
  53.     4   IF (NQ(K)) 15,5,9
  54.     5   CALL    TMST(XBUZ(M),TNOW,M,NSET)
  55.         XBUZ(M) = 0.0
  56.         RETURN
  57. C
  58. C       --- Put first customer of queue J in service
  59. C
  60. 6       CALL    RMOVE(MFE(J),J,NSET)
  61. C
  62. C       --- Cause end of service event
  63. C
  64.    10   CALL    DRAND(ISEED,RNUM)
  65.         ATRIB(1) = TNOW - XMU(M) * ALOG(RNUM)
  66.         ATRIB(2) = J
  67.         CALL    FILEM(1,NSET)
  68. C
  69. C       --- Test difference in queue length to determine if 
  70. C           jockeying to take place
  71. C
  72.         IF (NQ(K) - NQ(J) - 2) 7,8,8
  73.     7   RETURN
  74.     8   CALL    RMOVE(MLE(K),K,NSET)
  75.         ATRIB(4) = TNOW
  76.         CALL    FILEM(J,NSET)
  77.         RETURN
  78. C
  79. C       --- Since queue of server M is empty, last customer in queue
  80. C           of other server is served by M
  81. C
  82.     9   CALL    RMOVE(MLE(K),K,NSET)
  83.                         GO TO 10
  84.    15   CALL    ERROR(86,NSET)
  85.         CALL    EXIT
  86.         END
  87.