Context Navigation

surf_land_mod.F90 @ 5277

Last change on this file since 5277 was 5274, checked in by abarral, 9 hours ago
Replace yomcst.h by existing module
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 16.3 KB

Rev	Line
[781]	1	!
	2	MODULE surf_land_mod
[2952]	3
[781]	4	IMPLICIT NONE
	5
	6	CONTAINS
	7	!
	8	!****************************************************************************************
	9	!
	10	SUBROUTINE surf_land(itime, dtime, date0, jour, knon, knindex, &
[2410]	11	rlon, rlat, yrmu0, &
[888]	12	debut, lafin, zlev, ccanopy, swnet, lwnet, albedo, &
[4523]	13	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, precip_bs, temp_air, spechum, &
[1067]	14	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	15	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	16	pref, u1, v1, gustiness, rugoro, pctsrf, &
[1146]	17	lwdown_m, q2m, t2m, &
[888]	18	snow, qsol, agesno, tsoil, &
[4523]	19	z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, fluxbs, &
[996]	20	qsurf, tsurf_new, dflux_s, dflux_l, &
[2952]	21	flux_u1, flux_v1 , &
[5022]	22	veget,lai,height &
	23	#ifdef ISO
	24	,xtprecip_rain, xtprecip_snow,xtspechum, &
	25	xtsnow, xtsol,xtevap,h1, &
	26	runoff_diag,xtrunoff_diag,Rland_ice &
	27	#endif
	28	)
[781]	29
[1067]	30	USE dimphy
	31	USE surface_data, ONLY : ok_veget
[4283]	32	USE carbon_cycle_mod
[1146]	33
[4283]	34
[2571]	35	! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
[1146]	36	#ifdef ORCHIDEE_NOOPENMP
[2571]	37	! Compilation with cpp key ORCHIDEE NOOPENMP
[1146]	38	USE surf_land_orchidee_noopenmp_mod
	39	#else
[2571]	40	#if ORCHIDEE_NOZ0H
	41	! Compilation with cpp key ORCHIDEE NOZ0H
	42	USE surf_land_orchidee_noz0h_mod
	43	#else
[2952]	44	#if ORCHIDEE_NOFREIN
	45	! Compilation with cpp key ORCHIDEE_NOFREIN
	46	USE surf_land_orchidee_nofrein_mod
	47	#else
[3435]	48	#if ORCHIDEE_NOUNSTRUCT
	49	! Compilation with cpp key ORCHIDEE_NOUNSTRUCT
	50	USE surf_land_orchidee_nounstruct_mod
	51	#else
[4283]	52	#if ORCHIDEE_NOLIC
	53	! Compilation with cpp key ORCHIDEE_NOLIC
	54	USE surf_land_orchidee_nolic_mod
	55	#else
	56	! Default version
[1067]	57	USE surf_land_orchidee_mod
[1146]	58	#endif
[2571]	59	#endif
[2952]	60	#endif
[3435]	61	#endif
[4283]	62	#endif
	63
[1067]	64	USE surf_land_bucket_mod
	65	USE calcul_fluxs_mod
[1785]	66	USE indice_sol_mod
[5022]	67	#ifdef ISO
	68	use infotrac_phy, ONLY: ntiso,niso
	69	use isotopes_mod, ONLY: nudge_qsol, iso_eau
	70	#ifdef ISOVERIF
	71	use isotopes_verif_mod
	72	#endif
	73	#endif
	74
[5274]	75	USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO &
	76	, RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA &
	77	, R_ecc, R_peri, R_incl &
	78	, RA, RG, R1SA &
	79	, RSIGMA &
	80	, R, RMD, RMV, RD, RV, RCPD &
	81	, RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 &
	82	, RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w &
	83	, RCW, RCS &
	84	, RLVTT, RLSTT, RLMLT, RTT, RATM &
	85	, RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS &
	86	, RALPD, RBETD, RGAMD
	87	USE print_control_mod, ONLY: lunout
[5273]	88	USE dimsoil_mod_h, ONLY: nsoilmx
[5274]	89
[2227]	90	INCLUDE "clesphys.h"
[2952]	91	INCLUDE "dimpft.h"
[781]	92
	93	! Input variables
	94	!****************************************************************************************
	95	INTEGER, INTENT(IN) :: itime, jour, knon
	96	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	97	REAL, INTENT(IN) :: date0
	98	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
[2410]	99	REAL, DIMENSION(klon), INTENT(IN) :: yrmu0 ! cosine of solar zenith angle
[781]	100	LOGICAL, INTENT(IN) :: debut, lafin
	101	REAL, INTENT(IN) :: dtime
[888]	102	REAL, DIMENSION(klon), INTENT(IN) :: zlev, ccanopy
	103	REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet
	104	REAL, DIMENSION(klon), INTENT(IN) :: albedo ! albedo for whole short-wave interval
[781]	105	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
	106	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1067]	107	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[4523]	108	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs
[781]	109	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	110	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	111	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[888]	112	REAL, DIMENSION(klon), INTENT(IN) :: pref ! pressure reference
[2240]	113	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[781]	114	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
	115	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[888]	116	REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downwelling longwave radiation at mean surface
	117	! corresponds to previous sollwdown
[1146]	118	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
[5022]	119	#ifdef ISO
	120	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	121	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
	122	#endif
[781]	123	! In/Output variables
	124	!****************************************************************************************
	125	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
	126	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	127	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
[5022]	128	#ifdef ISO
	129	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow, xtsol
	130	#endif
[781]	131
	132	! Output variables
	133	!****************************************************************************************
[2243]	134	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
[2227]	135	!albedo SB >>>
	136	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! albdeo for shortwave interval 1(visible)
	137	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! albedo for shortwave interval 2(near infrared)
	138	REAL, DIMENSION(6), INTENT(IN) :: SFRWL
	139	REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new
	140	!albedo SB <<<
[888]	141	REAL, DIMENSION(klon), INTENT(OUT) :: evap
[4523]	142	REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat, fluxbs
[781]	143	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
[888]	144	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	145	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[1067]	146	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1 ! flux for U and V at first model level
[2952]	147	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
	148	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
[5022]	149	#ifdef ISO
	150	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
	151	REAL, DIMENSION(klon), INTENT(OUT) :: h1
	152	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
	153	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
	154	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
	155	#endif
[781]	156
	157	! Local variables
	158	!****************************************************************************************
[888]	159	REAL, DIMENSION(klon) :: p1lay_tmp
	160	REAL, DIMENSION(klon) :: pref_tmp
	161	REAL, DIMENSION(klon) :: swdown ! downwelling shortwave radiation at land surface
	162	REAL, DIMENSION(klon) :: epot_air ! potential air temperature
[781]	163	REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
[1067]	164	REAL, DIMENSION(klon) :: u0, v0 ! surface speed
[4523]	165	REAL, DIMENSION(klon) :: precip_totsnow ! total solid precip
[781]	166	INTEGER :: i
	167
[2227]	168	!albedo SB >>>
	169	REAL, DIMENSION(klon) :: alb1_new,alb2_new
	170	!albedo SB <<<
[781]	171
[5022]	172	#ifdef ISO
	173	real, parameter :: t_coup = 273.15
	174	real, dimension(klon) :: fqfonte_diag
	175	real, dimension(klon) :: snow_evap_diag
	176	real, dimension(klon) :: fqcalving_diag
	177	integer :: ixt
	178	#endif
[4523]	179	!****************************************************************************************
	180	!Total solid precip
	181
	182	IF (ok_bs) THEN
[4526]	183	precip_totsnow(:)=precip_snow(:)+precip_bs(:)
[4523]	184	ELSE
[4526]	185	precip_totsnow(:)=precip_snow(:)
[4523]	186	ENDIF
	187	!****************************************************************************************
[5022]	188	#ifdef ISO
	189	#ifdef ISOVERIF
	190	! write(,) 'surf_land_mod 162'
	191	do i=1,knon
	192	if (iso_eau.gt.0) then
	193	call iso_verif_egalite_choix(precip_snow(i), &
	194	& xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
	195	& errmax,errmaxrel)
	196	call iso_verif_egalite_choix(qsol(i), &
	197	& xtsol(iso_eau,i),'surf_land_mod 139', &
	198	& errmax,errmaxrel)
	199	endif
	200	enddo
	201	#endif
	202	#ifdef ISOVERIF
	203	! write(,) 'surf_land 169: ok_veget=',ok_veget
	204	do i=1,knon
	205	do ixt=1,ntiso
	206	call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
	207	enddo
	208	enddo
	209	#endif
	210	#endif
[4523]	211
	212
[781]	213	!****************************************************************************************
	214	! Choice between call to vegetation model (ok_veget=true) or simple calculation below
	215	!
	216	!****************************************************************************************
	217	IF (ok_veget) THEN
	218	!****************************************************************************************
[888]	219	! Call model sechiba in model ORCHIDEE
[781]	220	!
	221	!****************************************************************************************
	222	p1lay_tmp(:) = 0.0
[888]	223	pref_tmp(:) = 0.0
[781]	224	p1lay_tmp(1:knon) = p1lay(1:knon)/100.
[888]	225	pref_tmp(1:knon) = pref(1:knon)/100.
	226	!
[2188]	227	!* Calculate incoming flux for SW and LW interval: swdown
[888]	228	!
	229	swdown(:) = 0.0
	230	DO i = 1, knon
	231	swdown(i) = swnet(i)/(1-albedo(i))
	232	END DO
	233	!
	234	!* Calculate potential air temperature
	235	!
	236	epot_air(:) = 0.0
	237	DO i = 1, knon
	238	epot_air(i) = RCPDtemp_air(i)(pref(i)/p1lay(i))**RKAPPA
	239	END DO
[781]	240
[5022]	241	#ifdef ISO
[5217]	242	CALL abort_physic('surf_land_mod 220','isos pas prevus dans orchidee',1)
[5022]	243	#endif
[888]	244	! temporary for keeping same results using lwdown_m instead of lwdown
[781]	245	CALL surf_land_orchidee(itime, dtime, date0, knon, &
[2410]	246	knindex, rlon, rlat, yrmu0, pctsrf, &
[781]	247	debut, lafin, &
[2240]	248	zlev, u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, &
[1067]	249	cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
[4523]	250	precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
[1146]	251	pref_tmp, q2m, t2m, &
[4526]	252	evap, fluxsens, fluxlat, &
[888]	253	tsol_rad, tsurf_new, alb1_new, alb2_new, &
[2952]	254	emis_new, z0m, z0h, qsurf, &
[5022]	255	veget, lai, height &
	256	!#ifdef ISO
	257	! , xtprecip_rain, xtprecip_snow, xtspechum, xtevap &
	258	!#endif
	259	)
	260
	261	#ifdef ISO
	262	#ifdef ISOVERIF
	263	write(,) 'surf_land 193: apres surf_land_orchidee'
	264	do i=1,knon
	265	if (iso_eau.gt.0) then
	266	call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
	267	& 'surf_land 197',errmax,errmaxrel)
	268	endif !if (iso_eau.gt.0) then
	269	enddo !do i=1,knon
	270	#endif
	271	#endif
[781]	272	!
[888]	273	!* Add contribution of relief to surface roughness
[781]	274	!
	275	DO i=1,knon
[2243]	276	z0m(i) = MAX(1.5e-05,SQRT(z0m(i)2 + rugoro(i)2))
[781]	277	ENDDO
	278
	279	ELSE ! not ok_veget
	280	!****************************************************************************************
	281	! No extern vegetation model choosen, call simple bucket calculations instead.
	282	!
	283	!****************************************************************************************
[5022]	284	#ifdef ISO
	285	#ifdef ISOVERIF
	286	! write(,) 'surf_land 247'
	287	call iso_verif_egalite_vect1D( &
	288	& xtsnow,snow,'surf_land_mod 207',niso,klon)
	289	#endif
	290	#endif
	291
	292	#ifdef ISO
	293	if (nudge_qsol.eq.1) then
	294	call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
	295	endif
	296	!write(,) 'surf_land 258'
	297	#endif
[781]	298	CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
[4523]	299	tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
[1067]	300	spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
[2240]	301	u1, v1, gustiness, rugoro, swnet, lwnet, &
[888]	302	snow, qsol, agesno, tsoil, &
[2243]	303	qsurf, z0m, alb1_new, alb2_new, evap, &
[5022]	304	fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
	305	#ifdef ISO
	306	,xtprecip_rain, xtprecip_snow,xtspechum, &
	307	xtsnow, xtsol,xtevap,h1, &
	308	& runoff_diag, xtrunoff_diag,Rland_ice &
	309	#endif
	310	& )
[2243]	311	z0h(1:knon)=z0m(1:knon) ! En attendant mieux
[781]	312
[4523]	313
[781]	314	ENDIF ! ok_veget
	315
[4523]	316	! blowing snow not treated yet over land
	317	fluxbs(:)=0.
	318
	319
[1067]	320	!****************************************************************************************
	321	! Calculation for all land models
	322	! - Flux calculation at first modele level for U and V
	323	!****************************************************************************************
	324	! Suppose zero surface speed
	325	u0(:)=0.0
	326	v0(:)=0.0
	327	CALL calcul_flux_wind(knon, dtime, &
[2240]	328	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	329	AcoefU, AcoefV, BcoefU, BcoefV, &
	330	p1lay, temp_air, &
	331	flux_u1, flux_v1)
[2227]	332
[5022]	333	#ifdef ISO
	334	#ifdef ISOVERIF
	335	! write(,) 'surf_land 237: sortie'
	336	DO i=1,knon
	337	IF (iso_eau >= 0) THEN
	338	call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
	339	& 'surf_land 241',errmax,errmaxrel)
	340	ENDIF !if (iso_eau.gt.0) then
	341	ENDDO !do i=1,knon
	342	#endif
	343	#endif
	344
[2227]	345	!albedo SB >>>
[3391]	346	SELECT CASE(NSW)
	347	CASE(2)
[2227]	348	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	349	alb_dir_new(1:knon,2)=alb2_new(1:knon)
[3391]	350	CASE(4)
[2227]	351	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	352	alb_dir_new(1:knon,2)=alb2_new(1:knon)
	353	alb_dir_new(1:knon,3)=alb2_new(1:knon)
	354	alb_dir_new(1:knon,4)=alb2_new(1:knon)
[3391]	355	CASE(6)
[2227]	356	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	357	alb_dir_new(1:knon,2)=alb1_new(1:knon)
	358	alb_dir_new(1:knon,3)=alb1_new(1:knon)
	359	alb_dir_new(1:knon,4)=alb2_new(1:knon)
	360	alb_dir_new(1:knon,5)=alb2_new(1:knon)
	361	alb_dir_new(1:knon,6)=alb2_new(1:knon)
[3391]	362	END SELECT
	363
	364	alb_dif_new=alb_dir_new
[2227]	365	!albedo SB <<<
[1067]	366
[781]	367	END SUBROUTINE surf_land
[5022]	368
	369
	370	#ifdef ISO
	371	SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
	372
	373	USE dimphy
	374	USE infotrac_phy, ONLY: niso
	375	USE isotopes_mod, ONLY: region_nudge_qsol
	376	INTEGER, INTENT(IN) :: knon
	377	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
	378	REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
	379	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	380	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsol
	381	REAL :: lat_min_nudge_qsol,lat_max_nudge_qsol
	382	REAL :: lon_min_nudge_qsol,lon_max_nudge_qsol
	383	INTEGER :: i,ixt
	384	REAL :: qsol_new
	385
	386	IF (region_nudge_qsol == 1) THEN
	387	! Aamzonie du Sud
	388	lat_min_nudge_qsol=-15.0
	389	lat_max_nudge_qsol=-5.0
	390	lon_min_nudge_qsol=-70.0
	391	lon_max_nudge_qsol=-50.0
	392	ELSE IF (region_nudge_qsol == 2) THEN
	393	! Aamzonie du Nord
	394	lat_min_nudge_qsol=-5.0
	395	lat_max_nudge_qsol=5.0
	396	lon_min_nudge_qsol=-70.0
	397	lon_max_nudge_qsol=-50.0
	398	ELSE
	399	WRITE(,) 'surf_land 298: cas pas prevu'
	400	WRITE(,) 'region_nudge_qsol=',region_nudge_qsol
	401	stop
	402	ENDIF
	403
	404	! write(,) 'surf_land 314: knon=',knon
	405	! write(,) 'rlat=',rlat
	406	! write(,) 'rlon=',rlon
	407	! write(,) 'region_nudge_qsol=',region_nudge_qsol
	408
	409	DO i=1,knon
	410	IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. &
	411	& (rlat(knindex(i)) <= lat_max_nudge_qsol).and. &
	412	& (rlon(knindex(i)) >= lon_min_nudge_qsol).and. &
	413	& (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN
	414	! write(,) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
	415	! & rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
	416	qsol_new=qsol(i)
	417	IF (region_nudge_qsol == 1) THEN
	418	qsol_new=max(qsol(i),50.0)
	419	ELSE IF (region_nudge_qsol == 2) THEN
	420	qsol_new=max(qsol(i),120.0)
	421	ELSE !if (region_nudge_qsol.eq.1) then
	422	WRITE(,) 'surf_land 317: cas pas prevu'
	423	WRITE(,) 'region_nudge_qsol=',region_nudge_qsol
	424	STOP
	425	ENDIF !if (region_nudge_qsol.eq.1) then
	426	IF (qsol(i) > 0.0) THEN
	427	DO ixt=1,niso
	428	xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i)
	429	ENDDO
	430	ELSE !IF (qsol(i) > 0.0) THEN
	431	DO ixt=1,niso
	432	xtsol(ixt,i)=0.0
	433	ENDDO
	434	ENDIF !IF (qsol(i) > 0.0) THEN
	435	qsol(i)=qsol_new
	436	WRITE(,) 'surf_land 346: qsol_new=',qsol(i)
	437	ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
	438	ENDDO !DO i=1,knon
	439
	440	END SUBROUTINE surf_land_nudge_qsol
	441	#endif
	442
[781]	443	!
	444	!****************************************************************************************
	445	!
	446	END MODULE surf_land_mod
	447	!
	448	!****************************************************************************************
	449	!

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

Download in other formats:

Original Format