1 2 SUBROUTINE GRDPTG() 3 !======================================================================= 4 ! GRDPTG module of the AERMOD Dispersion Model 5 ! 6 ! Purpose: To construct a profile of gridded values of the 7 ! vertical potential temperature gradient 8 ! 9 ! Input: Profile array of observed data (PFLTG) 10 ! Number of levels in the profile (NTGLVL) 11 ! Gridded heights at which data are required (GRIDHT) 12 ! 13 ! Output: Potential temperature gradient at the grid heights 14 ! (GRIDTG) 15 ! 16 ! Assumptions: No value of the potential temperature gradient 17 ! (observed or computed) is less than -50.0 18 ! 19 ! Called by: METEXT 20 ! 21 ! Programmer: Jim Paumier (PES, Inc.) 30 Sept 1993 22 ! 23 ! Revision history: 24 ! 12/5/94 - J. Paumier (PES, Inc) 25 ! - changed the tolerance for a gridded profile height 26 ! to be within 0.1 m of an observed profile height 27 ! rather than 0.5 m 28 ! 07/07/95 - J. Paumier (PES,Inc) 29 ! - moved the check for a minimum value in stable 30 ! layers to outside the initial DO WHILE ... ENDDO 31 ! 32 !----------------------------------------------------------------------- 33 ! 34 !---- Variable declarations 35 ! 36 USE MAIN1 37 IMPLICIT NONE 38 CHARACTER MODNAM*12 39 40 SAVE 41 42 INTEGER PINDEX , GINDEX , NDX 43 REAL VBELOW , HTBELO 44 ! 45 !---- Data definitions 46 ! PINDEX Array index for the profile of observed values 47 ! GINDEX Array index for the profile of gridded values 48 ! VBELOW Nonmissing value from the observed data profile 49 ! that is below the the gridded level 50 ! 51 ! 52 !---- Data initializations 53 ! 54 ! 55 MODNAM = 'GRDPTG' ! 3044 56 GINDEX = 1 57 PINDEX = 1 58 VBELOW = -999.0 59 ! 60 ! ------------------------------------------------------------------ 61 ! Loop over each grid level until a value is computed for each level 62 ! where a value is required OR the number of levels in the gridded 63 ! profile exceeds the maximum number 64 ! ------------------------------------------------------------------ 65 ! 66 DO WHILE ( GINDEX.LE.MXGLVL ) 67 ! 68 ! ------------------------------------------- 69 ! Now begin looping over the observed profile 70 ! ------------------------------------------- 71 72 ! The 'blending' of the reference profile with observations now 73 ! applies only to the stable atmosphere 74 75 IF ( STABLE ) THEN ! 264828 76 ! 77 DO WHILE ( GRIDTG(GINDEX).LT.-90.0 .AND. PINDEX.LE.NTGLVL ) ! 221502 78 ! 79 IF ( PFLTG(PINDEX).GE.-50.0 ) THEN ! 221502 80 ! 81 ! ------------------------------------------------- 82 ! Data at this level are not missing; determine its 83 ! location relative to the height at which data are 84 ! required and act accordingly. 85 ! ------------------------------------------------- 86 IF ( ABS(PFLTGZ(PINDEX)-GRIDHT(GINDEX)).LE.0.1 ) THEN ! 0 87 ! USE the parameter at this level 88 GRIDTG(GINDEX) = PFLTG(PINDEX) ! 0 89 ! 90 ELSEIF ( GRIDHT(GINDEX).GT.PFLTGZ(PINDEX) ) THEN 91 IF ( PINDEX.LT.NTGLVL ) THEN ! 0 92 ! SAVE value for possible interpolation 93 VBELOW = PFLTG(PINDEX) ! 0 94 HTBELO = PFLTGZ(PINDEX) 95 96 ELSE 97 ! this is the top level 98 ! PROFILE upward from this level --- CALL XTRPTG 99 CALL XTRPTG(PFLTGZ(PINDEX),PFLTG(PINDEX), & 100 & GRIDHT(GINDEX),GRIDTG(GINDEX)) 101 ENDIF 102 ! 103 ELSEIF ( GRIDHT(GINDEX).LT.PFLTGZ(PINDEX) ) THEN 104 IF ( VBELOW.GE.-50.0 ) THEN ! 0 105 ! INTERPOLATE between the two values --- CALL NTRPTG 106 CALL NTRPTG(HTBELO,VBELOW,PFLTGZ(PINDEX), & 107 & PFLTG(PINDEX),GRIDHT(GINDEX), & 108 & GRIDTG(GINDEX)) 109 110 ELSE 111 ! BELOW is missing 112 ! PROFILE down from this level --- CALL XTRPDN 113 114 CALL XTRPDN(GRIDHT(GINDEX),GRIDTG(GINDEX)) ! 0 115 116 ENDIF 117 ! 118 ELSE 119 ! This section is for DEBUGging - the program should never 120 ! reach this point 121 PRINT * , ' ---> ERROR: The search for data to' ! 0 122 PRINT * , & 123 & ' construct the gridded profile' 124 PRINT * , ' failed on ' , KURDAT 125 ! 126 ENDIF 127 ! 128 ELSE 129 ! 130 ! ------------------------------------------------------- 131 ! The parameter at this level is missing - if this is not 132 ! the top level, continue the search; if it is the top 133 ! level, then make a computation. 134 ! ------------------------------------------------------- 135 ! 136 IF ( PINDEX.EQ.NTGLVL ) THEN ! 221502 137 IF ( VBELOW.GE.-50.0 ) THEN ! 221502 138 ! PROFILE up from BELOW --- CALL XTRPTG 139 CALL XTRPTG(PFLTGZ(PINDEX),PFLTG(PINDEX), & 140 & GRIDHT(GINDEX),GRIDTG(GINDEX)) 141 142 ELSE 143 ! there are no data 144 ! COMPUTE value: full parameterization --- CALL REFPTG 145 CALL REFPTG(GRIDHT(GINDEX),GRIDTG(GINDEX)) ! 221502 146 ENDIF 147 ! 148 ELSE 149 ! this is not the top level, repeat loop 150 CONTINUE ! 0 151 ! 152 ENDIF 153 ! 154 ENDIF 155 ! parameter (not) missing at this level 156 ! 157 ! --------------------------------------------------------- 158 ! Increment the observed profile counter if a value at this 159 ! grid level was not computed on this pass and continue 160 ! processing 161 ! --------------------------------------------------------- 162 ! 163 IF ( (GRIDTG(GINDEX).LT.-50.0) .AND. (PINDEX.LT.NTGLVL) )& 164 & PINDEX = PINDEX + 1 165 ! 166 ENDDO ! Loop over observed data profile 167 168 ELSEIF ( UNSTAB ) THEN 169 170 CALL REFPTG(GRIDHT(GINDEX),GRIDTG(GINDEX)) ! 43326 171 172 ENDIF 173 ! ------------------------------------------------------------ 174 ! Increment the gridded profile counter and repeat the process 175 ! starting with the observed value from the profile height as 176 ! defined by PINDEX 177 ! ------------------------------------------------------------ 178 ! 179 GINDEX = GINDEX + 1 ! 264828 180 ! 181 ENDDO ! Loop over gridded data profile 182 ! 183 ! 184 ! ------------------------------------------------------------ 185 ! Apply lower limit of SPTGMN (=0.002 K/m in MAIN1.INC) to 186 ! lapse rate for stable layers. 187 ! ------------------------------------------------------------ 188 ! 189 DO NDX = 1 , MXGLVL ! 3044 190 IF ( STABLE .OR. (UNSTAB .AND. GRIDHT(NDX).GT.ZI) ) GRIDTG(NDX)& 191 & = MAX(SPTGMN,GRIDTG(NDX)) 192 ENDDO 193 194 CONTINUE ! 3044 195 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