SUBROUTINE MESSAGE_OUT(MESSAGE_INDEX, SECTION_INDEX, STRING_PARAM) C---------------------------------------------------------------------- C- C- Purpose and Methods : Handles message output. Given a message number, the C- current section number, and an optional message string, this routine C- generates a message string and passes it on to the routine that outputs C- the message. This routine also calls ASSIGN_ERROR() with a code based C- on the message number given. C- C- Inputs : MESSAGE_INDEX The code indicating what message to print C- SECTION_INDEX The identification of the current section C- STRING_PARAM A secondary string that may be printed if the C- message number calls for it. C- Outputs : none C- Controls: none C- C- Created 30-JUL-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE C- C---------------------------------------------------------------------- IMPLICIT NONE C---------------------------------------------------------------------- C C Global declarations C INCLUDE 'LSMP$SOURCE:PARSE_TOKENS.PARAMS' INCLUDE 'LSMP$SOURCE:PARSE_TOKENS.INC' INTEGER TRULEN EXTERNAL TRULEN INTRINSIC MOD C C Argument declarations C INTEGER MESSAGE_INDEX INTEGER SECTION_INDEX CHARACTER*(*) STRING_PARAM C C Local declarations C CHARACTER*200 BUFFER INTEGER MESSAGE_TYPE INTEGER ERROR_TYPE INTEGER MESSAGE_NUMBER INTEGER MESSAGE_LENGTH INTEGER STRING_LENGTH CHARACTER*80 ST_MESSAGE( 1:MAX_NUM_MESSAGES ) SAVE ST_MESSAGE C C Get the message number, message type, and error type from the message C index. C ERROR_TYPE = MESSAGE_INDEX / 1000 MESSAGE_TYPE = MOD(MESSAGE_INDEX / 100, 10) * 100 MESSAGE_NUMBER = MOD(MESSAGE_INDEX, 100) C C Build a message string and send it to MESSAGE_PRINT C IF (MESSAGE_TYPE .EQ. MES_STRING) THEN CALL MESSAGE_PRINT(STRING_PARAM(1:TRULEN(STRING_PARAM))) C ELSE WRITE (BUFFER, 100) LINE_NUMBER, ST_MESSAGE(MESSAGE_NUMBER) 100 FORMAT('Error, line ', I, ': ', A) IF (((MESSAGE_TYPE .EQ. MES_SECTION) .OR. (MESSAGE_TYPE .EQ. & MES_SECTION_STRING)) .AND. (SECTION_INDEX .NE. 0)) THEN CALL ADDSTR(BUFFER, ' in section ' // & TOKEN_STRING(INDEX_TO_SECTION( SECTION_INDEX)), BUFFER, & MESSAGE_LENGTH) MESSAGE_LENGTH = MIN( MESSAGE_LENGTH, LEN(BUFFER)) ENDIF C IF (MESSAGE_TYPE .EQ. MES_SECTION_STRING) THEN CALL ADDSTR(BUFFER, ' '// STRING_PARAM, BUFFER, & MESSAGE_LENGTH) MESSAGE_LENGTH = MIN( MESSAGE_LENGTH, LEN(BUFFER)) ENDIF C CALL MESSAGE_PRINT(BUFFER(1:TRULEN(BUFFER) )) ENDIF C C Send the error status to ASSIGN_ERROR C CALL ASSIGN_ERROR(ERROR_TYPE) C C Keep track of how many messages generated C MESSAGE_COUNT = MESSAGE_COUNT + 1 C C C 999 RETURN C C Initialize the message strings C ENTRY INIT_MESSAGES() C ST_MESSAGE( 1 ) = 'No values specified for item' ST_MESSAGE( 2 ) = & 'The following members were not specified' ST_MESSAGE( 3 ) = 'PASS THROUGH' ST_MESSAGE( 4 ) = & 'A member was specified when it should not have been' ST_MESSAGE( 5 ) = 'PASS THROUGH' ST_MESSAGE( 6 ) = 'Value out of range' ST_MESSAGE( 7 ) = 'Range not contiguous' ST_MESSAGE( 8 ) = 'Range not symmetric' ST_MESSAGE( 9 ) = 'HD value is smaller than EM value' ST_MESSAGE( 10) = & 'TOT value does not lie between EM and HD values' ST_MESSAGE( 11) = 'Range not constant over ETA' ST_MESSAGE( 12) = 'Range not decreasing' ST_MESSAGE( 13) = 'Range not increasing' ST_MESSAGE( 14) = 'Range no constant over PHI' ST_MESSAGE( 15) = & 'Value not within tolerance in relation to other members' ST_MESSAGE( 16) = & 'Contents in TRANSV_ENERGY_CUT imply that a member ' // & 'should be 0' ST_MESSAGE( 17) = & 'Contents in TRANSV_ENERGY_CUT imply that a member ' // & 'should not be 0' ST_MESSAGE( 18) = & 'Contents in ADC_ZERESP imply that a member should be 0' ST_MESSAGE( 19) = 'Open on file failed' ST_MESSAGE( 20) = 'Read on file failed' ST_MESSAGE( 21) = 'Expected a NUMBER, found:' ST_MESSAGE( 22) = 'Invalid integer value:' ST_MESSAGE( 23) = 'Expected AND, TO, or END_OF_LINE, found:' ST_MESSAGE( 24) = 'Expected AND or END_OF_LINE, found:' ST_MESSAGE( 25) = 'Expected PLUS or MINUS, found:' ST_MESSAGE( 26) = 'Invalid range:' ST_MESSAGE( 27) = 'Expected TO, found:' ST_MESSAGE( 28) = 'Expected EM, HD, or TOT; found:' ST_MESSAGE( 29) = 'Expected ET, L2, PX, or PY; found:' ST_MESSAGE( 30) = & 'Expected EM_PROM, HD_PROM, PX_PROM, or PY_PROM; found:' ST_MESSAGE( 31) = 'END_WITH without a corresponding WITH' ST_MESSAGE( 32) = 'WITH block without an item assignment' ST_MESSAGE( 33) = 'Unclosed WITH statement before END_SECTION' ST_MESSAGE( 34) = 'SECTION block without an item assignment' ST_MESSAGE( 35) = 'Expected END_OF_LINE, found:' ST_MESSAGE( 36) = 'Program error in routine TRANSFORM_RANGE' ST_MESSAGE( 37) = 'Have already specified all valid variables ' // & 'before LIST statement' ST_MESSAGE( 38) = 'Have not specified all non-integer variables ' & // 'before LIST statement' ST_MESSAGE( 39) = 'Expected VARIABLE or END_OF_LINE, found:' ST_MESSAGE( 40) = 'Variable not valid in current section:' ST_MESSAGE( 41) = 'Variable has already been specified:' ST_MESSAGE( 42) = 'Program error in routine ' // & 'PARSE_REMAINING_VARIABLES' ST_MESSAGE( 43) = 'Program error in routine ' // & 'BUILD_SECOND_STACK' ST_MESSAGE( 44) = 'Attempting to specify too many variables' ST_MESSAGE( 45) = 'Expected a VARIABLE, found:' ST_MESSAGE( 46) = 'Invalid combination of CHANNEL and LOOKUP:' ST_MESSAGE( 47) = 'CHANNEL TOT not valid' ST_MESSAGE( 48) = 'Program error in routine PARSE_WITH' ST_MESSAGE( 49) = & 'Program error in routine PUSH_VAR, attempt to increase ' // & 'stack beyond bounds' ST_MESSAGE( 50) = & 'Program error in routine PULL_VAR, attempt to decrease ' // & 'stack beyond bounds' ST_MESSAGE( 51) = 'Expected an enumerated value, found:' ST_MESSAGE( 52) = 'Expected END_LIST, found:' ST_MESSAGE( 53) = 'Expected WITH, LIST, END_WITH, END_SECTION, ' & // 'or ASSIGN; found:' ST_MESSAGE( 54) = 'Program error in routine PARSE_SECTION' ST_MESSAGE( 55) = 'Not all variables have been specified' ST_MESSAGE( 56) = 'Member of item redefined in assignment' ST_MESSAGE( 57) = 'Expected SECTION or END_OF_FILE, found:' ST_MESSAGE( 58) = 'Expected a section name, found:' ST_MESSAGE( 59) = 'Program error in routine DISPATCH' ST_MESSAGE( 60) = & 'Cannot derive quantities: GLOBAL_ADC_SCALE is 0' C RETURN END