4-Dec-1991 11:47:04 VAX FORTRAN V5.4-79 Page 1 4-Dec-1991 11:06:36 ASSIGN_SINGLE.FOR;4 0001 SUBROUTINE ASSIGN_SINGLE( UNIT_NUM, SECTION_INDEX, RANGES, 0002 & FIRST_ITEM_INTEGER, FIRST_ITEM_REAL, REDEFINED, ERROR) 0003 C---------------------------------------------------------------------- 0004 C- 0005 C- Purpose and Methods : Performs the assignment for a single value 0006 C- assignment statement. Gets the value from the file, and loops through 0007 C- the dimensions of the array assigning values. When this routine 0008 C- returns, the entire statement including the END_OF_LINE has been 0009 C- parsed. SECTION_INDEX is used to find the width of each dimension 0010 C- of FIRST_ITEM, and whether FIRST_ITEM is an INTEGER or a REAL 0011 C- variable. 0012 C- 0013 C- Inputs : 0014 C- UNIT_NUM The IO unit number. 0015 C- SECTION_INDEX The index that selects the description of the current 0016 C- section. 0017 C- RANGES The array containing the range that each variable is 0018 C- active over. 0019 C- FIRST_ITEM_INTEGER (* MODIFIED *) 0020 C- FIRST_ITEM_REAL (* MODIFIED *) 0021 C- The first item in the array to be filled. It is 0022 C- intended that this routine be called with the same 0023 C- parameter for both of these arguments, so this 0024 C- routine can be used to assign both REAL values and 0025 C- INTEGER values. Only the variable appropriate to 0026 C- the data type of the current section is accessed. 0027 C- 0028 C- Outputs : 0029 C- REDEFINED Has an assignment occured to a member of the item whose 0030 C- value has already been defined. 0031 C- ERROR Error status. .TRUE. on error. 0032 C- 0033 C- Filled common block array with FIRST_ITEM as first element 0034 C- 0035 C- Controls: none 0036 C- 0037 C- Created 9-JUL-1990 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE 0038 C- 0039 C---------------------------------------------------------------------- 0040 IMPLICIT NONE 0041 C---------------------------------------------------------------------- 0042 C 0043 C Global declarations 0044 C 0045 INCLUDE 'LSMP$SOURCE:PARSE_TOKENS.PARAMS' 0587 INCLUDE 'LSMP$SOURCE:PARSE_TOKENS.INC' 0731 INTEGER JBIT 0732 EXTERNAL JBIT 0733 C 0734 C Argument declarations 0735 C 0736 INTEGER UNIT_NUM 0737 INTEGER SECTION_INDEX 0738 INTEGER RANGES(1:MAX_NUM_DIMENSIONS) 0739 LOGICAL RANGES_L(32, 1:MAX_NUM_DIMENSIONS) 0740 INTEGER FIRST_ITEM_INTEGER(1:*) 0741 REAL FIRST_ITEM_REAL(1:*) ASSIGN_SINGLE 4-Dec-1991 11:47:04 VAX FORTRAN V5.4-79 Page 2 4-Dec-1991 11:06:36 ASSIGN_SINGLE.FOR;4 0742 LOGICAL REDEFINED 0743 LOGICAL ERROR 0744 C 0745 C Local variables 0746 C 0747 INTEGER COUNT1, COUNT2, COUNT3, COUNT4, COUNT5 0748 INTEGER POSITION 0749 INTEGER TOKEN 0750 CHARACTER*20 STRING_VALUE 0751 REAL NUMBER_VALUE 0752 C 0753 ERROR = .FALSE. 0754 IF (DIAGNOSTICS) REDEFINED = .FALSE. 0755 C 0756 C Expand RANGES into RANGES_L 0757 C 0758 DO COUNT1 = 1, MAX_NUM_DIMENSIONS 0759 DO POSITION = 1, 32 0760 C&IF VAXVMS,VAXELN 0761 IF (BTEST(RANGES(COUNT1), POSITION-1)) THEN 0762 C&ELSE 0763 C& IF (JBIT(RANGES(COUNT1), POSITION)) THEN 0764 C&ENDIF 0765 RANGES_L(POSITION, COUNT1) = .TRUE. 0766 ELSE 0767 RANGES_L(POSITION, COUNT1) = .FALSE. 0768 ENDIF 0769 END DO 0770 END DO 0771 C 0772 IF (DATA_TYPE( SECTION_INDEX ) .EQ. DATA_ENUMERATED_LOOKUP ) THEN 0773 CALL CHECK_NEXT_TOKEN(UNIT_NUM, C_ENUMERATED, TOKEN, 0774 & STRING_VALUE, NUMBER_VALUE, ERROR, CHECK_CLASS ) 0775 IF (ERROR) THEN 0776 CALL MESSAGE_OUT(MES_EXPECT_ENUM, SECTION_INDEX, STRING_VALUE) 0777 CALL FINISH_SECTION(UNIT_NUM) 0778 GOTO 999 0779 ENDIF 0780 CALL ENUMERATED_TO_REAL( TOKEN, NUMBER_VALUE ) 0781 ELSE 0782 CALL CHECK_NEXT_TOKEN(UNIT_NUM, T_NUMBER, TOKEN, STRING_VALUE, 0783 & NUMBER_VALUE, ERROR, CHECK_TOKEN) 0784 IF (ERROR) THEN 0785 CALL MESSAGE_OUT( MES_EXPECTED_NUMBER, SECTION_INDEX, 0786 & STRING_VALUE) 0787 CALL FINISH_SECTION(UNIT_NUM) 0788 GOTO 999 0789 ENDIF 0790 ENDIF 0791 C 0792 DO COUNT1 = 1, WIDTHS(1,SECTION_INDEX) 0793 IF (RANGES_L(COUNT1, 1)) THEN 0794 DO COUNT2 = 1, WIDTHS(2,SECTION_INDEX) 0795 IF (RANGES_L(COUNT2, 2)) THEN 0796 DO COUNT3 = 1, WIDTHS(3,SECTION_INDEX) 0797 IF (RANGES_L(COUNT3,3)) THEN 0798 DO COUNT4 = 1, WIDTHS(4,SECTION_INDEX) ASSIGN_SINGLE 4-Dec-1991 11:47:04 VAX FORTRAN V5.4-79 Page 3 4-Dec-1991 11:06:36 ASSIGN_SINGLE.FOR;4 0799 IF (RANGES_L(COUNT4,4)) THEN 0800 DO COUNT5 = 1, WIDTHS(5,SECTION_INDEX) 0801 IF (RANGES_L(COUNT5,5)) THEN 0802 C 0803 POSITION = (COUNT1 - 1) + 0804 & WIDTHS(1,SECTION_INDEX) * (COUNT2 -1) + 0805 & WIDTHS(1,SECTION_INDEX) * 0806 & WIDTHS(2,SECTION_INDEX) * (COUNT3 -1) + 0807 & WIDTHS(1,SECTION_INDEX) * 0808 & WIDTHS(2,SECTION_INDEX) * 0809 & WIDTHS(3,SECTION_INDEX) * (COUNT4 -1) + 0810 & WIDTHS(1,SECTION_INDEX) * 0811 & WIDTHS(2,SECTION_INDEX) * 0812 & WIDTHS(3,SECTION_INDEX) * 0813 & WIDTHS(4,SECTION_INDEX) * (COUNT 5 -1) + 1 0814 C 0815 IF (DIAGNOSTICS) THEN 0816 IF ((DATA_TYPE(SECTION_INDEX) .EQ. 0817 & DATA_INTEGER ) .OR. 0818 & (DATA_TYPE(SECTION_INDEX) .EQ. 0819 & DATA_ENUMERATED_LOOKUP)) THEN 0820 IF (FIRST_ITEM_INTEGER( POSITION ) 0821 & .NE. MIN_INTEGER ) REDEFINED = .TRUE. 0822 ELSE 0823 IF (FIRST_ITEM_REAL(POSITION) 0824 & .NE. MIN_REAL) REDEFINED = .TRUE. 0825 ENDIF 0826 ENDIF 0827 C 0828 IF ((DATA_TYPE(SECTION_INDEX) .EQ. 0829 & DATA_INTEGER) .OR. 0830 & (DATA_TYPE(SECTION_INDEX) .EQ. 0831 & DATA_ENUMERATED_LOOKUP)) THEN 0832 FIRST_ITEM_INTEGER(POSITION) = NINT( 0833 & NUMBER_VALUE ) 0834 ELSE 0835 FIRST_ITEM_REAL( POSITION ) = NUMBER_VALUE 0836 ENDIF 0837 C 0838 ENDIF 0839 END DO 0840 ENDIF 0841 END DO 0842 ENDIF 0843 END DO 0844 ENDIF 0845 END DO 0846 ENDIF 0847 END DO 0848 C 0849 999 RETURN 0850 END ASSIGN_SINGLE 4-Dec-1991 11:47:04 VAX FORTRAN V5.4-79 Page 4 01 4-Dec-1991 11:06:36 ASSIGN_SINGLE.FOR;4 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 695 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 24 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 904 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 3 WIDTHS_CMN 1252 PIC OVR REL GBL SHR NOEXE RD WRT LONG 4 LSM_ERROR 16 PIC OVR REL GBL SHR NOEXE RD WRT LONG 5 TOKEN_STRING_CMN 1220 PIC OVR REL GBL SHR NOEXE RD WRT LONG 6 LSMP_SPECIFIC 24 PIC OVR REL GBL SHR NOEXE RD WRT LONG 7 LSMP_SPECIFIC_STRINGS 170 PIC OVR REL GBL SHR NOEXE RD WRT LONG Total Space Allocated 4305 ENTRY POINTS Address Type Name 0-00000000 ASSIGN_SINGLE VARIABLES Address Type Name Address Type Name 2-00000294 I*4 COUNT1 2-00000298 I*4 COUNT2 2-0000029C I*4 COUNT3 ** I*4 COUNT4 ** I*4 COUNT5 6-00000000 L*4 DIAGNOSTICS AP-0000001C@ L*4 ERROR 3-00000000 I*4 LINE_NUMBER 7-00000000 CHAR LSM_DIRECTORY_NAME 4-00000004 I*4 LSM_ERROR_CODE 4-00000008 I*4 LSM_ERROR_LINE 4-00000000 I*4 LSM_ERROR_SEVERITY 6-0000000C L*4 LSM_FILE_LOADED 7-00000028 CHAR LSM_FILE_NAME 4-0000000C I*4 LSM_IOSTAT 7-00000050 CHAR LSM_MESSAGE_FILE 6-00000014 I*4 LSM_REVISION_NUMBER 6-00000010 L*4 LSO_FILE_LOADED 6-00000008 I*4 MESSAGE_COUNT 6-00000004 I*4 MESSAGE_UNIT_NUM 2-000002A4 R*4 NUMBER_VALUE ** I*4 POSITION AP-00000018@ L*4 REDEFINED AP-00000008@ I*4 SECTION_INDEX 2-00000280 CHAR STRING_VALUE 2-000002A0 I*4 TOKEN AP-00000004@ I*4 UNIT_NUM ARRAYS Address Type Name Bytes Dimensions 3-00000424 I*4 DATA_TYPE 96 (24) AP-00000010@ I*4 FIRST_ITEM_INTEGER ** (*) AP-00000014@ R*4 FIRST_ITEM_REAL ** (*) 3-00000484 I*4 INDEX_TO_SECTION 96 (24) 3-000003C4 I*4 NUM_ACTIVE_VARIABLES 96 (24) AP-0000000C@ I*4 RANGES 20 (5) 2-00000000 L*4 RANGES_L 640 (32, 5) 5-00000000 CHAR TOKEN_STRING 1220 (61) 3-000001E4 I*4 VARIABLE_ORDER 480 (5, 24) 3-00000004 I*4 WIDTHS 480 (5, 24) ASSIGN_SINGLE 4-Dec-1991 11:47:04 VAX FORTRAN V5.4-79 Page 5 01 4-Dec-1991 11:06:36 ASSIGN_SINGLE.FOR;4 LABELS Address Label 0-000002B6 999 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name CHECK_NEXT_TOKEN ENUMERATED_TO_REAL FINISH_SECTION L*4 FOR$BJTEST MESSAGE_OUT COMMAND QUALIFIERS FOR/LIST [.SOURCE]ASSIGN_SINGLE.FOR /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /DESIGN=(NOCOMMENTS,NOPLACEHOLDERS) /SHOW=(NODICTIONARY,NOINCLUDE,MAP,NOPREPROCESSOR,SINGLE) /STANDARD=(NOSEMANTIC,NOSOURCE_FORM,NOSYNTAX) /WARNINGS=(NODECLARATIONS,GENERAL,NOULTRIX,NOVAXELN) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /I4 /NOMACHINE_CODE /OPTIMIZE /NOPARALLEL /NOANALYSIS_DATA /NODIAGNOSTICS /LIST=MSUTRGROOT:[000000.TRG_OFFLINE.SOURCE_LSMPROG]ASSIGN_SINGLE.LIS;1 /OBJECT=MSUTRGROOT:[000000.TRG_OFFLINE.SOURCE_LSMPROG]ASSIGN_SINGLE.OBJ;2 COMPILATION STATISTICS Run Time: 0.94 seconds Elapsed Time: 2.02 seconds Page Faults: 412 Dynamic Memory: 624 pages