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