SUBROUTINE PARSE_SECTION( UNIT_NUM, SECTION_INDEX, & FIRST_ITEM, ERROR ) C---------------------------------------------------------------------- C- C- Purpose and Methods : Parses a section given an index into the arrays C- describing each section and the first item in the array to be filled. C- C- Inputs : C- UNIT_NUM the IO unit number C- SECTION_INDEX a token that is an index into arrays describing C- characteristics of the current section. C- FIRST_ITEM (* MODIFIED *) C- The first item in the array to be filled. C- Outputs : C- ERROR Error status. .TRUE. on error C- filled array of which FIRST_ITEM is the first element C- C- Controls: none C- C- Created 19-JUN-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE C- C---------------------------------------------------------------------- IMPLICIT NONE C---------------------------------------------------------------------- C C global declarations C INCLUDE 'D0$LEVEL1:PARSE_TOKENS.PARAMS' INCLUDE 'D0$LEVEL1:PARSE_TOKENS.INC' INCLUDE 'D0$LEVEL1:LEVEL1_LOOKUP.PARAMS' INCLUDE 'D0$LEVEL1:LEVEL1_LOOKUP.INC' C C argument declarations C INTEGER UNIT_NUM INTEGER SECTION_INDEX INTEGER FIRST_ITEM(1:*) LOGICAL ERROR C C local variables C INTEGER TOKEN CHARACTER*20 STRING_VALUE REAL NUMBER_VALUE INTEGER RANGE C INTEGER ORDER_VAR(1:STACK_PTR) ! The list of variables specified. ! (STACK_PTR) is the pointer to current ! position. (STACK_LIST) is the number ! of variables from a LIST ! statement C INTEGER ORDER_LIST(1:STACK_PTR) ! This one used in parsing list ! statements C INTEGER RANGE_ARRAY(1:MAX_NUM_DIMENSIONS) ! This variable is used to pass ! the range each variable is ! active over C INTEGER POSITION INTEGER COUNT LOGICAL REDEFINED LOGICAL EMPTY_SECTION LOGICAL EMPTY_WITH C INTEGER RANGE_PROM INTEGER RANGE_CHANNEL INTEGER RANGE_LOOKUP INTEGER RANGE_SIGN_ETA INTEGER RANGE_PHI INTEGER RANGE_MAGN_ETA INTEGER RANGE_PAGE INTEGER RANGE_INDEX INTEGER RANGE_BIN C C C C Initialize the data arrays. First, the stacks must be set empty. C ORDER_VAR(STACK_PTR) = 0 ORDER_VAR(STACK_LIST) = 0 ORDER_LIST(STACK_PTR) = 0 ORDER_LIST(STACK_LIST) = 0 C EMPTY_SECTION = .TRUE. C C this loop looks for one of WITH, LIST, ASSIGN, END_WITH, C or END_SECTION. If one is found, a check is made to see if it C was found in a valid context. If not, error processing occurs. C Otherwise, WITH statements are parsed to the END_OF_LINE, LIST C statements are passed to another routine which parses to the C END_OF_LINE after the END_LIST, ASSIGN statements are parsed to the C following END_OF_LINE, END_WITH and END_SECTION statements C are parsed to the END_OF_LINE. The loop is exited on the successful C parsing of an END_SECTION statement. C DO WHILE (.TRUE.) CALL CHECK_NEXT_TOKEN( UNIT_NUM, C_BODY, TOKEN, STRING_VALUE, & NUMBER_VALUE, ERROR, CHECK_CLASS + IGNORE_EOL ) IF (ERROR) THEN CALL MESSAGE_OUT(MES_EXPECT_BODY, SECTION_INDEX, STRING_VALUE) CALL FINISH_SECTION( UNIT_NUM ) GOTO 999 ENDIF C C Parse a WITH statement C IF (TOKEN .EQ. T_WITH) THEN C C Parse the variable, and build the range. C CALL PARSE_WITH( UNIT_NUM, ORDER_VAR, SECTION_INDEX, & RANGE, ERROR ) IF (ERROR) GOTO 999 C IF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_PROM) THEN RANGE_PROM = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_CHANNEL) THEN RANGE_CHANNEL = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_LOOKUP) THEN RANGE_LOOKUP = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_SIGN_ETA) THEN RANGE_SIGN_ETA = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_PHI) THEN RANGE_PHI = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_MAGN_ETA) THEN RANGE_MAGN_ETA = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_PAGE) THEN RANGE_PAGE = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_INDEX) THEN RANGE_INDEX = RANGE ELSEIF (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_BIN) THEN RANGE_BIN = RANGE ELSE CALL MESSAGE_OUT(MES_PROG_PARSE_SECTION, SECTION_INDEX, ' ') ERROR = .TRUE. GOTO 999 ENDIF C C Need to check to see if a valid combination of CHANNEL and LOOKUP has C been selected. C IF ((ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_CHANNEL) .OR. & (ORDER_VAR(ORDER_VAR(STACK_PTR)) .EQ. T_LOOKUP) ) THEN CALL CHECK_CHANNEL_LOOKUP( SECTION_INDEX, ORDER_VAR, & RANGE_CHANNEL, RANGE_LOOKUP, ERROR ) IF (ERROR) THEN CALL FINISH_SECTION(UNIT_NUM) GOTO 999 ENDIF ENDIF C EMPTY_WITH = .TRUE. C C PARSE_WITH has already scanned up through the END_OF_LINE, so now can C repeat loop. C C parse an END_WITH C ELSEIF ( TOKEN .EQ. T_END_WITH ) THEN CALL PARSE_END_WITH( UNIT_NUM, EMPTY_WITH, & ORDER_VAR, ERROR ) IF (ERROR) GOTO 999 C C parse an END_SECTION. there must be no unclosed WITH statements C ELSEIF (TOKEN .EQ. T_END_SECTION) THEN CALL PARSE_END_SECTION( UNIT_NUM, EMPTY_SECTION, & ORDER_VAR, ERROR ) IF (ERROR) GOTO 999 C C if VERBOSE is on, dump the contents of the item. C C IF (VERBOSE) CALL DUMP_SECTION( SECTION_INDEX ) C C below is the only non-error exit from this routine C GOTO 999 C C C C Parse an ASSIGN statement. C ELSEIF (TOKEN .EQ. T_ASSIGN) THEN C C check if all variables have been specified C IF ( ORDER_VAR(STACK_PTR) .NE. & NUM_ACTIVE_VARIABLES(SECTION_INDEX) ) THEN CALL MESSAGE_OUT(MES_NOT_VARSPEC, SECTION_INDEX, ' ') ERROR = .TRUE. CALL FINISH_SECTION( UNIT_NUM ) GOTO 999 ENDIF C C Put the ranges into one array, and merge CHANNEL and LOOKUP if C necessary C CALL TRANSFORM_RANGE(SECTION_INDEX, RANGE_PROM, & RANGE_CHANNEL, RANGE_LOOKUP, & RANGE_SIGN_ETA, RANGE_PHI, RANGE_MAGN_ETA, RANGE_PAGE, & RANGE_INDEX, RANGE_BIN, RANGE_ARRAY, ERROR) IF (ERROR) THEN CALL FINISH_SECTION( UNIT_NUM ) GOTO 999 ENDIF C C Read the value from the file and assign it to the selected range. C CALL ASSIGN_SINGLE( UNIT_NUM, SECTION_INDEX, RANGE_ARRAY, & FIRST_ITEM, FIRST_ITEM, REDEFINED, ERROR ) IF (ERROR) GOTO 999 C C Should be followed by END OF LINE C CALL PARSE_EOL(UNIT_NUM, ERROR) IF (ERROR) GOTO 999 C EMPTY_SECTION = .FALSE. EMPTY_WITH = .FALSE. IF (DIAGNOSTICS .AND. REDEFINED) THEN CALL MESSAGE_OUT(MES_REDEFINED, SECTION_INDEX, ' ') ENDIF C C C C Parse a LIST statement. See if all non-integer variables C have been specified. Calculate how many remain. Get the variables one C at a time. Transform the ranges into the array of ranges. Add the C variables to the stack. Make another stack from this that maps varying C speed onto the dimensions of the array. Call ASSIGN_LIST to assign the C list contents to the item. ASSIGN_LIST needs the IO unit number, the C current section index, the array of ranges, and the mapping of varying C speed to array dimensions. ASSIGN_LIST will parse through the C END_OF_LINE after the END_LIST. Reset secondary stack. Remove list C variables from stack. Repeat loop C C ELSEIF ( TOKEN .EQ. T_LIST ) THEN C C see if all non-integer variables have been specified. C CALL LIST_CHECK_SPECIFIED( SECTION_INDEX, ORDER_VAR, ERROR ) IF (ERROR) THEN CALL FINISH_SECTION(UNIT_NUM) GOTO 999 ENDIF C C calculate how many variables remain C ORDER_VAR(STACK_LIST) = NUM_ACTIVE_VARIABLES(SECTION_INDEX) - & ORDER_VAR(STACK_PTR) C C get the remaining variables from the list C CALL PARSE_REMAINING_VARIABLES(UNIT_NUM, & SECTION_INDEX, ORDER_VAR, RANGE_PROM, & RANGE_SIGN_ETA, RANGE_PHI, RANGE_MAGN_ETA, RANGE_PAGE, & RANGE_INDEX, RANGE_BIN, ERROR ) IF (ERROR) GOTO 999 C C check if all variables have been specified now C IF (ORDER_VAR(STACK_PTR) .NE. & NUM_ACTIVE_VARIABLES(SECTION_INDEX)) THEN CALL MESSAGE_OUT(MES_NOT_VARSPEC, SECTION_INDEX, ' ') ERROR = .TRUE. CALL FINISH_SECTION( UNIT_NUM ) GOTO 999 ENDIF C C Transform the ranges into an array where each entry corresponds to a C dimension in the item. C CALL TRANSFORM_RANGE( SECTION_INDEX, RANGE_PROM, & RANGE_CHANNEL, RANGE_LOOKUP, RANGE_SIGN_ETA, RANGE_PHI, & RANGE_MAGN_ETA, RANGE_PAGE, RANGE_INDEX, RANGE_BIN, & RANGE_ARRAY, ERROR) IF (ERROR) THEN CALL FINISH_SECTION(UNIT_NUM) GOTO 999 ENDIF C C Build a secondary stack indicating which variables in the HOLDS array C vary and in what order. Instead a being a stack of tokens, it is a C stack of indicies into the HOLDS and WIDTHS arrays. Put on first C list variables, then other variables, then empty dimensions. C CALL BUILD_SECOND_STACK(SECTION_INDEX, ORDER_VAR, ORDER_LIST) C C Have now built everything needed to assign the list. C CALL ASSIGN_LIST( UNIT_NUM, SECTION_INDEX, RANGE_ARRAY, & ORDER_LIST, FIRST_ITEM, FIRST_ITEM, REDEFINED, ERROR ) IF (ERROR) GOTO 999 IF (DIAGNOSTICS .AND. REDEFINED) THEN CALL MESSAGE_OUT(MES_REDEFINED, SECTION_INDEX, ' ') ENDIF EMPTY_SECTION = .FALSE. EMPTY_WITH = .FALSE. C C reset the stacks to their pre-list state C ORDER_LIST(STACK_PTR) = 0 ORDER_LIST(STACK_LIST) = 0 ORDER_VAR(STACK_PTR) = ORDER_VAR(STACK_PTR) - & ORDER_VAR(STACK_LIST) ORDER_VAR(STACK_LIST) = 0 C C Should never enter this block. All cases should have been taken care of C above. C ELSE CALL MESSAGE_OUT(MES_PROG_PARSE_SECTION, SECTION_INDEX, ' ') ERROR = .TRUE. GOTO 999 C C repeat loop C ENDIF C END DO C 999 RETURN END C C C