SUBROUTINE RT_ERROR (OUT,ERROR) INTEGER*4 OUT ! LOGICAL UNIT TO REPORT TO INTEGER*4 ERROR ! FORTRAN RUNTIME ERROR NUMBER C************************************************************************ C*** C*** THIS ROUTINE WILL REPORT THE RUN-TIME ERROR TO THE LOGICAL UNIT C*** SPECIFIED. C*** TWO ERROR TYPES ARE SUPPORTED, 1-68 = SYSTEM: 100-126 Disksubs C*** specific C*** C************************************************************************ C CHARACTER*40 MESS CHARACTER*40 MESSAGE (68), DSK_TAPE (27) C DATA MESSAGE /'Not a FORTRAN specific error ', ! 1 1 ' * Undefined * ', ! 2 1 ' * Undefined * ', ! 3 1 ' * Undefined * ', ! 4 1 ' * Undefined * ', ! 5 1 ' * Undefined * ', ! 6 1 ' * Undefined * ', ! 7 1 ' * Undefined * ', ! 8 1 ' * Undefined * ', ! 9 1 ' * Undefined * ', ! 10 1 ' * Undefined * ', ! 11 1 ' * Undefined * ', ! 12 1 ' * Undefined * ', ! 13 1 ' * Undefined * ', ! 14 1 ' * Undefined * ', ! 15 1 ' * Undefined * ', ! 16 1 'Syntax error in NAMELIST input ', ! 17 1 'Too many values for NAMELIST variable ', ! 18 1 'Inv. ref. to variable in NAMELIST input ', ! 19 1 'REWIND error ', ! 20 1 'Duplicate file specifications ', ! 21 1 'Input record too long ', ! 22 1 'BACKSPACE error ', ! 23 1 'End-Of-File during read ', ! 24 1 'Record number outside of range ', ! 25 1 'OPEN or DEFINE FILE required ', ! 26 1 'Too many records in I/O statement ', ! 27 1 'CLOSE error ', ! 28 1 'File not found ', ! 29 1 'Open failure ', ! 30 1 'Mixed file access modes ', ! 31 1 'Invalid Logical Unit Number ', ! 32 1 'ENDFILE error ', ! 33 1 'Unit already open ', ! 34 1 'Segmented record format error ', ! 35 1 'Attempt to access non-existent record ', ! 36 1 'Inconsistent record number ', ! 37 1 'Error during write operation ', ! 38 1 'Error during read operation ', ! 39 1 'Recursive I/O operation ', ! 40 1 'Insufficient virtual memory ', ! 41 1 'No such device ', ! 42 1 'File name specification error ', ! 43 1 'Inconsistent record type ', ! 44 1 'Keyword value error in OPEN statement ', ! 45 1 'Inconsistent OPEN/CLOSE parameters ', ! 46 1 'Write to READONLY file ', ! 47 1 'Invalid argument to Runtime lib routine ', ! 48 1 'Invalid key specification ', ! 49 1 'Inconsistent key change or duplication ', ! 50 1 'Inconsistent file organization ', ! 51 1 'Specified record locked ', ! 52 1 'No current record ', ! 53 1 'REWRITE error ', ! 54 1 'DELETE error ', ! 55 1 'UNLOCK error ', ! 56 1 'FIND error ', ! 57 1 ' * Undefined * ', ! 58 1 'List directed I/O syntax error ', ! 59 1 'Infinite format loop ', ! 60 1 'Format/variable-type mismatch ', ! 61 1 'Syntax error in format ', ! 62 1 'Output conversion error ', ! 63 1 'Input conversion error ', ! 64 1 ' * Undefined * ', ! 65 1 'Output statement overflows record ', ! 66 1 'Input statement requires too much data ', ! 67 1 'Variable format expression value error '/ ! 68 C DATA DSK_TAPE /'DSK_OPEN: LUN less than 1 ', ! 100 1 'DSK_OPEN: LUN greater than 40 ', ! 101 1 'DSK_OPEN: LUN previously opened by DSK ', ! 102 1 'DSK_OPEN: Record Size too Small ', ! 103 1 'DSK_OPEN: Record Size Exceedes 8192 ', ! 104 1 'DSK_OPEN: File previosly OPENED by Sys. ', ! 105 1 'DSK_OPEN: Accessing Formatted File ', ! 106 1 'DSK_LINK: LUN Less than 1 ', ! 107 1 'DSK_LINK: LUN Greater than 40 ', ! 108 1 'DSK_LINK: LUN Previously Opened by DSK ', ! 109 1 'DSK_LINK: Record Size too small ', ! 110 1 'DSK_LINK: Record Size Exceedes 8192 ', ! 111 1 'DSK_LINK: Access is UNKNOWN File no OPEN', ! 112 1 'DSK_LINK: File not Opened UNFORMATTED ', ! 113 1 'DSK_LINK: File not Created SEQUENTIAL ', ! 114 1 'DSK_LINK: File Access not Opened DIRECT ', ! 115 1 'DSK_LINK: FILENAME =not LUN Filename ', ! 116 1 'DSK_LINK: REC_SIZE =not File Record Size', ! 117 1 'DSK_CLOSE: LUN not Opened by DSK_SUBS ', ! 118 1 'DSK_I/O: Inconsistant Record Length ', ! 119 1 'DSK_OPEN: *** not defined *** ', ! 120 1 'ADSK_: File NOT Accessed - Record Size 0', ! 121 1 'ADSK_: No Available DSK_ Luns ', ! 122 1 'ADSK_: Mis-Match of File-Array-Crop Size', ! 123 1 'ADSK_: File NOT Opened Successfully ', ! 124 1 'ADSK_: I/O ERROR - Transfer Terminated ', ! 125 1 'ADSK_: DSK_CLOSE Error Return '/ ! 126 C LOGICAL MESS_ONLY INTEGER*4 ERRP C C ********************************************************************** C C ** PROCESS THE CALL C C ********************************************************************** C MESS_ONLY = .FALSE. GO TO 10 C ENTRY RT_MESSAGE (MESS,ERROR) MESS_ONLY = .TRUE. GO TO 10 C 10 IF (ERROR .EQ. 0) THEN IF (MESS_ONLY) MESS = ' ' RETURN ELSE IF ( ERROR .GE. 100 .AND. ERROR .LT. 127 ) THEN ERRP = ERROR - 99 IF (MESS_ONLY) THEN MESS = DSK_TAPE(ERRP) ELSE IF ( OUT .EQ. 0 ) THEN TYPE 13,ERROR,DSK_TAPE(ERRP) ELSE WRITE (OUT,13) ERROR,DSK_TAPE(ERRP) ENDIF 13 FORMAT (' %%% DISK_SUBS or TAPE_SUBS Run-Time Error Number ', 1 I5,'. %%%',/, 2 1X,'(',A40,')' ) ENDIF ELSE IF (ERROR .LT. 0 .OR. ERROR .GT. 68) THEN IF (MESS_ONLY) THEN ENCODE (40,11,MESS) ERROR ELSE IF ( OUT .EQ. 0 ) THEN TYPE 11,ERROR ELSE WRITE (OUT,11) ERROR ENDIF 11 FORMAT (' %FORTRAN Run-Time error : ',I5,'.') ENDIF ELSE IF (MESS_ONLY) THEN MESS = MESSAGE (ERROR) ELSE IF ( OUT .EQ. 0 ) THEN TYPE 12,ERROR, MESSAGE(ERROR) ELSE WRITE (OUT,12) ERROR, MESSAGE (ERROR) ENDIF ENDIF 12 FORMAT (' %%% FORTRAN Run-Time error number : ',I5,'. %%%',/, 1 1X,'(',A40,')') ENDIF C RETURN END