home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 349_01 / sss.arc / EX_0501.FOR < prev    next >
Text File  |  1991-04-09  |  3KB  |  150 lines
  1. C     Program EX_0501.FOR
  2. C     Listing 9F - see documentation in TUTOR.SSS
  3.  
  4. $include:'SSSF1.H'
  5.  
  6.       subroutine prime
  7. $include:'SSSF2.H'
  8.       logical opens, repars
  9.       integer ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  10.      +CLOSES, WATCH
  11.       real*8 inter, rept
  12.       common opens, repars, inter, rept,
  13.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  14.      +CLOSES, WATCH
  15.  
  16.       ARRIVL = 1
  17.       STARTA = 2
  18.       ENDACT = 3
  19.       NEXTAC = 4
  20.       STRTDY = 5
  21.       CLOSES = 0
  22.       WATCH  = 1
  23.  
  24.       call INIQUE(3, 1, 1)
  25.  
  26.       call INISTA(1,'Sojourn time         ',0,10,0.0,0.2)
  27.       call CREATE(0.0, WATCH )
  28.       call CREATE(0.5, CLOSES)
  29.       call SIMEND(10.0)
  30.  
  31.       opens  = .TRUE.
  32.       repars = .FALSE.
  33.       inter  = 7.0/25.0
  34.       rept   = 2.0/24.0
  35.       return
  36.       end
  37.  
  38.       subroutine clshop
  39. $include:'SSSF2.H'
  40.       logical opens, repars
  41.       integer ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  42.      +CLOSES, WATCH
  43.       real*8 inter, rept
  44.       common opens, repars, inter, rept,
  45.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  46.      +CLOSES, WATCH
  47.  
  48.       opens = .FALSE.
  49.   99  if (NQ(3).gt.0) then
  50.         call REMVFQ(3, 1)
  51.         call TALLY(1, T() - A(1))
  52.         call DISPOS
  53.         goto 99
  54.       endif
  55.       return
  56.       end
  57.  
  58.       subroutine newday
  59. $include:'SSSF2.H'
  60.       logical opens, repars
  61.       integer ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  62.      +CLOSES, WATCH
  63.       real*8 inter, rept
  64.       common opens, repars, inter, rept,
  65.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  66.      +CLOSES, WATCH
  67.  
  68.       call CREATE(0.5, CLOSES)
  69.       call DISPOS
  70.       opens  = .TRUE.
  71.       repars = .FALSE.
  72.   99  if (NQ(1).gt.0) then
  73.         call REMVFQ(1, 1)
  74.         call QUEUE(2, 0.0)
  75.         goto 99
  76.       endif
  77.       return
  78.       end
  79.  
  80.       Program EX_0501
  81. $include:'SSSF2.H'
  82.       logical opens, repars
  83.       integer ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  84.      +CLOSES, WATCH
  85.       real*8 inter, rept
  86.       common opens, repars, inter, rept,
  87.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  88.      +CLOSES, WATCH
  89.       integer ecode
  90.  
  91.       call prime
  92.    99 ecode = NEXTEV()
  93.       if (ecode.gt.0) then
  94.         goto (101, 102, 103, 104, 105) ecode
  95.  
  96. C ARRIVL
  97.   101   continue
  98.         if (IDE().eq.WATCH) then
  99.           call CREATE(EX(inter), WATCH)
  100.           call SETA(1, T())
  101.           call SCHED(0.0, NEXTAC, WATCH)
  102.         else
  103.           call SCHED(0.5, STRTDY, CLOSES)
  104.           call clshop
  105.         endif
  106.         goto 99
  107.  
  108. C NEXTAC
  109.   104   continue
  110.         if (opens) then
  111.           if (repars) then
  112.             call QUEUE(2, 0.0)
  113.           else
  114.             call SCHED(0.0, STARTA, IDE())
  115.           endif
  116.         else
  117.           call QUEUE(1, 0.0)
  118.         endif
  119.         goto 99
  120.  
  121. C STARTA
  122.   102   continue
  123.         call SCHED(EX(rept), ENDACT, 0)
  124.         repars = .TRUE.
  125.         goto 99
  126.  
  127. C ENDACT
  128.   103   continue
  129.         call QUEUE(3, 0.0)
  130.         if (NQ(2).gt.0) then
  131.           call REMVFQ(2, 1)
  132.           call SCHED(0.0, STARTA, 0)
  133.         else
  134.           repars = .FALSE.
  135.         endif
  136.         goto 99
  137.  
  138. C STRTDY
  139.   105   continue
  140.         call newday
  141.         goto 99
  142.  
  143.       else
  144.  
  145.         call SUMRY(' ')
  146.         stop 'End of simulation'
  147.  
  148.       endif
  149.       end
  150.