1 2 3 SUBROUTINE GRDWD 4 !======================================================================= 5 ! GRDWD module of the AERMOD Dispersion Model 6 ! 7 ! Purpose: To construct a profile of gridded values of wind 8 ! direction. 9 ! 10 ! Input: Parameter profile array 11 ! Number of levels in the profile 12 ! Height at which data are required 13 ! 14 ! Output: Array of values at the specified grid heights. 15 ! 16 ! Assumptions: 17 ! 18 ! Called by: 19 ! 20 ! Programmer: Jim Paumier 30 Sept 1993 21 ! Pacific Environmental Services 22 ! 23 ! Revision history: 24 ! 12/5/94 - J. Paumier (Pacific Environmental Svcs., 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 ! 29 ! <none> 30 ! 31 !----------------------------------------------------------------------- 32 ! 33 !---- Variable declarations 34 ! 35 USE MAIN1 36 IMPLICIT NONE 37 CHARACTER MODNAM*12 38 39 SAVE 40 41 INTEGER PINDEX , GINDEX 42 REAL VBELOW , HTBELO 43 ! 44 !---- Data definitions 45 ! PINDEX Array index for the profile of observed values 46 ! GINDEX Array index for the profile of gridded values 47 ! VBELOW Value from the observed data profile that is 48 ! below the the gridded level 49 ! 50 ! 51 !---- Data initializations 52 ! 53 MODNAM = 'GRDWD ' ! 3044 54 ! 55 GINDEX = 1 56 PINDEX = 1 57 VBELOW = -999.0 58 ! 59 ! ------------------------------------------------------------------ 60 ! Loop over each grid level until a value is computed for each level 61 ! where a value is required OR the number of levels in the gridded 62 ! profile exceeds the maximum number 63 ! NOTE: There are 3 options for turning the wind with height. 64 ! ------------------------------------------------------------------ 65 66 DO WHILE ( GINDEX.LE.MXGLVL ) 67 68 ! ------------------------------------------- 69 ! Now begin looping over the observed profile 70 ! ------------------------------------------- 71 ! 72 DO WHILE ( GRIDWD(GINDEX).LT.-90.0 .AND. PINDEX.LE.NPLVLS ) ! 264828 73 ! 74 IF ( PFLWD(PINDEX).GE.0.0 ) THEN ! 264828 75 ! 76 ! ---------------------------------------------------------- 77 ! Data at this level are not missing; determine its location 78 ! relative to the height at which data are required and act 79 ! accordingly. 80 ! ---------------------------------------------------------- 81 IF ( ABS(PFLHT(PINDEX)-GRIDHT(GINDEX)).LE.0.1 ) THEN ! 264828 82 ! USE the parameter at this level 83 84 IF ( PFLWD(PINDEX).GT.360.0 ) THEN ! 0 85 PFLWD(PINDEX) = PFLWD(PINDEX) - 360.0 ! 0 86 ELSEIF ( PFLWD(PINDEX).LE.0.0 ) THEN 87 PFLWD(PINDEX) = PFLWD(PINDEX) + 360.0 ! 0 88 ENDIF 89 90 GRIDWD(GINDEX) = PFLWD(PINDEX) ! 0 91 ! 92 ELSEIF ( GRIDHT(GINDEX).GT.PFLHT(PINDEX) ) THEN 93 IF ( PINDEX.LT.NPLVLS ) THEN ! 249608 94 ! SAVE value for possible interpolation 95 VBELOW = PFLWD(PINDEX) ! 0 96 HTBELO = PFLHT(PINDEX) 97 98 ELSE ! this is the top level 99 ! PROFILE upward from this level --- CALL XTRPWD 100 CALL XTRPWD(PFLHT(PINDEX),PFLWD(PINDEX), & 101 & GRIDHT(GINDEX),GRIDWD(GINDEX)) 102 ENDIF 103 ! 104 ELSEIF ( GRIDHT(GINDEX).LT.PFLHT(PINDEX) ) THEN 105 IF ( VBELOW.GE.0.0 ) THEN ! 15220 106 ! INTERPOLATE between the two values --- CALL NTRPWD 107 CALL NTRPWD(HTBELO,VBELOW,PFLHT(PINDEX), & 108 & PFLWD(PINDEX),GRIDHT(GINDEX), & 109 & GRIDWD(GINDEX)) 110 111 ELSE ! BELOW is missing 112 ! PROFILE down from this level --- CALL XTRPWD 113 CALL XTRPWD(PFLHT(PINDEX),PFLWD(PINDEX), & 114 & GRIDHT(GINDEX),GRIDWD(GINDEX)) 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 * , ' construct the gridded profile' 123 PRINT * , ' of WDIR failed on ' , KURDAT 124 ! 125 ENDIF 126 ! 127 ELSE 128 ! 129 ! ------------------------------------------------------- 130 ! The parameter at this level is missing - if this is not 131 ! the top level, continue the search; if it is the top 132 ! level, then make a computation. 133 ! ------------------------------------------------------- 134 ! 135 IF ( PINDEX.EQ.NPLVLS ) THEN ! 0 136 IF ( VBELOW.GE.0.0 ) THEN ! 0 137 ! PROFILE up from BELOW --- CALL XTRPWD 138 CALL XTRPWD(HTBELO,VBELOW,GRIDHT(GINDEX), & 139 & GRIDWD(GINDEX)) 140 141 ELSE ! there are no data 142 ! PROFILE up from BELOW with WDREF --- CALL XTRPWD 143 CALL XTRPWD(UREFHT,WDREF,GRIDHT(GINDEX), & 144 & GRIDWD(GINDEX)) 145 146 ENDIF 147 ! 148 ELSE ! this is not the top level, repeat loop 149 CONTINUE ! 0 150 ! 151 ENDIF 152 ! 153 ENDIF ! parameter (not) missing at this level 154 ! 155 ! --------------------------------------------------------- 156 ! Increment the observed profile counter if a value at this 157 ! grid level was not computed on this pass 158 ! --------------------------------------------------------- 159 ! 160 IF ( (GRIDWD(GINDEX).LT.0.0) .AND. (PINDEX.LT.NPLVLS) ) & 161 & PINDEX = PINDEX + 1 162 ! 163 ENDDO ! Loop over observed data profile 164 ! 165 ! ------------------------------------------------------------ 166 ! Increment the gridded profile counter and repeat the process 167 ! starting with the observed value from the profile height as 168 ! defined by PINDEX 169 ! ------------------------------------------------------------ 170 ! 171 GINDEX = GINDEX + 1 ! 264828 172 173 ENDDO ! Loop over gridded data profile 174 ! 175 CONTINUE ! 3044 176 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