1 2 3 SUBROUTINE TGINIT() 4 !======================================================================= 5 ! TGINIT module of the AERMOD Dispersion Model 6 ! 7 ! Purpose: To compute the temperature scaling parameter and 8 ! gradient at 5 m for the stable atmosphere 9 ! 10 ! Input: Friction velocity, Obukhov length, ambient temperature, 11 ! surface roughness length 12 ! 13 ! Output: THETA_STAR and dTHETA/dZ at TREFHT 14 ! 15 ! Assumptions: 16 ! 17 ! Called by: GRDPTG 18 ! 19 ! Programmer: Jim Paumier (PES, Inc.) 30 Sept 1993 20 ! 21 ! Revision history: 22 ! JOP March 14, 1995 The initial gradient is now stored in 23 ! TG4PFL rather than the first level of 24 ! profiled gradients 25 ! 26 ! References: Model Coding Abstract for the Met Interface dated 27 ! August 6, 1992 and all subsequent addenda/corrigenda 28 ! 29 !----------------------------------------------------------------------- 30 ! 31 !---- Variable declarations 32 ! 33 USE MAIN1 34 IMPLICIT NONE 35 CHARACTER MODNAM*12 36 37 SAVE 38 39 REAL , PARAMETER :: TGMINHT = 2.0 , TGMAXHT = 100.0 40 INTEGER :: LVL 41 REAL :: REFLVL 42 43 MODNAM = 'TGINIT' ! 3044 44 PATH = 'MX' 45 46 !---- Variable initializations 47 48 49 ! The computations are made only for a stable atmosphere 50 51 IF ( STABLE ) THEN 52 53 REFLVL = -99.0 ! 2546 54 LVL = 1 55 DO WHILE ( REFLVL.LT.0.0 .AND. LVL.LE.NTGLVL ) 56 57 IF ( PFLTGZ(LVL).GT.SFCZ0 ) THEN ! 2546 58 REFLVL = PFLTGZ(LVL) ! 0 59 60 ELSE 61 LVL = LVL + 1 ! 2546 62 63 ENDIF 64 65 ENDDO 66 67 IF ( REFLVL.GT.0.0 .AND. REFLVL.LE.100.0 ) THEN ! 2546 68 THSTAR = PFLTG(LVL)*VONKAR*PFLTGZ(LVL) & 69 & /(1.0+5.0*PFLTGZ(LVL)/OBULEN) 70 71 ELSE 72 THSTAR = USTAR**2/(G*VONKAR*OBULEN/TA) ! 2546 73 74 ENDIF 75 76 ! Determine the reference level for computing a temperature 77 ! gradient for profiling 78 79 ! Compute DTHETA/dZ at TREFHT 80 81 TG4PFL = (THSTAR/(VONKAR*TGMINHT))*(1.0+5.0*TGMINHT/OBULEN) ! 2546 82 TG4XTR = (THSTAR/(VONKAR*TGMAXHT))*(1.0+5.0*TGMAXHT/OBULEN) 83 84 ELSE 85 86 ! For the unstable case 87 THSTAR = -9.0 ! 498 88 TG4PFL = XVAL 89 90 ENDIF 91 92 CONTINUE ! 3044 93 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