1 SUBROUTINE DELTAH(XARG) 2 !*********************************************************************** 3 ! DELTAH Module of the AMS/EPA Regulatory Model - AERMOD 4 ! 5 ! PURPOSE: To calculate plume rise 6 ! 7 ! PROGRAMMER: Roger Brode, Jim Paumier, PES, Inc. 8 ! 9 ! DATE: September 30, 1993 10 ! 11 ! CHANGES: Modified to maintain better consistency with ISCST3 for 12 ! Schulman-Scire downwash algorithm. 13 ! Roger Brode, PES, Inc. - 12/6/99 14 ! 15 ! CHANGES: Corrected variable name from SVMP to SVPM. 16 ! Roger Brode, PES, Inc. - 5/24/99 17 ! 18 ! CHANGES: Added XARG as actual argument for CBLPRN. 19 ! Roger Brode, PES, Inc. - 12/5/94 20 ! 21 ! INPUTS: The distance at which to make the computation, XARG 22 ! 23 ! OUTPUTS: Distance-Dependent Plume Rise, DHP (m) 24 ! 25 ! CALLED FROM: PCALC 26 ! 27 ! Assumptions: All plume rise calculations are for gradual rise, 28 ! except in stable conditions when the downwind distance 29 ! exceeds XMAX 30 ! 31 ! References: "Dispersion in the Stable Boundary Layer", 32 ! A. Venkatram, 2/12/93 33 ! "A Dispersion Model for the Convective Boundary Layer", 34 ! J. Weil, 8/17/93 35 ! "Plume Penetration of the CBL and Source 3: Source 36 ! Strength and Plume Rise", J. Weil, 9/1/93 37 ! 38 !*********************************************************************** 39 40 ! Variable Declarations 41 USE MAIN1 42 IMPLICIT NONE 43 ! --- Include PRIME plume rise parameters 44 INCLUDE 'params.pri' 45 46 CHARACTER MODNAM*12 47 INTEGER :: KITER , NDXZPL 48 REAL :: XARG , XMAXTMP , XRISE , ZPLM , DHPOLD , DHFOUT , DTCRIT ,& 49 & DHCLM , DHCHK , SVPM , UPM , TGPM , PTPM , PTP 50 51 LOGICAL :: LDBHR 52 53 SAVE 54 55 ! Variable Initializations 56 MODNAM = 'DELTAH' !2021756 57 58 FSTREC = .FALSE. 59 IF ( (STABLE .OR. (UNSTAB .AND. (HS.GE.ZI))) .AND. (XARG.GE.XMAX) & 60 & ) THEN 61 ! Use final stable plume rise (DHF) calculated in DISTF (DHP) 62 ! at XMAX 63 DHP = DHFAER ! 542988 64 65 66 ELSEIF ( (STABLE .OR. (UNSTAB .AND. (HS.GE.ZI))) .AND. & 67 & (XARG.LT.XMAX) ) THEN 68 !---- Compute stable plume rise for the distance XARG --- CALL SBLRIS 69 ! Use iterative approach to plume rise calculations. 70 ! First compute temporary distance to "final rise" based on current 71 ! values of UP and BVPRIM. Then, don't pass a distance larger than 72 ! XMAXTMP to SBLRIS. This avoids potential for math error in 73 ! SUB. SBLRIS for distances beyond the value of XMAX computed 74 !---- iteratively outside the receptor loop in SUB. DISTF. 75 XMAXTMP = UP*ATAN2(FM*BVPRIM,-FB)/BVPRIM !1156738 76 XRISE = AMIN1(XARG,XMAXTMP) 77 CALL SBLRIS(XRISE) 78 KITER = 0 79 50 ZPLM = HSP + 0.5*DHP !1800404 80 DHPOLD = DHP 81 82 !---- Locate index below ZPLM 83 84 CALL LOCATE(GRIDHT,1,MXGLVL,ZPLM,NDXZPL) 85 86 !---- Get Wind speed at ZPLM; replace UP. Also, replace TGP, 87 ! vertical potential temperature gradient, if stable. 88 89 CALL GINTRP(GRIDHT(NDXZPL),GRIDSV(NDXZPL),GRIDHT(NDXZPL+1), & 90 & GRIDSV(NDXZPL+1),ZPLM,SVPM) 91 CALL GINTRP(GRIDHT(NDXZPL),GRIDWS(NDXZPL),GRIDHT(NDXZPL+1), & 92 & GRIDWS(NDXZPL+1),ZPLM,UPM) 93 SVPM = AMAX1(SVPM,SVMIN,0.05*UPM) 94 UPM = SQRT(UPM*UPM+2.*SVPM*SVPM) 95 !RWB Use average of stack top and midpoint wind speeds. 96 UP = 0.5*(US+UPM) 97 98 CALL GINTRP(GRIDHT(NDXZPL),GRIDTG(NDXZPL),GRIDHT(NDXZPL+1), & 99 & GRIDTG(NDXZPL+1),ZPLM,TGPM) 100 CALL GINTRP(GRIDHT(NDXZPL),GRIDPT(NDXZPL),GRIDHT(NDXZPL+1), & 101 & GRIDPT(NDXZPL+1),ZPLM,PTPM) 102 !RWB Use average of stack top and midpoint temperature gradients. 103 TGP = 0.5*(TGS+TGPM) 104 PTP = 0.5*(PTS+PTPM) 105 BVF = SQRT(G*TGP/PTP) 106 IF ( BVF.LT.1.0E-10 ) BVF = 1.0E-10 107 BVPRIM = 0.7*BVF 108 109 ! Repeat calculation of temporary distance to "final rise" using 110 ! current values of UP and BVPRIM. 111 XMAXTMP = UP*ATAN2(FM*BVPRIM,-FB)/BVPRIM 112 XRISE = AMIN1(XARG,XMAXTMP) 113 CALL SBLRIS(XRISE) 114 115 KITER = KITER + 1 116 117 !RJP Add temporary debugging statements 118 119 IF ( DEBUG ) THEN 120 WRITE (DBGUNT,6001) KITER , DHPOLD , DHP , ZPLM , UP , TGP ! 0 121 6001 FORMAT (/,5X,'OPTH2 ITER. #',I1,': OLD DELH = ',F6.1, & 122 & ' M; NEW DELH = ',F6.1,' M; MET LEVEL = ',F6.1, & 123 & ' M; NEW Upl = ',F5.2,' M/S; NEW DTHDZ = ',F7.4, & 124 & ' K/M') 125 ENDIF 126 IF ( ABS((DHPOLD-DHP)/DHP).LT.0.01 ) GOTO 60 !1800404 127 IF ( KITER.GE.5 ) THEN ! 643666 128 DHP = 0.5*(DHP+DHPOLD) ! 0 129 IF ( DEBUG ) WRITE (DBGUNT,6002) DHP 130 6002 FORMAT (/,5X,'OPTH2 ITERATION FAILED TO CONVERGE; PLUME', & 131 & ' RISE SET AT ',F6.1,' METERS.',/) 132 GOTO 60 133 ELSE 134 GOTO 50 ! 643666 135 ENDIF 136 137 60 CONTINUE !1156738 138 139 !RWB After completing iteration, reset UP and TGP to stack top 140 !RWB values for subsequent distance-dependent plume rise calcs. 141 UP = US 142 TGP = TGS 143 PTP = PTS 144 BVF = SQRT(G*TGP/PTP) 145 IF ( BVF.LT.1.0E-10 ) BVF = 1.0E-10 146 BVPRIM = 0.7*BVF 147 !crfl-3/6/95 Make sure SBL rise is not greater than CBL rise. 148 CALL CBLPRD(XARG) 149 DHP = AMIN1(DHP,DHP1) 150 DHP = AMIN1(DHP,DHFAER) 151 152 ELSEIF ( UNSTAB ) THEN 153 ! (i.e., for UNSTABle cases, with HS < ZI) 154 155 ! Compute plume rise for the direct plume --- CALL CBLPRD 156 CALL CBLPRD(XARG) ! 322030 157 158 ! Compute plume rise for the indirect plume --- CALL CBLPRN 159 CALL CBLPRN(XARG) 160 161 IF ( PPF.GT.0.0 ) THEN 162 ! Compute plume rise for the penetrated plume --- CALL CBLPR3 163 CALL CBLPR3 ! 208794 164 165 ELSE 166 ! No plume penetration - plume rise is zero for this source 167 DHP3 = 0.0 ! 113236 168 169 ENDIF 170 171 ENDIF 172 173 CONTINUE !2021756 174 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