Context Navigation

module_physics_addtendc.F

Last change on this file was 2761, checked in by aslmd, 2 years ago
Applied planetary adaptation changes to WRFV3. job done previously by LMD_LES_MARS_install. Moved Registry.EM.newphys to put it simply in Registry.EM
File size: 53.7 KB

Rev	Line
[17]	1	!WRF:MODEL_LAYER: PHYSICS
	2	!
	3	! note: this module really belongs in the dyn_em directory since it is
	4	! specific only to the EM core. Leaving here for now, with an
	5	! #if ( EM_CORE == 1 ) directive. JM 20031201
	6	!
	7
	8	! This MODULE holds the routines which are used to perform updates of the
	9	! model C-grid tendencies with physics A-grid tendencies
	10	! The module consolidates code that was (up to v1.2) duplicated in
	11	! module_em and module_rk and in
	12	! module_big_step_utilities.F and module_big_step_utilities_em.F
	13
	14	! This MODULE CONTAINS the following routines:
	15	! update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
	16	! add_a2a, add_a2c_u, and add_a2c_v
	17
	18
	19	MODULE module_physics_addtendc
	20
	21	#if ( EM_CORE == 1 )
	22
	23	USE module_state_description
	24	USE module_configure
	25
	26	CONTAINS
	27
	28	SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
	29	scalar_tendf,mu_tendf, &
	30	RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN, &
	31	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
	32	RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
	33	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN, &
	34	RMUNDGDTEN, &
	35	n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
	36	ids, ide, jds, jde, kds, kde, &
	37	ims, ime, jms, jme, kms, kme, &
	38	its, ite, jts, jte, kts, kte )
	39	!-------------------------------------------------------------------
	40	IMPLICIT NONE
	41	!-------------------------------------------------------------------
	42
	43	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
	44
	45	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
	46	ims, ime, jms, jme, kms, kme, &
	47	its, ite, jts, jte, kts, kte, &
	48	n_moist,n_scalar,rk_step
	49
	50	LOGICAL , INTENT(IN) :: adv_moist_cond
	51
	52	REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: &
	53	ru_tendf, &
	54	rv_tendf, &
	55	rt_tendf
	56
	57	REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf
	58
	59	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
	60	INTENT(INOUT) :: moist_tendf
	61
	62	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
	63	INTENT(INOUT) :: scalar_tendf
	64
	65	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
	66	RTHRATEN, &
	67	RTHBLTEN, &
	68	RTHCUTEN, &
	69	RUBLTEN, &
	70	RVBLTEN, &
	71	RQVBLTEN, &
	72	RQCBLTEN, &
	73	RQIBLTEN, &
	74	RQVCUTEN, &
	75	RQCCUTEN, &
	76	RQRCUTEN, &
	77	RQICUTEN, &
	78	RQSCUTEN, &
	79	RTHNDGDTEN, &
	80	RQVNDGDTEN, &
	81	RUNDGDTEN, &
	82	RVNDGDTEN
	83
	84	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
	85	!------------------------------------------------------------------
	86
	87	! set up loop bounds for this grid's boundary conditions
	88
	89	if (config_flags%ra_lw_physics .gt. 0 .or. &
	90	config_flags%ra_sw_physics .gt. 0) &
	91	CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
	92	ids, ide, jds, jde, kds, kde, &
	93	ims, ime, jms, jme, kms, kme, &
	94	its, ite, jts, jte, kts, kte )
	95
	96	! if (config_flags%bl_pbl_physics .gt. 0) &
	97	!****MARS
	98	! - All the LMD physics packages provide one tendency in the WRF sense
	99	! - PBL was chosen for practical reasons (U+V+T)
	100	! - The tendencies are supposed to be A-gridded
	101	if ( (config_flags%bl_pbl_physics .gt. 0) &
	102	.OR. (config_flags%modif_wrf) ) &
	103	CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
	104	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
	105	scalar_tendf,adv_moist_cond, &
	106	RTHBLTEN,RUBLTEN,RVBLTEN, &
	107	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
	108	ids, ide, jds, jde, kds, kde, &
	109	ims, ime, jms, jme, kms, kme, &
	110	its, ite, jts, jte, kts, kte )
	111
	112	if (config_flags%cu_physics .gt. 0) &
	113	CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
	114	RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
	115	RQICUTEN,RQSCUTEN,moist_tendf, &
	116	ids, ide, jds, jde, kds, kde, &
	117	ims, ime, jms, jme, kms, kme, &
	118	its, ite, jts, jte, kts, kte )
	119
	120	if (config_flags%grid_fdda .gt. 0) &
	121	CALL phy_fg_ten(config_flags,rk_step,n_moist, &
	122	rt_tendf,ru_tendf,rv_tendf, &
	123	mu_tendf, moist_tendf, &
	124	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
	125	RQVNDGDTEN,RMUNDGDTEN, &
	126	ids, ide, jds, jde, kds, kde, &
	127	ims, ime, jms, jme, kms, kme, &
	128	its, ite, jts, jte, kts, kte )
	129
	130	END SUBROUTINE update_phy_ten
	131
	132	!=================================================================
	133	SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, &
	134	ids, ide, jds, jde, kds, kde, &
	135	ims, ime, jms, jme, kms, kme, &
	136	its, ite, jts, jte, kts, kte )
	137	!-----------------------------------------------------------------
	138	IMPLICIT NONE
	139	!-----------------------------------------------------------------
	140	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
	141
	142	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
	143	ims, ime, jms, jme, kms, kme, &
	144	its, ite, jts, jte, kts, kte
	145
	146	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
	147	RTHRATEN
	148
	149	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
	150	rt_tendf
	151
	152	! LOCAL VARS
	153
	154	INTEGER :: i,j,k
	155
	156	CALL add_a2a(rt_tendf,RTHRATEN,config_flags, &
	157	ids,ide, jds, jde, kds, kde, &
	158	ims, ime, jms, jme, kms, kme, &
	159	its, ite, jts, jte, kts, kte )
	160
	161	END SUBROUTINE phy_ra_ten
	162
	163	!=================================================================
	164	SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, &
	165	rt_tendf,ru_tendf,rv_tendf,moist_tendf, &
	166	scalar_tendf,adv_moist_cond, &
	167	RTHBLTEN,RUBLTEN,RVBLTEN, &
	168	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
	169	ids, ide, jds, jde, kds, kde, &
	170	ims, ime, jms, jme, kms, kme, &
	171	its, ite, jts, jte, kts, kte )
	172	!-----------------------------------------------------------------
	173	IMPLICIT NONE
	174	!-----------------------------------------------------------------
	175	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
	176
	177	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
	178	ims, ime, jms, jme, kms, kme, &
	179	its, ite, jts, jte, kts, kte, &
	180	n_moist, n_scalar, rk_step
	181
	182	LOGICAL , INTENT(IN) :: adv_moist_cond
	183
	184	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
	185	INTENT(INOUT) :: moist_tendf
	186
	187	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), &
	188	INTENT(INOUT) :: scalar_tendf
	189
	190	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
	191	RTHBLTEN, &
	192	RUBLTEN, &
	193	RVBLTEN, &
	194	RQVBLTEN, &
	195	RQCBLTEN, &
	196	RQIBLTEN
	197
	198	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
	199	rt_tendf, &
	200	ru_tendf, &
	201	rv_tendf
	202	! LOCAL VARS
	203
	204	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
	205
	206	!-----------------------------------------------------------------
	207
	208
	209	!****MARS
	210	!****MARS
	211	!update with LMD physics tendencies
	212	if (config_flags%modif_wrf) then
	213	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	214	ids,ide, jds, jde, kds, kde, &
	215	ims, ime, jms, jme, kms, kme, &
	216	its, ite, jts, jte, kts, kte )
	217	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	218	ids,ide, jds, jde, kds, kde, &
	219	ims, ime, jms, jme, kms, kme, &
	220	its, ite, jts, jte, kts, kte )
	221	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	222	ids,ide, jds, jde, kds, kde, &
	223	ims, ime, jms, jme, kms, kme, &
	224	its, ite, jts, jte, kts, kte )
	225	endif
	226	!****MARS
	227	!****MARS
	228
	229
	230	SELECT CASE(config_flags%bl_pbl_physics)
	231
	232	CASE (YSUSCHEME)
	233
	234	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	235	ids,ide, jds, jde, kds, kde, &
	236	ims, ime, jms, jme, kms, kme, &
	237	its, ite, jts, jte, kts, kte )
	238
	239	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	240	ids,ide, jds, jde, kds, kde, &
	241	ims, ime, jms, jme, kms, kme, &
	242	its, ite, jts, jte, kts, kte )
	243
	244	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	245	ids,ide, jds, jde, kds, kde, &
	246	ims, ime, jms, jme, kms, kme, &
	247	its, ite, jts, jte, kts, kte )
	248
	249	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	250	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
	251	config_flags, &
	252	ids,ide, jds, jde, kds, kde, &
	253	ims, ime, jms, jme, kms, kme, &
	254	its, ite, jts, jte, kts, kte )
	255
	256	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	257	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
	258	config_flags, &
	259	ids,ide, jds, jde, kds, kde, &
	260	ims, ime, jms, jme, kms, kme, &
	261	its, ite, jts, jte, kts, kte )
	262
	263	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	264	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
	265	config_flags, &
	266	ids,ide, jds, jde, kds, kde, &
	267	ims, ime, jms, jme, kms, kme, &
	268	its, ite, jts, jte, kts, kte )
	269
	270	IF(.not. adv_moist_cond)THEN
	271
	272	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	273	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
	274	config_flags, &
	275	ids,ide, jds, jde, kds, kde, &
	276	ims, ime, jms, jme, kms, kme, &
	277	its, ite, jts, jte, kts, kte )
	278
	279	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	280	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
	281	config_flags, &
	282	ids,ide, jds, jde, kds, kde, &
	283	ims, ime, jms, jme, kms, kme, &
	284	its, ite, jts, jte, kts, kte )
	285	ENDIF
	286
	287	CASE (MRFSCHEME)
	288
	289	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	290	ids,ide, jds, jde, kds, kde, &
	291	ims, ime, jms, jme, kms, kme, &
	292	its, ite, jts, jte, kts, kte )
	293
	294	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	295	ids,ide, jds, jde, kds, kde, &
	296	ims, ime, jms, jme, kms, kme, &
	297	its, ite, jts, jte, kts, kte )
	298
	299	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	300	ids,ide, jds, jde, kds, kde, &
	301	ims, ime, jms, jme, kms, kme, &
	302	its, ite, jts, jte, kts, kte )
	303
	304	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	305	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
	306	config_flags, &
	307	ids,ide, jds, jde, kds, kde, &
	308	ims, ime, jms, jme, kms, kme, &
	309	its, ite, jts, jte, kts, kte )
	310
	311	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	312	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
	313	config_flags, &
	314	ids,ide, jds, jde, kds, kde, &
	315	ims, ime, jms, jme, kms, kme, &
	316	its, ite, jts, jte, kts, kte )
	317
	318	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	319	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
	320	config_flags, &
	321	ids,ide, jds, jde, kds, kde, &
	322	ims, ime, jms, jme, kms, kme, &
	323	its, ite, jts, jte, kts, kte )
	324
	325	IF(.not. adv_moist_cond)THEN
	326
	327	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	328	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
	329	config_flags, &
	330	ids,ide, jds, jde, kds, kde, &
	331	ims, ime, jms, jme, kms, kme, &
	332	its, ite, jts, jte, kts, kte )
	333
	334	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	335	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
	336	config_flags, &
	337	ids,ide, jds, jde, kds, kde, &
	338	ims, ime, jms, jme, kms, kme, &
	339	its, ite, jts, jte, kts, kte )
	340	ENDIF
	341
	342	CASE (ACMPBLSCHEME)
	343
	344	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	345	ids,ide, jds, jde, kds, kde, &
	346	ims, ime, jms, jme, kms, kme, &
	347	its, ite, jts, jte, kts, kte )
	348
	349	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	350	ids,ide, jds, jde, kds, kde, &
	351	ims, ime, jms, jme, kms, kme, &
	352	its, ite, jts, jte, kts, kte )
	353
	354	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	355	ids,ide, jds, jde, kds, kde, &
	356	ims, ime, jms, jme, kms, kme, &
	357	its, ite, jts, jte, kts, kte )
	358
	359	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	360	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
	361	config_flags, &
	362	ids,ide, jds, jde, kds, kde, &
	363	ims, ime, jms, jme, kms, kme, &
	364	its, ite, jts, jte, kts, kte )
	365
	366	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	367	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
	368	config_flags, &
	369	ids,ide, jds, jde, kds, kde, &
	370	ims, ime, jms, jme, kms, kme, &
	371	its, ite, jts, jte, kts, kte )
	372
	373	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	374	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
	375	config_flags, &
	376	ids,ide, jds, jde, kds, kde, &
	377	ims, ime, jms, jme, kms, kme, &
	378	its, ite, jts, jte, kts, kte )
	379
	380	IF(.not. adv_moist_cond)THEN
	381
	382	if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
	383	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
	384	config_flags, &
	385	ids,ide, jds, jde, kds, kde, &
	386	ims, ime, jms, jme, kms, kme, &
	387	its, ite, jts, jte, kts, kte )
	388
	389	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
	390	config_flags, &
	391	ids,ide, jds, jde, kds, kde, &
	392	ims, ime, jms, jme, kms, kme, &
	393	its, ite, jts, jte, kts, kte )
	394	ENDIF
	395
	396	ENDIF
	397
	398	CASE (MYJPBLSCHEME)
	399
	400	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	401	ids,ide, jds, jde, kds, kde, &
	402	ims, ime, jms, jme, kms, kme, &
	403	its, ite, jts, jte, kts, kte )
	404
	405	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	406	ids,ide, jds, jde, kds, kde, &
	407	ims, ime, jms, jme, kms, kme, &
	408	its, ite, jts, jte, kts, kte )
	409
	410	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	411	ids,ide, jds, jde, kds, kde, &
	412	ims, ime, jms, jme, kms, kme, &
	413	its, ite, jts, jte, kts, kte )
	414
	415	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	416	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
	417	config_flags, &
	418	ids,ide, jds, jde, kds, kde, &
	419	ims, ime, jms, jme, kms, kme, &
	420	its, ite, jts, jte, kts, kte )
	421
	422	IF(.not. adv_moist_cond)THEN
	423
	424	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	425	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
	426	config_flags, &
	427	ids,ide, jds, jde, kds, kde, &
	428	ims, ime, jms, jme, kms, kme, &
	429	its, ite, jts, jte, kts, kte )
	430
	431	ELSE
	432
	433	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	434	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
	435	config_flags, &
	436	ids,ide, jds, jde, kds, kde, &
	437	ims, ime, jms, jme, kms, kme, &
	438	its, ite, jts, jte, kts, kte )
	439
	440	ENDIF
	441
	442	CASE (GFSSCHEME)
	443
	444	CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, &
	445	ids,ide, jds, jde, kds, kde, &
	446	ims, ime, jms, jme, kms, kme, &
	447	its, ite, jts, jte, kts, kte )
	448
	449	CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, &
	450	ids,ide, jds, jde, kds, kde, &
	451	ims, ime, jms, jme, kms, kme, &
	452	its, ite, jts, jte, kts, kte )
	453
	454	CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, &
	455	ids,ide, jds, jde, kds, kde, &
	456	ims, ime, jms, jme, kms, kme, &
	457	its, ite, jts, jte, kts, kte )
	458
	459	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	460	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, &
	461	config_flags, &
	462	ids,ide, jds, jde, kds, kde, &
	463	ims, ime, jms, jme, kms, kme, &
	464	its, ite, jts, jte, kts, kte )
	465
	466	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	467	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, &
	468	config_flags, &
	469	ids,ide, jds, jde, kds, kde, &
	470	ims, ime, jms, jme, kms, kme, &
	471	its, ite, jts, jte, kts, kte )
	472
	473	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	474	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, &
	475	config_flags, &
	476	ids,ide, jds, jde, kds, kde, &
	477	ims, ime, jms, jme, kms, kme, &
	478	its, ite, jts, jte, kts, kte )
	479
	480	IF(.not. adv_moist_cond)THEN
	481
	482	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	483	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, &
	484	config_flags, &
	485	ids,ide, jds, jde, kds, kde, &
	486	ims, ime, jms, jme, kms, kme, &
	487	its, ite, jts, jte, kts, kte )
	488
	489	if (P_QT .ge. PARAM_FIRST_SCALAR) &
	490	CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, &
	491	config_flags, &
	492	ids,ide, jds, jde, kds, kde, &
	493	ims, ime, jms, jme, kms, kme, &
	494	its, ite, jts, jte, kts, kte )
	495	ENDIF
	496
	497	CASE DEFAULT
	498
	499	! print*,'phy_bl_ten: The pbl scheme does not exist'
	500
	501	END SELECT
	502
	503	END SUBROUTINE phy_bl_ten
	504
	505	!=================================================================
	506	SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, &
	507	RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
	508	RQICUTEN,RQSCUTEN,moist_tendf, &
	509	ids, ide, jds, jde, kds, kde, &
	510	ims, ime, jms, jme, kms, kme, &
	511	its, ite, jts, jte, kts, kte )
	512	!-----------------------------------------------------------------
	513	IMPLICIT NONE
	514	!-----------------------------------------------------------------
	515	TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
	516
	517	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
	518	ims, ime, jms, jme, kms, kme, &
	519	its, ite, jts, jte, kts, kte, &
	520	n_moist, rk_step
	521
	522	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
	523	INTENT(INOUT) :: moist_tendf
	524
	525	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
	526	RTHCUTEN, &
	527	RQVCUTEN, &
	528	RQCCUTEN, &
	529	RQRCUTEN, &
	530	RQICUTEN, &
	531	RQSCUTEN
	532
	533	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
	534	rt_tendf
	535
	536	! LOCAL VARS
	537
	538	INTEGER :: i,j,k
	539
	540	SELECT CASE (config_flags%cu_physics)
	541
	542	CASE (KFSCHEME)
	543	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
	544	ids,ide, jds, jde, kds, kde, &
	545	ims, ime, jms, jme, kms, kme, &
	546	its, ite, jts, jte, kts, kte )
	547
	548	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	549	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
	550	config_flags, &
	551	ids,ide, jds, jde, kds, kde, &
	552	ims, ime, jms, jme, kms, kme, &
	553	its, ite, jts, jte, kts, kte )
	554
	555	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	556	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
	557	config_flags, &
	558	ids,ide, jds, jde, kds, kde, &
	559	ims, ime, jms, jme, kms, kme, &
	560	its, ite, jts, jte, kts, kte )
	561
	562	if (P_QR .ge. PARAM_FIRST_SCALAR) &
	563	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
	564	config_flags, &
	565	ids,ide, jds, jde, kds, kde, &
	566	ims, ime, jms, jme, kms, kme, &
	567	its, ite, jts, jte, kts, kte )
	568
	569	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	570	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
	571	config_flags, &
	572	ids,ide, jds, jde, kds, kde, &
	573	ims, ime, jms, jme, kms, kme, &
	574	its, ite, jts, jte, kts, kte )
	575
	576	if (P_QS .ge. PARAM_FIRST_SCALAR) &
	577	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
	578	config_flags, &
	579	ids,ide, jds, jde, kds, kde, &
	580	ims, ime, jms, jme, kms, kme, &
	581	its, ite, jts, jte, kts, kte )
	582
	583	CASE (BMJSCHEME)
	584	CALL add_a2a(rt_tendf,RTHCUTEN, &
	585	config_flags, &
	586	ids,ide, jds, jde, kds, kde, &
	587	ims, ime, jms, jme, kms, kme, &
	588	its, ite, jts, jte, kts, kte )
	589
	590	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	591	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
	592	config_flags, &
	593	ids,ide, jds, jde, kds, kde, &
	594	ims, ime, jms, jme, kms, kme, &
	595	its, ite, jts, jte, kts, kte )
	596
	597	CASE (KFETASCHEME)
	598	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
	599	ids,ide, jds, jde, kds, kde, &
	600	ims, ime, jms, jme, kms, kme, &
	601	its, ite, jts, jte, kts, kte )
	602
	603	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	604	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
	605	config_flags, &
	606	ids,ide, jds, jde, kds, kde, &
	607	ims, ime, jms, jme, kms, kme, &
	608	its, ite, jts, jte, kts, kte )
	609
	610	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	611	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
	612	config_flags, &
	613	ids,ide, jds, jde, kds, kde, &
	614	ims, ime, jms, jme, kms, kme, &
	615	its, ite, jts, jte, kts, kte )
	616
	617	if (P_QR .ge. PARAM_FIRST_SCALAR) &
	618	CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, &
	619	config_flags, &
	620	ids,ide, jds, jde, kds, kde, &
	621	ims, ime, jms, jme, kms, kme, &
	622	its, ite, jts, jte, kts, kte )
	623
	624	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	625	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
	626	config_flags, &
	627	ids,ide, jds, jde, kds, kde, &
	628	ims, ime, jms, jme, kms, kme, &
	629	its, ite, jts, jte, kts, kte )
	630
	631	if (P_QS .ge. PARAM_FIRST_SCALAR) &
	632	CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, &
	633	config_flags, &
	634	ids,ide, jds, jde, kds, kde, &
	635	ims, ime, jms, jme, kms, kme, &
	636	its, ite, jts, jte, kts, kte )
	637
	638	CASE (GDSCHEME, G3SCHEME)
	639	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
	640	ids,ide, jds, jde, kds, kde, &
	641	ims, ime, jms, jme, kms, kme, &
	642	its, ite, jts, jte, kts, kte )
	643
	644	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	645	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
	646	config_flags, &
	647	ids,ide, jds, jde, kds, kde, &
	648	ims, ime, jms, jme, kms, kme, &
	649	its, ite, jts, jte, kts, kte )
	650
	651	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	652	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
	653	config_flags, &
	654	ids,ide, jds, jde, kds, kde, &
	655	ims, ime, jms, jme, kms, kme, &
	656	its, ite, jts, jte, kts, kte )
	657
	658	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	659	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
	660	config_flags, &
	661	ids,ide, jds, jde, kds, kde, &
	662	ims, ime, jms, jme, kms, kme, &
	663	its, ite, jts, jte, kts, kte )
	664
	665	CASE (SASSCHEME)
	666	CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, &
	667	ids,ide, jds, jde, kds, kde, &
	668	ims, ime, jms, jme, kms, kme, &
	669	its, ite, jts, jte, kts, kte )
	670
	671	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	672	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, &
	673	config_flags, &
	674	ids,ide, jds, jde, kds, kde, &
	675	ims, ime, jms, jme, kms, kme, &
	676	its, ite, jts, jte, kts, kte )
	677
	678	if (P_QC .ge. PARAM_FIRST_SCALAR) &
	679	CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, &
	680	config_flags, &
	681	ids,ide, jds, jde, kds, kde, &
	682	ims, ime, jms, jme, kms, kme, &
	683	its, ite, jts, jte, kts, kte )
	684
	685	if (P_QI .ge. PARAM_FIRST_SCALAR) &
	686	CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, &
	687	config_flags, &
	688	ids,ide, jds, jde, kds, kde, &
	689	ims, ime, jms, jme, kms, kme, &
	690	its, ite, jts, jte, kts, kte )
	691
	692	CASE DEFAULT
	693
	694	END SELECT
	695
	696	END SUBROUTINE phy_cu_ten
	697
	698	!=================================================================
	699	SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, &
	700	rt_tendf,ru_tendf,rv_tendf, &
	701	mu_tendf, moist_tendf, &
	702	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, &
	703	RQVNDGDTEN,RMUNDGDTEN, &
	704	ids, ide, jds, jde, kds, kde, &
	705	ims, ime, jms, jme, kms, kme, &
	706	its, ite, jts, jte, kts, kte )
	707	!-----------------------------------------------------------------
	708	IMPLICIT NONE
	709	!-----------------------------------------------------------------
	710	TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
	711
	712	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
	713	ims, ime, jms, jme, kms, kme, &
	714	its, ite, jts, jte, kts, kte, &
	715	n_moist, rk_step
	716
	717	REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), &
	718	INTENT(INOUT) :: moist_tendf
	719
	720	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: &
	721	RTHNDGDTEN, &
	722	RUNDGDTEN, &
	723	RVNDGDTEN, &
	724	RQVNDGDTEN
	725
	726	REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN
	727
	728	REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: &
	729	rt_tendf, &
	730	ru_tendf, &
	731	rv_tendf
	732
	733	REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf
	734
	735	! LOCAL VARS
	736
	737	INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
	738
	739	!-----------------------------------------------------------------
	740
	741	SELECT CASE(config_flags%grid_fdda)
	742
	743	CASE (PSUFDDAGD)
	744
	745	CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, &
	746	ids,ide, jds, jde, kds, kde, &
	747	ims, ime, jms, jme, kms, kme, &
	748	its, ite, jts, jte, kts, kte )
	749
	750	! note fdda u and v tendencies are staggered
	751	CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, &
	752	ids,ide, jds, jde, kds, kde, &
	753	ims, ime, jms, jme, kms, kme, &
	754	its, ite, jts, jte, kts, kte )
	755
	756	CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, &
	757	ids,ide, jds, jde, kds, kde, &
	758	ims, ime, jms, jme, kms, kme, &
	759	its, ite, jts, jte, kts, kte )
	760
	761	CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, &
	762	ids,ide, jds, jde, kds, kds, &
	763	ims, ime, jms, jme, kms, kms, &
	764	its, ite, jts, jte, kts, kts )
	765
	766	if (P_QV .ge. PARAM_FIRST_SCALAR) &
	767	CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, &
	768	config_flags, &
	769	ids,ide, jds, jde, kds, kde, &
	770	ims, ime, jms, jme, kms, kme, &
	771	its, ite, jts, jte, kts, kte )
	772
	773
	774	CASE DEFAULT
	775
	776	END SELECT
	777
	778	END SUBROUTINE phy_fg_ten
	779
	780	!----------------------------------------------------------------------
	781	SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
	782	RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA, &
	783	HTOP,HBOT,CUTOP,CUBOT, &
	784	CUPPT, DT, config_flags, &
	785	ids,ide, jds,jde, kds,kde, &
	786	ims,ime, jms,jme, kms,kme, &
	787	its,ite, jts,jte, kts,kte )
	788	!----------------------------------------------------------------------
	789	USE module_state_description
[94]	790	!!!******MARS MARS
	791	!!!******MARS MARS
	792	! USE module_cu_kf
	793	! USE module_cu_kfeta
[17]	794	!----------------------------------------------------------------------
	795	IMPLICIT NONE
	796	!----------------------------------------------------------------------
	797	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	798
	799	INTEGER, INTENT(IN ) :: &
	800	ids,ide, jds,jde, kds,kde, &
	801	ims,ime, jms,jme, kms,kme, &
	802	its,ite, jts,jte, kts,kte
	803
	804
	805	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	806	INTENT(INOUT) :: RTHCUTEN, &
	807	RQVCUTEN, &
	808	RQCCUTEN, &
	809	RQRCUTEN, &
	810	RQICUTEN, &
	811	RQSCUTEN
	812
	813	REAL, DIMENSION( ims:ime , jms:jme ), &
	814	INTENT(INOUT) :: RAINC, &
	815	RAINCV, &
	816	PRATEC, &
	817	NCA, &
	818	HTOP, &
	819	HBOT, &
	820	CUTOP, &
	821	CUBOT, &
	822	CUPPT
	823	REAL, INTENT(IN) :: DT
	824
	825	! LOCAL VAR
	826
	827	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
	828	INTEGER :: NCUTOP, NCUBOT
	829
	830	!-----------------------------------------------------------------
	831
	832	IF (config_flags%cu_physics .eq. 0) return
	833
	834	! SET START AND END POINTS FOR TILES
	835
	836	i_start = its
	837	i_end = min( ite,ide-1 )
	838	j_start = jts
	839	j_end = min( jte,jde-1 )
	840	!
	841	! IF( config_flags%nested .or. config_flags%specified ) THEN
	842	! i_start = max( its,ids+1 )
	843	! i_end = min( ite,ide-2 )
	844	! j_start = max( jts,jds+1 )
	845	! j_end = min( jte,jde-2 )
	846	! ENDIF
	847	!
	848	k_start = kts
	849	k_end = min( kte, kde-1 )
	850
	851	! Update total cumulus scheme precipitation
	852
	853	! in mm
	854
	855	DO J = j_start,j_end
	856	DO i = i_start,i_end
	857	RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
	858	CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
	859	ENDDO
	860	ENDDO
	861
	862	SELECT CASE (config_flags%cu_physics)
	863
	864	CASE (KFSCHEME)
	865
	866	DO J = j_start,j_end
	867	DO i = i_start,i_end
	868
	869	IF ( NCA(I,J) .GT. 0 ) THEN
	870
	871	IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
	872
	873	! set tendency to zero
	874	PRATEC(I,J)=0.
	875	RAINCV(I,J)=0.
	876	DO k = k_start,k_end
	877	RTHCUTEN(i,k,j)=0.
	878	RQVCUTEN(i,k,j)=0.
	879	RQCCUTEN(i,k,j)=0.
	880	RQRCUTEN(i,k,j)=0.
	881	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
	882	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
	883	ENDDO
	884	ENDIF
	885
	886	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
	887
	888	ENDIF
	889	!
	890	ENDDO
	891	ENDDO
	892
	893	CASE (BMJSCHEME)
	894
	895	DO J = j_start,j_end
	896	DO i = i_start,i_end
	897
	898	! HTOP, HBOT FOR GFDL RADIATION
	899	NCUTOP=NINT(CUTOP(I,J))
	900	NCUBOT=NINT(CUBOT(I,J))
	901	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
	902	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
	903	ENDIF
	904	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
	905	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
	906	ENDIF
	907
	908	ENDDO
	909	ENDDO
	910
	911	CASE (KFETASCHEME)
	912
	913	DO J = j_start,j_end
	914	DO i = i_start,i_end
	915
	916	! HTOP, HBOT FOR GFDL RADIATION
	917	NCUTOP=NINT(CUTOP(I,J))
	918	NCUBOT=NINT(CUBOT(I,J))
	919	IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
	920	HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
	921	ENDIF
	922	IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
	923	HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
	924	ENDIF
	925
	926	IF ( NCA(I,J) .GT. 0 ) THEN
	927
	928
	929	IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
	930
	931	! set tendency to zero
	932	PRATEC(I,J)=0.
	933	RAINCV(I,J)=0.
	934	DO k = k_start,k_end
	935	RTHCUTEN(i,k,j)=0.
	936	RQVCUTEN(i,k,j)=0.
	937	RQCCUTEN(i,k,j)=0.
	938	RQRCUTEN(i,k,j)=0.
	939	if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
	940	if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
	941	ENDDO
	942	ENDIF
	943
	944	NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
	945	! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
	946
	947	ENDIF
	948	!
	949	ENDDO
	950	ENDDO
	951
	952	CASE DEFAULT
	953
	954	END SELECT
	955
	956	END SUBROUTINE advance_ppt
	957
	958	SUBROUTINE add_a2a(lvar,rvar,config_flags, &
	959	ids,ide, jds, jde, kds, kde, &
	960	ims, ime, jms, jme, kms, kme, &
	961	its, ite, jts, jte, kts, kte )
	962	!------------------------------------------------------------
	963	IMPLICIT NONE
	964	!------------------------------------------------------------
	965	TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
	966
	967	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	968	ims, ime, jms, jme, kms, kme, &
	969	its, ite, jts, jte, kts, kte
	970
	971	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
	972	rvar
	973	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
	974	lvar
	975
	976	! LOCAL VARS
	977	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
	978
	979	i_start = its
	980	i_end = MIN(ite,ide-1)
	981	j_start = jts
	982	j_end = MIN(jte,jde-1)
	983	ktf = min(kte,kde-1)
	984
	985	IF ( config_flags%specified .or. &
	986	config_flags%nested) i_start = MAX(ids+1,its)
	987	IF ( config_flags%specified .or. &
	988	config_flags%nested) i_end = MIN(ide-2,ite)
	989	IF ( config_flags%specified .or. &
	990	config_flags%nested) j_start = MAX(jds+1,jts)
	991	IF ( config_flags%specified .or. &
	992	config_flags%nested) j_end = MIN(jde-2,jte)
	993	IF ( config_flags%periodic_x ) i_start = its
	994	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
	995
	996	DO j = j_start,j_end
	997	DO k = kts,ktf
	998	DO i = i_start,i_end
	999	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
	1000	ENDDO
	1001	ENDDO
	1002	ENDDO
	1003
	1004	END SUBROUTINE add_a2a
	1005
	1006	!------------------------------------------------------------
	1007	SUBROUTINE add_a2c_u(lvar,rvar,config_flags, &
	1008	ids,ide, jds, jde, kds, kde, &
	1009	ims, ime, jms, jme, kms, kme, &
	1010	its, ite, jts, jte, kts, kte )
	1011	!------------------------------------------------------------
	1012	!------------------------------------------------------------
	1013	IMPLICIT NONE
	1014	!------------------------------------------------------------
	1015
	1016	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	1017
	1018	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	1019	ims, ime, jms, jme, kms, kme, &
	1020	its, ite, jts, jte, kts, kte
	1021
	1022	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
	1023	rvar
	1024	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
	1025	lvar
	1026
	1027	! LOCAL VARS
	1028
	1029	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
	1030
	1031	ktf=min(kte,kde-1)
	1032
	1033	i_start = its
	1034	i_end = ite
	1035	j_start = jts
	1036	j_end = MIN(jte,jde-1)
	1037
	1038	IF ( config_flags%specified .or. &
	1039	config_flags%nested) i_start = MAX(ids+1,its)
	1040	IF ( config_flags%specified .or. &
	1041	config_flags%nested) i_end = MIN(ide-1,ite)
	1042	IF ( config_flags%specified .or. &
	1043	config_flags%nested) j_start = MAX(jds+1,jts)
	1044	IF ( config_flags%specified .or. &
	1045	config_flags%nested) j_end = MIN(jde-2,jte)
	1046	IF ( config_flags%periodic_x ) i_start = its
	1047	IF ( config_flags%periodic_x ) i_end = ite
	1048
	1049	DO j = j_start,j_end
	1050	DO k = kts,ktf
	1051	DO i = i_start,i_end
	1052	lvar(i,k,j) = lvar(i,k,j) + &
	1053	0.5*(rvar(i,k,j)+rvar(i-1,k,j))
	1054	ENDDO
	1055	ENDDO
	1056	ENDDO
	1057
	1058	END SUBROUTINE add_a2c_u
	1059
	1060	!------------------------------------------------------------
	1061	SUBROUTINE add_a2c_v(lvar,rvar,config_flags, &
	1062	ids,ide, jds, jde, kds, kde, &
	1063	ims, ime, jms, jme, kms, kme, &
	1064	its, ite, jts, jte, kts, kte )
	1065	!------------------------------------------------------------
	1066	!------------------------------------------------------------
	1067	IMPLICIT NONE
	1068	!------------------------------------------------------------
	1069
	1070	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	1071
	1072	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	1073	ims, ime, jms, jme, kms, kme, &
	1074	its, ite, jts, jte, kts, kte
	1075
	1076	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
	1077	rvar
	1078	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
	1079	lvar
	1080
	1081	! LOCAL VARS
	1082
	1083	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
	1084
	1085	ktf=min(kte,kde-1)
	1086
	1087	i_start = its
	1088	i_end = MIN(ite,ide-1)
	1089	j_start = jts
	1090	j_end = jte
	1091
	1092	IF ( config_flags%specified .or. &
	1093	config_flags%nested) i_start = MAX(ids+1,its)
	1094	IF ( config_flags%specified .or. &
	1095	config_flags%nested) i_end = MIN(ide-2,ite)
	1096	IF ( config_flags%specified .or. &
	1097	config_flags%nested) j_start = MAX(jds+1,jts)
	1098	IF ( config_flags%specified .or. &
	1099	config_flags%nested) j_end = MIN(jde-1,jte)
	1100	IF ( config_flags%periodic_x ) i_start = its
	1101	IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
	1102
	1103	DO j = j_start,j_end
	1104	DO k = kts,kte
	1105	DO i = i_start,i_end
	1106	lvar(i,k,j) = lvar(i,k,j) + &
	1107	0.5*(rvar(i,k,j)+rvar(i,k,j-1))
	1108	ENDDO
	1109	ENDDO
	1110	ENDDO
	1111
	1112	END SUBROUTINE add_a2c_v
	1113
	1114	!------------------------------------------------------------
	1115	SUBROUTINE add_c2c_u(lvar,rvar,config_flags, &
	1116	ids,ide, jds, jde, kds, kde, &
	1117	ims, ime, jms, jme, kms, kme, &
	1118	its, ite, jts, jte, kts, kte )
	1119	!------------------------------------------------------------
	1120	!------------------------------------------------------------
	1121	IMPLICIT NONE
	1122	!------------------------------------------------------------
	1123
	1124	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	1125
	1126	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	1127	ims, ime, jms, jme, kms, kme, &
	1128	its, ite, jts, jte, kts, kte
	1129
	1130	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
	1131	rvar
	1132	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
	1133	lvar
	1134
	1135	! LOCAL VARS
	1136
	1137	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
	1138
	1139	ktf=min(kte,kde-1)
	1140
	1141	i_start = its
	1142	i_end = ite
	1143	j_start = jts
	1144	j_end = MIN(jte,jde-1)
	1145
	1146
	1147	IF ( config_flags%specified .or. &
	1148	config_flags%nested) i_start = MAX(ids+1,its)
	1149	IF ( config_flags%specified .or. &
	1150	config_flags%nested) i_end = MIN(ide-1,ite)
	1151	IF ( config_flags%specified .or. &
	1152	config_flags%nested) j_start = MAX(jds+1,jts)
	1153	IF ( config_flags%specified .or. &
	1154	config_flags%nested) j_end = MIN(jde-2,jte)
	1155
	1156	! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
	1157
	1158	DO j = j_start,j_end
	1159	DO k = kts,ktf
	1160	DO i = i_start,i_end
	1161	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
	1162	ENDDO
	1163	ENDDO
	1164	ENDDO
	1165
	1166	END SUBROUTINE add_c2c_u
	1167
	1168	SUBROUTINE add_c2c_v(lvar,rvar,config_flags, &
	1169	ids,ide, jds, jde, kds, kde, &
	1170	ims, ime, jms, jme, kms, kme, &
	1171	its, ite, jts, jte, kts, kte )
	1172	!------------------------------------------------------------
	1173	!------------------------------------------------------------
	1174	IMPLICIT NONE
	1175	!------------------------------------------------------------
	1176
	1177	TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
	1178
	1179	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	1180	ims, ime, jms, jme, kms, kme, &
	1181	its, ite, jts, jte, kts, kte
	1182
	1183	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::&
	1184	rvar
	1185	REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
	1186	lvar
	1187
	1188	! LOCAL VARS
	1189
	1190	INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
	1191
	1192	ktf=min(kte,kde-1)
	1193
	1194	i_start = its
	1195	i_end = MIN(ite,ide-1)
	1196	j_start = jts
	1197	j_end = jte
	1198
	1199	IF ( config_flags%specified .or. &
	1200	config_flags%nested) i_start = MAX(ids+1,its)
	1201	IF ( config_flags%specified .or. &
	1202	config_flags%nested) i_end = MIN(ide-2,ite)
	1203	IF ( config_flags%specified .or. &
	1204	config_flags%nested) j_start = MAX(jds+1,jts)
	1205	IF ( config_flags%specified .or. &
	1206	config_flags%nested) j_end = MIN(jde-1,jte)
	1207
	1208	! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
	1209
	1210	DO j = j_start,j_end
	1211	DO k = kts,kte
	1212	DO i = i_start,i_end
	1213	lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
	1214	ENDDO
	1215	ENDDO
	1216	ENDDO
	1217
	1218	END SUBROUTINE add_c2c_v
	1219
	1220	#endif
	1221
	1222	END MODULE module_physics_addtendc

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

Download in other formats:

Original Format