C
C     Title:            Error routines
C
C     Function Name:    ERRDSW  Check Directive status return
C                       ERRFCS  Check FCS error
C                       ERRISB  Check IO status block return
C
C     File  Name:       ERROR.FTN
C
C     Author:           E.D.Willink
C
C     Description:
C       Three functions to check standard QIO and directive status returns
C
C     Modification List:
C     1.A  Date: 26-JUN-81      ORIGINAL
C     1.B  Date: 28-OCT-82      Use LENGTH not LEN as length function
C BH  1.C  Date: 15-APR-83      Declare functions as LOGICAL, not LOGICAL*2
C EDW 1.D  Date: 14-SEP-83      Correct declaration of ERRISB
C
C     Restrictions:
C
C     Calling Sequence:
C
C       IF(ERRDSW(LUNMSG,IDSW,LUNERR,'Message')) GOTO 999
C       IF(ERRFCS(LUNMSG,IFCS,LUNERR,'Message')) GOTO 999
C       IF(ERRISB(LUNMSG,IOSB,LUNERR,'Message')) GOTO 999
C
C     External Routines called:
C
C       QIOSYM
C
C     Parameter List:
C     Inputs :
C       LUNMSG          INTEGER*2 LUN to be used for the error message
C                               - assigned by the user (normally to TI:)
C       LUNERR          INTEGER*2 LUN to be used to look up the message from
C                               LB:[1,2]QIOSYM.MSG - unassigned by the user
C       'Message'       LOGICAL*1 array containing an additional text message
C                               to accompany the system text
C       IDSW            INTEGER*2 directive status return from directive call
C       IFCS(2)         INTEGER*2 array containing the FCS error in low byte
C       IOSB(2)         INTEGER*2 array I/O status block
C
C     Outputs:
C       LOGICAL         Output declaration
C       .TRUE.          If an error occurred
C       .FALSE.         If no error condition existed
C                                               was output to MSGLUN
C     Output text:      (Produced only if an error exists)
C
C     |TT5    -- Message
C     |TT5    -- PRIVILEGE VIOLATION
C     |TT5    -- DSW low byte = "360 DSW high byte = "0
C
C     Common Blocks:
C       None
C
CEND
      FUNCTION ERRDSW(LUNMSG,IDSW,LUNERR,TEXT)
      LOGICAL*1 TEXT(64),TSKNAM(6)
      LOGICAL   ERRDSW
      INTEGER*2 TSKBUF(16)
      EQUIVALENCE (TSKNAM(1),TSKBUF(10))
      ERRDSW=.FALSE.
      IF((IDSW.AND."200).EQ.0)RETURN
      ERRDSW=.TRUE.
      CALL GETTSK(TSKBUF)
      CALL R50ASC(6,TSKBUF,TSKNAM)
      NUMBER="600-(IDSW.AND."377)
      WRITE(LUNMSG,1000)(TSKNAM(I),I=1,6),(TEXT(I),I=1,LENGTH(TEXT))
1000  FORMAT(' '6A1' -- ',64A1)
      CALL QIOSYM(LUNMSG,LUNERR,NUMBER)
      WRITE(LUNMSG,1100)
     + (TSKNAM(I),I=1,6),IDSW.AND."377,(IDSW/"400).AND."377
1100  FORMAT(' '6A1' -- DSW low byte : "'O3' DSW high byte : "'O3)
      RETURN
      END
C
      FUNCTION ERRFCS(LUNMSG,IFCS,LUNERR,TEXT)
      LOGICAL*1 TEXT(64),TSKNAM(6)
      LOGICAL   ERRFCS
      INTEGER*2 IFCS(2),TSKBUF(16)
      EQUIVALENCE (TSKNAM(1),TSKBUF(10))
      ERRFCS=.FALSE.
      IF((IFCS(1).AND."200).EQ.0)RETURN
      ERRFCS=.TRUE.
      CALL GETTSK(TSKBUF)
      CALL R50ASC(6,TSKBUF,TSKNAM)
      NUMBER="400-(IFCS(1).AND."377)
      IF((IFCS(1).AND."377).NE.0)NUMBER=NUMBER+"200
      WRITE(LUNMSG,1000)(TSKNAM(I),I=1,6),(TEXT(I),I=1,LENGTH(TEXT))
1000  FORMAT(' '6A1' -- ',64A1)
      CALL QIOSYM(LUNMSG,LUNERR,NUMBER)
      WRITE(LUNMSG,1100) (TSKNAM(I),I=1,6),
     + IFCS(1).AND."377,(IFCS(1)/"400).AND."377,IFCS(2)
1100  FORMAT(' '6A1' -- FCS low byte : "'O3' FCS high byte : "'O3,
     +' FCS high word : 'I6'.')
      RETURN
      END
C
      FUNCTION ERRISB(LUNMSG,IOSB,LUNERR,TEXT)
      LOGICAL*1 TEXT(64),TSKNAM(6)
      LOGICAL   ERRISB
      INTEGER*2 IOSB(2),TSKBUF(16)
      EQUIVALENCE (TSKNAM(1),TSKBUF(10))
      ERRISB=.FALSE.
      IF((IOSB(1).AND."200).EQ.0)RETURN
      ERRISB=.TRUE.
      CALL GETTSK(TSKBUF)
      CALL R50ASC(6,TSKBUF,TSKNAM)
      NUMBER="400-(IOSB(1).AND."377)
      WRITE(LUNMSG,1000)(TSKNAM(I),I=1,6),(TEXT(I),I=1,LENGTH(TEXT))
1000  FORMAT(' '6A1' -- ',64A1)
      CALL QIOSYM(LUNMSG,LUNERR,NUMBER)
      WRITE(LUNMSG,1100) (TSKNAM(I),I=1,6),
     + IOSB(1).AND."377,(IOSB(1)/"400).AND."377,IOSB(2)
1100  FORMAT(' '6A1' -- IOSB low byte : "'O3' IOSB high byte : "'O3,
     +' IOSB high word : 'I6'.')
      RETURN
      END