Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SUBROUTINE ERROR(MESSAG, STATUS)
C************************************************************
C
C  THIS SUBROUTINE IS USED TO PRINT ERROR MESSAGES
C  DURING THE EXECUTION OF "GIDUS" AND "DISLIB". THE
C  ERROR MESSAGES ARE PRINTED ON THE GT40 (PRECEEDED BY
C  A BELL IF FATAL) AND ARE ALSO WRITTEN IN THE LOG FILE
C  "DISLIB.LOG", IF LOGGING IS ENABLED.
C
C  NOTE THAT "177 IS A NON-PRINTING FILLER CHARACTER
C
C  POSSIBLE ERRORS:
C	NONE
C
C  ROUTINES CALLED:
C	SFIELD - GENERAL BYTE STORAGE ROUTINE
C	GFIELD - GENERAL BYTE RETREIVAL ROUTINE
C	SNDCHR - SENDS AN IMAGE CHARACTER TO THE GT40
C
C************************************************************
	IMPLICIT INTEGER (A - Z)
	LOGICAL LOG
	INTEGER MESSAG(12), STRING(60)
	COMMON /LOGBLK/ LOG, GTLOG, FATAL, WARN
	DATA GT40 /5/

1	FORMAT(1X,60A1,' "',O3,2X,I6)
2	FORMAT(60A1,' "',O3,2X,I6)
3	FORMAT(1X,60A1)
4	FORMAT(60A1)

C  CONVERT MESSAG FROM A5 FORMAT TO A1 FORMAT, STORE IN STRING
	DO 100 I = 1,60
	  CALL SFIELD(STRING(I), 0, 7, "177)
100	CONTINUE
	J = 0
	DO 200 I = 1,60
	  WORD = I / 5 + (MOD(I,5) .EQ. 0) + 1
	  POS = MOD(I,5) + 5 * (MOD(I,5) .EQ. 0) * (-1)
	  CHAR = GFIELD(MESSAG(WORD), (POS - 1) * 7, 7)
	  IF(CHAR .EQ. 0) GO TO 300
	  CALL SFIELD(STRING(I), 0, 7, CHAR)
	  J = I
200	CONTINUE

C  OVER-WRITE TRAILING SPACES WITH FILLER
300	DO 400 I = J,1,-1
	  IF(GFIELD(STRING(I), 0, 7) .NE. "40) GO TO 500
	  CALL SFIELD(STRING(I), 0, 7, "177)
400	CONTINUE
500	IF(GFIELD(STRING(1), 0, 7) .EQ. "77) CALL SNDCHR(7)
	IF(STATUS .EQ. 0) GO TO 600
	WRITE(GT40, 1) STRING, STATUS, STATUS
	IF(LOG) WRITE(GTLOG, 2) STRING, STATUS, STATUS
	GO TO 700
600	WRITE(GT40, 3) STRING
	IF(LOG) WRITE(GTLOG, 4) STRING

C  UPDATE THE ERROR COUNTS
700	IF(GFIELD(STRING(1), 0, 7) .EQ. "77) FATAL = FATAL + 1
	IF(GFIELD(STRING(1), 0, 7) .EQ. "45) WARN = WARN + 1
	RETURN
	END