module_fdda_psufddagd.F
References to this file elsewhere.
1 !wrf:model_layer:physics
2 !
3 !
4 !
5 MODULE module_fdda_psufddagd
6
7 USE module_dm
8
9 CONTAINS
10 !
11 !-------------------------------------------------------------------
12 !
13 SUBROUTINE fddagd(itimestep,dt,xtime,id,analysis_interval, end_fdda_hour, &
14 if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, &
15 if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, &
16 guv, gt, gq, if_ramping, dtramp_min, &
17 u3d,v3d,th3d,t3d, &
18 qv3d, &
19 p3d,pi3d, &
20 u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old, &
21 u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new, &
22 RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
23 pblh, ht, z, z_at_w, &
24 ids,ide, jds,jde, kds,kde, &
25 ims,ime, jms,jme, kms,kme, &
26 its,ite, jts,jte, kts,kte )
27
28 !-------------------------------------------------------------------
29 implicit none
30 !-------------------------------------------------------------------
31 !-- u3d 3d u-velocity staggered on u points
32 !-- v3d 3d v-velocity staggered on v points
33 !-- th3d 3d potential temperature (k)
34 !-- t3d temperature (k)
35 !-- qv3d 3d water vapor mixing ratio (kg/kg)
36 !-- p3d 3d pressure (pa)
37 !-- pi3d 3d exner function (dimensionless)
38 !-- rundgdten staggered u tendency due to
39 ! fdda grid nudging (m/s/s)
40 !-- rvndgdten staggered v tendency due to
41 ! fdda grid nudging (m/s/s)
42 !-- rthndgdten theta tendency due to
43 ! fdda grid nudging (K/s)
44 !-- rqvndgdten qv tendency due to
45 ! fdda grid nudging (kg/kg/s)
46 !-- rmundgdten mu tendency due to
47 ! fdda grid nudging (Pa/s)
48 !-- ids start index for i in domain
49 !-- ide end index for i in domain
50 !-- jds start index for j in domain
51 !-- jde end index for j in domain
52 !-- kds start index for k in domain
53 !-- kde end index for k in domain
54 !-- ims start index for i in memory
55 !-- ime end index for i in memory
56 !-- jms start index for j in memory
57 !-- jme end index for j in memory
58 !-- kms start index for k in memory
59 !-- kme end index for k in memory
60 !-- its start index for i in tile
61 !-- ite end index for i in tile
62 !-- jts start index for j in tile
63 !-- jte end index for j in tile
64 !-- kts start index for k in tile
65 !-- kte end index for k in tile
66 !-------------------------------------------------------------------
67 !
68 INTEGER, INTENT(IN) :: itimestep, analysis_interval, end_fdda_hour
69
70 INTEGER, INTENT(IN) :: if_no_pbl_nudging_uv, if_no_pbl_nudging_t, &
71 if_no_pbl_nudging_q
72 INTEGER, INTENT(IN) :: if_zfac_uv, if_zfac_t, if_zfac_q
73 INTEGER, INTENT(IN) :: k_zfac_uv, k_zfac_t, k_zfac_q
74 INTEGER, INTENT(IN) :: if_ramping
75
76 INTEGER , INTENT(IN) :: id
77 REAL, INTENT(IN) :: DT, xtime, dtramp_min
78
79 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
80 ims,ime, jms,jme, kms,kme, &
81 its,ite, jts,jte, kts,kte
82
83 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
84 INTENT(IN) :: qv3d, &
85 p3d, &
86 pi3d, &
87 th3d, &
88 t3d, &
89 z, &
90 z_at_w
91
92 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
93 INTENT(INOUT) :: rundgdten, &
94 rvndgdten, &
95 rthndgdten, &
96 rqvndgdten
97
98 REAL, DIMENSION( ims:ime, jms:jme ), &
99 INTENT(INOUT) :: rmundgdten
100
101 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
102 INTENT(INOUT) :: u_ndg_old, &
103 v_ndg_old, &
104 t_ndg_old, &
105 q_ndg_old, &
106 u_ndg_new, &
107 v_ndg_new, &
108 t_ndg_new, &
109 q_ndg_new
110
111 REAL, DIMENSION( ims:ime, jms:jme ), &
112 INTENT(INOUT) :: mu_ndg_old, &
113 mu_ndg_new
114
115 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
116 INTENT(IN) :: u3d, &
117 v3d
118
119 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: pblh, &
120 ht
121
122 REAL, INTENT(IN) :: guv, gt, gq
123
124 INTEGER :: i, j, k, itsu, jtsv, itf, jtf, ktf, i0, k0, j0
125 REAL :: xtime_old, xtime_new, coef, val_analysis
126 INTEGER :: kpbl, dbg_level
127
128 REAL :: zpbl, zagl, zagl_bot, zagl_top, tfac, actual_end_fdda_min
129 REAL, DIMENSION( its:ite, kts:kte, jts:jte, 4 ) :: wpbl ! 1: u, 2: v, 3: t, 4: q
130 REAL, DIMENSION( kts:kte, 4 ) :: wzfac ! 1: u, 2: v, 3: t, 4: q
131
132 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
133
134 CHARACTER (LEN=256) :: message
135
136 actual_end_fdda_min = end_fdda_hour*60.0
137 IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) &
138 actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
139 IF( xtime > actual_end_fdda_min ) THEN
140 ! If xtime is greater than the end time, no need to calculate tendencies. Just set the tnedencies
141 ! to zero to turn off nudging and return.
142 DO j = jts, jte
143 DO k = kts, kte
144 DO i = its, ite
145 RUNDGDTEN(i,k,j) = 0.0
146 RVNDGDTEN(i,k,j) = 0.0
147 RTHNDGDTEN(i,k,j) = 0.0
148 RQVNDGDTEN(i,k,j) = 0.0
149 IF( k .EQ. kts ) RMUNDGDTEN(i,j) = 0.
150 ENDDO
151 ENDDO
152 ENDDO
153 RETURN
154 ENDIF
155
156 xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0
157 xtime_new = xtime_old + analysis_interval
158 coef = (xtime-xtime_old)/(xtime_new-xtime_old)
159
160 IF ( wrf_dm_on_monitor()) THEN
161
162 CALL get_wrf_debug_level( dbg_level )
163
164 IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN
165
166 IF( xtime < end_fdda_hour*60.0 ) THEN
167 WRITE(message,'(a,i1,a,f10.3,a)') &
168 'D0',id,' Analysis nudging read in new data at time = ', xtime, ' min.'
169 CALL wrf_message( TRIM(message) )
170 WRITE(message,'(a,i1,a,2f8.2,a)') &
171 'D0',id,' Analysis nudging bracketing times = ', xtime_old, xtime_new, ' min.'
172 CALL wrf_message( TRIM(message) )
173 ENDIF
174
175 actual_end_fdda_min = end_fdda_hour*60.0
176 IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) &
177 actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
178
179 IF( dbg_level .GE. 10 .AND. xtime <= actual_end_fdda_min ) THEN
180 ! Find the mid point of the tile and print out the sample values
181 i0 = (ite-its)/2+its
182 j0 = (jte-jts)/2+jts
183
184 IF( guv > 0.0 ) THEN
185 DO k = kts, kte
186 WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
187 ' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
188 ' u_ndg_old=', u_ndg_old(i0,k,j0), ' u_ndg_new=', u_ndg_new(i0,k,j0)
189 CALL wrf_message( TRIM(message) )
190 ENDDO
191 DO k = kts, kte
192 WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
193 ' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
194 ' v_ndg_old=', v_ndg_old(i0,k,j0), ' v_ndg_new=', v_ndg_new(i0,k,j0)
195 CALL wrf_message( TRIM(message) )
196 ENDDO
197 ENDIF
198
199 IF( gt > 0.0 ) THEN
200 DO k = kts, kte
201 WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
202 ' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
203 ' t_ndg_old=', t_ndg_old(i0,k,j0), ' t_ndg_new=', t_ndg_new(i0,k,j0)
204 CALL wrf_message( TRIM(message) )
205 ENDDO
206 ENDIF
207
208 IF( gq > 0.0 ) THEN
209 DO k = kts, kte
210 WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
211 ' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
212 ' q_ndg_old=', q_ndg_old(i0,k,j0), ' q_ndg_new=', q_ndg_new(i0,k,j0)
213 CALL wrf_message( TRIM(message) )
214 ENDDO
215 ENDIF
216
217 ENDIF
218 ENDIF
219 ENDIF
220
221 jtsv=MAX0(jts,jds+1)
222 itsu=MAX0(its,ids+1)
223
224 jtf=MIN0(jte,jde-1)
225 ktf=MIN0(kte,kde-1)
226 itf=MIN0(ite,ide-1)
227 !
228 ! If the user-defined namelist switches (if_no_pbl_nudging_uv, if_no_pbl_nudging_t,
229 ! if_no_pbl_nudging_q swithes) are set to 1, compute the weighting function, wpbl(:,k,:,:),
230 ! based on the PBL depth. wpbl = 1 above the PBL and wpbl = 0 in the PBL. If all
231 ! the switche are set to zero, wpbl = 1 (default value).
232 !
233 wpbl(:,:,:,:) = 1.0
234
235 IF( if_no_pbl_nudging_uv == 1 ) THEN
236
237 DO j=jts,jtf
238 DO i=itsu,itf
239
240 kpbl = 1
241 zpbl = 0.5 * ( pblh(i-1,j) + pblh(i,j) )
242
243 loop_ku: DO k=kts,ktf
244 zagl = 0.5 * ( z(i-1,k,j)-ht(i-1,j) + z(i,k,j)-ht(i,j) )
245 zagl_bot = 0.5 * ( z_at_w(i-1,k, j)-ht(i-1,j) + z_at_w(i,k, j)-ht(i,j) )
246 zagl_top = 0.5 * ( z_at_w(i-1,k+1,j)-ht(i-1,j) + z_at_w(i,k+1,j)-ht(i,j) )
247 IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
248 kpbl = k
249 EXIT loop_ku
250 ENDIF
251 ENDDO loop_ku
252
253 DO k=kts,ktf
254 IF( k <= kpbl ) wpbl(i, k, j, 1) = 0.0
255 IF( k == kpbl+1 ) wpbl(i, k, j, 1) = 0.1
256 IF( k > kpbl+1 ) wpbl(i, k, j, 1) = 1.0
257 ENDDO
258
259 ENDDO
260 ENDDO
261
262 DO i=its,itf
263 DO j=jtsv,jtf
264
265 kpbl = 1
266 zpbl = 0.5 * ( pblh(i,j-1) + pblh(i,j) )
267
268 loop_kv: DO k=kts,ktf
269 zagl = 0.5 * ( z(i,k,j-1)-ht(i,j-1) + z(i,k,j)-ht(i,j) )
270 zagl_bot = 0.5 * ( z_at_w(i,k, j-1)-ht(i,j-1) + z_at_w(i,k, j)-ht(i,j) )
271 zagl_top = 0.5 * ( z_at_w(i,k+1,j-1)-ht(i,j-1) + z_at_w(i,k+1,j)-ht(i,j) )
272 IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
273 kpbl = k
274 EXIT loop_kv
275 ENDIF
276 ENDDO loop_kv
277
278 DO k=kts,ktf
279 IF( k <= kpbl ) wpbl(i, k, j, 2) = 0.0
280 IF( k == kpbl+1 ) wpbl(i, k, j, 2) = 0.1
281 IF( k > kpbl+1 ) wpbl(i, k, j, 2) = 1.0
282 ENDDO
283
284 ENDDO
285 ENDDO
286
287 ENDIF
288
289 IF( if_no_pbl_nudging_t == 1 ) THEN
290
291 DO j=jts,jtf
292 DO i=its,itf
293
294 kpbl = 1
295 zpbl = pblh(i,j)
296
297 loop_kt: DO k=kts,ktf
298 zagl = z(i,k,j)-ht(i,j)
299 zagl_bot = z_at_w(i,k, j)-ht(i,j)
300 zagl_top = z_at_w(i,k+1,j)-ht(i,j)
301 IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
302 kpbl = k
303 EXIT loop_kt
304 ENDIF
305 ENDDO loop_kt
306
307 DO k=kts,ktf
308 IF( k <= kpbl ) wpbl(i, k, j, 3) = 0.0
309 IF( k == kpbl+1 ) wpbl(i, k, j, 3) = 0.1
310 IF( k > kpbl+1 ) wpbl(i, k, j, 3) = 1.0
311 ENDDO
312
313 ENDDO
314 ENDDO
315
316 ENDIF
317
318 IF( if_no_pbl_nudging_q == 1 ) THEN
319
320 DO j=jts,jtf
321 DO i=its,itf
322
323 kpbl = 1
324 zpbl = pblh(i,j)
325
326 loop_kq: DO k=kts,ktf
327 zagl = z(i,k,j)-ht(i,j)
328 zagl_bot = z_at_w(i,k, j)-ht(i,j)
329 zagl_top = z_at_w(i,k+1,j)-ht(i,j)
330 IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
331 kpbl = k
332 EXIT loop_kq
333 ENDIF
334 ENDDO loop_kq
335
336 DO k=kts,ktf
337 IF( k <= kpbl ) wpbl(i, k, j, 4) = 0.0
338 IF( k == kpbl+1 ) wpbl(i, k, j, 4) = 0.1
339 IF( k > kpbl+1 ) wpbl(i, k, j, 4) = 1.0
340 ENDDO
341
342 ENDDO
343 ENDDO
344
345 ENDIF
346 !
347 ! If the user-defined namelist switches (if_zfac_uv, if_zfac_t,
348 ! if_zfac_q swithes) are set to 1, compute the weighting function, wzfac(k,:),
349 ! based on the namelist specified k values (k_zfac_uv, k_zfac_t and k_zfac_q) below which analysis
350 ! nudging is turned off (wzfac = 1 above k_zfac_x and = 0 in below k_zfac_x). If all
351 ! the switche are set to zero, wzfac = 1 (default value).
352 !
353 wzfac(:,:) = 1.0
354
355 IF( if_zfac_uv == 1 ) THEN
356
357 DO j=jts,jtf
358 DO i=itsu,itf
359 DO k=kts,ktf
360 IF( k <= k_zfac_uv ) wzfac(k, 1:2) = 0.0
361 IF( k == k_zfac_uv+1 ) wzfac(k, 1:2) = 0.1
362 IF( k > k_zfac_uv+1 ) wzfac(k, 1:2) = 1.0
363 ENDDO
364 ENDDO
365 ENDDO
366
367 ENDIF
368
369 IF( if_zfac_t == 1 ) THEN
370
371 DO j=jts,jtf
372 DO i=itsu,itf
373 DO k=kts,ktf
374 IF( k <= k_zfac_t ) wzfac(k, 3) = 0.0
375 IF( k == k_zfac_t+1 ) wzfac(k, 3) = 0.1
376 IF( k > k_zfac_t+1 ) wzfac(k, 3) = 1.0
377 ENDDO
378 ENDDO
379 ENDDO
380
381 ENDIF
382
383 IF( if_zfac_q == 1 ) THEN
384
385 DO j=jts,jtf
386 DO i=itsu,itf
387 DO k=kts,ktf
388 IF( k <= k_zfac_q ) wzfac(k, 4) = 0.0
389 IF( k == k_zfac_q+1 ) wzfac(k, 4) = 0.1
390 IF( k > k_zfac_q+1 ) wzfac(k, 4) = 1.0
391 ENDDO
392 ENDDO
393 ENDDO
394
395 ENDIF
396 !
397 ! If if_ramping and dtramp_min are defined by user, comput a time weighting function, tfac,
398 ! for analysis nudging so that at the end of the nudging period (which has to be at a
399 ! analysis time) we ramp down the nudging coefficient, based on the use-defined sign of dtramp_min.
400 !
401 ! When dtramp_min is negative, ramping ends at end_fdda_hour and starts at
402 ! end_fdda_hour-ABS(dtramp_min).
403 !
404 ! When dtramp_min is positive, ramping starts at end_fdda_hour and ends at
405 ! end_fdda_hour+ABS(dtramp_min). In this case, the obs values are extrapolated using
406 ! the obs tendency saved from the previous FDDA wondow. More specifically for extrapolation,
407 ! coef (see codes below) is recalculated to reflect extrapolation during the ramping period.
408 !
409 tfac = 1.0
410
411 IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
412
413 IF( dtramp_min <= 0.0 ) THEN
414 actual_end_fdda_min = end_fdda_hour*60.0
415 ELSE
416 actual_end_fdda_min = end_fdda_hour*60.0 + dtramp_min
417 ENDIF
418
419 IF( xtime < actual_end_fdda_min-ABS(dtramp_min) )THEN
420 tfac = 1.0
421 ELSEIF( xtime >= actual_end_fdda_min-ABS(dtramp_min) .AND. xtime <= actual_end_fdda_min )THEN
422 tfac = ( actual_end_fdda_min - xtime ) / ABS(dtramp_min)
423 IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval*60.0)/(analysis_interval*60.0)
424 ELSE
425 tfac = 0.0
426 ENDIF
427
428 ENDIF
429 !
430 ! Compute 3-D nudging tendencies for u, v, t and q
431 !
432 DO j=jts,jtf
433 DO k=kts,ktf
434 DO i=itsu,itf
435 val_analysis = u_ndg_old(i,k,j) *( 1.0 - coef ) + u_ndg_new(i,k,j) * coef
436 RUNDGDTEN(i,k,j) = guv * wpbl(i,k,j,1) * wzfac(k,1) * tfac * &
437 ( val_analysis - u3d(i,k,j) )
438 ENDDO
439 ENDDO
440 ENDDO
441
442 DO j=jtsv,jtf
443 DO k=kts,ktf
444 DO i=its,itf
445 val_analysis = v_ndg_old(i,k,j) *( 1.0 - coef ) + v_ndg_new(i,k,j) * coef
446 RVNDGDTEN(i,k,j) = guv * wpbl(i,k,j,2) * wzfac(k,2) * tfac * &
447 ( val_analysis - v3d(i,k,j) )
448 ENDDO
449 ENDDO
450 ENDDO
451
452 DO j=jts,jtf
453 DO k=kts,ktf
454 DO i=its,itf
455 val_analysis = t_ndg_old(i,k,j) *( 1.0 - coef ) + t_ndg_new(i,k,j) * coef
456 RTHNDGDTEN(i,k,j) = gt * wpbl(i,k,j,3) * wzfac(k,3) * tfac * &
457 ( val_analysis - th3d(i,k,j) + 300.0 )
458
459 val_analysis = q_ndg_old(i,k,j) *( 1.0 - coef ) + q_ndg_new(i,k,j) * coef
460 RQVNDGDTEN(i,k,j) = gq * wpbl(i,k,j,4) * wzfac(k,4) * tfac * &
461 ( val_analysis - qv3d(i,k,j) )
462 ENDDO
463 ENDDO
464 ENDDO
465
466 END SUBROUTINE fddagd
467
468
469 SUBROUTINE fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
470 run_hours, &
471 if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, &
472 if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, &
473 guv, gt, gq, if_ramping, dtramp_min, end_fdda_hour, &
474 restart, allowed_to_read, &
475 ids, ide, jds, jde, kds, kde, &
476 ims, ime, jms, jme, kms, kme, &
477 its, ite, jts, jte, kts, kte )
478 !-------------------------------------------------------------------
479 IMPLICIT NONE
480 !-------------------------------------------------------------------
481 !
482 INTEGER , INTENT(IN) :: id
483 LOGICAL, INTENT(IN) :: restart, allowed_to_read
484 INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
485 ims, ime, jms, jme, kms, kme, &
486 its, ite, jts, jte, kts, kte
487 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT) :: &
488 rundgdten, &
489 rvndgdten, &
490 rthndgdten, &
491 rqvndgdten
492 INTEGER, INTENT(IN) :: run_hours
493 INTEGER, INTENT(IN) :: if_no_pbl_nudging_uv, if_no_pbl_nudging_t, &
494 if_no_pbl_nudging_q, end_fdda_hour
495 INTEGER, INTENT(IN) :: if_zfac_uv, if_zfac_t, if_zfac_q
496 INTEGER, INTENT(IN) :: k_zfac_uv, k_zfac_t, k_zfac_q
497 INTEGER, INTENT(IN) :: if_ramping
498 REAL, INTENT(IN) :: dtramp_min
499 REAL, INTENT(IN) :: guv, gt, gq
500 REAL :: actual_end_fdda_min
501
502 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: rmundgdten
503 INTEGER :: i, j, k
504
505 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
506
507 CHARACTER (LEN=256) :: message
508
509 IF ( wrf_dm_on_monitor() ) THEN
510
511 IF( guv > 0.0 ) THEN
512 WRITE(message,'(a,i1,a,e12.4)') &
513 'D0',id,' Analysis nudging for wind is turned on and Guv= ', guv
514 CALL wrf_message(TRIM(message))
515 ELSE IF( guv < 0.0 ) THEN
516 CALL wrf_error_fatal('In grid FDDA, Guv must be positive.')
517 ELSE
518 WRITE(message,'(a,i1,a,e12.4)') &
519 'D0',id,' Analysis nudging for wind is turned off and Guv= ', guv
520 CALL wrf_message(TRIM(message))
521 ENDIF
522
523 IF( gt > 0.0 ) THEN
524 WRITE(message,'(a,i1,a,e12.4)') &
525 'D0',id,' Analysis nudging for temperature is turned on and Gt= ', gt
526 CALL wrf_message(TRIM(message))
527 ELSE IF( gt < 0.0 ) THEN
528 CALL wrf_error_fatal('In grid FDDA, Gt must be positive.')
529 ELSE
530 WRITE(message,'(a,i1,a,e12.4)') &
531 'D0',id,' Analysis nudging for temperature is turned off and Gt= ', gt
532 CALL wrf_message(TRIM(message))
533 ENDIF
534
535 IF( gq > 0.0 ) THEN
536 WRITE(message,'(a,i1,a,e12.4)') &
537 'D0',id,' Analysis nudging for water vapor mixing ratio is turned on and Gq= ', gq
538 CALL wrf_message(TRIM(message))
539 ELSE IF( gq < 0.0 ) THEN
540 CALL wrf_error_fatal('In grid FDDA, Gq must be positive.')
541 ELSE
542 WRITE(message,'(a,i1,a,e12.4)') &
543 'D0',id,' Analysis nudging for water vapor mixing ratio is turned off and Gq= ', gq
544 CALL wrf_message(TRIM(message))
545 ENDIF
546
547 IF( guv > 0.0 .AND. if_no_pbl_nudging_uv == 1 ) THEN
548 WRITE(message,'(a,i1,a)') &
549 'D0',id,' Analysis nudging for wind is turned off within the PBL.'
550 CALL wrf_message(TRIM(message))
551 ENDIF
552
553 IF( gt > 0.0 .AND. if_no_pbl_nudging_t == 1 ) THEN
554 WRITE(message,'(a,i1,a)') &
555 'D0',id,' Analysis nudging for temperature is turned off within the PBL.'
556 CALL wrf_message(TRIM(message))
557 ENDIF
558
559 IF( gq > 0.0 .AND. if_no_pbl_nudging_q == 1 ) THEN
560 WRITE(message,'(a,i1,a)') &
561 'D0',id,' Analysis nudging for water vapor mixing ratio is turned off within the PBL.'
562 CALL wrf_message(TRIM(message))
563 ENDIF
564
565 IF( guv > 0.0 .AND. if_zfac_uv == 1 ) THEN
566 WRITE(message,'(a,i1,a,i3)') &
567 'D0',id,' Analysis nudging for wind is turned off below layer', k_zfac_uv
568 CALL wrf_message(TRIM(message))
569 ENDIF
570
571 IF( gt > 0.0 .AND. if_zfac_t == 1 ) THEN
572 WRITE(message,'(a,i1,a,i3)') &
573 'D0',id,' Analysis nudging for temperature is turned off below layer', k_zfac_t
574 CALL wrf_message(TRIM(message))
575 ENDIF
576
577 IF( gq > 0.0 .AND. if_zfac_q == 1 ) THEN
578 WRITE(message,'(a,i1,a,i3)') &
579 'D0',id,' Analysis nudging for water vapor mixing ratio is turned off below layer', &
580 k_zfac_q
581 CALL wrf_message(TRIM(message))
582 ENDIF
583
584 IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
585 IF( dtramp_min <= 0.0 ) THEN
586 actual_end_fdda_min = end_fdda_hour*60.0
587 ELSE
588 actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
589 ENDIF
590
591 IF( actual_end_fdda_min <= run_hours*60. ) THEN
592 WRITE(message,'(a,i1,a)') &
593 'D0',id,' Analysis nudging is ramped down near the end of the nudging period,'
594 CALL wrf_message(TRIM(message))
595
596 WRITE(message,'(a,f6.2,a,f6.2,a)') &
597 ' starting at ', (actual_end_fdda_min - ABS(dtramp_min))/60.0, &
598 'h, ending at ', actual_end_fdda_min/60.0,'h.'
599 CALL wrf_message(TRIM(message))
600 ENDIF
601 ENDIF
602
603 ENDIF
604
605 IF(.not.restart) THEN
606 DO j = jts,jte
607 DO k = kts,kte
608 DO i = its,ite
609 rundgdten(i,k,j) = 0.
610 rvndgdten(i,k,j) = 0.
611 rthndgdten(i,k,j) = 0.
612 rqvndgdten(i,k,j) = 0.
613 if(k.eq.kts) rmundgdten(i,j) = 0.
614 ENDDO
615 ENDDO
616 ENDDO
617 ENDIF
618
619 END SUBROUTINE fddagdinit
620 !-------------------------------------------------------------------
621 END MODULE module_fdda_psufddagd