1 2 SUBROUTINE HRQEXT(IS) 3 !*********************************************************************** 4 !* HRQEXT Module of AERMOD 5 !* 6 !* PURPOSE: To Assign Hourly Source Parameters 7 !* 8 !* PROGRAMMER: Jayant Hardikar, Roger Brode 9 !* 10 !* DATE: September 15, 1993 11 !* 12 !* INPUTS: Variable QFLAG and Current Source Number Being Processed 13 !* 14 !* OUTPUTS: Source Arrays 15 !* 16 !* MODIFIED: REMOVED THE 'POINT' SOURCE CONDITION, SO IT APPLIES 17 !* TO ALL SOURCE TYPES, EXCEPT SAVING THE TEMP & VEL 18 !* 19 !* CALLED FROM: HRLOOP 20 !************************************************************************ 21 !* 22 !* Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 27 SAVE 28 INTEGER :: I , IS , IHYEAR , IHMON , IHDAY , IHHOUR 29 CHARACTER RDFRM*20 30 31 CHARACTER*8 HRSOID 32 33 !* Variable Initializations 34 MODNAM = 'HRQEXT' ! 0 35 !* 36 !* READ Record to Buffers, A80 and 80A1 37 !* Length of ISTRG is Set in PARAMETER Statement in MAIN1 38 ! Setup READ format and ECHO format for runstream record, 39 ! based on the ISTRG PARAMETER (set in MAIN1) 40 WRITE (RDFRM,9100) ISTRG , ISTRG 41 9100 FORMAT ('(A',I3.3,',T1,',I3.3,'A1)') 42 READ (IHREMI,RDFRM,ERR=99,END=999) RUNST1 , (RUNST(I),I=1,ISTRG) 43 !* 44 !* Convert Lower Case to Upper Case Letters --- CALL LWRUPR 45 CALL LWRUPR ! 0 46 !* 47 !* Define Fields on Card --- CALL DEFINE 48 CALL DEFINE 49 !* 50 !* Get the Contents of the Fields --- CALL GETFLD 51 CALL GETFLD 52 !* 53 !* Check for number of fields - error if less than 7. 54 IF ( IFC.LT.7 ) THEN 55 CALL ERRHDL(PATH,MODNAM,'E','201','HOUREMIS') ! 0 56 RUNERR = .TRUE. 57 GOTO 999 58 ENDIF 59 !* 60 !* Assign the Fields to Local Varables and Check The Numerical Field 61 !* 62 CALL STONUM(FIELD(3),ILEN_FLD,FNUM,IMIT) ! 0 63 IHYEAR = NINT(FNUM) 64 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 65 66 CALL STONUM(FIELD(4),ILEN_FLD,FNUM,IMIT) 67 IHMON = NINT(FNUM) 68 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 69 70 CALL STONUM(FIELD(5),ILEN_FLD,FNUM,IMIT) 71 IHDAY = NINT(FNUM) 72 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 73 74 CALL STONUM(FIELD(6),ILEN_FLD,FNUM,IMIT) 75 IHHOUR = NINT(FNUM) 76 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 77 78 HRSOID = FIELD(7) 79 80 IF ( IFC.GE.8 ) THEN 81 CALL STONUM(FIELD(8),ILEN_FLD,HRQS,IMIT) ! 0 82 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 83 ELSE 84 !* Emission rate is missing - set to zero 85 HRQS = 0.0 ! 0 86 ENDIF 87 88 IF ( SRCTYP(IS).EQ.'POINT' .AND. IFC.EQ.10 ) THEN ! 0 89 !* Also Assign Exit Temperature and Exit Velocity 90 91 CALL STONUM(FIELD(9),ILEN_FLD,HRTS,IMIT) ! 0 92 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 93 94 CALL STONUM(FIELD(10),ILEN_FLD,HRVS,IMIT) 95 IF ( IMIT.NE.1 ) CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) 96 97 ELSEIF ( SRCTYP(IS).EQ.'POINT' ) THEN 98 !* Some missing parameters - assign zeros to all 99 HRTS = 0.0 ! 0 100 HRVS = 0.0 101 ENDIF 102 103 !* Check for Date and Time Consistency ; If Failed, Issue Fatal Error 104 KURHRQ = IHYEAR*1000000 + IHMON*10000 + IHDAY*100 + IHHOUR ! 0 105 IF ( KURDAT.NE.KURHRQ ) THEN 106 !* WRITE Error Message - Date mismatch 107 WRITE (DUMMY,'(I8.8)') KURDAT ! 0 108 CALL ERRHDL(PATH,MODNAM,'E','455',DUMMY) 109 RUNERR = .TRUE. 110 ENDIF 111 112 113 !* Check for Source ID Consistency ; If Failed - Abort Program 114 IF ( HRSOID.NE.SRCID(IS) ) THEN ! 0 115 WRITE (DUMMY,'(A8)') SRCID(IS) ! 0 116 CALL ERRHDL(PATH,MODNAM,'E','342',SRCID(IS)) 117 RUNERR = .TRUE. 118 ENDIF 119 120 !* Assign the Hourly Emission Parameters to the Stack Variables 121 AQS(IS) = HRQS ! 0 122 123 IF ( SRCTYP(IS).EQ.'POINT' ) THEN 124 ATS(IS) = HRTS ! 0 125 AVS(IS) = HRVS 126 ENDIF 127 128 129 !* Perform QA Error Checking on Source Parameters 130 !* 131 132 IF ( SRCTYP(IS).EQ.'POINT' ) THEN ! 0 133 IF ( ATS(IS).EQ.0.0 ) THEN ! 0 134 !* Set Temperature to Small Negative Value for Ambient Releases 135 ATS(IS) = -1.0E-5 ! 0 136 ELSEIF ( ATS(IS).GT.2000.0 ) THEN 137 !* WRITE Informational Message: Exit Temp. > 2000K 138 CALL ERRHDL(PATH,MODNAM,'I','320','HRTS') ! 0 139 ENDIF 140 141 IF ( AVS(IS).LT.0.0 ) THEN ! 0 142 !* WRITE Informational Message: Negative or Zero Exit Velocity 143 CALL ERRHDL(PATH,MODNAM,'I','325','HRVS') ! 0 144 !* Set to Small Value to Avoid Zero-divide and Underflow 145 AVS(IS) = 1.0E-5 146 ELSEIF ( AVS(IS).LT.1.0E-5 ) THEN 147 !* Set to Small Value to Avoid Zero-divide and Underflow 148 AVS(IS) = 1.0E-5 ! 0 149 ELSEIF ( AVS(IS).GT.50.0 ) THEN 150 !* WRITE Informational Message: Exit Velocity > 50.0 m/s 151 CALL ERRHDL(PATH,MODNAM,'I','320','HRVS') ! 0 152 ENDIF 153 ENDIF 154 155 GOTO 999 ! 0 156 157 !* Write Error Message for Error Reading Hourly Emissions File 158 99 CALL ERRHDL(PATH,MODNAM,'E','510','HOUREMIS') ! 0 159 RUNERR = .TRUE. 160 161 999 CONTINUE ! 0 162 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