Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_fdda_psufddagd.F @ 3547

Last change on this file since 3547 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 21.0 KB

Line
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	xtime_old = FLOOR(xtime/analysis_interval) * analysis_interval * 1.0
137	xtime_new = xtime_old + analysis_interval
138	coef = (xtime-xtime_old)/(xtime_new-xtime_old)
139
140
141	IF ( wrf_dm_on_monitor()) THEN
142
143	CALL get_wrf_debug_level( dbg_level )
144
145	IF( xtime-xtime_old < 0.5*dt/60.0 ) THEN
146
147	IF( xtime < end_fdda_hour*60.0 ) THEN
148	WRITE(message,'(a,i1,a,f10.3,a)') &
149	'D0',id,' Analysis nudging read in new data at time = ', xtime, ' min.'
150	CALL wrf_message( TRIM(message) )
151	WRITE(message,'(a,i1,a,2f8.2,a)') &
152	'D0',id,' Analysis nudging bracketing times = ', xtime_old, xtime_new, ' min.'
153	CALL wrf_message( TRIM(message) )
154	ENDIF
155
156	actual_end_fdda_min = end_fdda_hour*60.0
157	IF( if_ramping == 1 .AND. dtramp_min > 0.0 ) &
158	actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
159
160	IF( dbg_level .GE. 10 .AND. xtime <= actual_end_fdda_min ) THEN
161	! Find the mid point of the tile and print out the sample values
162	i0 = (ite-its)/2+its
163	j0 = (jte-jts)/2+jts
164
165	IF( guv > 0.0 ) THEN
166	DO k = kts, kte
167	WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
168	' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
169	' u_ndg_old=', u_ndg_old(i0,k,j0), ' u_ndg_new=', u_ndg_new(i0,k,j0)
170	CALL wrf_message( TRIM(message) )
171	ENDDO
172	DO k = kts, kte
173	WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
174	' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
175	' v_ndg_old=', v_ndg_old(i0,k,j0), ' v_ndg_new=', v_ndg_new(i0,k,j0)
176	CALL wrf_message( TRIM(message) )
177	ENDDO
178	ENDIF
179
180	IF( gt > 0.0 ) THEN
181	DO k = kts, kte
182	WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
183	' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
184	' t_ndg_old=', t_ndg_old(i0,k,j0), ' t_ndg_new=', t_ndg_new(i0,k,j0)
185	CALL wrf_message( TRIM(message) )
186	ENDDO
187	ENDIF
188
189	IF( gq > 0.0 ) THEN
190	DO k = kts, kte
191	WRITE(message,'(a,i1,a,3i4,a,f10.4,a,f10.4)') &
192	' D0',id,' sample analysis values at i,k,j=', i0, k, j0, &
193	' q_ndg_old=', q_ndg_old(i0,k,j0), ' q_ndg_new=', q_ndg_new(i0,k,j0)
194	CALL wrf_message( TRIM(message) )
195	ENDDO
196	ENDIF
197
198	ENDIF
199	ENDIF
200	ENDIF
201
202	jtsv=MAX0(jts,jds+1)
203	itsu=MAX0(its,ids+1)
204
205	jtf=MIN0(jte,jde-1)
206	ktf=MIN0(kte,kde-1)
207	itf=MIN0(ite,ide-1)
208	!
209	! If the user-defined namelist switches (if_no_pbl_nudging_uv, if_no_pbl_nudging_t,
210	! if_no_pbl_nudging_q swithes) are set to 1, compute the weighting function, wpbl(:,k,:,:),
211	! based on the PBL depth. wpbl = 1 above the PBL and wpbl = 0 in the PBL. If all
212	! the switche are set to zero, wpbl = 1 (default value).
213	!
214	wpbl(:,:,:,:) = 1.0
215
216	IF( if_no_pbl_nudging_uv == 1 ) THEN
217
218	DO j=jts,jtf
219	DO i=itsu,itf
220
221	kpbl = 1
222	zpbl = 0.5 * ( pblh(i-1,j) + pblh(i,j) )
223
224	loop_ku: DO k=kts,ktf
225	zagl = 0.5 * ( z(i-1,k,j)-ht(i-1,j) + z(i,k,j)-ht(i,j) )
226	zagl_bot = 0.5 * ( z_at_w(i-1,k, j)-ht(i-1,j) + z_at_w(i,k, j)-ht(i,j) )
227	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) )
228	IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
229	kpbl = k
230	EXIT loop_ku
231	ENDIF
232	ENDDO loop_ku
233
234	DO k=kts,ktf
235	IF( k <= kpbl ) wpbl(i, k, j, 1) = 0.0
236	IF( k == kpbl+1 ) wpbl(i, k, j, 1) = 0.1
237	IF( k > kpbl+1 ) wpbl(i, k, j, 1) = 1.0
238	ENDDO
239
240	ENDDO
241	ENDDO
242
243	DO i=its,itf
244	DO j=jtsv,jtf
245
246	kpbl = 1
247	zpbl = 0.5 * ( pblh(i,j-1) + pblh(i,j) )
248
249	loop_kv: DO k=kts,ktf
250	zagl = 0.5 * ( z(i,k,j-1)-ht(i,j-1) + z(i,k,j)-ht(i,j) )
251	zagl_bot = 0.5 * ( z_at_w(i,k, j-1)-ht(i,j-1) + z_at_w(i,k, j)-ht(i,j) )
252	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) )
253	IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
254	kpbl = k
255	EXIT loop_kv
256	ENDIF
257	ENDDO loop_kv
258
259	DO k=kts,ktf
260	IF( k <= kpbl ) wpbl(i, k, j, 2) = 0.0
261	IF( k == kpbl+1 ) wpbl(i, k, j, 2) = 0.1
262	IF( k > kpbl+1 ) wpbl(i, k, j, 2) = 1.0
263	ENDDO
264
265	ENDDO
266	ENDDO
267
268	ENDIF
269
270	IF( if_no_pbl_nudging_t == 1 ) THEN
271
272	DO j=jts,jtf
273	DO i=its,itf
274
275	kpbl = 1
276	zpbl = pblh(i,j)
277
278	loop_kt: DO k=kts,ktf
279	zagl = z(i,k,j)-ht(i,j)
280	zagl_bot = z_at_w(i,k, j)-ht(i,j)
281	zagl_top = z_at_w(i,k+1,j)-ht(i,j)
282	IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
283	kpbl = k
284	EXIT loop_kt
285	ENDIF
286	ENDDO loop_kt
287
288	DO k=kts,ktf
289	IF( k <= kpbl ) wpbl(i, k, j, 3) = 0.0
290	IF( k == kpbl+1 ) wpbl(i, k, j, 3) = 0.1
291	IF( k > kpbl+1 ) wpbl(i, k, j, 3) = 1.0
292	ENDDO
293
294	ENDDO
295	ENDDO
296
297	ENDIF
298
299	IF( if_no_pbl_nudging_q == 1 ) THEN
300
301	DO j=jts,jtf
302	DO i=its,itf
303
304	kpbl = 1
305	zpbl = pblh(i,j)
306
307	loop_kq: DO k=kts,ktf
308	zagl = z(i,k,j)-ht(i,j)
309	zagl_bot = z_at_w(i,k, j)-ht(i,j)
310	zagl_top = z_at_w(i,k+1,j)-ht(i,j)
311	IF( zpbl >= zagl_bot .AND. zpbl < zagl_top ) THEN
312	kpbl = k
313	EXIT loop_kq
314	ENDIF
315	ENDDO loop_kq
316
317	DO k=kts,ktf
318	IF( k <= kpbl ) wpbl(i, k, j, 4) = 0.0
319	IF( k == kpbl+1 ) wpbl(i, k, j, 4) = 0.1
320	IF( k > kpbl+1 ) wpbl(i, k, j, 4) = 1.0
321	ENDDO
322
323	ENDDO
324	ENDDO
325
326	ENDIF
327	!
328	! If the user-defined namelist switches (if_zfac_uv, if_zfac_t,
329	! if_zfac_q swithes) are set to 1, compute the weighting function, wzfac(k,:),
330	! based on the namelist specified k values (k_zfac_uv, k_zfac_t and k_zfac_q) below which analysis
331	! nudging is turned off (wzfac = 1 above k_zfac_x and = 0 in below k_zfac_x). If all
332	! the switche are set to zero, wzfac = 1 (default value).
333	!
334	wzfac(:,:) = 1.0
335
336	IF( if_zfac_uv == 1 ) THEN
337
338	DO j=jts,jtf
339	DO i=itsu,itf
340	DO k=kts,ktf
341	IF( k <= k_zfac_uv ) wzfac(k, 1:2) = 0.0
342	IF( k == k_zfac_uv+1 ) wzfac(k, 1:2) = 0.1
343	IF( k > k_zfac_uv+1 ) wzfac(k, 1:2) = 1.0
344	ENDDO
345	ENDDO
346	ENDDO
347
348	ENDIF
349
350	IF( if_zfac_t == 1 ) THEN
351
352	DO j=jts,jtf
353	DO i=itsu,itf
354	DO k=kts,ktf
355	IF( k <= k_zfac_t ) wzfac(k, 3) = 0.0
356	IF( k == k_zfac_t+1 ) wzfac(k, 3) = 0.1
357	IF( k > k_zfac_t+1 ) wzfac(k, 3) = 1.0
358	ENDDO
359	ENDDO
360	ENDDO
361
362	ENDIF
363
364	IF( if_zfac_q == 1 ) THEN
365
366	DO j=jts,jtf
367	DO i=itsu,itf
368	DO k=kts,ktf
369	IF( k <= k_zfac_q ) wzfac(k, 4) = 0.0
370	IF( k == k_zfac_q+1 ) wzfac(k, 4) = 0.1
371	IF( k > k_zfac_q+1 ) wzfac(k, 4) = 1.0
372	ENDDO
373	ENDDO
374	ENDDO
375
376	ENDIF
377	!
378	! If if_ramping and dtramp_min are defined by user, comput a time weighting function, tfac,
379	! for analysis nudging so that at the end of the nudging period (which has to be at a
380	! analysis time) we ramp down the nudging coefficient, based on the use-defined sign of dtramp_min.
381	!
382	! When dtramp_min is negative, ramping ends at end_fdda_hour and starts at
383	! end_fdda_hour-ABS(dtramp_min).
384	!
385	! When dtramp_min is positive, ramping starts at end_fdda_hour and ends at
386	! end_fdda_hour+ABS(dtramp_min). In this case, the obs values are extrapolated using
387	! the obs tendency saved from the previous FDDA wondow. More specifically for extrapolation,
388	! coef (see codes below) is recalculated to reflect extrapolation during the ramping period.
389	!
390	tfac = 1.0
391
392	IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
393
394	IF( dtramp_min <= 0.0 ) THEN
395	actual_end_fdda_min = end_fdda_hour*60.0
396	ELSE
397	actual_end_fdda_min = end_fdda_hour*60.0 + dtramp_min
398	ENDIF
399
400	IF( xtime < actual_end_fdda_min-ABS(dtramp_min) )THEN
401	tfac = 1.0
402	ELSEIF( xtime >= actual_end_fdda_min-ABS(dtramp_min) .AND. xtime <= actual_end_fdda_min )THEN
403	tfac = ( actual_end_fdda_min - xtime ) / ABS(dtramp_min)
404	IF( dtramp_min > 0.0 ) coef = (xtime-xtime_old+analysis_interval60.0)/(analysis_interval60.0)
405	ELSE
406	tfac = 0.0
407	ENDIF
408
409	ENDIF
410	!
411	! Compute 3-D nudging tendencies for u, v, t and q
412	!
413	DO j=jts,jtf
414	DO k=kts,ktf
415	DO i=itsu,itf
416	val_analysis = u_ndg_old(i,k,j) ( 1.0 - coef ) + u_ndg_new(i,k,j) coef
417	RUNDGDTEN(i,k,j) = guv * wpbl(i,k,j,1) * wzfac(k,1) * tfac * &
418	( val_analysis - u3d(i,k,j) )
419	ENDDO
420	ENDDO
421	ENDDO
422
423	DO j=jtsv,jtf
424	DO k=kts,ktf
425	DO i=its,itf
426	val_analysis = v_ndg_old(i,k,j) ( 1.0 - coef ) + v_ndg_new(i,k,j) coef
427	RVNDGDTEN(i,k,j) = guv * wpbl(i,k,j,2) * wzfac(k,2) * tfac * &
428	( val_analysis - v3d(i,k,j) )
429	ENDDO
430	ENDDO
431	ENDDO
432
433	DO j=jts,jtf
434	DO k=kts,ktf
435	DO i=its,itf
436	val_analysis = t_ndg_old(i,k,j) ( 1.0 - coef ) + t_ndg_new(i,k,j) coef
437	RTHNDGDTEN(i,k,j) = gt * wpbl(i,k,j,3) * wzfac(k,3) * tfac * &
438	( val_analysis - th3d(i,k,j) + 300.0 )
439
440	val_analysis = q_ndg_old(i,k,j) ( 1.0 - coef ) + q_ndg_new(i,k,j) coef
441	RQVNDGDTEN(i,k,j) = gq * wpbl(i,k,j,4) * wzfac(k,4) * tfac * &
442	( val_analysis - qv3d(i,k,j) )
443	ENDDO
444	ENDDO
445	ENDDO
446
447	END SUBROUTINE fddagd
448
449
450	SUBROUTINE fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
451	run_hours, &
452	if_no_pbl_nudging_uv, if_no_pbl_nudging_t, if_no_pbl_nudging_q, &
453	if_zfac_uv, k_zfac_uv, if_zfac_t, k_zfac_t, if_zfac_q, k_zfac_q, &
454	guv, gt, gq, if_ramping, dtramp_min, end_fdda_hour, &
455	restart, allowed_to_read, &
456	ids, ide, jds, jde, kds, kde, &
457	ims, ime, jms, jme, kms, kme, &
458	its, ite, jts, jte, kts, kte )
459	!-------------------------------------------------------------------
460	IMPLICIT NONE
461	!-------------------------------------------------------------------
462	!
463	INTEGER , INTENT(IN) :: id
464	LOGICAL, INTENT(IN) :: restart, allowed_to_read
465	INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
466	ims, ime, jms, jme, kms, kme, &
467	its, ite, jts, jte, kts, kte
468	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(OUT) :: &
469	rundgdten, &
470	rvndgdten, &
471	rthndgdten, &
472	rqvndgdten
473	INTEGER, INTENT(IN) :: run_hours
474	INTEGER, INTENT(IN) :: if_no_pbl_nudging_uv, if_no_pbl_nudging_t, &
475	if_no_pbl_nudging_q, end_fdda_hour
476	INTEGER, INTENT(IN) :: if_zfac_uv, if_zfac_t, if_zfac_q
477	INTEGER, INTENT(IN) :: k_zfac_uv, k_zfac_t, k_zfac_q
478	INTEGER, INTENT(IN) :: if_ramping
479	REAL, INTENT(IN) :: dtramp_min
480	REAL, INTENT(IN) :: guv, gt, gq
481	REAL :: actual_end_fdda_min
482
483	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: rmundgdten
484	INTEGER :: i, j, k
485
486	LOGICAL , EXTERNAL :: wrf_dm_on_monitor
487
488	CHARACTER (LEN=256) :: message
489
490	IF ( wrf_dm_on_monitor() ) THEN
491
492	IF( guv > 0.0 ) THEN
493	WRITE(message,'(a,i1,a,e12.4)') &
494	'D0',id,' Analysis nudging for wind is turned on and Guv= ', guv
495	CALL wrf_message(TRIM(message))
496	ELSE IF( guv < 0.0 ) THEN
497	CALL wrf_error_fatal('In grid FDDA, Guv must be positive.')
498	ELSE
499	WRITE(message,'(a,i1,a,e12.4)') &
500	'D0',id,' Analysis nudging for wind is turned off and Guv= ', guv
501	CALL wrf_message(TRIM(message))
502	ENDIF
503
504	IF( gt > 0.0 ) THEN
505	WRITE(message,'(a,i1,a,e12.4)') &
506	'D0',id,' Analysis nudging for temperature is turned on and Gt= ', gt
507	CALL wrf_message(TRIM(message))
508	ELSE IF( gt < 0.0 ) THEN
509	CALL wrf_error_fatal('In grid FDDA, Gt must be positive.')
510	ELSE
511	WRITE(message,'(a,i1,a,e12.4)') &
512	'D0',id,' Analysis nudging for temperature is turned off and Gt= ', gt
513	CALL wrf_message(TRIM(message))
514	ENDIF
515
516	IF( gq > 0.0 ) THEN
517	WRITE(message,'(a,i1,a,e12.4)') &
518	'D0',id,' Analysis nudging for water vapor mixing ratio is turned on and Gq= ', gq
519	CALL wrf_message(TRIM(message))
520	ELSE IF( gq < 0.0 ) THEN
521	CALL wrf_error_fatal('In grid FDDA, Gq must be positive.')
522	ELSE
523	WRITE(message,'(a,i1,a,e12.4)') &
524	'D0',id,' Analysis nudging for water vapor mixing ratio is turned off and Gq= ', gq
525	CALL wrf_message(TRIM(message))
526	ENDIF
527
528	IF( guv > 0.0 .AND. if_no_pbl_nudging_uv == 1 ) THEN
529	WRITE(message,'(a,i1,a)') &
530	'D0',id,' Analysis nudging for wind is turned off within the PBL.'
531	CALL wrf_message(TRIM(message))
532	ENDIF
533
534	IF( gt > 0.0 .AND. if_no_pbl_nudging_t == 1 ) THEN
535	WRITE(message,'(a,i1,a)') &
536	'D0',id,' Analysis nudging for temperature is turned off within the PBL.'
537	CALL wrf_message(TRIM(message))
538	ENDIF
539
540	IF( gq > 0.0 .AND. if_no_pbl_nudging_q == 1 ) THEN
541	WRITE(message,'(a,i1,a)') &
542	'D0',id,' Analysis nudging for water vapor mixing ratio is turned off within the PBL.'
543	CALL wrf_message(TRIM(message))
544	ENDIF
545
546	IF( guv > 0.0 .AND. if_zfac_uv == 1 ) THEN
547	WRITE(message,'(a,i1,a,i3)') &
548	'D0',id,' Analysis nudging for wind is turned off below layer', k_zfac_uv
549	CALL wrf_message(TRIM(message))
550	ENDIF
551
552	IF( gt > 0.0 .AND. if_zfac_t == 1 ) THEN
553	WRITE(message,'(a,i1,a,i3)') &
554	'D0',id,' Analysis nudging for temperature is turned off below layer', k_zfac_t
555	CALL wrf_message(TRIM(message))
556	ENDIF
557
558	IF( gq > 0.0 .AND. if_zfac_q == 1 ) THEN
559	WRITE(message,'(a,i1,a,i3)') &
560	'D0',id,' Analysis nudging for water vapor mixing ratio is turned off below layer', &
561	k_zfac_q
562	CALL wrf_message(TRIM(message))
563	ENDIF
564
565	IF( if_ramping == 1 .AND. ABS(dtramp_min) > 0.0 ) THEN
566	IF( dtramp_min <= 0.0 ) THEN
567	actual_end_fdda_min = end_fdda_hour*60.0
568	ELSE
569	actual_end_fdda_min = end_fdda_hour*60.0 + ABS(dtramp_min)
570	ENDIF
571
572	IF( actual_end_fdda_min <= run_hours*60. ) THEN
573	WRITE(message,'(a,i1,a)') &
574	'D0',id,' Analysis nudging is ramped down near the end of the nudging period,'
575	CALL wrf_message(TRIM(message))
576
577	WRITE(message,'(a,f6.2,a,f6.2,a)') &
578	' starting at ', (actual_end_fdda_min - ABS(dtramp_min))/60.0, &
579	'h, ending at ', actual_end_fdda_min/60.0,'h.'
580	CALL wrf_message(TRIM(message))
581	ENDIF
582	ENDIF
583
584	ENDIF
585
586	IF(.not.restart) THEN
587	DO j = jts,jte
588	DO k = kts,kte
589	DO i = its,ite
590	rundgdten(i,k,j) = 0.
591	rvndgdten(i,k,j) = 0.
592	rthndgdten(i,k,j) = 0.
593	rqvndgdten(i,k,j) = 0.
594	if(k.eq.kts) rmundgdten(i,j) = 0.
595	ENDDO
596	ENDDO
597	ENDDO
598	ENDIF
599
600	END SUBROUTINE fddagdinit
601	!-------------------------------------------------------------------
602	END MODULE module_fdda_psufddagd

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

Download in other formats:

Original Format