Context Navigation

module_fdda_psufddagd.F

Last change on this file was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 21.6 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format