home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / montr3.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  2.3 KB  |  64 lines
  1.         SUBROUTINE      MONTR(NSET)
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     MONTR                                   /
  5. C/      Date-written.   Jan. 23rd 1984                          /
  6. C/      File-name.      MONTR3.FOR                              /
  7. C/      Remarks.        Subroutine MONTR.FOR page 134           /
  8. C/                      The monitoring of events as they occur. /
  9. C/            Revised version of MONTR.        /
  10. C/            This is the version for Example-3.    /
  11. C/                                                              /
  12. C////////////////////////////////////////////////////////////////
  13. C       
  14.         INTEGER*4       NSET(6,1)
  15. C
  16.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  17.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  18.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  19. C
  20.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  21.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  22.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  23.      3         NDAY,NYR,JCLR
  24. C
  25.     COMMON /C3/ XISYS,BUS
  26. C
  27. C
  28. C       --- IF JEVNT .GE. 101   Print NSET
  29. C
  30.         IF (JEVNT - 101) 9,7,9
  31.     7   WRITE(NPRNT,100) TNOW
  32.   100     FORMAT(1H1,10X,'** GASP Job Storage area dump at',F10.4,
  33.      1           2X,'Time units **'//)
  34. C
  35.     IF (TNOW - 0.05) 22,22,23
  36.    23    ATRIB(1) = ATRIB(1) + 1000.0
  37.     CALL    FILEM(1,NSET)   
  38.    22 DO  1000  I=1,ID
  39.         WRITE(NPRNT,101) I,(NSET(J,I),J=1,MXX)
  40.   101    FORMAT(12I10)
  41.  1000 CONTINUE
  42.         RETURN
  43.     9   IF (MFE(1)) 3,6,1
  44. C
  45. C       --- IF JMNIT = 1 Print TNOQ, Current event code, and all
  46. C           attributes of the next event.
  47. C
  48.     1   IF (JMNIT - 1) 5,4,3
  49.     3   WRITE(NPRNT,199)
  50.   199     FORMAT(///26X,' Error Exit, type 99 error.')
  51.         CALL    EXIT
  52.     4   MMFE = MFE(1)
  53.         WRITE(NPRNT,103) TNOW,ATRIB(2),(NSET(I,MMFE),I=1,MXX)
  54.   103     FORMAT(/10X,'Current event.... Time =',F8.2,5X,'Event =',
  55.      1           F7.2,/10X,'Next event.......',(6I8))
  56. C
  57.   105    FORMAT(/10X,'BUS =',F4.0,5X,'No. in System =',F4.0/)
  58.     WRITE(NPRNT,105) BUS,XISYS
  59.     5   RETURN
  60.     6   WRITE(NPRNT,104) TNOW
  61.   104     FORMAT(10X,' File 1 is empty at',F10.2)
  62.                         GO TO 5
  63.         END
  64.