1 2 SUBROUTINE EVALFL 3 !*********************************************************************** 4 ! EVALFL Module of AERMOD 5 ! 6 ! PURPOSE: Output ARC Values for EVALFILE Option 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: November 29, 1993 11 ! 12 ! REVISIONS: Added true centerline calculations. 13 ! Changed 7/25/94, R.F. Lee. 14 ! 15 ! INPUTS: 16 ! 17 ! OUTPUTS: 18 ! 19 ! CALLED FROM: PCALC 20 !*********************************************************************** 21 22 ! Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 REAL :: CWIC , CWICN , CWICW , CWICL , UOUST , SVOU , HEOZI , & 27 & ZIOL , FSTAR , UOWST , XNDIM , PWSTAR , UOUT , SYOUT , & 28 & OBUOUT 29 30 SAVE 31 INTEGER :: I , INDEX 32 33 ! Variable Initializations 34 MODNAM = 'EVALFL' ! 0 35 36 ! LOOP Through ARCs 37 DO I = 1 , NUMARC 38 !C 39 !C Changes dated 2/25/94, 3/2/94, 3/4/94, 3/8/94, 3/9/94, 3/14/94, 40 !C and 4/20/94 41 !C by Russ Lee, to add Bowen Ratio and additional parameters. 42 !C 43 ! Calculate Crosswind Integrated Concentration, CWIC 44 !CRFL 45 !CRFL "ARCMAX" was changed to ARCCL in the following statement to 46 !CRFL give a "true" CWIC. Changed 7/25/94, R.F. Lee. 47 !CRFL 48 !RWB CWIC = SRT2PI * SYMAX(I) * ARCCL(I) 49 !RWB Modify CWIC to be sum of CWIC's of individual "plumes". 2/13/95 50 !RWB Note that WRAP and LIFT components are included in ARCCL. 51 IF ( (STABLE .OR. (UNSTAB .AND. HS.GE.ZI)) ) THEN ! 0 52 CWIC = SRT2PI*SYMAX(I)*ARCCL(I) ! 0 53 ! Now calculate CWIC with U*ZI normalization, 54 ! using maximum of HE & ZI, instead of ZI. 55 CWICN = CWIC*UMAX(I)*AMAX1(HEMAX(I),ZI) 56 ELSE 57 ! Calculate WRAP and LIFT components of CWIC 58 ! First calculate CWIC without U*ZI normalization. 59 ! Note that the CHIDM_, CHINM_ and CHI3M_ terms have already been 60 ! normalized by QTK. 61 CWICW = SRT2PI*SYMAX(I)*(CHIDMW(I)+CHINMW(I)) & 62 & + SRT2PI*SY3MX(I)*CHI3MW(I) 63 CWICL = SRT2PI*SYMAX(I)*(CHIDML(I)+CHINML(I)) & 64 & + SRT2PI*SY3MX(I)*CHI3ML(I) 65 ! Combine WRAP and LIFT components. Include decay and normalization. 66 CWIC = (FOPT*CWICW+(1.0-FOPT)*CWICL)*D 67 68 ! Calculate WRAP and LIFT components of CWIC 69 ! Now calculate CWIC with U*ZI normalization. 70 ! Use HPEN (=AMAX1(HE3,ZI)) for penetrated source instead of ZI. 71 CWICW = SRT2PI*SYMAX(I)*UMAX(I)*ZI*(CHIDMW(I)+CHINMW(I)) & 72 & + SRT2PI*SY3MX(I)*U3MAX(I)*HPEN*CHI3MW(I) 73 CWICL = SRT2PI*SYMAX(I)*UMAX(I)*ZI*(CHIDML(I)+CHINML(I)) & 74 & + SRT2PI*SY3MX(I)*U3MAX(I)*HPEN*CHI3ML(I) 75 ! Combine WRAP and LIFT components. Include decay and normalization. 76 CWICN = (FOPT*CWICW+(1.0-FOPT)*CWICL)*D 77 78 ENDIF 79 80 ! Calculate U/Ustar 81 IF ( USTAR.GE.1.0E-10 ) THEN ! 0 82 UOUST = UMAX(I)/USTAR ! 0 83 ELSE 84 UOUST = -999. ! 0 85 ENDIF 86 87 ! Calculate sigma-v / U 88 IF ( UMAX(I).GE.1.0E-10 ) THEN ! 0 89 SVOU = SVMAX(I)/UMAX(I) ! 0 90 ELSE 91 SVOU = -999. ! 0 92 ENDIF 93 94 ! Calculate He / Zi 95 IF ( ZI.GE.1.0E-10 ) THEN ! 0 96 HEOZI = HEMAX(I)/ZI ! 0 97 ELSE 98 HEOZI = -999. ! 0 99 ENDIF 100 101 ! Calculate Zi / L 102 IF ( ABS(OBULEN).GE.1.0E-10 ) THEN ! 0 103 ZIOL = ZI/OBULEN ! 0 104 ELSE 105 ZIOL = 999. ! 0 106 ENDIF 107 108 !RWBC Calculate total F 109 !RWB FTOT = FB + FM 110 !RWB Replace FTOT with FSTAR (non-dimensional buoyancy flux). 2/13/95 111 !RWB Note that UP is the latest value for plume rise wind speed 112 !RWB from the iterative stable plume rise. 113 IF ( WSTAR.GE.1.0E-10 ) THEN ! 0 114 FSTAR = FB/(UP*WSTAR*WSTAR*ZI) ! 0 115 ELSE 116 FSTAR = -999. ! 0 117 ENDIF 118 119 IF ( OBULEN.LT.0. ) THEN ! 0 120 121 ! Calculate U / WSTAR when L < 0 122 IF ( WSTAR.GE.1.0E-10 ) THEN ! 0 123 UOWST = UMAX(I)/WSTAR ! 0 124 ELSE 125 UOWST = -999. ! 0 126 ENDIF 127 128 ! Calculate nondimensional distance when L < 0 129 IF ( UMAX(I).GE.1.0E-10 .AND. ZI.GE.1.0E-10 ) THEN ! 0 130 XNDIM = DXMAX(I)*WSTAR/(UMAX(I)*ZI) ! 0 131 ELSE 132 XNDIM = -999. ! 0 133 ENDIF 134 !crfl 5/18/95 When unstable, put WSTAR into PWSTAR variable to be printed. 135 PWSTAR = WSTAR ! 0 136 137 ELSE 138 139 ! Set UOWST and XNDIM to -999 when L >= 0 140 UOWST = -999. ! 0 141 XNDIM = -999. 142 !crfl 5/18/95 When stable, put Sigma-Z into PWSTAR variable to be printed. 143 PWSTAR = SZMAX(I) 144 ENDIF 145 146 !CRFL 147 !CRFL Added ARCCL(I), arc true centerline concentration for the arc. 148 !CRFL Change made 7/25/94, R.F. Lee. 149 !CRFL 150 !RWB WRITE(IELUNT(ISRC),9000) SRCID(ISRC), KURDAT, ARCID(I), 151 !RWB & ARCMAX(I), QMAX(I), CWIC, 152 !RWB & DXMAX(I), UMAX(I), SVMAX(I), 153 !RWB & SWMAX(I), SYMAX(I), HEMAX(I), 154 !RWB & OBULEN, ZI, USTAR, WSTAR, FB, FM, 155 !RWB & BOWEN, UOUST, SVOU, ZIOL, UOWST, XNDIM, 156 !RWB & HEOZI, FTOT, AHS(ISRC), ARCCL(I), DOPTS 157 !RWBCRWB Added DOPTS, Developmental Options (C*10) 158 159 !RWB Modified to output CHI's for individual "plumes". 2/13/95 160 !RWB First select appropriate sigma-y to print out. Use SY3 for mostly 161 !RWB penetrated plumes. 162 IF ( UNSTAB .AND. HS.LT.ZI .AND. PPF.GT.0.999 ) THEN ! 0 163 UOUT = U3MAX(I) ! 0 164 SYOUT = SY3MX(I) 165 ELSE 166 UOUT = UMAX(I) ! 0 167 SYOUT = SYMAX(I) 168 ENDIF 169 170 IF ( URBSTAB ) THEN ! 0 171 OBUOUT = ABS(URBOBULEN) ! 0 172 ELSE 173 OBUOUT = OBULEN ! 0 174 ENDIF 175 176 177 !crfl 5/18/95 Changed WSTAR to PWSTAR so I could output another variable 178 !crfl (Sigma-Z) in stable conditions without upsetting WSTAR. 179 WRITE (IELUNT(ISRC),9000) SRCID(ISRC) , KURDAT , ARCID(I) , & 180 & ARCMAX(I) , QMAX(I) , CWIC , CWICN , & 181 & DXMAX(I) , UOUT , SVMAX(I) , SWMAX(I)& 182 & , SYOUT , HEMAX(I) , OBUOUT , ZI , & 183 & USTAR , PWSTAR , FB , FM , BOWEN , & 184 & PPF , CHIDML(I) , CHINML(I) , & 185 & CHI3ML(I) , XNDIM , HEOZI , FSTAR , & 186 & AHS(ISRC) , ARCCL(I) , AFV , & 187 & HSBLMX(I) 188 189 !CRFL & /,9X,6(1X,G12.4),/,9X,3(1X,G12.4)) 190 9000 FORMAT (1X,A8,1X,I8.8,1X,A8,4(1X,G12.6),/,9X,6(1X,G12.4),/,9X, & 191 & 6(1X,G12.4),/,9X,6(1X,G12.4),/,9X,4(1X,G12.4),1X, & 192 & '0000000000',1X,G12.4,1X,G12.4) 193 !RWB Added Flow Vector, AFV 194 !RWB Added height of effective reflecting surface, HSBLMX 195 196 197 ENDDO 198 !C End of changes dated 2/25/94 through 3/14/94 by Russ Lee 199 !C 200 201 CONTINUE ! 0 202 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