Context Navigation

surf_land_bucket_mod.F90 @ 5274

Last change on this file since 5274 was 5274, checked in by abarral, 33 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: 12.8 KB

Rev	Line
[781]	1	!
[1072]	2	MODULE surf_land_bucket_mod
[781]	3	!
	4	! Surface land bucket module
	5	!
	6	! This module is used when no external land model is choosen.
	7	!
	8	IMPLICIT NONE
	9
	10	CONTAINS
	11
	12	SUBROUTINE surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
	13	tsurf, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, &
[888]	14	spechum, petAcoef, peqAcoef, petBcoef, peqBcoef, pref, &
[2240]	15	u1, v1, gustiness, rugoro, swnet, lwnet, &
[888]	16	snow, qsol, agesno, tsoil, &
	17	qsurf, z0_new, alb1_new, alb2_new, evap, &
[5022]	18	fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
	19	#ifdef ISO
	20	,xtprecip_rain, xtprecip_snow,xtspechum, &
	21	xtsnow, xtsol,xtevap,h1, &
	22	runoff_diag,xtrunoff_diag,Rland_ice &
	23	#endif
	24	)
[781]	25
[996]	26	USE limit_read_mod
	27	USE surface_data
	28	USE fonte_neige_mod
	29	USE calcul_fluxs_mod
	30	USE cpl_mod
	31	USE dimphy
[3974]	32	USE geometry_mod, ONLY: longitude,latitude
[996]	33	USE mod_grid_phy_lmdz
	34	USE mod_phys_lmdz_para
[1785]	35	USE indice_sol_mod
[5022]	36	#ifdef ISO
	37	use infotrac_phy, ONLY: ntiso,niso
	38	USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
	39	ridicule_qsol
	40	USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
	41	#ifdef ISOVERIF
	42	USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
	43	iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
	44	#endif
	45	#endif
[5274]	46	USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO &
	47	, RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA &
	48	, R_ecc, R_peri, R_incl &
	49	, RA, RG, R1SA &
	50	, RSIGMA &
	51	, R, RMD, RMV, RD, RV, RCPD &
	52	, RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12 &
	53	, RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w &
	54	, RCW, RCS &
	55	, RLVTT, RLSTT, RLMLT, RTT, RATM &
	56	, RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS &
	57	, RALPD, RBETD, RGAMD
[5273]	58	USE dimsoil_mod_h, ONLY: nsoilmx
[781]	59	!****************************************************************************************
[5274]	60	! Bucket calculations for surface.
[781]	61	!
[793]	62	INCLUDE "clesphys.h"
[781]	63
	64	! Input variables
	65	!****************************************************************************************
	66	INTEGER, INTENT(IN) :: itime, jour, knon
	67	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	68	LOGICAL, INTENT(IN) :: debut
	69	REAL, INTENT(IN) :: dtime
	70	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
	71	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
	72	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
	73	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	74	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
	75	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
	76	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
[888]	77	REAL, DIMENSION(klon), INTENT(IN) :: pref
[2240]	78	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[781]	79	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
[888]	80	REAL, DIMENSION(klon), INTENT(IN) :: swnet, lwnet
[5022]	81	#ifdef ISO
	82	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	83	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
	84	#endif
[781]	85
	86	! In/Output variables
	87	!****************************************************************************************
	88	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
	89	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	90	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
[5022]	91	#ifdef ISO
	92	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow,xtsol
	93	#endif
[781]	94
	95	! Output variables
	96	!****************************************************************************************
	97	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
	98	REAL, DIMENSION(klon), INTENT(OUT) :: z0_new
[888]	99	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
[781]	100	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[888]	101	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	102	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[5022]	103	#ifdef ISO
	104	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
	105	REAL, DIMENSION(klon), INTENT(OUT) :: h1
	106	REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrunoff_diag
	107	REAL, DIMENSION(klon), INTENT(OUT) :: runoff_diag
	108	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
	109	#endif
[781]	110
	111	! Local variables
	112	!****************************************************************************************
	113	REAL, DIMENSION(klon) :: soilcap, soilflux
	114	REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
[888]	115	REAL, DIMENSION(klon) :: alb_neig, alb_lim
[781]	116	REAL, DIMENSION(klon) :: zfra
[888]	117	REAL, DIMENSION(klon) :: radsol ! total net radiance at surface
[1067]	118	REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
[996]	119	REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
[781]	120	INTEGER :: i
[5022]	121	#ifdef ISO
	122	INTEGER :: ixt
	123	REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
	124	REAL, DIMENSION(klon) :: snow_prec,qsol_prec
	125	REAL, PARAMETER :: t_coup = 273.15
	126	REAL, DIMENSION(klon) :: fq_fonte_diag
	127	REAL, DIMENSION(klon) :: fqfonte_diag
	128	REAL, DIMENSION(klon) :: snow_evap_diag
	129	REAL, DIMENSION(klon) :: fqcalving_diag
	130	REAL :: max_eau_sol_diag
	131	REAL, DIMENSION(klon) :: run_off_lic_diag
	132	REAL :: coeff_rel_diag
	133	#endif
[781]	134	!
	135	!****************************************************************************************
	136
[5022]	137	#ifdef ISO
	138	#ifdef ISOVERIF
	139	!write(,) 'surf_land_bucket 152'
	140	DO i=1,knon
	141	IF (iso_eau > 0) THEN
	142	CALL iso_verif_egalite_choix(precip_snow(i), &
	143	& xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
	144	& errmax,errmaxrel)
	145	CALL iso_verif_egalite_choix(qsol(i), &
	146	& xtsol(iso_eau,i),'surf_land_bucket 134', &
	147	& errmax,errmaxrel)
	148	ENDIF
	149	ENDDO
	150	#endif
	151	#ifdef ISOVERIF
	152	DO i=1,knon
	153	DO ixt=1,niso
	154	CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
	155	ENDDO !do ixt=1,niso
	156	ENDDO !do i=1,knon
	157	!write(,) 'surf_land_bucket 152'
	158	#endif
	159	#endif
[781]	160
	161	!
[888]	162	!* Read from limit.nc : albedo(alb_lim), length of rugosity(z0_new)
[781]	163	!
[996]	164	CALL limit_read_rug_alb(itime, dtime, jour,&
	165	knon, knindex, &
	166	z0_new, alb_lim)
[781]	167	!
	168	!* Calcultaion of fluxes
	169	!
[888]	170
	171	! calculate total absorbed radiance at surface
	172	radsol(:) = 0.0
	173	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
	174
[781]	175	! calculate constants
	176	CALL calbeta(dtime, is_ter, knon, snow, qsol, beta, capsol, dif_grnd)
[1724]	177	if (type_veget=='betaclim') then
[2351]	178	CALL calbeta_clim(knon,jour,latitude(knindex(1:knon)),beta)
[1724]	179	endif
[781]	180
	181	! calculate temperature, heat capacity and conduction flux in soil
[3974]	182	IF (soil_model) THEN
	183	CALL soil(dtime, is_ter, knon, snow, tsurf, qsol, &
	184	& longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
	185
[781]	186	DO i=1, knon
	187	cal(i) = RCPD / soilcap(i)
	188	radsol(i) = radsol(i) + soilflux(i)
	189	END DO
	190	ELSE
	191	cal(:) = RCPD * capsol(:)
[1742]	192	IF (klon_glo .EQ. 1) THEN
	193	cal(:) = 0.
	194	ENDIF
[781]	195	ENDIF
	196
[1067]	197	! Suppose zero surface speed
	198	u0(:)=0.0
	199	v0(:)=0.0
	200	u1_lay(:) = u1(:) - u0(:)
	201	v1_lay(:) = v1(:) - v0(:)
	202
[781]	203	CALL calcul_fluxs(knon, is_ter, dtime, &
[2254]	204	tsurf, p1lay, cal, beta, tq_cdrag, tq_cdrag, pref, &
[781]	205	precip_rain, precip_snow, snow, qsurf, &
[2240]	206	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
[2254]	207	1.,petAcoef, peqAcoef, petBcoef, peqBcoef, &
[781]	208	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
	209
[5022]	210	#ifdef ISO
	211	! verif
	212	#ifdef ISOVERIF
	213	!write(,) 'surf_land_bucket 211'
	214	DO i=1,knon
	215	IF (iso_eau > 0) THEN
	216	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
	217	& snow(i),'surf_land_bucket 522', &
	218	& errmax,errmaxrel)
	219	ENDIF !IF (iso_eau > 0) then
	220	ENDDO !DO i=1,knon
	221	#endif
	222	! end verif
	223	#endif
	224	#ifdef ISO
	225	DO i=1,knon
	226	snow_prec(i)=snow(i)
	227	qsol_prec(i)=qsol(i)
	228	DO ixt=1,niso
	229	xtsnow_prec(ixt,i)=xtsnow(ixt,i)
	230	xtsol_prec(ixt,i) =xtsol(ixt,i)
	231	ENDDO !DO ixt=1,niso
	232	! initialisation:
	233	fqfonte_diag(i) =0.0
	234	fq_fonte_diag(i) =0.0
	235	snow_evap_diag(i)=0.0
	236	ENDDO !DO i=1,knon
	237	#ifdef ISOVERIF
	238	! write(,) 'surf_land_bucket 235'
	239	DO i=1,knon
	240	IF (iso_eau > 0) THEN
	241	CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
	242	& 'surf_land_bucket 141')
	243	ENDIF
	244	ENDDO !DO i=1,knon
	245	#endif
	246	#endif
[781]	247	!
	248	!* Calculate snow height, run_off, age of snow
	249	!
	250	CALL fonte_neige( knon, is_ter, knindex, dtime, &
	251	tsurf, precip_rain, precip_snow, &
[5022]	252	snow, qsol, tsurf_new, evap &
	253	#ifdef ISO
	254	& ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
	255	& ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
	256	#endif
	257	& )
	258
	259	#ifdef ISO
	260	#ifdef ISOVERIF
	261	DO i=1,knon
	262	DO ixt=1,niso
	263	CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
	264	ENDDO
	265	ENDDO
	266	#endif
	267	#ifdef ISOVERIF
	268	!write(,) 'surf_land_bucket 235'
	269	DO i=1,knon
	270	IF (iso_eau > 0) THEN
	271	CALL iso_verif_egalite_choix(qsol_prec(i), &
	272	& xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
	273	& errmax,errmaxrel)
	274	CALL iso_verif_egalite_choix(precip_snow(i), &
	275	& xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
	276	& errmax,errmaxrel)
	277	! attention, dans fonte_neige, on modifie snow sans modifier
	278	! xtsnow
	279	! c'est fait plus tard dans gestion_neige
	280	! write(,) 'surf_land_bucket 287: i=',i
	281	! write(,) 'snow(i)=',snow(i)
	282	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
	283	& snow_prec(i),'surf_land_bucket 245', &
	284	& errmax,errmaxrel)
	285	ENDIF
	286	IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
	287	IF (qsol_prec(i) > ridicule_qsol) THEN
	288	CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
	289	& ,xtsol_prec(iso_O18,i)/qsol_prec(i) &
	290	& ,'surf_land_bucket 642')
	291	ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
	292	ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
	293	ENDDO !DO i=1,knon
	294	!write(,) 'surf_land_mod 291'
	295	!write(,) 'snow_evap_diag(1)=',snow_evap_diag(1)
	296	#endif
	297	CALL calcul_iso_surf_ter_vectall(klon,knon, &
	298	& evap,snow_evap_diag,snow, &
	299	& fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
	300	& precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
	301	& tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
	302	& qsol,xtsol,qsol_prec,xtsol_prec, &
	303	& max_eau_sol_diag, &
	304	& xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
	305	& knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
	306	& )
	307	!#ifdef ISOVERIF
	308	! write(,) 'surf_land_bucket 303'
	309	!#endif
	310	#endif
	311
[781]	312	!
	313	!* Calculate the age of snow
	314	!
	315	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
	316
	317	WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
	318
	319	DO i=1, knon
	320	zfra(i) = MAX(0.0,MIN(1.0, snow(i)/(snow(i)+10.0)))
[888]	321	alb_lim(i) = alb_neig(i) zfra(i) + alb_lim(i)(1.0-zfra(i))
[781]	322	END DO
	323
	324	!
[888]	325	!* Return albedo :
	326	! alb1_new and alb2_new are here given the same values
	327	!
	328	alb1_new(:) = 0.0
	329	alb2_new(:) = 0.0
	330	alb1_new(1:knon) = alb_lim(1:knon)
	331	alb2_new(1:knon) = alb_lim(1:knon)
	332
	333	!
[781]	334	!* Calculate the rugosity
	335	!
[996]	336	DO i = 1, knon
[1146]	337	z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)2 + rugoro(i)2))
[996]	338	END DO
[781]	339
[996]	340	!* Send to coupler
	341	! The run-off from river and coast are not calculated in the bucket modele.
	342	! For testing purpose of the coupled modele we put the run-off to zero.
	343	IF (type_ocean=='couple') THEN
	344	dummy_riverflow(:) = 0.0
	345	dummy_coastalflow(:) = 0.0
	346	CALL cpl_send_land_fields(itime, knon, knindex, &
	347	dummy_riverflow, dummy_coastalflow)
[781]	348	ENDIF
	349
	350	!
[996]	351	!* End
[781]	352	!
[996]	353	END SUBROUTINE surf_land_bucket
[781]	354	!
	355	!****************************************************************************************
	356	!
	357	END MODULE surf_land_bucket_mod

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

Download in other formats:

Original Format