Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_fddagd_driver.F @ 13

Last change on this file since 13 was 1, checked in by lfita, 11 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 18.1 KB

Rev	Line
[1]	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	RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
	12	u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old, &
	13	q_ndg_old,mu_ndg_old, &
	14	u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new, &
	15	q_ndg_new,mu_ndg_new, &
	16	u3d,v3d,th_phy,ph,rho,moist, &
	17	p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w, &
	18	grid,config_flags,DX,n_moist, &
	19	STEPFG, &
	20	pblh,ht,regime,znt, &
	21	ids,ide, jds,jde, kds,kde, &
	22	ims,ime, jms,jme, kms,kme, &
	23	i_start,i_end, j_start,j_end, kts,kte, num_tiles, &
	24	u10, v10, th2, q2, &
	25	u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
	26	rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
	27	u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
	28	rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
	29	ips,ipe,jps,jpe,kps,kpe, &
	30	imsx,imex,jmsx,jmex,kmsx,kmex, &
	31	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
	32	imsy,imey,jmsy,jmey,kmsy,kmey, &
	33	ipsy,ipey,jpsy,jpey,kpsy,kpey )
	34	!------------------------------------------------------------------
	35	USE module_configure
	36	USE module_state_description
	37	USE module_model_constants
	38	USE module_domain, ONLY : domain
	39
	40	! *** add new modules of schemes here
	41
	42	USE module_fdda_psufddagd
	43	USE module_fdda_spnudging
	44
	45	!------------------------------------------------------------------
	46	IMPLICIT NONE
	47	!======================================================================
	48	! Grid structure in physics part of WRF
	49	!----------------------------------------------------------------------
	50	! The horizontal velocities used in the physics are unstaggered
	51	! relative to temperature/moisture variables. All predicted
	52	! variables are carried at half levels except w, which is at full
	53	! levels. Some arrays with names (*8w) are at w (full) levels.
	54	!
	55	!----------------------------------------------------------------------
	56	! In WRF, kms (smallest number) is the bottom level and kme (largest
	57	! number) is the top level. In your scheme, if 1 is at the top level,
	58	! then you have to reverse the order in the k direction.
	59	!
	60	! kme - half level (no data at this level)
	61	! kme ----- full level
	62	! kme-1 - half level
	63	! kme-1 ----- full level
	64	! .
	65	! .
	66	! .
	67	! kms+2 - half level
	68	! kms+2 ----- full level
	69	! kms+1 - half level
	70	! kms+1 ----- full level
	71	! kms - half level
	72	! kms ----- full level
	73	!
	74	!======================================================================
	75	!-- RUNDGDTEN U tendency due to
	76	! FDDA analysis nudging (m/s^2)
	77	!-- RVNDGDTEN V tendency due to
	78	! FDDA analysis nudging (m/s^2)
	79	!-- RTHNDGDTEN Theta tendency due to
	80	! FDDA analysis nudging (K/s)
	81	!-- RPHNDGDTEN Geopotential tendency due to
	82	! FDDA analysis nudging (m^2/s^3)
	83	!-- RQVNDGDTEN Qv tendency due to
	84	! FDDA analysis nudging (kg/kg/s)
	85	!-- RMUNDGDTEN mu tendency due to
	86	! FDDA analysis nudging (Pa/s)
	87	!-- itimestep number of time steps
	88	!-- u3d u-velocity staggered on u points (m/s)
	89	!-- v3d v-velocity staggered on v points (m/s)
	90	!-- th_phy potential temperature (K)
	91	!-- moist moisture array (4D - last index is species) (kg/kg)
	92	!-- p_phy pressure (Pa)
	93	!-- pi_phy exner function (dimensionless)
	94	!-- p8w pressure at full levels (Pa)
	95	!-- t_phy temperature (K)
	96	!-- dz8w dz between full levels (m)
	97	!-- z height above sea level (m)
	98	!-- config_flags
	99	!-- DX horizontal space interval (m)
	100	!-- DT time step (second)
	101	!-- n_moist number of moisture species
	102	!-- STEPFG number of timesteps per FDDA re-calculation
	103	!-- KPBL k-index of PBL top
	104	!-- ids start index for i in domain
	105	!-- ide end index for i in domain
	106	!-- jds start index for j in domain
	107	!-- jde end index for j in domain
	108	!-- kds start index for k in domain
	109	!-- kde end index for k in domain
	110	!-- ims start index for i in memory
	111	!-- ime end index for i in memory
	112	!-- jms start index for j in memory
	113	!-- jme end index for j in memory
	114	!-- kms start index for k in memory
	115	!-- kme end index for k in memory
	116	!-- jts start index for j in tile
	117	!-- jte end index for j in tile
	118	!-- kts start index for k in tile
	119	!-- kte end index for k in tile
	120	!
	121	!******************************************************************
	122	!------------------------------------------------------------------
	123	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	124	TYPE(domain) , TARGET :: grid
	125	!
	126
	127	INTEGER , INTENT(IN) :: id
	128
	129	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
	130	ims,ime, jms,jme, kms,kme, &
	131	kts,kte, num_tiles, &
	132	ips,ipe,jps,jpe,kps,kpe, &
	133	imsx,imex,jmsx,jmex,kmsx,kmex, &
	134	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
	135	imsy,imey,jmsy,jmey,kmsy,kmey, &
	136	ipsy,ipey,jpsy,jpey,kpsy,kpey, &
	137	n_moist
	138
	139	INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
	140	& i_start,i_end,j_start,j_end
	141
	142	INTEGER, INTENT(IN ) :: itimestep,STEPFG
	143	!
	144	REAL, INTENT(IN ) :: DT,DX,XTIME
	145
	146
	147	!
	148	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	149	INTENT(IN ) :: p_phy, &
	150	pi_phy, &
	151	p8w, &
	152	rho, &
	153	t_phy, &
	154	u3d, &
	155	v3d, &
	156	ph, &
	157	dz8w, &
	158	z, &
	159	z_at_w, &
	160	th_phy
	161	!
	162	REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), &
	163	INTENT(IN ) :: moist
	164	!
	165	!
	166	!
	167	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	168	INTENT(INOUT) :: RUNDGDTEN, &
	169	RVNDGDTEN, &
	170	RTHNDGDTEN, &
	171	RPHNDGDTEN, &
	172	RQVNDGDTEN
	173
	174	REAL, DIMENSION( ims:ime, jms:jme ), &
	175	INTENT(INOUT) :: RMUNDGDTEN
	176
	177	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	178	INTENT(INOUT) :: u_ndg_old, &
	179	v_ndg_old, &
	180	t_ndg_old, &
	181	ph_ndg_old,&
	182	q_ndg_old, &
	183	u_ndg_new, &
	184	v_ndg_new, &
	185	t_ndg_new, &
	186	ph_ndg_new,&
	187	q_ndg_new
	188	REAL, DIMENSION( ims:ime, jms:jme ), &
	189	INTENT(INOUT) :: mu_ndg_old, &
	190	mu_ndg_new
	191
	192	!
	193	REAL, DIMENSION( ims:ime , jms:jme ), &
	194	INTENT(IN ) :: pblh, &
	195	ht, &
	196	znt
	197
	198	REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) :: regime
	199
	200	REAL, DIMENSION( ims:ime, jms:jme ), &
	201	INTENT(IN ) :: u10, &
	202	v10, &
	203	th2, &
	204	q2
	205
	206	REAL, DIMENSION( ims:ime, jms:jme ), &
	207	INTENT(IN) :: u10_ndg_old, &
	208	v10_ndg_old, &
	209	t2_ndg_old, &
	210	th2_ndg_old, &
	211	q2_ndg_old, &
	212	rh_ndg_old, &
	213	psl_ndg_old, &
	214	ps_ndg_old, &
	215	odis_ndg_old, &
	216	u10_ndg_new, &
	217	v10_ndg_new, &
	218	t2_ndg_new, &
	219	th2_ndg_new, &
	220	q2_ndg_new, &
	221	rh_ndg_new, &
	222	psl_ndg_new, &
	223	ps_ndg_new, &
	224	odis_ndg_new
	225
	226	REAL, DIMENSION( ims:ime, jms:jme ), &
	227	INTENT(IN) :: tob_ndg_old, &
	228	tob_ndg_new
	229
	230	! LOCAL VAR
	231
	232	!
	233	INTEGER :: i,J,K,NK,jj,ij
	234	CHARACTER (LEN=256) :: message
	235
	236	!------------------------------------------------------------------
	237	!
	238	#if ! ( NMM_CORE == 1 )
	239	if (config_flags%grid_fdda .eq. 0 .AND. config_flags%grid_sfdda .eq. 0) return
	240
	241	IF (itimestep == 1) THEN
	242
	243	IF( config_flags%grid_fdda .eq. 1 ) THEN
	244	!$OMP PARALLEL DO &
	245	!$OMP PRIVATE ( ij,i,j,k )
	246	DO ij = 1 , num_tiles
	247	DO j=j_start(ij),j_end(ij)
	248	DO i=i_start(ij),i_end(ij)
	249
	250	DO k=kts,min(kte+1,kde)
	251	u_ndg_old(i,k,j) = u3d(i,k,j)
	252	v_ndg_old(i,k,j) = v3d(i,k,j)
	253	t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
	254	ph_ndg_old(i,k,j) = ph(i,k,j)
	255	q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
	256	ENDDO
	257	mu_ndg_old(i,j) = 0.0
	258
	259	ENDDO
	260	ENDDO
	261
	262	ENDDO
	263
	264	! IF( config_flags%grid_sfdda .eq. 1 ) THEN
	265	! DO ij = 1 , num_tiles
	266	! DO j=j_start(ij),j_end(ij)
	267	! DO i=i_start(ij),i_end(ij)
	268	! u10_ndg_old(i,j) = u10(i,j)
	269	! v10_ndg_old(i,j) = v10(i,j)
	270	! th2_ndg_old(i,j) = th2(i,j) - 300.0
	271	! q2_ndg_old(i,j) = q2(i,j)
	272	! ENDDO
	273	! ENDDO
	274
	275	! ENDDO
	276	! ENDIF
	277	!$OMP END PARALLEL DO
	278
	279	ENDIF
	280	ENDIF
	281
	282	!GMM if fgdtzero = 1, tendencies are zero in between calls
	283
	284	IF (mod(itimestep-1,STEPFG) .eq. 0 .and. config_flags%fgdtzero .eq. 1) THEN
	285
	286	!$OMP PARALLEL DO &
	287	!$OMP PRIVATE ( ij,i,j,k )
	288	DO ij = 1 , num_tiles
	289	DO j=j_start(ij),j_end(ij)
	290	DO i=i_start(ij),i_end(ij)
	291
	292	DO k=kts,min(kte+1,kde)
	293	RTHNDGDTEN(I,K,J)=0.
	294	RUNDGDTEN(I,K,J)=0.
	295	RVNDGDTEN(I,K,J)=0.
	296	RPHNDGDTEN(I,K,J)=0.
	297	RQVNDGDTEN(I,K,J)=0.
	298	ENDDO
	299
	300	RMUNDGDTEN(I,J)=0.
	301
	302	ENDDO
	303	ENDDO
	304
	305	ENDDO
	306	!$OMP END PARALLEL DO
	307
	308	ENDIF
	309
	310	IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
	311
	312	!$OMP PARALLEL DO &
	313	!$OMP PRIVATE ( ij,i,j,k )
	314	DO ij = 1 , num_tiles
	315	DO j=j_start(ij),j_end(ij)
	316	DO i=i_start(ij),i_end(ij)
	317
	318	DO k=kts,min(kte+1,kde)
	319	RTHNDGDTEN(I,K,J)=0.
	320	RUNDGDTEN(I,K,J)=0.
	321	RVNDGDTEN(I,K,J)=0.
	322	RPHNDGDTEN(I,K,J)=0.
	323	RQVNDGDTEN(I,K,J)=0.
	324	ENDDO
	325
	326	RMUNDGDTEN(I,J)=0.
	327
	328	ENDDO
	329	ENDDO
	330
	331	ENDDO
	332	!$OMP END PARALLEL DO
	333
	334	!
	335	IF( config_flags%grid_fdda /= 0 ) THEN
	336	fdda_select: SELECT CASE(config_flags%grid_fdda)
	337
	338	CASE (PSUFDDAGD)
	339
	340	!$OMP PARALLEL DO &
	341	!$OMP PRIVATE ( ij, i,j,k )
	342	DO ij = 1 , num_tiles
	343	CALL wrf_debug(100,'in PSU FDDA scheme')
	344
	345	IF( config_flags%bl_pbl_physics /= 1 &
	346	.AND. config_flags%bl_pbl_physics /= 5 &
	347	.AND. config_flags%bl_pbl_physics /= 6 &
	348	.AND. config_flags%bl_pbl_physics /= 7 &
	349	.AND. config_flags%bl_pbl_physics /= 99 ) THEN
	350	DO j=MAX(j_start(ij)-1,jds),j_end(ij)
	351	DO i=MAX(i_start(ij)-1,ids),i_end(ij)
	352	IF( pblh(i,j) > z_at_w(i,2,j)-ht(i,j) ) THEN
	353	regime(i,j) = 4.0
	354	ELSE
	355	regime(i,j) = 1.0
	356	ENDIF
	357	ENDDO
	358	ENDDO
	359	ENDIF
	360
	361	CALL FDDAGD(itimestep,dx,dt,xtime, &
	362	id, &
	363	config_flags%auxinput10_interval_m, &
	364	config_flags%auxinput10_end_h, &
	365	config_flags%if_no_pbl_nudging_uv, &
	366	config_flags%if_no_pbl_nudging_t, &
	367	config_flags%if_no_pbl_nudging_q, &
	368	config_flags%if_zfac_uv, &
	369	config_flags%k_zfac_uv, &
	370	config_flags%if_zfac_t, &
	371	config_flags%k_zfac_t, &
	372	config_flags%if_zfac_q, &
	373	config_flags%k_zfac_q, &
	374	config_flags%guv, &
	375	config_flags%gt, config_flags%gq, &
	376	config_flags%if_ramping, config_flags%dtramp_min, &
	377	config_flags%grid_sfdda, &
	378	config_flags%auxinput9_interval_m, &
	379	config_flags%auxinput9_end_h, &
	380	config_flags%guv_sfc, &
	381	config_flags%gt_sfc, config_flags%gq_sfc, config_flags%rinblw, &
	382	u3d,v3d,th_phy,t_phy, &
	383	moist(ims,kms,jms,P_QV), &
	384	p_phy,pi_phy, &
	385	u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old, &
	386	u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new, &
	387	u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
	388	rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
	389	u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
	390	rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
	391	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
	392	pblh, ht, regime, znt, z, z_at_w, &
	393	ids,ide, jds,jde, kds,kde, &
	394	ims,ime, jms,jme, kms,kme, &
	395	i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte )
	396
	397	ENDDO
	398	!$OMP END PARALLEL DO
	399
	400	CASE (SPNUDGING)
	401	CALL wrf_debug(100,'in SPECTRAL NUDGING scheme')
	402	CALL SPECTRAL_NUDGING(grid,itimestep,dt,xtime, &
	403	id, &
	404	config_flags%auxinput10_interval_m, &
	405	config_flags%auxinput10_end_h, &
	406	config_flags%if_no_pbl_nudging_uv, &
	407	config_flags%if_no_pbl_nudging_t, &
	408	config_flags%if_no_pbl_nudging_ph, &
	409	config_flags%if_zfac_uv, &
	410	config_flags%k_zfac_uv, &
	411	config_flags%dk_zfac_uv, &
	412	config_flags%if_zfac_t, &
	413	config_flags%k_zfac_t, &
	414	config_flags%dk_zfac_t, &
	415	config_flags%if_zfac_ph, &
	416	config_flags%k_zfac_ph, &
	417	config_flags%dk_zfac_ph, &
	418	config_flags%guv, &
	419	config_flags%gt, &
	420	config_flags%gph, &
	421	config_flags%if_ramping, config_flags%dtramp_min, &
	422	config_flags%xwavenum, config_flags%ywavenum, &
	423	u3d,v3d,th_phy,ph, &
	424	u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old, &
	425	u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new, &
	426	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN,&
	427	pblh, ht, z, z_at_w, &
	428	ids,ide, jds,jde, kds,kde, &
	429	ims,ime, jms,jme, kms,kme, &
	430	i_start,i_end,j_start,j_end,kts,kte, num_tiles, &
	431	ips,ipe,jps,jpe,kps,kpe, &
	432	imsx,imex,jmsx,jmex,kmsx,kmex, &
	433	ipsx,ipex,jpsx,jpex,kpsx,kpex, &
	434	imsy,imey,jmsy,jmey,kmsy,kmey, &
	435	ipsy,ipey,jpsy,jpey,kpsy,kpey )
	436
	437
	438	CASE DEFAULT
	439
	440	WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
	441	CALL wrf_error_fatal ( wrf_err_message )
	442
	443	END SELECT fdda_select
	444	ENDIF
	445
	446	ENDIF
	447
	448	#endif
	449	!
	450	END SUBROUTINE fddagd_driver
	451	END MODULE module_fddagd_driver

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

Download in other formats:

Original Format