Context Navigation

surf_land_mod.F90 @ 5225

Last change on this file since 5225 was 5202, checked in by Laurent Fairhead, 8 weeks ago
Updating cirrus branch to trunk revision 5171
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: 15.5 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 , &
[5202]	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
[5202]	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
[3391]	75	USE print_control_mod, ONLY: lunout
	76
[781]	77	INCLUDE "dimsoil.h"
[888]	78	INCLUDE "YOMCST.h"
[2227]	79	INCLUDE "clesphys.h"
[2952]	80	INCLUDE "dimpft.h"
[781]	81
	82	! Input variables
	83	!****************************************************************************************
	84	INTEGER, INTENT(IN) :: itime, jour, knon
	85	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	86	REAL, INTENT(IN) :: date0
	87	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
[2410]	88	REAL, DIMENSION(klon), INTENT(IN) :: yrmu0 ! cosine of solar zenith angle
[781]	89	LOGICAL, INTENT(IN) :: debut, lafin
	90	REAL, INTENT(IN) :: dtime
[888]	91	REAL, DIMENSION(klon), INTENT(IN) :: zlev, ccanopy
	92	REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet
	93	REAL, DIMENSION(klon), INTENT(IN) :: albedo ! albedo for whole short-wave interval
[781]	94	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
	95	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1067]	96	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[4523]	97	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow, precip_bs
[781]	98	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	99	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	100	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[888]	101	REAL, DIMENSION(klon), INTENT(IN) :: pref ! pressure reference
[2240]	102	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[781]	103	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
	104	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[888]	105	REAL, DIMENSION(klon), INTENT(IN) :: lwdown_m ! downwelling longwave radiation at mean surface
	106	! corresponds to previous sollwdown
[1146]	107	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
[5202]	108	#ifdef ISO
	109	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	110	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
	111	#endif
[781]	112	! In/Output variables
	113	!****************************************************************************************
	114	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
	115	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	116	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
[5202]	117	#ifdef ISO
	118	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow, xtsol
	119	#endif
[781]	120
	121	! Output variables
	122	!****************************************************************************************
[2243]	123	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
[2227]	124	!albedo SB >>>
	125	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! albdeo for shortwave interval 1(visible)
	126	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! albedo for shortwave interval 2(near infrared)
	127	REAL, DIMENSION(6), INTENT(IN) :: SFRWL
	128	REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new
	129	!albedo SB <<<
[888]	130	REAL, DIMENSION(klon), INTENT(OUT) :: evap
[4523]	131	REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens, fluxlat, fluxbs
[781]	132	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
[888]	133	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	134	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[1067]	135	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1 ! flux for U and V at first model level
[2952]	136	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
	137	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
[5202]	138	#ifdef ISO
	139	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
	140	REAL, DIMENSION(klon), INTENT(OUT) :: h1
	141	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
	142	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
	143	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
	144	#endif
[781]	145
	146	! Local variables
	147	!****************************************************************************************
[888]	148	REAL, DIMENSION(klon) :: p1lay_tmp
	149	REAL, DIMENSION(klon) :: pref_tmp
	150	REAL, DIMENSION(klon) :: swdown ! downwelling shortwave radiation at land surface
	151	REAL, DIMENSION(klon) :: epot_air ! potential air temperature
[781]	152	REAL, DIMENSION(klon) :: tsol_rad, emis_new ! output from interfsol not used
[1067]	153	REAL, DIMENSION(klon) :: u0, v0 ! surface speed
[4523]	154	REAL, DIMENSION(klon) :: precip_totsnow ! total solid precip
[781]	155	INTEGER :: i
	156
[2227]	157	!albedo SB >>>
	158	REAL, DIMENSION(klon) :: alb1_new,alb2_new
	159	!albedo SB <<<
[781]	160
[5202]	161	#ifdef ISO
	162	real, parameter :: t_coup = 273.15
	163	real, dimension(klon) :: fqfonte_diag
	164	real, dimension(klon) :: snow_evap_diag
	165	real, dimension(klon) :: fqcalving_diag
	166	integer :: ixt
	167	#endif
[4523]	168	!****************************************************************************************
	169	!Total solid precip
	170
	171	IF (ok_bs) THEN
[4526]	172	precip_totsnow(:)=precip_snow(:)+precip_bs(:)
[4523]	173	ELSE
[4526]	174	precip_totsnow(:)=precip_snow(:)
[4523]	175	ENDIF
	176	!****************************************************************************************
[5202]	177	#ifdef ISO
	178	#ifdef ISOVERIF
	179	! write(,) 'surf_land_mod 162'
	180	do i=1,knon
	181	if (iso_eau.gt.0) then
	182	call iso_verif_egalite_choix(precip_snow(i), &
	183	& xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
	184	& errmax,errmaxrel)
	185	call iso_verif_egalite_choix(qsol(i), &
	186	& xtsol(iso_eau,i),'surf_land_mod 139', &
	187	& errmax,errmaxrel)
	188	endif
	189	enddo
	190	#endif
	191	#ifdef ISOVERIF
	192	! write(,) 'surf_land 169: ok_veget=',ok_veget
	193	do i=1,knon
	194	do ixt=1,ntiso
	195	call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
	196	enddo
	197	enddo
	198	#endif
	199	#endif
[4523]	200
	201
[781]	202	!****************************************************************************************
	203	! Choice between call to vegetation model (ok_veget=true) or simple calculation below
	204	!
	205	!****************************************************************************************
	206	IF (ok_veget) THEN
	207	!****************************************************************************************
[888]	208	! Call model sechiba in model ORCHIDEE
[781]	209	!
	210	!****************************************************************************************
	211	p1lay_tmp(:) = 0.0
[888]	212	pref_tmp(:) = 0.0
[781]	213	p1lay_tmp(1:knon) = p1lay(1:knon)/100.
[888]	214	pref_tmp(1:knon) = pref(1:knon)/100.
	215	!
[2188]	216	!* Calculate incoming flux for SW and LW interval: swdown
[888]	217	!
	218	swdown(:) = 0.0
	219	DO i = 1, knon
	220	swdown(i) = swnet(i)/(1-albedo(i))
	221	END DO
	222	!
	223	!* Calculate potential air temperature
	224	!
	225	epot_air(:) = 0.0
	226	DO i = 1, knon
	227	epot_air(i) = RCPDtemp_air(i)(pref(i)/p1lay(i))**RKAPPA
	228	END DO
[781]	229
[5202]	230	#ifdef ISO
	231	CALL abort_gcm('surf_land_mod 220','isos pas prevus dans orchidee',1)
	232	#endif
[888]	233	! temporary for keeping same results using lwdown_m instead of lwdown
[781]	234	CALL surf_land_orchidee(itime, dtime, date0, knon, &
[2410]	235	knindex, rlon, rlat, yrmu0, pctsrf, &
[781]	236	debut, lafin, &
[2240]	237	zlev, u1, v1, gustiness, temp_air, spechum, epot_air, ccanopy, &
[1067]	238	cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
[4523]	239	precip_rain, precip_totsnow, lwdown_m, swnet, swdown, &
[1146]	240	pref_tmp, q2m, t2m, &
[4526]	241	evap, fluxsens, fluxlat, &
[888]	242	tsol_rad, tsurf_new, alb1_new, alb2_new, &
[2952]	243	emis_new, z0m, z0h, qsurf, &
[5202]	244	veget, lai, height &
	245	!#ifdef ISO
	246	! , xtprecip_rain, xtprecip_snow, xtspechum, xtevap &
	247	!#endif
	248	)
	249
	250	#ifdef ISO
	251	#ifdef ISOVERIF
	252	write(,) 'surf_land 193: apres surf_land_orchidee'
	253	do i=1,knon
	254	if (iso_eau.gt.0) then
	255	call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
	256	& 'surf_land 197',errmax,errmaxrel)
	257	endif !if (iso_eau.gt.0) then
	258	enddo !do i=1,knon
	259	#endif
	260	#endif
[781]	261	!
[888]	262	!* Add contribution of relief to surface roughness
[781]	263	!
	264	DO i=1,knon
[2243]	265	z0m(i) = MAX(1.5e-05,SQRT(z0m(i)2 + rugoro(i)2))
[781]	266	ENDDO
	267
	268	ELSE ! not ok_veget
	269	!****************************************************************************************
	270	! No extern vegetation model choosen, call simple bucket calculations instead.
	271	!
	272	!****************************************************************************************
[5202]	273	#ifdef ISO
	274	#ifdef ISOVERIF
	275	! write(,) 'surf_land 247'
	276	call iso_verif_egalite_vect1D( &
	277	& xtsnow,snow,'surf_land_mod 207',niso,klon)
	278	#endif
	279	#endif
	280
	281	#ifdef ISO
	282	if (nudge_qsol.eq.1) then
	283	call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
	284	endif
	285	!write(,) 'surf_land 258'
	286	#endif
[781]	287	CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
[4523]	288	tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
[1067]	289	spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, &
[2240]	290	u1, v1, gustiness, rugoro, swnet, lwnet, &
[888]	291	snow, qsol, agesno, tsoil, &
[2243]	292	qsurf, z0m, alb1_new, alb2_new, evap, &
[5202]	293	fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
	294	#ifdef ISO
	295	,xtprecip_rain, xtprecip_snow,xtspechum, &
	296	xtsnow, xtsol,xtevap,h1, &
	297	& runoff_diag, xtrunoff_diag,Rland_ice &
	298	#endif
	299	& )
[2243]	300	z0h(1:knon)=z0m(1:knon) ! En attendant mieux
[781]	301
[4523]	302
[781]	303	ENDIF ! ok_veget
	304
[4523]	305	! blowing snow not treated yet over land
	306	fluxbs(:)=0.
	307
	308
[1067]	309	!****************************************************************************************
	310	! Calculation for all land models
	311	! - Flux calculation at first modele level for U and V
	312	!****************************************************************************************
	313	! Suppose zero surface speed
	314	u0(:)=0.0
	315	v0(:)=0.0
	316	CALL calcul_flux_wind(knon, dtime, &
[2240]	317	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	318	AcoefU, AcoefV, BcoefU, BcoefV, &
	319	p1lay, temp_air, &
	320	flux_u1, flux_v1)
[2227]	321
[5202]	322	#ifdef ISO
	323	#ifdef ISOVERIF
	324	! write(,) 'surf_land 237: sortie'
	325	DO i=1,knon
	326	IF (iso_eau >= 0) THEN
	327	call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
	328	& 'surf_land 241',errmax,errmaxrel)
	329	ENDIF !if (iso_eau.gt.0) then
	330	ENDDO !do i=1,knon
	331	#endif
	332	#endif
	333
[2227]	334	!albedo SB >>>
[3391]	335	SELECT CASE(NSW)
	336	CASE(2)
[2227]	337	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	338	alb_dir_new(1:knon,2)=alb2_new(1:knon)
[3391]	339	CASE(4)
[2227]	340	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	341	alb_dir_new(1:knon,2)=alb2_new(1:knon)
	342	alb_dir_new(1:knon,3)=alb2_new(1:knon)
	343	alb_dir_new(1:knon,4)=alb2_new(1:knon)
[3391]	344	CASE(6)
[2227]	345	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	346	alb_dir_new(1:knon,2)=alb1_new(1:knon)
	347	alb_dir_new(1:knon,3)=alb1_new(1:knon)
	348	alb_dir_new(1:knon,4)=alb2_new(1:knon)
	349	alb_dir_new(1:knon,5)=alb2_new(1:knon)
	350	alb_dir_new(1:knon,6)=alb2_new(1:knon)
[3391]	351	END SELECT
	352
	353	alb_dif_new=alb_dir_new
[2227]	354	!albedo SB <<<
[1067]	355
[781]	356	END SUBROUTINE surf_land
[5202]	357
	358
	359	#ifdef ISO
	360	SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
	361
	362	USE dimphy
	363	USE infotrac_phy, ONLY: niso
	364	USE isotopes_mod, ONLY: region_nudge_qsol
	365	INTEGER, INTENT(IN) :: knon
	366	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
	367	REAL, DIMENSION(klon), INTENT(INOUT) :: qsol
	368	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	369	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsol
	370	REAL :: lat_min_nudge_qsol,lat_max_nudge_qsol
	371	REAL :: lon_min_nudge_qsol,lon_max_nudge_qsol
	372	INTEGER :: i,ixt
	373	REAL :: qsol_new
	374
	375	IF (region_nudge_qsol == 1) THEN
	376	! Aamzonie du Sud
	377	lat_min_nudge_qsol=-15.0
	378	lat_max_nudge_qsol=-5.0
	379	lon_min_nudge_qsol=-70.0
	380	lon_max_nudge_qsol=-50.0
	381	ELSE IF (region_nudge_qsol == 2) THEN
	382	! Aamzonie du Nord
	383	lat_min_nudge_qsol=-5.0
	384	lat_max_nudge_qsol=5.0
	385	lon_min_nudge_qsol=-70.0
	386	lon_max_nudge_qsol=-50.0
	387	ELSE
	388	WRITE(,) 'surf_land 298: cas pas prevu'
	389	WRITE(,) 'region_nudge_qsol=',region_nudge_qsol
	390	stop
	391	ENDIF
	392
	393	! write(,) 'surf_land 314: knon=',knon
	394	! write(,) 'rlat=',rlat
	395	! write(,) 'rlon=',rlon
	396	! write(,) 'region_nudge_qsol=',region_nudge_qsol
	397
	398	DO i=1,knon
	399	IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. &
	400	& (rlat(knindex(i)) <= lat_max_nudge_qsol).and. &
	401	& (rlon(knindex(i)) >= lon_min_nudge_qsol).and. &
	402	& (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN
	403	! write(,) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
	404	! & rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
	405	qsol_new=qsol(i)
	406	IF (region_nudge_qsol == 1) THEN
	407	qsol_new=max(qsol(i),50.0)
	408	ELSE IF (region_nudge_qsol == 2) THEN
	409	qsol_new=max(qsol(i),120.0)
	410	ELSE !if (region_nudge_qsol.eq.1) then
	411	WRITE(,) 'surf_land 317: cas pas prevu'
	412	WRITE(,) 'region_nudge_qsol=',region_nudge_qsol
	413	STOP
	414	ENDIF !if (region_nudge_qsol.eq.1) then
	415	IF (qsol(i) > 0.0) THEN
	416	DO ixt=1,niso
	417	xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i)
	418	ENDDO
	419	ELSE !IF (qsol(i) > 0.0) THEN
	420	DO ixt=1,niso
	421	xtsol(ixt,i)=0.0
	422	ENDDO
	423	ENDIF !IF (qsol(i) > 0.0) THEN
	424	qsol(i)=qsol_new
	425	WRITE(,) 'surf_land 346: qsol_new=',qsol(i)
	426	ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
	427	ENDDO !DO i=1,knon
	428
	429	END SUBROUTINE surf_land_nudge_qsol
	430	#endif
	431
[781]	432	!
	433	!****************************************************************************************
	434	!
	435	END MODULE surf_land_mod
	436	!
	437	!****************************************************************************************
	438	!

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

Download in other formats:

Original Format