1 2 3 SUBROUTINE NTRPTG(HTBELO,VBELOW,HTABOV,VABOVE,REQDHT,VALUE) 4 !======================================================================= 5 ! NTRPTG Module of the AERMOD Dispersion Model 6 ! 7 ! Purpose: To compute the potential temperature gradient at an 8 ! intermediate level by interpolating between two 9 ! observed values. 10 ! 11 ! Input: Profile heights and values above and below the height 12 ! at which the value is required 13 ! 14 ! Output: Potential temperature gradient at the required level 15 ! 16 ! Called by: REFPTG 17 ! 18 ! Assumptions: 19 ! 20 ! 21 ! Programmer: Jim Paumier (PES, Inc.) 30 September 1993 22 ! 23 ! Revision history: 24 ! JOP March 14, 1995 - modified the check on the ratio for a 25 ! positive slope and observed values 26 ! 27 !----------------------------------------------------------------------- 28 ! 29 !---- Variable declarations 30 ! 31 IMPLICIT NONE 32 REAL :: HTBELO , VBELOW , HTABOV , VABOVE , REQDHT , VALUE , & 33 & REFABV , REFBLW , RATIO , REFREQ , VALINT , REFINT 34 ! 35 !---- Data dictionary 36 ! 37 ! REFABV = Reference profile value above the height at which a 38 ! value is required (HTABOV) 39 ! REFBLW = Reference profile value bbelow the height at which a 40 ! value is required (HTBELO) 41 ! REFREQ = Reference profile value at the height at which a 42 ! value is required (REQDHT) 43 ! 44 !---- Data initializations 45 ! 46 ! 47 !....................................................................... 48 !---- The computation requires 3 estimates from the reference/theoretical 49 ! profile: one height above, one height below and from the level at 50 ! which the parameter is needed. The ratio of the differences 51 ! [EST(requested ht) - EST(ht below)] / [EST(ht above) - EST(ht below)] 52 ! is applied to the difference between the observed values to obtain 53 ! interpolated value. 54 ! 55 ! Compute the reference profile value at the height below the 56 ! requested height --- CALL REFPTG 57 CALL REFPTG(HTBELO,REFBLW) ! 0 58 ! 59 ! Compute the reference profile value at the height above the 60 ! requested height --- CALL REFPTG 61 CALL REFPTG(HTABOV,REFABV) 62 ! 63 ! Compute the reference profile value at the requested height 64 ! --- CALL REFPTG 65 CALL REFPTG(REQDHT,REFREQ) 66 ! 67 IF ( ABS(REFABV-REFBLW).GT.0.0001 ) THEN 68 ! 69 ! Linearly interpolate to REQDHT from observed and reference profiles 70 CALL GINTRP(HTBELO,VBELOW,HTABOV,VABOVE,REQDHT,VALINT) ! 0 71 CALL GINTRP(HTBELO,REFBLW,HTABOV,REFABV,REQDHT,REFINT) 72 ! REFREQ is value from REFerence profile at REQuired height 73 ! REFINT is value from REFerence profile linearly INTerpolated to req ht 74 ! VALINT is the observed VALue linearly INTerpolated to required height 75 RATIO = REFREQ/REFINT 76 VALUE = RATIO*VALINT 77 ELSE 78 ! INTERPOLATE between VABOVE and VBELOW 79 CALL GINTRP(HTBELO,VBELOW,HTABOV,VABOVE,REQDHT,VALUE) ! 0 80 ! 81 ENDIF 82 83 CONTINUE ! 0 84 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