C
      PROGRAM STARLO
C
C
C
C
C This program :
C 1. Extracts data from the Starlog data logger
C 2. Sets up the header block.
C 3. Inserts cycle and logging programs.
C
C NOTE:
C       We throw away the first log due to a nasty value - probably
C       because we slid the plug home causing noise.
C
C       Set the terminal to SLAVE and assign it a name of LO:
C       
C       The data file contains one header record in following format
C
C
C 0 - 2  first day  (3)
C 3 - 5  first month(3)
C 6 - 8  first year (3)
C 9 -11  first hour (3)
C 12-14  first min  (3)
C 15-17  last day   (3)
C 18-20  last month (3)
C 21-23  last year  (3)
C 24-26  last hour  (3)
C 27-29  last min   (3)
C 30-32  num bytes/log (3)
C 33-38  log int mins (6)
C
C
C
      LOGICAL TCMD, ACTION, PROG, PRINT, DATA
      INTEGER*4OPCODE(20), LTIME, CTIME, NUMLGS, IL, LI
      INTEGER*4PLINE(5), OP1, OP2, IFSTM
      BYTE PNME(20), BLINE(20), IBEL, DATFIL(30)
      INTEGER IBUF(42), ONEOP(5)
      COMMON ACTION, PROG, DATA
      COMMON/DATE/IDF, IMF, IYF, IFSTH, IFSTM, IDL, IML, IYL, LASTH, LAS
     *TM, IBPL, LI
      DATA OPCODE/'END ', 'SCL ', 'DIR ', 'ADD ', 'AVE ', 'GET ', 'EXT '
     *, 'DIVK', 'NEG ', 'MULK', 'TOT ', 'MUL ', 'LIM ', 'MOV ', 'ADDK', 
     *'JMP ', 'MULH', 'JMPA', 'MAX ', 'MIN '/
      DATA CTIME/2/, LTIME/600/, IBEL/7/
      DATA ONEOP/5, 6, 7, 9, 18/
      DATA PRINT/.FALSE./
      EQUIVALENCE(PLINE, BLINE)
C
      OPEN(UNIT = 2, NAME = 'LO:', TYPE = 'OLD', ERR = 333)
C
      WRITE(5, 2000) 
2000    FORMAT('0          PROGRAM STARTLOG',/)
C
C
C###########################################
C             PROGRAM LISTING              #
C###########################################
C
2010  CONTINUE
        WRITE(5, 2040) 
2040      FORMAT('$Do you want the logger programs listed (Y/N) ?')
        READ(5, 2050) IANS
2050      FORMAT(A1)
        CALL CNVTUC(1, IANS)
2020  IF (.NOT.(IANS.EQ.'Y'.OR.IANS.EQ.'N')) GOTO 2010
      IF (.NOT.(IANS.EQ.'Y')) GOTO 2060
        CALL LOGDMP(IBUF, OPCODE, PRINT)
C
C
C########################################
C          CHANGE LOGGER PROGRAM        #
C########################################
C
C
2060  CONTINUE
2080  CONTINUE
        WRITE(5, 2110) 
2110      FORMAT('$Do you want the logger programs changed (Y/N) ?')
        READ(5, 2120) IANS
2120      FORMAT(A1)
        CALL CNVTUC(1, IANS)
2090  IF (.NOT.(IANS.EQ.'N'.OR.IANS.EQ.'Y')) GOTO 2080
      IF (.NOT.(IANS.EQ.'Y')) GOTO 2130
        WRITE(5, 2150) 
2150      FORMAT('0Both CYCLE and LOG programs will be updated')
        WRITE(5, 2160) 
2160      FORMAT('$Enter name of file containing program code ->')
        READ(5, 2170) PNME
2170      FORMAT(20A1)
        PNME(20) = 0
        OPEN(UNIT = 1, NAME = PNME, TYPE = 'OLD', READONLY)
        LOGADD = 128
        ISTAT = 0
        ACTION = .FALSE.
        CALL READCM(PLINE, ISTAT)
2180    IF (.NOT.(ISTAT.EQ.0)) GOTO 2190
          DO 2200 I = 1, 20
            IF (.NOT.(BLINE(I).EQ.9)) GOTO 2220
C Remove tabs
              BLINE(I) = ' '
2220        CONTINUE
2200      CONTINUE
          IF (.NOT.(BLINE(1).EQ.'*')) GOTO 2240
Cloging action required
            ACTION = .TRUE.
            DO 2260 I = 2, 20
              BLINE(I - 1) = BLINE(I)
2260        CONTINUE
2240      CONTINUE
          CALL CNVTUC(4, BLINE)
          TCMD = .FALSE.
          DO 2280 ICMD = 1, 20
            IF (.NOT.(OPCODE(ICMD).EQ.PLINE(1))) GOTO 2300
              TCMD = .TRUE.
              GOTO 2290
2300        CONTINUE
2280      CONTINUE
2290      CONTINUE
          IF (.NOT.(.NOT.TCMD)) GOTO 2320
            WRITE(5, 2340) PLINE, IBEL
2340          FORMAT('0Invalid program statement [ ',5A4,' ]',/,'****** 
     *ABORT ******',A1)
            CALL EXIT(255)
2320      CONTINUE
          IBUF(1) = ICMD - 1
          IF (.NOT.(ICMD.EQ.1)) GOTO 2350
C If an END statement
            PROG = .TRUE.
            ACTION = .FALSE.
            CALL PUTLOG(IBUF, LOGADD, 1, J)
            LOGADD = LOGADD + 1
            GOTO 2360
2350      CONTINUE
            IJ = 5
            DO 2370 J = 1, 2
              DO 2390 I = IJ, 20
                IF (.NOT.(BLINE(I).NE.' ')) GOTO 2410
                  GOTO 2400
2410            CONTINUE
2390          CONTINUE
2400          CONTINUE
              IF (.NOT.(BLINE(I).EQ.'C'.OR.BLINE(I).EQ.'c')) GOTO 2430
                I = I + 1
2430          CONTINUE
              CALL ASCBIN(16, BLINE(I), 10, OP2, JSTAT)
              IF (.NOT.(JSTAT.EQ.16)) GOTO 2450
                DO 2470 I = 1, 5
                  IF (.NOT.(ICMD.EQ.ONEOP(I))) GOTO 2490
                    GOTO 2480
2490              CONTINUE
2470            CONTINUE
2480            CONTINUE
                IF (.NOT.(I.EQ.6)) GOTO 2510
                  WRITE(5, 2530) PLINE, IBEL
2530                FORMAT('0Invalid operator [ ',5A4,' ]',/,'****** ABO
     *RT ******',A1)
                  CALL EXIT(255)
2510            CONTINUE
2450          CONTINUE
              IF (.NOT.(J.EQ.1)) GOTO 2540
                OP1 = OP2
                IJ = 22 - JSTAT
2540          CONTINUE
2370        CONTINUE
            IBUF(2) = OP1
            IBUF(3) = OP2
            PROG = .TRUE.
            CALL PUTLOG(IBUF, LOGADD, 3, JSTAT)
            LOGADD = LOGADD + 3
2360      CONTINUE
          CALL READCM(PLINE, ISTAT)
        GOTO 2180
2190    CONTINUE
        PROG = .FALSE.
        CALL LOGDMP(IBUF, OPCODE, PRINT)
C
C
C
C############################################
C        EXTRACT DATA FROM LOGGER           #
C############################################
C
C
2130  CONTINUE
2560  CONTINUE
        WRITE(5, 2590) 
2590      FORMAT('$Do you want to suck data from the logger (Y/N) ?')
        READ(5, 2600) IANS
2600      FORMAT(A1)
        CALL CNVTUC(1, IANS)
2570  IF (.NOT.(IANS.EQ.'Y'.OR.IANS.EQ.'N')) GOTO 2560
      IF (.NOT.(IANS.EQ.'Y')) GOTO 2610
        PRINT = .TRUE.
        CALL LOGDMP(IBUF, OPCODE, PRINT)
        IF (.NOT.(DATA)) GOTO 2630
          WRITE(5, 2650) 
2650        FORMAT('$Enter filename to store data ->')
          READ(5, 2660) DATFIL
2660        FORMAT(30A1)
          DATFIL(30) = 0
          OPEN(UNIT = 4, NAME = DATFIL, TYPE = 'NEW')
          WRITE(4, 2670) IDF, IMF, IYF, IFSTH, IFSTM, IDL, IML, IYL, LAS
     *TH, LASTM, IBPL, LI
2670        FORMAT(' ',11I3,I6)
          CALL COUNTB(NCHNS)
          CALL GETLOG(IBUF, 5, 2, ISTAT)
          IL = IBUF(2)
          IL = IL*256
          ISTART = 1024
          ICT = 0
          WRITE(5, 2680) 
2680        FORMAT('0')
          NUMLGS = (IBUF(1) + IL - 1024)/NCHNS
2690      IF (.NOT.(NUMLGS.GT.0)) GOTO 2710
            CALL GETLOG(IBUF, ISTART, NCHNS, ISTAT)
            IF (.NOT.(ICT.GT.0)) GOTO 2720
              WRITE(4, 2740) (IBUF(I), I = 1, NCHNS)
2740            FORMAT(' ',24I4)
2720        CONTINUE
            ISTART = ISTART + NCHNS
            ICT = ICT + 1
            IF (.NOT.(MOD(ICT, 20).EQ.0)) GOTO 2750
              WRITE(5, 2770) ICT
2770            FORMAT('+',I4,' logs read - continuing')
2750        CONTINUE
2700        NUMLGS = NUMLGS - 1
          GOTO 2690
2710      CONTINUE
          WRITE(5, 2780) ICT
2780        FORMAT('+',I4,' Total logs read             ')
          CLOSE(UNIT = 4)
2630    CONTINUE
C
C
C
C##################################################
C         INITIALIZE AND ARM LOGGER               #
C##################################################
C
C
C
2610  CONTINUE
2790  CONTINUE
        WRITE(5, 2820) 
2820      FORMAT('$Shall we INITIALIZE and ARM the logger (Y/N) ?')
        READ(5, 2830) IANS
2830      FORMAT(A1)
        CALL CNVTUC(1, IANS)
2800  IF (.NOT.(IANS.EQ.'Y'.OR.IANS.EQ.'N')) GOTO 2790
      IF (.NOT.(IANS.EQ.'N')) GOTO 2840
        WRITE(5, 2860) 
2860      FORMAT('0Program STARLOG finished')
        STOP
2840  CONTINUE
      WRITE(5, 2870) 
2870    FORMAT('$Enter the logger serial number ->')
      READ(5, 2880) ISERL
2880    FORMAT(I4)
      WRITE(5, 2890) 
2890    FORMAT('$Enter the site number ->')
      READ(5, 2900) ISITE
2900    FORMAT(I4)
      IBUF(1) = MOD(ISERL, 256)
      IBUF(2) = ISERL/256
      PROG = .FALSE.
      CALL PUTLOG(IBUF, 246, 2, ISTAT)
      IBUF(1) = MOD(ISITE, 256)
      IBUF(2) = ISITE/256
      IBUF(3) = 0
      CALL PUTLOG(IBUF, 240, 3, ISTAT)
      WRITE(5, 2910) 
2910    FORMAT('0NOTE: the cycle time is strapped in the logger',/'     
     * and can only be changed by re-strapping',/'      normally the str
     *ap is for 2 secs.')
      WRITE(5, 2920) 
2920    FORMAT('$Enter CYCLE TIME in secs  ->')
      READ(5, *) CTIME
      LTIME =  - 1
2930  IF (.NOT.(LTIME.LE.0)) GOTO 2940
        WRITE(5, 2950) 
2950      FORMAT('$Enter the LOGGING INTERVAL in mins  ->')
        READ(5, *) LTIME
      GOTO 2930
2940  CONTINUE
      LTIME = LTIME*60
      ICDOWN = LTIME/CTIME
      LCYCL = CTIME*4
C
      DO 2960 I = 1, 7
        IBUF(I) = 0
2960  CONTINUE
CSet bytes 0-4 in logger
      CALL PUTLOG(IBUF, 0, 5, ISTAT)
      IBUF(1) = MOD(ICDOWN, 256)
      IBUF(2) = ICDOWN/256
      IBUF(3) = IBUF(1)
      IBUF(4) = IBUF(2)
      IBUF(5) = LCYCL
CSet bytes 11-15 in logger
      CALL PUTLOG(IBUF, 11, 5, ISTAT)
      DO 2980 I = 1, 42
        IBUF(I) = 0
2980  CONTINUE
CSet bytes 24-119 to zero
      CALL PUTLOG(IBUF, 24, 40, ISTAT)
      CALL PUTLOG(IBUF, 64, 40, ISTAT)
      CALL PUTLOG(IBUF, 104, 16, ISTAT)
C
C
      STOP
333   WRITE(5, 3000) IBEL
3000    FORMAT('0Device "LO:" does not exist',A1)
      STOP
      END
C
C
C##################################
C ********* END OF MAINLINE *******
C##################################
C
C
C
C
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE GETLOG(IBUF, ISTART, INUM, ISTAT)
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
C
C Where:
C       IBUF  = Binary buffer to collect data
C       ISTART= Integer logger start address
C       INUM  = Integer number of charaters to xfer.
C       ISTAT = -1 for inum too large (>42)
C                0 successfull
C
C
      INTEGER*4IBLK, ISLAB, NUM
      LOGICAL FUN, FIRST, ACTION, PROG, DATA
      INTEGER PARM(6), ISB(2), IBUF(1)
      BYTE HEXIN(86), GETCMD(7)
      COMMON ACTION, PROG, DATA
      DATA FUN/"4630/
      DATA FIRST/.TRUE./
C
      IF (.NOT.(INUM.GT.42)) GOTO 3010
        ISTAT =  - 1
        RETURN
3010  CONTINUE
      GETCMD(1) = 'G'
      PARM(5) = 7
      PARM(3) = 1
      CALL GETADR(PARM, HEXIN, , , GETCMD)
      IBLK = ISTART/256
      ISLAB = MOD(ISTART, 256)
      IF (.NOT.((ISLAB+INUM).GT.256)) GOTO 3030
        NUM = 256 - ISLAB
        IS = 2
        CALL BINASC(NUM, 2, 16, GETCMD(6), IS)
        PARM(2) = NUM*2 + 2
C
        IS = 2
        CALL BINASC(IBLK, 2, 16, GETCMD(2), IS)
        IS = 2
        CALL BINASC(ISLAB, 2, 16, GETCMD(4), IS)
        ISB(2) = 0
3050    IF (.NOT.(ISB(2).NE.PARM(2))) GOTO 3060
          CALL WTQIO(FUN, 2, 7, , ISB, PARM)
        GOTO 3050
3060    CONTINUE
        IPT = ISB(2) - 1
        CALL GETADR(PARM, HEXIN(IPT), , , GETCMD)
        IBLK = IBLK + 1
        ISLAB = 0
        NUM = INUM - NUM
        GOTO 3040
3030  CONTINUE
        NUM = INUM
3040  CONTINUE
      IS = 2
      CALL BINASC(NUM, 2, 16, GETCMD(6), IS)
      PARM(2) = NUM*2 + 2
C
      IS = 2
      CALL BINASC(IBLK, 2, 16, GETCMD(2), IS)
      IS = 2
      CALL BINASC(ISLAB, 2, 16, GETCMD(4), IS)
      ISB(2) = 0
3070  IF (.NOT.(ISB(2).NE.PARM(2))) GOTO 3080
        CALL WTQIO(FUN, 2, 7, , ISB, PARM)
      GOTO 3070
3080  CONTINUE
      J = 1
      DO 3090 I = 1, INUM
        CALL ASCBIN(2, HEXIN(J), 16, NUM)
        IF (.NOT.(I.EQ.1)) GOTO 3110
          IF (.NOT.(NUM.NE.0)) GOTO 3130
            IF (.NOT.((128.AND.NUM).EQ.0)) GOTO 3150
              ACTION = .TRUE.
              GOTO 3160
3150        CONTINUE
              ACTION = .FALSE.
3160        CONTINUE
            GOTO 3140
3130      CONTINUE
            ACTION = .FALSE.
3140      CONTINUE
3110    CONTINUE
        IBUF(I) = NUM
        J = J + 2
3090  CONTINUE
      ISTAT = 0
      RETURN
      END
C
C
C
C
C
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE PUTLOG(IBUF, ISTART, INUM, ISTAT)
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
C
C
      INTEGER*4NUM, IBLK, ISLAB
      INTEGER PARM(6), PARM1(6), IBUF(1)
      LOGICAL FIRST, FUN, ACTION, PROG, DATA
      BYTE PUTCMD(7), HEXBUF(84)
      COMMON ACTION, PROG, DATA
      DATA FIRST/.TRUE./
      DATA FUN/"410/
C
C
      IF (.NOT.(INUM.GT.42)) GOTO 3170
        ISTAT =  - 1
        RETURN
3170  CONTINUE
      PUTCMD(1) = 'P'
      PARM(2) = 7
      CALL GETADR(PARM, PUTCMD)
      CALL GETADR(PARM1, HEXBUF)
      IS = 2
      NUM = INUM
      CALL BINASC(NUM, 2, 16, PUTCMD(6), IS)
      PARM1(2) = INUM*2
      IBLK = ISTART/256
      ISLAB = MOD(ISTART, 256)
      IS = 2
      CALL BINASC(IBLK, 2, 16, PUTCMD(2), IS)
      IS = 2
      CALL BINASC(ISLAB, 2, 16, PUTCMD(4), IS)
      J = 1
      DO 3190 I = 1, INUM
        IS = 2
        NUM = IBUF(I)
        IF (.NOT.(I.EQ.1)) GOTO 3210
          IF (.NOT.(PROG)) GOTO 3230
            IF (.NOT.(ACTION)) GOTO 3250
Cclear no-action bit
              NUM = NUM.AND.127
              ACTION = .FALSE.
              GOTO 3260
3250        CONTINUE
Cset no-action bit
              NUM = NUM.OR.128
3260        CONTINUE
            PROG = .FALSE.
3230      CONTINUE
3210    CONTINUE
        CALL BINASC(NUM, 2, 16, HEXBUF(J), IS)
        J = J + 2
3190  CONTINUE
      CALL WTQIO(FUN, 2, 7, , , PARM)
      CALL WTQIO(FUN, 2, 7, , , PARM1)
      ISTAT = 0
      RETURN
      END
C
C
C
C
C
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE LOGDMP(IBUF, OPCODE, PRINT)
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
C This routine prints the logger header block and programs
C
C
      LOGICAL FIRST, CYPROG, ACTION, PROG, PRINT, DATA
      REAL XCUM(2)
      INTEGER*4OPCODE(1), JMNTH(12), IFSTM, LOGINT, LASTLG, ICUR, NUMLGS
      INTEGER*4LASTL, LI, I4, PCMD(5)
      BYTE DAT(9), FNME(30), IBEL
      INTEGER IBUF(1), MCR(2)
      COMMON ACTION, PROG, DATA
      COMMON/DATE/IDF, IMF, IYF, IFSTH, IFSTM, IDL, IML, IYL, LASTH, LAS
     *TM, IBYTES, LI
      DATA JMNTH/'Jan-', 'Feb-', 'Mar-', 'Apr-', 'May-', 'Jun-', 'Jul-',
     * 'Aug-', 'Sep-', 'Oct-', 'Nov-', 'Dec-'/
      DATA FIRST/.TRUE./, IBEL/7/
      DATA MCR/3RMCR, 3R.../, PCMD/'PRI ', '=STA', 'RLOG', '.DAT', '/DE 
     *'/
C
      IF (.NOT.(FIRST)) GOTO 3270
        IF (.NOT.(PRINT)) GOTO 3290
          OPEN(UNIT = 3, NAME = 'starlog.dat', TYPE = 'NEW')
          GOTO 3300
3290    CONTINUE
          WRITE(5, 3310) 
3310        FORMAT('$Where shall I list the program ? ')
          READ(5, 3320) FNME
3320        FORMAT(30A1)
          FNME(30) = 0
          OPEN(UNIT = 3, NAME = FNME, TYPE = 'NEW')
          FIRST = .FALSE.
3300    CONTINUE
3270  CONTINUE
CGet logger ID
      CALL GETLOG(IBUF, 240, 8, ISTAT)
      CALL DATE(DAT)
      WRITE(3, 3330) DAT
3330    FORMAT('1*** STARLOG HEADER AND PROGRAM DUMP ***   ',9A1,/)
      ISERL = IBUF(7) + 256*IBUF(8)
      ISITE = IBUF(1) + 256*IBUF(2)
      CALL COUNTB(IBYTES)
      WRITE(3, 3340) ISERL, ISITE
3340    FORMAT('0Logger Serial No. ',I4,/,' Logger  Site  No. ',I4)
      CALL GETLOG(IBUF, 0, 16, ISTAT)
      LI = IBUF(7)
      LI = LI*256
      I4 = IBUF(6)
      NUMLGS = (I4 + LI) - 1024
      NUMLGS = NUMLGS/IBYTES
      IF (.NOT.(NUMLGS.EQ.0)) GOTO 3350
        WRITE(3, 3370) 
3370      FORMAT('0 THIS LOGGER CONTAINS NO DATA')
        WRITE(5, 3380) IBEL
3380      FORMAT('0 THIS LOGGER CONTAINS NO DATA',A1)
        DATA = .FALSE.
        GOTO 3360
3350  CONTINUE
        DATA = .TRUE.
        IOFLOW = 2.AND.IBUF(5)
        IF (.NOT.(IOFLOW.NE.0)) GOTO 3390
          WRITE(3, 3410) 
3410        FORMAT('0WARNING - The logger data area has been OVERFLOWED'
     *)
3390    CONTINUE
        SCS = SECNDS(0.)
        IMIN = SCS/60.
        CALL IDATE(IM, ID, IY)
        CALL JDATE(IM, ID, IY, JDAT, N)
        I4 = JDAT
C Current minutes
        ICUR = I4*1440 - (1440 - IMIN)
        IS = 1
        DO 3420 J = 1, 2
          ACUM = 0.
          XMUL = 1.
          DO 3440 I = IS, IS + 3
            A = IBUF(I)
            ACUM = ACUM + A*XMUL
            XMUL = XMUL*256.
3440      CONTINUE
          XCUM(J) = ACUM
          IS = 8
3420    CONTINUE
        LASTL = XCUM(1) - XCUM(2)
        LASTL = LASTL*IBUF(16)/240
        LASTLG = ICUR - LASTL
        IYL = IY
        IF (.NOT.(LASTLG.LT.0.)) GOTO 3460
          IYL = IY - 1
          CALL JDATE(12, 31, IYL, JD, N)
          I4 = JD
          LASTLG = I4*1440 + ICUR - LASTL
3460    CONTINUE
        LOG = ((IBUF(14) + IBUF(15)*256)*IBUF(16)/4)/60
        LOGINT = LOG*NUMLGS
C First log time in minutes
        IFSTM = LASTLG - LOGINT
        IYF = IYL
        IF (.NOT.(IFSTM.LT.0)) GOTO 3480
          IYF = IY - 1
          CALL JDATE(12, 31, IYF, JD, N)
          I4 = JD
          IFSTM = I4*1440 + LASTLG - LOGINT
3480    CONTINUE
C First log time in days
        IFSTD = IFSTM/1440 + 1
        IFSTH = MOD(IFSTM, 1440)/60
        IFSTM = MOD(IFSTM, 1440) - IFSTH*60
        CALL CDATE(IFSTD, IMF, IDF, IYF)
C Last log in days
        LASTD = LASTLG/1440 + 1
        LASTH = MOD(LASTLG, 1440)/60
        LASTM = MOD(LASTLG, 1440) - LASTH*60
        CALL CDATE(LASTD, IML, IDL, IYL)
C
        WRITE(3, 3500) IDF, JMNTH(IMF), IYF, IFSTH, IFSTM
3500      FORMAT('0Logger Start Time       :',I2,'-',A4,I2,'   ',I2,':'I
     *2)
        WRITE(3, 3510) IDL, JMNTH(IML), IYL, LASTH, LASTM
3510      FORMAT(' Logger End   Time       :',I2,'-',A4,I2,'   ',I2,':'I
     *2)
3360  CONTINUE
      WRITE(3, 3520) IBUF(16)/4
3520    FORMAT('0Hardware Cycle Time     :',I4,' secs.')
      LI = (IBUF(14) + IBUF(15)*256)*IBUF(16)/4
      LI = LI/60
      WRITE(3, 3530) LI
3530    FORMAT('0Logging Interval        :',I4,' mins.')
      WRITE(3, 3540) NUMLGS
3540    FORMAT(' Number of Log Intervals :',I6)
      WRITE(3, 3550) IBYTES
3550    FORMAT(' Number of Bytes/Log-int :',I6,/)
C
      WRITE(3, 3560) 
3560    FORMAT('0******** Start of Program Listing ********',/)
      CYPROG = .TRUE.
      ISTART = 128
3570  IF (.NOT.(ISTART.LT.240)) GOTO 3580
        CALL GETLOG(IBUF, ISTART, 3, ISTAT)
        IF (.NOT.((IBUF(1).AND.127).EQ.0)) GOTO 3590
          IF (.NOT.(CYPROG)) GOTO 3610
            CYPROG = .FALSE.
            WRITE(3, 3630) 
3630          FORMAT('0********* End of Cycle Program   *********',/)
            ISTART = ISTART + 1
            GOTO 3570
3610      CONTINUE
            WRITE(3, 3640) 
3640          FORMAT('0*********  End of Log Program    *********',/)
            GOTO 3580
3620      CONTINUE
          GOTO 3600
3590    CONTINUE
          INDX = IBUF(1) + 1
          INDX = INDX.AND.127
          IF (.NOT.(ACTION)) GOTO 3650
            WRITE(3, 3670) OPCODE(INDX), IBUF(2), IBUF(3)
3670          FORMAT('                  *',A4,' ',2I4)
            ACTION = .FALSE.
            GOTO 3660
3650      CONTINUE
            WRITE(3, 3680) OPCODE(INDX), IBUF(2), IBUF(3)
3680          FORMAT('                   ',A4,' ',2I4)
3660      CONTINUE
          ISTART = ISTART + 3
3600    CONTINUE
      GOTO 3570
3580  CONTINUE
      IF (.NOT.(PRINT)) GOTO 3690
        CLOSE(UNIT = 3)
        CALL SPAWN(MCR, , , 1, , , , PCMD, 20)
        CALL WAITFR(1)
        PRINT = .FALSE.
        WRITE(5, 3710) 
3710      FORMAT('0HEADER BLOCK has been printed on LP:')
        WRITE(5, 3720) IBEL
3720      FORMAT('0 START of data extraction - please wait !',/,A1)
3690  CONTINUE
      RETURN
      END
C
C
C
C
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE READCM(PLINE, ISTAT)
C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
      INTEGER*4PLINE(5)
      ISTAT = 0
      READ(1, 100, END=10) PLINE
100   FORMAT(5A4)
      RETURN
10    ISTAT =  - 10
      RETURN
      END
C
C
C
C~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE COUNTB(ICHNS)
C~~~~~~~~~~~~~~~~~~~~~~~~~~~
C
C
C Count number of bytes logged
      INTEGER IBUF(42)
      LOGICAL ACTION, PROG, DATA
      COMMON ACTION, PROG, DATA
C
      ISTART = 128
      ILOOP = 0
      ICHNS = 0
3730  IF (.NOT.(ILOOP.LT.2)) GOTO 3740
        IBUF(1) = 1
3750    IF (.NOT.((IBUF(1).AND.127).NE.0)) GOTO 3760
          CALL GETLOG(IBUF, ISTART, 3, ISTAT)
          IF (.NOT.(ACTION)) GOTO 3770
            ICHNS = ICHNS + 1
3770      CONTINUE
          ISTART = ISTART + 3
        GOTO 3750
3760    CONTINUE
        ISTART = ISTART - 2
        ILOOP = ILOOP + 1
      GOTO 3730
3740  CONTINUE
      RETURN
      END