FTN4
      SUBROUTINE TMPER(IERTN,IERNB,ITSNB,LU 
     .     ,IP1,IP2), 92080-1X511 REV.2026  800528
C 
C 
C     NAME:   TMPER      ERROR DURING TMP 
C     SOURCE: &TMPER    92080-18511 
C     BINARY: %TMPER    92080-1X511    PART OF  %ZTMP  92080-16510
C 
C     PMGR:   FRANCOIS GAULLIER 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     THIS SUBROUTINE PRINTOUT THE FOLLOWING MESSAGE: 
C 
C     MEMORY UNLOCK/FORMAT MODE OFF/BLOCK MODE OFF/CLEAR DISPLAY/RC/LF
C 
C     ERROR : TMP  XX ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ         TS=1234,LU=12 
C 
C   WHERE   ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ IS THE FOLLOWING: 
C 
C           MISSING USER WRITTEN SUBROUTINE:  XXXXXX
C    OR     DATA SET #  XX IS FULL
C    OR     DISC FILE:  XXXXXX ON CR YYYYY, IS FULL 
C    OR     INTERNAL ERROR:    XYZ**NNNNN 
C 
C              WHERE 'X' IDENTIFY THE MODULE, 'YZ' IDENTIFY THE CALL
C              AND 'NNNNN' PROVIDES ADDITIONAL INFORMATION. 
C 
C          X         MODULE NAME
C 
C          1            ZTMP
C          2           IOM70
C          3           IOM75
C          4             TSE
C          5           STORA
C          6           STORB
C          7           OFLPO
C 
C 
      DIMENSION MES(55),IWAIT(10) 
C 
      DATA MES/15555B,15530B,15446B,2Hk0,2HB ,15512B,6412B, 
     .        15446B,2HdC,2HER,2HRO,51033B,2H&d,2H@ ,2H: ,
     .        2HTM,2HP ,38*2H  /
      DATA IWAIT/10*15500B/ 
C 
      CALL PNAME(MES(18)) 
      IF(MES(19) .EQ. 2HP2)  MES(17)=2HPD 
C 
      CALL BLANC(MES(18),25)
      CALL JASC(IERNB,MES(18),-2,2) 
C-----MISSING USER WRITTEN SUBROUTINE 
      IF( IERNB.NE.1 .AND. IERNB.NE.2 .AND. IERNB.NE.53 )  GOTO 100 
      IF(IP2 .NE. -10)  GOTO 80 
      CALL MOVEW(34HMissing user written subroutine:  ,MES(20),17)
      CALL MOVEW(IP1,MES(37),3) 
      GOTO 1000 
   80 CALL JASC(IERNB+10,MES(18),-2,2)
      CALL MOVEW(30HInternal Error:       **      ,MES(20),15)
      CALL MOVEW(IP1,MES(28),3) 
      CALL CNUMO(IP2,MES(32)) 
      GOTO 1000 
C-----OUT OF SPACE DURING STORAGE 
  100 IF( IERNB.NE.25 .AND. IERNB.NE.65 )  GOTO 120 
      CALL MOVEW(22HData Set #xxxx is full,MES(20),11)
      CALL JASC(IP1,MES(25),1,4)
      GOTO 1000 
  120 IF( IERNB.NE.26 .AND. IERNB.NE.66 )  GOTO 140 
      CALL MOVEW(34HDisc file:  xxxxxx on CRxxxxxx, is,MES(20),17)
      CALL MOVEW(6H full ,MES(37),3)
      CALL MOVEW(IP1,MES(26),3) 
      CALL JASC(IP2,MES(32),1,6)
      GOTO 1000 
  140 IF( IERNB.NE.27 .AND. IERNB.NE.67 )  GOTO 160 
      CALL MOVEW(28HStorage device LU xx is full,MES(20),14)
      MES(29)=IASC(IP1) 
      GOTO 1000 
C-----MAG-TAPE IS NOT POSITIONNED PROPERLY
  160 IF( IERNB.NE.28 .AND. IERNB.NE.68 )  GOTO 180 
      CALL MOVEW(28HMag Tape LU# xx is not prope,MES(20),14)
      CALL JASC(IP1,MES(27),-2,2) 
      CALL MOVEW(14Hrly positioned,MES(34),7) 
      GOTO 1000 
  180 CALL MOVEW(28HData Capture terminal LU# xx,MES(20),14)
      CALL JASC(IP1,MES(33),-1,2) 
C-----DATA-CAPTURE TERMINAL IS OUT OF PAPER (ERROR # 30)
      IF(IERNB .NE. 30)  GOTO 200 
      CALL MOVEW(16H is out of paper,MES(34),8) 
      GOTO 1000 
C-----DATA-CAPTURE TERMINAL IS DOWN 
  200 IF(IERNB .NE. 31)  GOTO 210 
      CALL MOVEW(10H is down !,MES(34),5) 
      GOTO 1000 
C-----T-LOG RETURNED FROM DATA SUB. DOES NOT MATCH LENGTH REQ'D BY TS.
  210 IF(IERNB .NE. 46) GO TO 215 
      CALL MOVEW(48HData routine returned xxxx words when xxxx reqd!, 
     *   MES(20),24)
      CALL JASC(IP2,MES,61,4) 
      CALL JASC(IP1,MES,77,4) 
      GO TO 1000
C-----TERMINAL ASSIGNED A TS# NOT IN THE WORKING SET
215   IF(IERNB.NE.51)GO TO 217
      CALL MOVEW(48HTS assigned to this LU# not in the working set! , 
     *MES(20),24) 
      GO TO 1000
C-----TIME REPORTING TERMINAL NOT CAPABLE 
217   IF(IERNB.NE.52)GO TO 220
      CALL MOVEW(48HTime report.terminal can't run the TS# assigned!, 
     *MES(20),24) 
      GO TO 1000
C-----INTERNAL ERROR
  220 CALL MOVEW(30HInternal Error:       **      ,MES(20),15)
      CALL JASC(IP1,MES(28),1,6)
      CALL JASC(IP2,MES(32),1,6)
C 
C     ADD TS# AND DATACAPTURE TERMINAL LU 
C 
 1000 CALL CNUMD(ITSNB,MES(45)) 
      CALL MOVEW(4H,TS=,MES(44),2)
      CALL MOVEW(4H,LU=,MES(48),2)
      MES(50)=IASC(LU)
      K=51
      CALL MOVEW(IWAIT,MES(K),3)
      K=K+3 
      MES(K)=6412B
      IF(IERNB .LT. 50)  K=K-1
      CALL TMSOP(2,0,MES,K) 
      IF(IERNB .GE. 50)  CALL TMSAB(33) 
      K=IERTN 
      GOTO K
 9999 RETURN
      END 
      SUBROUTINE LOGEV(ICLAS,LU,IFLG,ITL,ITSN 
     .,ITIM0), 92080-1X511 REV.2026  800331 
C 
C     ICLAS    - CLASS I/O WORD USED TO SEND THE BUFFER 
C     LU       - LU USED TO PRINT EVENTS BUFFER 
C     IFL      - FLAG  (0, 2, 3, 1000, 2000 OR 3000)
C                IF 2 OR 3, CALCULATE THE STEP NUMBER 
C     ITL      - LENGTH OF THE LAST I/O IN BYTES
C     ITSN(1)  - TRANSACTION NUMBER 
C     ITSN(2)  - TRANSACTION STEP 
C 
C 
C         FORMAT OF THE BUFFER SEND TO 'CARAC' PROGRAM
C        ---------------------------------------------- 
C 
C     IBUF[1:4]   - TIME  (10'S - SEC - MIN - HOUR) 
C     IBUF[5]     - FLAG  0, 2, 3, 1000, 1001, 1010, 2000, 2010 
C     IBUF[6]     - DATA CAPTURE TERMINAL LU
C     IBUF[7]     - TS #
C     IBUF[8]     - TRANSACTION STEP
C     IBUF[9]     - I/O LENGTH IN BYTES 
C     IBUF[10:11] - TIME ELAPSED FROM PREVIOUS RQ TO THIS ONE 
C                   IN SEC. (REAL NUMBER) 
C 
C 
C     VALUE OF THE FLAG 
C       0      - A TS HAS JUST BEEN SELECTED ON THAT TERMINAL 
C                ELAPSED TIME IS 0. 
C       2      - AN INPUT HAS JUST BEEN REQUESTED 
C                ELAPSED TIME IS THE CPU TIME (REPONSE TIME)
C       3      - INPUT REQUEST JUST COMPLETED 
C                ELAPSED TIME IS THE USER TIME (THINKING + TYPING)
C       1000   - STORAGE HAS JUST BEEN REQUESTED BY TMP 
C                ELAPSED TIME IS 0. 
C       1010   - STORAGE IS JUST STARTING 
C                ELAPSED TIME IS WAIT TIME TO ACCESS STORAGE A
C       1020   - (OPTIONAL)  IMAGE STORAGE JUST COMPLETED 
C                ELAPSED TIME IS IMAGE STORAGE TIME 
C       2000   - STORAGE MODULE B IS JUST STARTING
C                ELAPSED TIME IS WAIT TIME TO ACCESS STORAGE MODULE B 
C       2010   - DISC / MAG. TAPE / USER / STORAGE IS COMPLETED 
C                ELAPSED TIME IS THE STORAGE TIME 
C 
C 
C 
      DIMENSION IBUF(11),ICLAS(1),ITSN(1),ITIM0(1)
C 
      LOGICAL ISNUL 
C 
      EQUIVALENCE (X,IBUF(10))
C 
      LUO=ICLAS(2)
      IF(LUO.EQ.0 .AND. ICLAS.EQ.0)  RETURN 
C 
      ITSTEP=0
      IF(IFLG .EQ. 0)  GOTO 500 
      IF(IFLG .GE. 100) GOTO 500
C 
      ITSTEP=ITSN(2)
C 
  500 CALL EXEC(11,IBUF,IBUF(6))
      X=0.
      IF(ISNUL(ITIM0,6))  X=TMDIF(ITIM0,IBUF) 
      CALL MOVEW(IBUF,ITIM0,6)
C 
      IBUF(5)=IFLG
      IBUF(6)=LU
      IBUF(7)=ITSN
      IBUF(8)=ITSTEP
      IBUF(9)=ITL 
C 
D     IF(LUO .EQ. 0)  GOTO 800
C###################################################################
D     WRITE(LUO,765)(IBUF(I),I=4,1,-1),(IBUF(I),I=5,9),X
D765  FORMAT(I4":"I2,X,I2"' ",I2"''  (",I4")    LU="I2,3I5,F12.2) 
C###################################################################
800   IF(ICLAS.EQ.0)  RETURN
      CALL EXEC(100024B,0,IBUF,11,0,0,ICLAS)
      GOTO 900
899   RETURN
900   RETURN
      END 
      FUNCTION TMDIF(ITIM0,ITIM1), 92080-1X511 REV.2026  800331 
      DIMENSION ITIM0(1),ITIM1(1) 
C 
C     WHERE ITIM0 & ITIM1 HAS THE FOLLOWING FORMAT: 
C        6 WORDS LONG.
C 
C     ITIM(1) = TENS OF MILLISECONDS
C     ITIM(2) = SECONDS 
C     ITIM(3) = MINUTES 
C     ITIM(4) = HOURS 
C     ITIM(5) = DAY OF YEAR 
C     ITIM(6) = YEAR
C 
      D=(ITIM1(5)-ITIM0(5))+365.*(ITIM1(6)-ITIM0(6))
      XH=(ITIM1(4)-ITIM0(4))+24.*D
      X=ITIM0(3)*60.+FLOAT(ITIM0(2))+(FLOAT(ITIM0)/100.)
      Y=ITIM1(3)*60.+FLOAT(ITIM1(2))+(FLOAT(ITIM1)/100.)
      TMDIF=(XH*3600.)+Y-X
      RETURN
      END 
      END$
                                    