C**********************************************************
      SUBROUTINE ERRPRC (SEVCOD,SUBNAM,ERRCOD,SUPLEN,SUPMSG,FILNAM)
C
C     ERRPRC IS THE ERROR MESSAGE HANDLER FOR STCSUB.
C
C     FATAL ERROR MESSAGES WILL BE OUTPUT TO LUN 1 OR LUN 2 DEPENDING
C     ON THE SETTING OF SENSE SWITCH 1. SETTING SENSE SWITCH 1
C     WILL ALLOW OUTPUT ON LUN 1, CLEARING SENSE SWITCH 1 WILL
C     ALLOW OUTPUT ON LUN 2.
C
C     NON-FATAL ERROR MESSAGES WILL BE OUTPUT TO LUN 1
C     WHICH WILL BE DYNAMICALLY ASSIGNED TO ITS TASK-BUILT
C     LUN OR TO MASS STORAGE FILE 'TASKNAME.ERR' DEPENDING ON
C     THE SETTING OF SENSE SWITCH 2. SETTING SENSE SWITCH
C     2 WILL ALLOW OUTPUT ON THE TASK-BUILT LUN, CLEARING
C     SENSE SWITCH 2 WILL ALLOW OUTPUT ON THE MASS STORAGE FILE
C     'TASKNAME.ERR'.
C
C     AT TASK BUILD TIME LUN 1 SHOULD BE ASSIGNED TO 'TI'
C                        LUN 2 SHOULD BE ASSIGNED TO 'CO'.
C
C     SEVCOD= SEVERITY CODE.
C     FOR SEVCOD='N' NON-FATAL, ERRPRC WILL RETURN TO ITS CALLER
C     OTHERWISE ERRPRC WILL EXIT.
C
C     SUBNAM= CALLING SUBROUTINE NAME.
C
C     ERRCOD= ERROR CODE.
C
C     SUPLEN= LENGTH OF SUPPLEMENTARY MESSAGE.
C     FOR SUPLEN=0 NO SUPPLEMENTARY MESSAGE IS OUTPUT.
C
C     SUPMSG= SUPPLEMENTARY MESSAGE ADDRESS.
C
C     FOR SUBNAM='FMSIO ' THE OPTIONAL SIXTH PARAMETER
C     WILL BE OUTPUT TO IDENTIFY THE MASS STORAGE FILE WHICH IS
C     INVOLVED IN THE ERROR.
C
      EXTERNAL THTASK
      BYTE SEVCOD,SUBNAM(6),SUPMSG(1)
      REAL FILNAM,THTASK,ERRFIL(7)
      INTEGER ERRCOD,SUPLEN,PUDARR(6,2),TTYLUN,TSW,SUPLMT,SUPSRT,SUPEND,
     1FIRST,OPLUN,SWT1,SWT2,COLUN,FALUN,ERROR(3),FILERR
      BYTE DATARR(9),TIMARR(8),TSKNAM(6),CFMS(6),CTHT(6),ERRFBY(28)
      EQUIVALENCE (ERRFIL,ERRFBY)
      DATA ERRFIL/'DB1:','[100',',100',']UDF','TSK.','ERR;','1   '/
      DATA ERRFBY(26)/"0/
C
C     INDIVIDUAL ELEMENTS OF ERRFIL MAY BE ALTERED BY SUPPLYING
C     DATA STATEMENTS FOR THE BYTE ARRAY ERRFBY.
C
      DATA FIRST/0/
      DATA FALUN/2/
      DATA ERRDAT/0/
      DATA CFMS/'F','M','S','I','O',' '/
      DATA CTHT/'T','H','T','A','S','K'/
      IF (FIRST.NE.0) GOTO 5
	FIRST=1  !  SET FIRST FLAG INCASE R50ASC HAS FATAL ERROR
      CALL R50ASC (6,THTASK (),ERRFBY(14))
      DO 3 I=14,19
      IF (ERRFBY(I).EQ.'.') ERRFBY(I)=' '
    3 CONTINUE
      CALL SSWTCH (1,SWT1)
      CALL SSWTCH (2,SWT2)
      IF (SWT1.EQ.1) FALUN=1
      CALL GETLUN (1,PUDARR(1,1))
      TTYLUN=IAND ("000377,PUDARR(2,1))
      CALL GETLUN (2,PUDARR(1,2))
      COLUN=IAND ("000377,PUDARR(2,2))
    5 CALL TIME (TIMARR)
      CALL DATE (DATARR)
      FILERR=0
      TSW=0
      DO 10 I=1,6
      IF (SUBNAM(I).EQ.CFMS(I)) TSW=TSW+1
      IF (SUBNAM(I).EQ.CTHT(I)) TSW=TSW+10
   10 TSKNAM(I)=' '
      IF (SWT2.EQ.1.OR.SEVCOD.NE.'N') GOTO 21
      IF (ERRDAT.EQ.1) CLOSE (UNIT=2,ERR=12)
   12 OPEN (UNIT=2,NAME=ERRFIL,TYPE='OLD',ACCESS='APPEND',
     1ERR=17)
      ERRDAT=2
      GOTO 41
   17 CALL ERRSNS (ERROR(1),ERROR(2),ERROR(3))
      IF (ERROR(1).EQ.29) GOTO 19
      IF (ERROR(3).EQ.0.AND.ERROR(2).EQ.-29) GOTO 18
      IF (ERROR(3).EQ.0.AND.ERROR(2).EQ.-27) GOTO 18
      FILERR=1
      ERRDAT=2
      GOTO 21
   18 CALL WAIT (250,1,ERROR(1))
      GOTO 17
   19 OPEN (UNIT=2,NAME=ERRFIL,RECORDSIZE=80,INITIALSIZE=100,
     1ERR=17)
      ERRDAT=2
      GOTO 41
   21 IF (ERRDAT.NE.2) GOTO 41
      CALL ASNLUN (2,PUDARR(1,2),COLUN)
      ERRDAT=1
   41 OPLUN=2
      IF (SWT2.EQ.1) OPLUN=1
      IF (SEVCOD.NE.'N'.OR.FILERR.EQ.1) OPLUN=FALUN
   42 IF (TSW.NE.60) CALL R50ASC (6,THTASK (),TSKNAM)
      WRITE (OPLUN,100) DATARR,TIMARR,PUDARR(1,1),TTYLUN,TSKNAM,SUBNAM,
     1ERRCOD
  100 FORMAT ('0STCSUB ',9A1,X,8A1,X,A2,O2,2(X,6A1),' ERROR=',I4)
      IF (TSW.NE.6) GOTO 20
      WRITE (OPLUN,200) FILNAM
  200 FORMAT (8X,'FILE=',A4,'DAT')
   20 IF (FILERR.NE.0) WRITE (OPLUN,400) ERRFIL
  400 FORMAT (8X,'MESSAGE DIVERTED FROM ',6A4,A1)
      IF (SUPLEN.LE.0) GOTO 40
      SUPLMT=SUPLEN
      SUPSRT=1
   30 SUPEND=SUPSRT+59
      IF (SUPEND.GT.SUPLMT) SUPEND=SUPLMT
      WRITE (OPLUN,300) (SUPMSG(I),I=SUPSRT,SUPEND)
  300 FORMAT (8X,60A1)
      SUPSRT=SUPSRT+60
      IF (SUPSRT.LE.SUPLMT) GOTO 30
   40 IF (ERRDAT.EQ.2) CLOSE (UNIT=2,ERR=50)
   50 IF (SEVCOD.NE.'N') CALL ABORT ()
      RETURN
      END	!OF ERRPRC

C**********************************************************
      SUBROUTINE SOTSER
C
C     SOTSER WILL CONDITIONALLY SUPPRESS THE PRINTING OF FORTRAN
C     OTS ERROR MESSAGES ON 'TI'. CLEARING SENSE SWITCH 0 WILL
C     CAUSE SOTSER TO SUPPRESS THE PRINTING OF ERROR MESSAGES.
C
      INTEGER SWT0
      CALL SSWTCH (0,SWT0)
      IF (SWT0.EQ.1) GOTO 60
      DO 10 I=1,14
      IF (I.EQ.3) GOTO 10
      CALL ERRSET (I,,,,.FALSE.,)
   10 CONTINUE
      DO 20 I=20,44
      IF (I.EQ.35.OR.I.EQ.36) GOTO 20
      CALL ERRSET (I,,,,.FALSE.,)
   20 CONTINUE
      DO 30 I=60,75
      IF (I.EQ.68.OR.I.EQ.69) GOTO 30
      CALL ERRSET (I,,,,.FALSE.,)
   30 CONTINUE
      DO 40 I=80,91
      IF (I.EQ.87.OR.I.EQ.88.OR.I.EQ.89) GOTO 40
      CALL ERRSET (I,,,,.FALSE.,)
   40 CONTINUE
      DO 50 I=100,101
      CALL ERRSET (I,,,,.FALSE.,)
   50 CONTINUE
   60 RETURN
      END	!OF SOTSER

C**********************************************************
      REAL FUNCTION THTASK 
C
C     THTASK WILL RETURN ITS CALLER'S TASK NAME IN RADIX-50 FORMAT.
C
C     CO ERROR CODES- GTSK$ DIRECTIVE STATUS CODE.
C
      REAL REC(8)
      INTEGER DSW
      CALL GETTSK (REC,DSW)
      THTASK=REC(1)
      IF (DSW.EQ.1) GOTO 10
      CALL ERRPRC ('F','THTASK',DSW,0)
   10 RETURN
      END	!OF THTASK

C**********************************************************
      INTEGER FUNCTION THTERM
C
C     THTERM WILL RETURN THE UNIT NUMBER FOR LUN 1 IN
C     INTEGER FORMAT.
C
C     LUN 1 SHOULD BE ASSIGNED TO 'TI' AT TASK BUILD TIME FOR
C     STCSUB SUPPORTED TASKS.
C
      INTEGER PUDARR(6)
      CALL GETLUN (1,PUDARR)
      THTERM=IAND ("000377,PUDARR(2))
      RETURN
      END	!OF THTERM