[2759] | 1 | !WRF:MEDIATION_LAYER:PHYSICS |
---|
| 2 | ! |
---|
| 3 | |
---|
| 4 | MODULE module_fddagd_driver |
---|
| 5 | CONTAINS |
---|
| 6 | |
---|
| 7 | !------------------------------------------------------------------ |
---|
| 8 | SUBROUTINE fddagd_driver(itimestep,dt,xtime, & |
---|
| 9 | id, & |
---|
| 10 | RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & |
---|
| 11 | RQVNDGDTEN,RMUNDGDTEN, & |
---|
| 12 | u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old, & |
---|
| 13 | u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new, & |
---|
| 14 | u3d,v3d,th_phy,rho,moist, & |
---|
| 15 | p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w, & |
---|
| 16 | config_flags,DX,n_moist, & |
---|
| 17 | STEPFG, & |
---|
| 18 | pblh,ht, & |
---|
| 19 | ids,ide, jds,jde, kds,kde, & |
---|
| 20 | ims,ime, jms,jme, kms,kme, & |
---|
| 21 | i_start,i_end, j_start,j_end, kts,kte, num_tiles) |
---|
| 22 | !------------------------------------------------------------------ |
---|
| 23 | USE module_configure |
---|
| 24 | USE module_state_description |
---|
| 25 | USE module_model_constants |
---|
| 26 | |
---|
| 27 | ! *** add new modules of schemes here |
---|
| 28 | |
---|
| 29 | USE module_fdda_psufddagd |
---|
| 30 | !------------------------------------------------------------------ |
---|
| 31 | IMPLICIT NONE |
---|
| 32 | !====================================================================== |
---|
| 33 | ! Grid structure in physics part of WRF |
---|
| 34 | !---------------------------------------------------------------------- |
---|
| 35 | ! The horizontal velocities used in the physics are unstaggered |
---|
| 36 | ! relative to temperature/moisture variables. All predicted |
---|
| 37 | ! variables are carried at half levels except w, which is at full |
---|
| 38 | ! levels. Some arrays with names (*8w) are at w (full) levels. |
---|
| 39 | ! |
---|
| 40 | !---------------------------------------------------------------------- |
---|
| 41 | ! In WRF, kms (smallest number) is the bottom level and kme (largest |
---|
| 42 | ! number) is the top level. In your scheme, if 1 is at the top level, |
---|
| 43 | ! then you have to reverse the order in the k direction. |
---|
| 44 | ! |
---|
| 45 | ! kme - half level (no data at this level) |
---|
| 46 | ! kme ----- full level |
---|
| 47 | ! kme-1 - half level |
---|
| 48 | ! kme-1 ----- full level |
---|
| 49 | ! . |
---|
| 50 | ! . |
---|
| 51 | ! . |
---|
| 52 | ! kms+2 - half level |
---|
| 53 | ! kms+2 ----- full level |
---|
| 54 | ! kms+1 - half level |
---|
| 55 | ! kms+1 ----- full level |
---|
| 56 | ! kms - half level |
---|
| 57 | ! kms ----- full level |
---|
| 58 | ! |
---|
| 59 | !====================================================================== |
---|
| 60 | !-- RUNDGDTEN U tendency due to |
---|
| 61 | ! FDDA analysis nudging (m/s^2) |
---|
| 62 | !-- RVNDGDTEN V tendency due to |
---|
| 63 | ! FDDA analysis nudging (m/s^2) |
---|
| 64 | !-- RTHNDGDTEN Theta tendency due to |
---|
| 65 | ! FDDA analysis nudging (K/s) |
---|
| 66 | !-- RQVNDGDTEN Qv tendency due to |
---|
| 67 | ! FDDA analysis nudging (kg/kg/s) |
---|
| 68 | !-- RMUNDGDTEN mu tendency due to |
---|
| 69 | ! FDDA analysis nudging (Pa/s) |
---|
| 70 | !-- itimestep number of time steps |
---|
| 71 | !-- u3d u-velocity staggered on u points (m/s) |
---|
| 72 | !-- v3d v-velocity staggered on v points (m/s) |
---|
| 73 | !-- th_phy potential temperature (K) |
---|
| 74 | !-- moist moisture array (4D - last index is species) (kg/kg) |
---|
| 75 | !-- p_phy pressure (Pa) |
---|
| 76 | !-- pi_phy exner function (dimensionless) |
---|
| 77 | !-- p8w pressure at full levels (Pa) |
---|
| 78 | !-- t_phy temperature (K) |
---|
| 79 | !-- dz8w dz between full levels (m) |
---|
| 80 | !-- z height above sea level (m) |
---|
| 81 | !-- config_flags |
---|
| 82 | !-- DX horizontal space interval (m) |
---|
| 83 | !-- DT time step (second) |
---|
| 84 | !-- n_moist number of moisture species |
---|
| 85 | !-- STEPFG number of timesteps per FDDA re-calculation |
---|
| 86 | !-- KPBL k-index of PBL top |
---|
| 87 | !-- ids start index for i in domain |
---|
| 88 | !-- ide end index for i in domain |
---|
| 89 | !-- jds start index for j in domain |
---|
| 90 | !-- jde end index for j in domain |
---|
| 91 | !-- kds start index for k in domain |
---|
| 92 | !-- kde end index for k in domain |
---|
| 93 | !-- ims start index for i in memory |
---|
| 94 | !-- ime end index for i in memory |
---|
| 95 | !-- jms start index for j in memory |
---|
| 96 | !-- jme end index for j in memory |
---|
| 97 | !-- kms start index for k in memory |
---|
| 98 | !-- kme end index for k in memory |
---|
| 99 | !-- jts start index for j in tile |
---|
| 100 | !-- jte end index for j in tile |
---|
| 101 | !-- kts start index for k in tile |
---|
| 102 | !-- kte end index for k in tile |
---|
| 103 | ! |
---|
| 104 | !****************************************************************** |
---|
| 105 | !------------------------------------------------------------------ |
---|
| 106 | TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags |
---|
| 107 | ! |
---|
| 108 | |
---|
| 109 | INTEGER , INTENT(IN) :: id |
---|
| 110 | |
---|
| 111 | INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & |
---|
| 112 | ims,ime, jms,jme, kms,kme, & |
---|
| 113 | kts,kte, num_tiles, & |
---|
| 114 | n_moist |
---|
| 115 | |
---|
| 116 | INTEGER, DIMENSION(num_tiles), INTENT(IN) :: & |
---|
| 117 | & i_start,i_end,j_start,j_end |
---|
| 118 | |
---|
| 119 | INTEGER, INTENT(IN ) :: itimestep,STEPFG |
---|
| 120 | ! |
---|
| 121 | REAL, INTENT(IN ) :: DT,DX,XTIME |
---|
| 122 | |
---|
| 123 | |
---|
| 124 | ! |
---|
| 125 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
---|
| 126 | INTENT(IN ) :: p_phy, & |
---|
| 127 | pi_phy, & |
---|
| 128 | p8w, & |
---|
| 129 | rho, & |
---|
| 130 | t_phy, & |
---|
| 131 | u3d, & |
---|
| 132 | v3d, & |
---|
| 133 | dz8w, & |
---|
| 134 | z, & |
---|
| 135 | z_at_w, & |
---|
| 136 | th_phy |
---|
| 137 | ! |
---|
| 138 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), & |
---|
| 139 | INTENT(IN ) :: moist |
---|
| 140 | ! |
---|
| 141 | ! |
---|
| 142 | ! |
---|
| 143 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
---|
| 144 | INTENT(INOUT) :: RUNDGDTEN, & |
---|
| 145 | RVNDGDTEN, & |
---|
| 146 | RTHNDGDTEN, & |
---|
| 147 | RQVNDGDTEN |
---|
| 148 | |
---|
| 149 | REAL, DIMENSION( ims:ime, jms:jme ), & |
---|
| 150 | INTENT(INOUT) :: RMUNDGDTEN |
---|
| 151 | |
---|
| 152 | REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & |
---|
| 153 | INTENT(INOUT) :: u_ndg_old, & |
---|
| 154 | v_ndg_old, & |
---|
| 155 | t_ndg_old, & |
---|
| 156 | q_ndg_old, & |
---|
| 157 | u_ndg_new, & |
---|
| 158 | v_ndg_new, & |
---|
| 159 | t_ndg_new, & |
---|
| 160 | q_ndg_new |
---|
| 161 | REAL, DIMENSION( ims:ime, jms:jme ), & |
---|
| 162 | INTENT(INOUT) :: mu_ndg_old, & |
---|
| 163 | mu_ndg_new |
---|
| 164 | |
---|
| 165 | ! |
---|
| 166 | REAL, DIMENSION( ims:ime , jms:jme ), & |
---|
| 167 | INTENT(IN ) :: pblh, & |
---|
| 168 | ht |
---|
| 169 | |
---|
| 170 | ! LOCAL VAR |
---|
| 171 | |
---|
| 172 | ! |
---|
| 173 | INTEGER :: i,J,K,NK,jj,ij |
---|
| 174 | |
---|
| 175 | !------------------------------------------------------------------ |
---|
| 176 | ! |
---|
| 177 | #if ! ( NMM_CORE == 1 ) |
---|
| 178 | if (config_flags%grid_fdda .eq. 0) return |
---|
| 179 | |
---|
| 180 | IF (itimestep == 1) THEN |
---|
| 181 | |
---|
| 182 | !$OMP PARALLEL DO & |
---|
| 183 | !$OMP PRIVATE ( ij,i,j,k ) |
---|
| 184 | DO ij = 1 , num_tiles |
---|
| 185 | DO j=j_start(ij),j_end(ij) |
---|
| 186 | DO i=i_start(ij),i_end(ij) |
---|
| 187 | |
---|
| 188 | DO k=kts,min(kte+1,kde) |
---|
| 189 | u_ndg_old(i,k,j) = u3d(i,k,j) |
---|
| 190 | v_ndg_old(i,k,j) = v3d(i,k,j) |
---|
| 191 | t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0 |
---|
| 192 | q_ndg_old(i,k,j) = moist(i,k,j,P_QV) |
---|
| 193 | ENDDO |
---|
| 194 | mu_ndg_old(i,j) = 0.0 |
---|
| 195 | |
---|
| 196 | ENDDO |
---|
| 197 | ENDDO |
---|
| 198 | |
---|
| 199 | ENDDO |
---|
| 200 | !$OMP END PARALLEL DO |
---|
| 201 | |
---|
| 202 | ENDIF |
---|
| 203 | |
---|
| 204 | IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN |
---|
| 205 | |
---|
| 206 | !$OMP PARALLEL DO & |
---|
| 207 | !$OMP PRIVATE ( ij,i,j,k ) |
---|
| 208 | DO ij = 1 , num_tiles |
---|
| 209 | DO j=j_start(ij),j_end(ij) |
---|
| 210 | DO i=i_start(ij),i_end(ij) |
---|
| 211 | |
---|
| 212 | DO k=kts,min(kte+1,kde) |
---|
| 213 | RTHNDGDTEN(I,K,J)=0. |
---|
| 214 | RUNDGDTEN(I,K,J)=0. |
---|
| 215 | RVNDGDTEN(I,K,J)=0. |
---|
| 216 | RQVNDGDTEN(I,K,J)=0. |
---|
| 217 | ENDDO |
---|
| 218 | |
---|
| 219 | RMUNDGDTEN(I,J)=0. |
---|
| 220 | |
---|
| 221 | ENDDO |
---|
| 222 | ENDDO |
---|
| 223 | |
---|
| 224 | ENDDO |
---|
| 225 | !$OMP END PARALLEL DO |
---|
| 226 | ! |
---|
| 227 | !$OMP PARALLEL DO & |
---|
| 228 | !$OMP PRIVATE ( ij, i,j,k ) |
---|
| 229 | DO ij = 1 , num_tiles |
---|
| 230 | fdda_select: SELECT CASE(config_flags%grid_fdda) |
---|
| 231 | |
---|
| 232 | CASE (PSUFDDAGD) |
---|
| 233 | CALL wrf_debug(100,'in PSU FDDA scheme') |
---|
| 234 | CALL FDDAGD(itimestep,dt,xtime, & |
---|
| 235 | id, & |
---|
| 236 | config_flags%gfdda_interval_m, & |
---|
| 237 | config_flags%gfdda_end_h, & |
---|
| 238 | config_flags%if_no_pbl_nudging_uv, & |
---|
| 239 | config_flags%if_no_pbl_nudging_t, & |
---|
| 240 | config_flags%if_no_pbl_nudging_q, & |
---|
| 241 | config_flags%if_zfac_uv, & |
---|
| 242 | config_flags%k_zfac_uv, & |
---|
| 243 | config_flags%if_zfac_t, & |
---|
| 244 | config_flags%k_zfac_t, & |
---|
| 245 | config_flags%if_zfac_q, & |
---|
| 246 | config_flags%k_zfac_q, & |
---|
| 247 | config_flags%guv, & |
---|
| 248 | config_flags%gt, config_flags%gq, & |
---|
| 249 | config_flags%if_ramping, config_flags%dtramp_min, & |
---|
| 250 | u3d,v3d,th_phy,t_phy, & |
---|
| 251 | moist(ims,kms,jms,P_QV), & |
---|
| 252 | p_phy,pi_phy, & |
---|
| 253 | u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old, & |
---|
| 254 | u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new, & |
---|
| 255 | RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,& |
---|
| 256 | pblh, ht, z, z_at_w, & |
---|
| 257 | ids,ide, jds,jde, kds,kde, & |
---|
| 258 | ims,ime, jms,jme, kms,kme, & |
---|
| 259 | i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte ) |
---|
| 260 | |
---|
| 261 | |
---|
| 262 | CASE DEFAULT |
---|
| 263 | |
---|
| 264 | WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda |
---|
| 265 | CALL wrf_error_fatal ( wrf_err_message ) |
---|
| 266 | |
---|
| 267 | END SELECT fdda_select |
---|
| 268 | |
---|
| 269 | ENDDO |
---|
| 270 | !$OMP END PARALLEL DO |
---|
| 271 | |
---|
| 272 | ENDIF |
---|
| 273 | |
---|
| 274 | #endif |
---|
| 275 | ! |
---|
| 276 | END SUBROUTINE fddagd_driver |
---|
| 277 | END MODULE module_fddagd_driver |
---|