module_fddagd_driver.F
References to this file elsewhere.
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