Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_fdda_psufddagd.F @ 3094

Last change on this file since 3094 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

Rev	Line
[2759]	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