1 2 SUBROUTINE VRTSBL(SZARG,HEARG,ZIARG) 3 !*********************************************************************** 4 ! VRTSBL Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Calculates Vertical Term for Use in Gaussian Plume 7 ! Equation for Stable Conditions. 8 ! 9 ! PROGRAMMER: Roger Brode 10 ! 11 ! DATE: September 30, 1993 12 ! 13 ! MODIFIED BY R.W. Brode, PES, Inc. to adjust HE and ZI for cases 14 ! with receptors below stack base (ZR < 0) - 12/26/00 15 ! 16 ! INPUTS: Plume Height, HE 17 ! Vertical Dispersion Parameter, SZ 18 ! Mixing/Reflection Height, HSBL (= max(zi,he)) 19 ! Receptor Height, ZR 20 ! 21 ! OUTPUTS: Vertical Term, FSUBZ 22 ! 23 ! ASSUMPTIONS: Vertical term for STABLE plumes includes 24 ! multiple reflection terms. 25 ! 26 ! REVISIONS: Concentrations for receptors above HSBL forced 27 ! to zero. Change made 8/31/94 by R.F. Lee. 28 ! 29 ! CALLED FROM: WRAP, LIFT 30 !*********************************************************************** 31 32 ! Variable Declarations 33 USE MAIN1 34 IMPLICIT NONE 35 CHARACTER MODNAM*12 36 INTEGER :: I 37 REAL :: SZARG , HEARG , ZIARG , A1 , A2 , A3 , A4 , A5 , A6 , & 38 & TWOIZI , SUM , T , V 39 REAL :: HETMP , ZITMP 40 41 SAVE 42 43 ! Variable Initializations 44 MODNAM = 'VRTSBL' ! 17634K 45 V = 0.0 46 47 IF ( ZR.EQ.0.0 ) THEN 48 ! Vertical Term for Case With FLAT Terrain and No Flagpole 49 ! Receptor (ZR = 0.0) 50 A1 = (-0.5/(SZARG*SZARG))*HEARG*HEARG ! 17634K 51 IF ( A1.GT.EXPLIM ) V = EXP(A1) 52 SUM = 0.0 53 DO I = 1 , 100 54 T = 0.0 ! 18600K 55 ! Use ZIARG (set in PCALC = max(HE,ZI)) instead of ZI. 56 TWOIZI = 2.*I*ZIARG 57 A2 = (-0.5/(SZARG*SZARG))*(TWOIZI-HEARG)*(TWOIZI-HEARG) 58 A3 = (-0.5/(SZARG*SZARG))*(TWOIZI+HEARG)*(TWOIZI+HEARG) 59 IF ( A2.GT.EXPLIM ) T = EXP(A2) 60 IF ( A3.GT.EXPLIM ) T = T + EXP(A3) 61 SUM = SUM + T 62 63 !RWB Modify convergence criterion to use relative value of T 64 ! Exit Loop 65 IF ( ABS(T).LE.5.0E-7*ABS(SUM) ) GOTO 50 66 ENDDO 67 ! Calculate Total Vert. Term - (2.*) was Removed for Optimization 68 50 V = 2.*(V+SUM) ! 17634K 69 70 ELSEIF ( ZR.LE.ZIARG ) THEN 71 ! Vertical Term for Case of ZR .NE. 0.0 72 ! First adjust for terrain below stack base with ZR < 0, 73 ! by keeping HE and ZI horizontal. 74 HETMP = MAX(HEARG,HEARG-ZR) ! 0 75 ZITMP = MAX(ZIARG,ZIARG-ZR) 76 77 A1 = (-0.5/(SZARG*SZARG))*(ZR-HETMP)*(ZR-HETMP) 78 A2 = (-0.5/(SZARG*SZARG))*(ZR+HETMP)*(ZR+HETMP) 79 IF ( A1.GT.EXPLIM ) V = EXP(A1) 80 IF ( A2.GT.EXPLIM ) V = V + EXP(A2) 81 SUM = 0.0 82 DO I = 1 , 100 83 T = 0.0 ! 0 84 TWOIZI = 2.*I*ZITMP 85 A3 = (-0.5/(SZARG*SZARG))*(ZR-(TWOIZI-HETMP)) & 86 & *(ZR-(TWOIZI-HETMP)) 87 A4 = (-0.5/(SZARG*SZARG))*(ZR+(TWOIZI-HETMP)) & 88 & *(ZR+(TWOIZI-HETMP)) 89 A5 = (-0.5/(SZARG*SZARG))*(ZR-(TWOIZI+HETMP)) & 90 & *(ZR-(TWOIZI+HETMP)) 91 A6 = (-0.5/(SZARG*SZARG))*(ZR+(TWOIZI+HETMP)) & 92 & *(ZR+(TWOIZI+HETMP)) 93 IF ( A3.GT.EXPLIM ) T = T + EXP(A3) 94 IF ( A4.GT.EXPLIM ) T = T + EXP(A4) 95 IF ( A5.GT.EXPLIM ) T = T + EXP(A5) 96 IF ( A6.GT.EXPLIM ) T = T + EXP(A6) 97 SUM = SUM + T 98 99 !RWB Modify convergence criterion to use relative value of T 100 ! Exit Loop 101 IF ( ABS(T).LE.1.0E-6*ABS(SUM) ) GOTO 100 102 ENDDO 103 100 V = V + SUM ! 0 104 !CRFL 105 !CRFL Add 'ELSE' to cover case where receptor is above HSBL, and 106 !CRFL set V = 0 for that case. 107 ELSE 108 V = 0.0 ! 0 109 ENDIF 110 111 ! Calculate FSUBZ from V; FSUBZ = V / (SQRT(2*PI) * SZARG) 112 FSUBZ = V/(SRT2PI*SZARG) ! 17634K 113 114 CONTINUE 115 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