1 SUBROUTINE SETUP 2 !*********************************************************************** 3 ! SETUP Module of the AMS/EPA Regulatory Model - AERMOD 4 ! 5 ! PURPOSE: Controls Processing of Run SETUP Information 6 ! 7 ! PROGRAMMER: Roger Brode, Jeff Wang 8 ! 9 ! MODIFIED BY D. Strimaitis, SRC (for GRIDDED TERRAIN Processing) 10 ! 11 ! MODIFIED: Determine final settings for DRYDPLT and WETDPLT; 12 ! reassign as .FALSE. if no deposition calculations 13 ! are invoked. Modify MODOPS header accordingly. 14 ! R.W. Brode, MACTEC/PES, Inc. - 10/26/2004 15 ! 16 ! MODIFIED: Moved the code to insert a blank line in temporary event 17 ! file after each pathway from SUB EVEFIL. 18 ! R.W. Brode, PES, Inc. - November 15, 1995. 19 ! 20 ! MODIFIED: Default format for METFRM modified to eliminate the 21 ! variable ZDM on input. 22 ! BY: J. Paumier, PES DATE: 27 July 1994 23 ! 24 ! DATE: December 15, 1993 25 ! 26 ! INPUTS: Input Runstream File 27 ! 28 ! OUTPUTS: Processing Option Switches 29 ! Arrays of Source Parameters 30 ! Arrays of Receptor Locations 31 ! Meteorological Data Specifications 32 ! Terrain Grid Data Specifications 33 ! Output Options 34 ! 35 ! CALLED FROM: MAIN 36 !*********************************************************************** 37 ! 38 ! Variable Declarations 39 USE MAIN1 40 IMPLICIT NONE 41 CHARACTER MODNAM*12 42 43 SAVE 44 INTEGER :: I , IFSTAT 45 LOGICAL NOPATH , NOKEY 46 CHARACTER RDFRM*20 , ECFRM*20 , EVFRM*20 47 CHARACTER INPFLD*2 , PATHWY(7)*2 48 INTERFACE 49 SUBROUTINE EXPATH(INPFLD,PATHWY,IPN,NOPATH) 50 CHARACTER(LEN=2) , INTENT(IN) :: INPFLD 51 CHARACTER(LEN=2) , INTENT(IN) , DIMENSION(:) :: PATHWY 52 INTEGER , INTENT(IN) :: IPN 53 LOGICAL , INTENT(OUT) :: NOPATH 54 END 55 END INTERFACE 56 57 58 ! Variable Initializations 59 MODNAM = 'SETUP' ! 3 60 EOF = .FALSE. 61 ILINE = 0 62 63 ! Setup READ format and ECHO format for runstream record, 64 ! based on the ISTRG PARAMETER (set in MAIN1) 65 WRITE (RDFRM,9100) ISTRG , ISTRG 66 9100 FORMAT ('(A',I3.3,',T1,',I3.3,'A1)') 67 WRITE (ECFRM,9250) ISTRG 68 9250 FORMAT ('(1X,A',I3.3,')') 69 WRITE (EVFRM,9300) ISTRG 70 9300 FORMAT ('(A',I3.3,')') 71 72 ! LOOP Through Input Runstream Records 73 DO WHILE ( .NOT.EOF ) 74 75 ! Increment the Line Counter 76 ILINE = ILINE + 1 ! 408 77 78 ! READ Record to Buffers, as A80 and 80A1 for ISTRG = 80. 79 ! Length of ISTRG is Set in PARAMETER Statement in MAIN1 80 READ (INUNIT,RDFRM,END=999) RUNST1 , (RUNST(I),I=1,ISTRG) 81 82 ! Convert Lower Case to Upper Case Letters --- CALL LWRUPR 83 CALL LWRUPR ! 408 84 85 ! Define Fields on Card --- CALL DEFINE 86 CALL DEFINE 87 88 ! Get the Contents of the Fields --- CALL GETFLD 89 CALL GETFLD 90 91 IF ( ECHO .AND. (FIELD(1).EQ.'OU' .AND. FIELD(2).EQ.'FINISHED')& 92 & ) THEN 93 ! Echo Last Input Card to Output File (Use Character Substring to 94 ! Avoid Echoing ^Z Which May Appear at "End of File" for Some 95 ! Editors). Also, Allow for Shift in the Input Runstream File of 96 ! Up to 3 Columns. 97 IF ( LOCB(1).EQ.1 ) THEN ! 3 98 WRITE (IOUNIT,9200) RUNST1(1:11) ! 3 99 9200 FORMAT (' ',A11) 100 ELSEIF ( LOCB(1).EQ.2 ) THEN 101 WRITE (IOUNIT,9210) RUNST1(1:12) ! 0 102 9210 FORMAT (' ',A12) 103 ELSEIF ( LOCB(1).EQ.3 ) THEN 104 WRITE (IOUNIT,9220) RUNST1(1:13) ! 0 105 9220 FORMAT (' ',A13) 106 ELSEIF ( LOCB(1).EQ.4 ) THEN 107 WRITE (IOUNIT,9230) RUNST1(1:14) ! 0 108 9230 FORMAT (' ',A14) 109 ENDIF 110 ELSEIF ( ECHO ) THEN 111 ! Echo Full Input Card to Output File 112 WRITE (IOUNIT,ECFRM) RUNST1 ! 405 113 ENDIF 114 115 ! If Blank Line, Then CYCLE to Next Card 116 IF ( BLINE ) GOTO 11 ! 408 117 118 ! Check for 'NO ECHO' In First Two Fields 119 IF ( FIELD(1).EQ.'NO' .AND. FIELD(2).EQ.'ECHO' ) THEN ! 375 120 ECHO = .FALSE. ! 0 121 GOTO 11 122 ENDIF 123 124 ! Extract Pathway ID From Field 1 --- CALL EXPATH 125 PATHWY(1) = 'CO' ! 375 126 PATHWY(2) = 'SO' 127 PATHWY(3) = 'RE' 128 PATHWY(4) = 'ME' 129 PATHWY(5) = 'TG' 130 PATHWY(6) = 'OU' 131 PATHWY(7) = '**' 132 CALL EXPATH(FIELD(1),PATHWY,7,NOPATH) 133 134 ! For Invalid Pathway and Comment Lines Skip to Next Record 135 IF ( NOPATH ) THEN 136 ! WRITE Error Message ! Invalid Pathway ID 137 CALL ERRHDL(PPATH,MODNAM,'E','100',PATH) ! 0 138 PATH = PPATH 139 GOTO 11 140 ELSEIF ( PATH.EQ.'**' ) THEN 141 GOTO 11 ! 6 142 ENDIF 143 144 ! Extract Keyword From Field 2 --- CALL EXKEY 145 CALL EXKEY(FIELD(2),NOKEY) ! 369 146 147 IF ( NOKEY ) THEN 148 ! WRITE Error Message ! Invalid Keyword 149 CALL ERRHDL(PATH,MODNAM,'E','105',KEYWRD) ! 0 150 PKEYWD = KEYWRD 151 GOTO 11 152 ENDIF 153 154 ! Check for Proper Order of Setup Cards --- CALL SETORD 155 CALL SETORD ! 369 156 157 ! Process Input Card Based on Pathway 158 IF ( PATH.EQ.'CO' ) THEN 159 ! Process COntrol Pathway Cards --- CALL COCARD 160 CALL COCARD ! 21 161 ! Echo Runstream Image to Temporary Event File (Except ELEVUNIT, 162 ! EVENTFIL, SAVEFILE, INITFILE & MULTYEAR) 163 IF ( KEYWRD.NE.'ELEVUNIT' .AND. KEYWRD.NE.'EVENTFIL' .AND. & 164 & KEYWRD.NE.'SAVEFILE' .AND. KEYWRD.NE.'INITFILE' .AND. & 165 & KEYWRD.NE.'MULTYEAR' ) WRITE (ITEVUT,EVFRM) RUNST1 166 IF ( KEYWRD.EQ.'FINISHED' ) WRITE (ITEVUT,*) ' ' 167 ELSEIF ( PATH.EQ.'SO' ) THEN 168 ! Echo Runstream Image to Temporary Event File 169 WRITE (ITEVUT,EVFRM) RUNST1 ! 291 170 ! Process SOurce Pathway Cards --- CALL SOCARD 171 CALL SOCARD 172 IF ( KEYWRD.EQ.'FINISHED' ) WRITE (ITEVUT,*) ' ' 173 ELSEIF ( PATH.EQ.'RE' ) THEN 174 ! Process REceptor Pathway Cards --- CALL RECARD 175 CALL RECARD ! 21 176 ELSEIF ( PATH.EQ.'ME' ) THEN 177 ! Process MEteorology Pathway Cards --- CALL MECARD 178 CALL MECARD ! 24 179 ! Echo Runstream Image to Temporary Event File (Except STARTEND 180 ! & DAYRANGE) 181 IF ( KEYWRD.NE.'STARTEND' .AND. KEYWRD.NE.'DAYRANGE' ) & 182 & WRITE (ITEVUT,EVFRM) RUNST1 183 IF ( KEYWRD.EQ.'FINISHED' ) WRITE (ITEVUT,*) ' ' 184 ELSEIF ( PATH.EQ.'TG' ) THEN 185 ! Process Terrain Grid Pathway Cards --- CALL TGCARD 186 CALL TGCARD ! 0 187 ! Echo Runstream Image to Temporary Event File 188 WRITE (ITEVUT,EVFRM) RUNST1 189 IF ( KEYWRD.EQ.'FINISHED' ) WRITE (ITEVUT,*) ' ' 190 ELSEIF ( PATH.EQ.'OU' ) THEN 191 ! Process OUtput Pathway Cards --- CALL OUCARD 192 CALL OUCARD ! 12 193 ENDIF 194 195 ! Store the Current Keyword as the Previous Keyword 196 PKEYWD = KEYWRD ! 369 197 198 ! Check for 'OU FINISHED' Card. Exit DO WHILE Loop By Branching 199 ! to Statement 999 in Order to Avoid Reading a ^Z "End of File" 200 ! Marker That May Be Present For Some Editors. 201 IF ( PATH.EQ.'OU' .AND. KEYWRD.EQ.'FINISHED' ) GOTO 999 202 203 GOTO 11 ! 366 204 999 EOF = .TRUE. ! 3 205 11 CONTINUE ! 408 206 ENDDO 207 208 ! Reinitialize Line Number Counter to Count Meteorology Data 209 ILINE = 0 ! 3 210 211 ! Check That All Pathways Were Finished 212 IF ( ICSTAT(25).NE.1 .OR. ISSTAT(25).NE.1 .OR. IRSTAT(25) & 213 & .NE.1 .OR. IMSTAT(25).NE.1 .OR. IOSTAT(25).NE.1 ) THEN 214 ! Runstream File Incomplete, Save I?STAT to IFSTAT and Write Message 215 IFSTAT = ICSTAT(25)*10000 + ISSTAT(25)*1000 + IRSTAT(25) & 216 & *100 + IMSTAT(25)*10 + IOSTAT(25) 217 WRITE (DUMMY,'(I5.5)') IFSTAT 218 CALL ERRHDL(PATH,MODNAM,'E','125',DUMMY) 219 ENDIF 220 221 ! Determine final settings for DRYDPLT and WETDPLT; reassign as 222 ! .FALSE. if no deposition calculations invoked. Modify MODOPS 223 ! header accordingly. 224 IF ( .NOT.LDPART .AND. .NOT.LDGAS ) THEN ! 3 225 ! No dry deposition calcs 226 DDPLETE = .FALSE. ! 3 227 MODOPS(13) = ' ' 228 ENDIF 229 IF ( .NOT.LWPART .AND. .NOT.LWGAS ) THEN ! 3 230 ! No wet deposition calcs 231 WDPLETE = .FALSE. ! 3 232 MODOPS(14) = ' ' 233 ENDIF 234 235 CONTINUE ! 3 236 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