1 2 3 SUBROUTINE INCLUD 4 !*********************************************************************** 5 !* INCLUD Module of ISCST3 Model 6 !* 7 !* PURPOSE: To read an external receptor/source file using the 8 !* INCLUDED keyword. 9 !* 10 !* PROGRAMMER: Jayant Hardikar, Roger Brode 11 !* 12 !* DATE: September 30, 1995 13 !* 14 !* MODIFIED: 15 !* 16 !* INPUTS: 17 !* 18 !* OUTPUTS: 19 !* 20 !* 21 !* CALLED FROM: MAIN 22 !*********************************************************************** 23 24 !* Variable Declarations 25 USE MAIN1 26 IMPLICIT NONE 27 CHARACTER MODNAM*12 28 29 SAVE 30 INTEGER :: I , ILREAL 31 LOGICAL NOPATH , NOKEY 32 CHARACTER RDFRM*20 , ECFRM*20 33 CHARACTER INPFLD*2 , PATHWY(7)*2 34 INTERFACE 35 SUBROUTINE EXPATH(INPFLD,PATHWY,IPN,NOPATH) 36 CHARACTER(LEN=2) , INTENT(IN) :: INPFLD 37 CHARACTER(LEN=2) , INTENT(IN) , DIMENSION(:) :: PATHWY 38 INTEGER , INTENT(IN) :: IPN 39 LOGICAL , INTENT(OUT) :: NOPATH 40 END 41 END INTERFACE 42 43 !* Variable Initializations 44 MODNAM = 'INCLUD' ! 0 45 EOF = .FALSE. 46 ILINE = 1 47 48 ! Setup READ format and ECHO format for runstream record, 49 ! based on the ISTRG PARAMETER (set in MAIN1) 50 WRITE (RDFRM,9100) ISTRG , ISTRG 51 9100 FORMAT ('(A',I3.3,',T1,',I3.3,'A1)') 52 WRITE (ECFRM,9250) ISTRG 53 9250 FORMAT ('(1X,A',I3.3,')') 54 55 56 IF ( IFC.EQ.3 ) THEN 57 ! Retrieve Included Filename as Character Substring to Maintain Case 58 INCFIL = RUNST1(LOCB(3):LOCE(3)) ! 0 59 OPEN (INCUNT,FILE=INCFIL,STATUS='OLD',ERR=99) 60 61 ELSEIF ( IFC.GT.4 ) THEN 62 ! WRITE Error Message ! Too Many Parameters 63 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 64 ELSE 65 ! WRITE Error Message ! No Parameters Specified 66 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 67 ENDIF 68 69 GOTO 1001 ! 0 70 71 ! Write Out Error Message for File OPEN Error 72 99 CALL ERRHDL(PATH,MODNAM,'E','500','INCFILE ') ! 0 73 GOTO 1002 74 75 1001 CONTINUE ! 0 76 77 78 ! LOOP Through Input Runstream Records 79 DO WHILE ( .NOT.EOF ) 80 81 ! Increment the Line Counter. It was Initially Set to 1, to Handle 82 ! the Code in Subroutine DEFINE 83 ILINE = ILINE + 1 ! 0 84 ILREAL = ILREAL + 1 85 86 ! READ Record to Buffers, as A80 and 80A1 for ISTRG = 80. 87 ! Length of ISTRG is Set in PARAMETER Statement in MAIN1 88 READ (INCUNT,RDFRM,END=999) RUNST1 , (RUNST(I),I=1,ISTRG) 89 90 ! Convert Lower Case to Upper Case Letters --- CALL LWRUPR 91 CALL LWRUPR ! 0 92 93 ! Define Fields on Card --- CALL DEFINE 94 CALL DEFINE 95 96 IF ( ILREAL.EQ.1 ) ILINE = ILINE - 1 97 98 ! Get the Contents of the Fields --- CALL GETFLD 99 CALL GETFLD 100 101 ! If Blank Line, Then CYCLE to Next Card 102 IF ( BLINE ) GOTO 11 103 104 ! Check for 'NO ECHO' In First Two Fields 105 ! Skip record with NO ECHO in INCLUDED file, but leave ECHO "on" 106 IF ( FIELD(1).EQ.'NO' .AND. FIELD(2).EQ.'ECHO' ) GOTO 11 ! 0 107 108 ! Extract Pathway ID From Field 1 --- CALL EXPATH 109 PATHWY(1) = 'CO' ! 0 110 PATHWY(2) = 'SO' 111 PATHWY(3) = 'RE' 112 PATHWY(4) = 'ME' 113 PATHWY(5) = 'TG' 114 PATHWY(6) = 'OU' 115 PATHWY(7) = '**' 116 CALL EXPATH(FIELD(1),PATHWY,7,NOPATH) 117 118 ! For Invalid Pathway and Comment Lines Skip to Next Record 119 IF ( NOPATH ) THEN 120 ! WRITE Error Message ! Invalid Pathway ID 121 CALL ERRHDL(PPATH,MODNAM,'E','100',PATH) ! 0 122 PATH = PPATH 123 GOTO 11 124 ELSEIF ( PATH.EQ.'**' ) THEN 125 GOTO 11 ! 0 126 ENDIF 127 128 ! Extract Keyword From Field 2 --- CALL EXKEY 129 CALL EXKEY(FIELD(2),NOKEY) ! 0 130 131 IF ( NOKEY ) THEN 132 ! WRITE Error Message ! Invalid Keyword 133 CALL ERRHDL(PATH,MODNAM,'E','105',KEYWRD) ! 0 134 PKEYWD = KEYWRD 135 GOTO 11 136 ENDIF 137 138 ! Check for Proper Order of Setup Cards --- CALL SETORD 139 IF ( KEYWRD.NE.'STARTING' .AND. KEYWRD.NE.'FINISHED' ) & 140 & CALL SETORD 141 142 ! First Check for Invalid Keywords (STARTING, FINISHED, INCLUDED) 143 IF ( KEYWRD.EQ.'STARTING' ) THEN 144 ! Cannot Use the STARTING keyword in the INCLUDED file 145 CALL ERRHDL(PATH,MODNAM,'E','140',KEYWRD) ! 0 146 147 ELSEIF ( KEYWRD.EQ.'INCLUDED' ) THEN 148 ! Cannot Recurse the INCLUDED Keyword in the INCLUDED file 149 ! Write Error Message: Repeat INCLUDED In Same Pathway 150 CALL ERRHDL(PATH,MODNAM,'E','135',KEYWRD) ! 0 151 152 ELSEIF ( KEYWRD.EQ.'FINISHED' ) THEN 153 ! Cannot Use the FINISHED Keyword in the INCLUDED File 154 CALL ERRHDL(PATH,MODNAM,'E','140',KEYWRD) ! 0 155 156 ! Process Input Card Based on Pathway 157 ELSEIF ( PATH.EQ.'SO' ) THEN 158 ! Process SOurce Pathway Cards --- CALL SOCARD 159 CALL SOCARD ! 0 160 ELSEIF ( PATH.EQ.'RE' ) THEN 161 ! Process REceptor Pathway Cards --- CALL RECARD 162 CALL RECARD ! 0 163 ELSEIF ( PATH.EQ.'EV' ) THEN 164 ! Process EVent Pathway Cards --- CALL EVCARD 165 CALL EVCARD ! 0 166 167 ENDIF 168 169 ! Store the Current Keyword as the Previous Keyword 170 PKEYWD = KEYWRD ! 0 171 172 GOTO 11 173 999 EOF = .TRUE. ! 0 174 11 CONTINUE ! 0 175 176 ENDDO 177 EOF = .FALSE. ! 0 178 179 ! Close the INCLUDED File 180 CLOSE (INCUNT) 181 182 1002 CONTINUE ! 0 183 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use