home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Interactive Reference Guide / C-C++ Interactive Reference Guide.iso / c_ref / csource5 / 349_01 / sss.arc / EX_0407.FOR < prev    next >
Encoding:
Text File  |  1991-04-09  |  3.8 KB  |  171 lines
  1. C     Program EX_0407.FOR
  2. C     Listing 8F - see documentation in TUTOR.SSS
  3.  
  4. $include:'SSSF1.H'
  5.  
  6.       subroutine prime
  7. $include:'SSSF2.H'
  8.       logical opens, repars
  9.       integer[c]
  10.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  11.      +CLOSES, WATCH
  12.       real*8 inter, rept, n, d, r
  13.       common opens, repars, inter, rept, n, d, r,
  14.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  15.      +CLOSES, WATCH
  16.  
  17.       ARRIVL = 1
  18.       STARTA = 2
  19.       ENDACT = 3
  20.       NEXTAC = 4
  21.       STRTDY = 5
  22.       CLOSES = 0
  23.       WATCH  = 1
  24.  
  25.       call INIQUE(0, 0, 3)
  26.       call inista(1,'Night box           ', 1, 0, 0, 0)
  27.       call inista(2,'W f repair          ', 1, 0, 0, 0)
  28.       call inista(3,'W f delivery        ', 1, 0, 0, 0)
  29.       call CREATE(0.0, WATCH )
  30.       call CREATE(0.5, CLOSES)
  31.       call SIMEND(10.0)
  32.  
  33.       n = 0
  34.       r = 0
  35.       d = 0
  36.  
  37.       opens  = .TRUE.
  38.       repars = .FALSE.
  39.       inter  = 7.0/25.0
  40.       rept   = 2.0/24.0
  41.       end
  42.  
  43.       subroutine clshop
  44. $include:'SSSF2.H'
  45.       logical opens, repars
  46.       real*8 inter, rept, n, d, r
  47.       integer[c]
  48.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  49.      +CLOSES, WATCH
  50.       common opens, repars, inter, rept, n, d, r,
  51.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  52.      +CLOSES, WATCH
  53.  
  54.       opens = .FALSE.
  55.       d = 0.0
  56.       call TALLY(3, d)
  57.       end
  58.  
  59.       subroutine box
  60. $include:'SSSF2.H'
  61.       logical opens, repars
  62.       real*8 inter, rept, n, d, r
  63.       integer[c]
  64.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  65.      +CLOSES, WATCH
  66.       common opens, repars, inter, rept, n, d, r,
  67.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  68.      +CLOSES, WATCH
  69.  
  70.       call DISPOS
  71.       n = n + 1.0
  72.       call TALLY(1, n)
  73.       end
  74.  
  75.       subroutine newday
  76. $include:'SSSF2.H'
  77.       logical opens, repars
  78.       real*8 inter, rept, n, d, r
  79.       integer[c]
  80.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  81.      +CLOSES, WATCH
  82.       common opens, repars, inter, rept, n, d, r,
  83.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  84.      +CLOSES, WATCH
  85.  
  86.       call CREATE(0.5, CLOSES)
  87.       call DISPOS
  88.       opens  = .TRUE.
  89.       repars = .FALSE.
  90.       r = r + n
  91.       call TALLY(2, r)
  92.       n = 0.0
  93.       call TALLY(1, n)
  94.       end
  95.  
  96.       Program EX_0407
  97. $include:'SSSF2.H'
  98.       logical opens, repars
  99.       real*8 inter, rept, n, d, r
  100.       integer[c] ecode,
  101.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  102.      +CLOSES, WATCH
  103.       common opens, repars, inter, rept, n, d, r,
  104.      +ARRIVL, STARTA, ENDACT, NEXTAC, STRTDY,
  105.      +CLOSES, WATCH
  106.  
  107.       call prime
  108.    99 ecode = NEXTEV()
  109.       if (ecode.gt.0) then
  110.         goto (101, 102, 103, 104, 105) ecode
  111.  
  112. C ARRIVL
  113.   101   continue
  114.         if (IDE().eq.WATCH) then
  115.           call CREATE(EX(inter), WATCH)
  116.           call SCHED(0.0, NEXTAC, WATCH )
  117.         else
  118.           call SCHED(0.5, STRTDY, CLOSES)
  119.           call clshop
  120.         endif
  121.         goto 99
  122.  
  123. C NEXTAC
  124.   104   continue
  125.         if (opens) then
  126.           r = r + 1
  127.           call TALLY(2, r)
  128.           if (repars) then
  129.             call DISPOS
  130.           else
  131.             call SCHED(0.0, STARTA, IDE())
  132.           endif
  133.  
  134.         else
  135.           call box
  136.         endif
  137.         goto 99
  138.  
  139. C STARTA
  140.   102   continue
  141.         call SCHED(EX(rept), ENDACT, 0)
  142.         r = r - 1
  143.         call TALLY(2, r)
  144.         repars = .TRUE.
  145.         goto 99
  146.  
  147. C ENDACT
  148.   103   continue
  149.         d = d + 1
  150.         call TALLY(3, d)
  151.         if (r.gt.0) then
  152.           call SCHED(0.0, STARTA, 0)
  153.         else
  154.           call DISPOS
  155.           repars = .FALSE.
  156.         endif
  157.         goto 99
  158.  
  159. C STRTDY
  160.   105   continue
  161.         call newday
  162.         goto 99
  163.  
  164.       else
  165.  
  166.         call SUMRY('  ')
  167.         stop 'End of simulation'
  168.  
  169.       endif
  170.       end
  171.