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_0604.FOR < prev    next >
Text File  |  1991-04-10  |  3KB  |  134 lines
  1. C     Program EX_0604.FOR
  2. C     Listing 13F - see documentation in TUTOR.SSS
  3.  
  4. $include:'SSSF1.H'
  5.  
  6.       subroutine prime
  7. $include:'SSSF2.H'
  8.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  9.      +  id, server
  10.       real*8 ORDNRY, DELUX
  11.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  12.      +  id, server, ORDNRY, DELUX
  13.  
  14.       id     = 0
  15.       server = 2
  16.       ARRIVL = 1
  17.       STARTA = 2
  18.       ENDACT = 3
  19.       NEXTAC = 4
  20.       ORDNRY = 0.0
  21.       DELUX  = 1.0
  22.  
  23.       call INIQUE(2, 3, 1)
  24.       call inista(1,'Interrupts           ',0,0,0,0)
  25.       call SIMEND(60.0)
  26.       call CREATE(0.0, 0)
  27.       return
  28.       end
  29.  
  30.       subroutine preemp
  31. $include:'SSSF2.H'
  32.  
  33.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  34.      +  id, server
  35.       real*8 ORDNRY, DELUX
  36.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  37.      +  id, server, ORDNRY, DELUX
  38.       real*8 remt
  39.  
  40.       call QUEUE(2, 0.0)
  41.       i = 1
  42.   99  continue
  43.       if ((i.le.NC()).and.
  44.      +  ((AIC(i, 3).eq.DELUX).or.(NEIC(i).ne.ENDACT)))
  45.      +  then
  46.         i = i + 1
  47.         goto 99
  48.       endif
  49.  
  50.       if (i.le.NC()) then
  51.         remt = TIC(i) - T()
  52.         call REMVFC(i)
  53.         call SETA(1, A(1) + 1.0)
  54.         call SETA(2, remt)
  55.  
  56.         call SETQDC(1, 'LIFO    ')
  57.         call QUEUE(1, 0.0)
  58.         call SETQDC(1, 'FIFO    ')
  59.         call REMVFQ(2, 1)
  60.         call SCHED(0, STARTA, IDE())
  61.       endif
  62.       return
  63.       end
  64.  
  65.       Program EX_0604
  66. $include:'SSSF2.H'
  67.       integer ARRIVL, STARTA, ENDACT, NEXTAC,
  68.      +  id, server
  69.       real*8 ORDNRY, DELUX
  70.       common ARRIVL, STARTA, ENDACT, NEXTAC,
  71.      +  id, server, ORDNRY, DELUX
  72.       integer ecode
  73.  
  74.       call prime
  75.  
  76.    99 ecode = NEXTEV()
  77.       if (ecode.gt.0) then
  78.         goto (101, 102, 103, 104) ecode
  79.  
  80. C ARRIVL
  81.   101   continue
  82.         id = id + 1
  83.         call CREATE(EX(2.0), id)
  84.         call SETA(1, 0.0)
  85.         call SETA(2, TR(1.0, 2.0, 3.0))
  86.  
  87.         if (RA().lt.0.25) then
  88.           call SETA(3, DELUX )
  89.         else
  90.           call SETA(3, ORDNRY)
  91.         endif
  92.         call SCHED(0.0, NEXTAC, IDE())
  93.         goto 99
  94.  
  95. C NEXTAC
  96.   104   continue
  97.         if (server.gt.0) then
  98.           call SCHED(0.0, STARTA, IDE())
  99.         elseif (A(3).eq.DELUX) then
  100.           call preemp()
  101.         else
  102.           call QUEUE(1, 0.0)
  103.         endif
  104.         goto 99
  105.  
  106. C STARTA
  107.   102   continue
  108.         call SCHED(A(2), ENDACT, IDE())
  109.         server = server - 1
  110.         goto 99
  111.  
  112. C ENDACT
  113.   103   continue
  114.         if (A(3).ne.DELUX) call TALLY(1, A(1))
  115.         call DISPOS
  116.         server = server + 1
  117.  
  118.         if (NQ(2).gt.0) then
  119.           call REMVFQ(2, 1)
  120.           call SCHED(0.0, STARTA, IDE())
  121.         elseif (NQ(1).gt.0) then
  122.           call REMVFQ(1, 1)
  123.           call SCHED(0.0, STARTA, IDE())
  124.         endif
  125.         goto 99
  126.  
  127.       else
  128.  
  129.         call SUMRY(' ')
  130.         stop 'End of simulation'
  131.  
  132.       endif
  133.       end
  134.