Context Navigation

surf_landice_mod.F90 @ 2272

Last change on this file since 2272 was 2258, checked in by Laurent Fairhead, 10 years ago
Merged trunk changes 2216:2237 into testing branch
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:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 13.9 KB

Rev	Line
[781]	1	!
	2	MODULE surf_landice_mod
	3
	4	IMPLICIT NONE
	5
	6	CONTAINS
	7	!
	8	!****************************************************************************************
	9	!
	10	SUBROUTINE surf_landice(itime, dtime, knon, knindex, &
[1910]	11	rlon, rlat, debut, lafin, &
	12	rmu0, lwdownm, albedo, pphi1, &
[888]	13	swnet, lwnet, tsurf, p1lay, &
[1067]	14	cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
	15	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	16	AcoefU, AcoefV, BcoefU, BcoefV, &
	17	ps, u1, v1, rugoro, pctsrf, &
[888]	18	snow, qsurf, qsol, agesno, &
[2258]	19	!albedo SB >>>
	20	! tsoil, z0_new, alb1, alb2, evap, fluxsens, fluxlat, &
	21	tsoil, z0_new, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
	22	!albedo SB <<<
[1067]	23	tsurf_new, dflux_s, dflux_l, &
[1910]	24	slope, cloudf, &
	25	snowhgt, qsnow, to_ice, sissnow, &
	26	alb3, runoff, &
[1067]	27	flux_u1, flux_v1)
[781]	28
[1067]	29	USE dimphy
[1910]	30	USE surface_data, ONLY : type_ocean, calice, calsno, ok_snow
[1067]	31	USE fonte_neige_mod, ONLY : fonte_neige, run_off_lic
	32	USE cpl_mod, ONLY : cpl_send_landice_fields
	33	USE calcul_fluxs_mod
[1334]	34	USE phys_output_var_mod
[1910]	35	#ifdef CPP_SISVAT
	36	USE surf_sisvat_mod, ONLY : surf_sisvat
	37	#endif
[1795]	38	USE indice_sol_mod
[1067]	39
[1795]	40	! INCLUDE "indicesol.h"
[781]	41	INCLUDE "dimsoil.h"
[793]	42	INCLUDE "YOMCST.h"
	43	INCLUDE "clesphys.h"
[781]	44
	45	! Input variables
	46	!****************************************************************************************
	47	INTEGER, INTENT(IN) :: itime, knon
	48	INTEGER, DIMENSION(klon), INTENT(in) :: knindex
	49	REAL, INTENT(in) :: dtime
[888]	50	REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiance
	51	REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiance
[781]	52	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
	53	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1067]	54	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[781]	55	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	56	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	57	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ
	58	REAL, DIMENSION(klon), INTENT(IN) :: BcoefH, BcoefQ
	59	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[781]	60	REAL, DIMENSION(klon), INTENT(IN) :: ps
[1067]	61	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
[781]	62	REAL, DIMENSION(klon), INTENT(IN) :: rugoro
	63	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
	64
[1910]	65	LOGICAL, INTENT(IN) :: debut !true if first step
	66	LOGICAL, INTENT(IN) :: lafin !true if last step
	67	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
	68	REAL, DIMENSION(klon), INTENT(IN) :: rmu0
	69	REAL, DIMENSION(klon), INTENT(IN) :: lwdownm !ylwdown
	70	REAL, DIMENSION(klon), INTENT(IN) :: albedo !mean albedo
	71	REAL, DIMENSION(klon), INTENT(IN) :: pphi1
	72	REAL, DIMENSION(klon), INTENT(IN) :: slope !mean slope in grid box
	73	REAL, DIMENSION(klon), INTENT(IN) :: cloudf !total cloud fraction
	74
[781]	75	! In/Output variables
	76	!****************************************************************************************
	77	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
	78	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	79	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
	80
	81	! Output variables
	82	!****************************************************************************************
	83	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
	84	REAL, DIMENSION(klon), INTENT(OUT) :: z0_new
[2258]	85	!albedo SB >>>
	86	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1 ! new albedo in visible SW interval
	87	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2 ! new albedo in near IR interval
	88	REAL, DIMENSION(6), INTENT(IN) ::SFRWL
	89	REAL, DIMENSION(klon,nsw), INTENT(OUT) ::alb_dir,alb_dif
	90	!albedo SB <<<
[781]	91	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[888]	92	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	93	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[1067]	94	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[781]	95
[1910]	96	REAL, DIMENSION(klon), INTENT(OUT) :: alb3
	97	REAL, DIMENSION(klon), INTENT(OUT) :: qsnow !column water in snow [kg/m2]
	98	REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt !Snow height (m)
	99	REAL, DIMENSION(klon), INTENT(OUT) :: to_ice
	100	REAL, DIMENSION(klon), INTENT(OUT) :: sissnow
	101	REAL, DIMENSION(klon), INTENT(OUT) :: runoff !Land ice runoff
	102
	103
[781]	104	! Local variables
	105	!****************************************************************************************
	106	REAL, DIMENSION(klon) :: soilcap, soilflux
	107	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
	108	REAL, DIMENSION(klon) :: zfra, alb_neig
[888]	109	REAL, DIMENSION(klon) :: radsol
[1067]	110	REAL, DIMENSION(klon) :: u0, v0, u1_lay, v1_lay
[1334]	111	INTEGER :: i,j
[781]	112
[1910]	113	REAL, DIMENSION(klon) :: emis_new !Emissivity
	114	REAL, DIMENSION(klon) :: swdown,lwdown
	115	REAL, DIMENSION(klon) :: precip_snow_adv, snow_adv !Snow Drift precip./advection
	116	REAL, DIMENSION(klon) :: bl_height, wind_velo !height boundary layer, wind spd
	117	REAL, DIMENSION(klon) :: dens_air, snow_cont_air !air density; snow content air
	118	REAL, DIMENSION(klon) :: alb_soil !albedo of underlying ice
	119	REAL, DIMENSION(klon) :: pexner !Exner potential
	120	REAL :: pref
	121	REAL, DIMENSION(klon,nsoilmx) :: tsoil0 !modfi
	122
	123	CHARACTER (len = 20) :: modname = 'surf_landice'
	124	CHARACTER (len = 80) :: abort_message
	125
[2258]	126	!albedo SB >>>
	127	real,dimension(klon) :: alb1,alb2
	128	!albedo SB <<<
	129
[781]	130	! End definition
	131	!****************************************************************************************
	132	!
	133	! Initialize output variables
[1910]	134	alb3(:) = 999999.
[888]	135	alb2(:) = 999999.
	136	alb1(:) = 999999.
[1910]	137
	138	runoff(:) = 0.
[888]	139	!****************************************************************************************
	140	! Calculate total absorbed radiance at surface
	141	!
	142	!****************************************************************************************
	143	radsol(:) = 0.0
	144	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
[781]	145
	146	!****************************************************************************************
[1910]	147	! ok_snow = TRUE : prepare and call SISVAT snow model
	148	! ok_snow = FALSE : soil_model, calcul_flux, fonte_neige, ...
	149	!
	150	!****************************************************************************************
	151	IF (ok_snow) THEN
	152	#ifdef CPP_SISVAT
	153	! Prepare for calling SISVAT
	154
	155	! Calculate incoming flux for SW and LW interval: swdown, lwdown
	156	swdown(:) = 0.0
	157	lwdown(:) = 0.0
	158	DO i = 1, knon
	159	swdown(i) = swnet(i)/(1-albedo(i))
	160	lwdown(i) = lwdownm(i)
	161	END DO
	162
	163	! Set constants and compute some input for SISVAT
	164	snow_adv(:) = 0. ! no snow blown in for now
	165	snow_cont_air(:) = 0.
	166	alb_soil(:) = albedo(:)
	167	pref = 100000. ! = 1000 hPa
	168	DO i = 1, knon
	169	wind_velo(i) = u1(i)2 + v1(i)2
	170	wind_velo(i) = wind_velo(i)**0.5
	171	pexner(i) = (p1lay(i)/pref)**(RD/RCPD)
	172	dens_air(i) = p1lay(i)/RD/temp_air(i) ! dry air density
	173	bl_height(i) = pphi1(i)/RG
	174	END DO
	175
	176	!****************************************************************************************
	177	! CALL to SISVAT interface
	178	!
	179	!****************************************************************************************
	180	! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
	181	DO i = 1, knon
	182	tsoil0(i,:)=tsoil(i,:)
	183	END DO
	184	! Martin
	185	PRINT*, 'on appelle surf_sisvat'
	186	! Martin
	187	CALL surf_sisvat(knon, rlon, rlat, knindex, itime, dtime, debut, lafin, &
	188	rmu0, swdown, lwdown, pexner, ps, p1lay, &
	189	precip_rain, precip_snow, precip_snow_adv, snow_adv, &
	190	bl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
	191	rugoro, snow_cont_air, alb_soil, slope, cloudf, &
	192	radsol, qsol, tsoil0, snow, snowhgt, qsnow, to_ice,sissnow, agesno, &
	193	AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
	194	run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &
	195	tsurf_new, alb1, alb2, alb3, &
	196	emis_new, z0_new, qsurf)
	197
	198	! Suppose zero surface speed
	199	u0(:) = 0.0
	200	v0(:) = 0.0
	201	! The calculation of heat/water fluxes, otherwise done by "CALL calcul_fluxs" is
	202	! integrated in SISVAT, using the same method. It can be found in "sisvat.f", in the
	203	! subroutine "SISVAT_TS2".
	204	! u0, v0=0., dif_grnd=0. and beta=1 are assumed there!
	205
	206	CALL calcul_flux_wind(knon, dtime, &
	207	u0, v0, u1, v1, cdragm, &
	208	AcoefU, AcoefV, BcoefU, BcoefV, &
	209	p1lay, temp_air, &
	210	flux_u1, flux_v1)
	211	#else
	212	abort_message='Pb de coherence: ok_snow = .true. mais CPP_SISVAT = .false.'
	213	CALL abort_gcm(modname,abort_message,1)
	214	#endif
	215	ELSE ! ok_snow=FALSE
	216
	217	!****************************************************************************************
[781]	218	! Soil calculations
	219	!
	220	!****************************************************************************************
	221	IF (soil_model) THEN
	222	CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
	223	cal(1:knon) = RCPD / soilcap(1:knon)
	224	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
	225	ELSE
	226	cal = RCPD * calice
	227	WHERE (snow > 0.0) cal = RCPD * calsno
	228	ENDIF
	229
	230
	231	!****************************************************************************************
	232	! Calulate fluxes
	233	!
	234	!****************************************************************************************
	235	beta(:) = 1.0
	236	dif_grnd(:) = 0.0
	237
[1067]	238	! Suppose zero surface speed
	239	u0(:)=0.0
	240	v0(:)=0.0
	241	u1_lay(:) = u1(:) - u0(:)
	242	v1_lay(:) = v1(:) - v0(:)
	243
[781]	244	CALL calcul_fluxs(knon, is_lic, dtime, &
[1067]	245	tsurf, p1lay, cal, beta, cdragh, ps, &
[781]	246	precip_rain, precip_snow, snow, qsurf, &
	247	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
[1067]	248	AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]	249	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
	250
[1067]	251	CALL calcul_flux_wind(knon, dtime, &
	252	u0, v0, u1, v1, cdragm, &
	253	AcoefU, AcoefV, BcoefU, BcoefV, &
	254	p1lay, temp_air, &
	255	flux_u1, flux_v1)
[781]	256
	257	!****************************************************************************************
	258	! Calculate snow height, age, run-off,..
	259	!
	260	!****************************************************************************************
	261	CALL fonte_neige( knon, is_lic, knindex, dtime, &
	262	tsurf, precip_rain, precip_snow, &
	263	snow, qsol, tsurf_new, evap)
	264
	265
	266	!****************************************************************************************
	267	! Calculate albedo
	268	!
	269	!****************************************************************************************
	270	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
	271	WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
	272	zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
[888]	273	alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
[781]	274	0.6 * (1.0-zfra(1:knon))
	275	!
	276	!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
[888]	277	! alb1(1 : knon) = 0.6 !IM cf FH/GK
	278	! alb1(1 : knon) = 0.82
	279	! alb1(1 : knon) = 0.77 !211003 Ksta0.77
	280	! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5
[781]	281	!IM: KstaTER0.77 & LMD_ARMIP6
	282
[888]	283	! Attantion: alb1 and alb2 are the same!
	284	alb1(1:knon) = 0.77
	285	alb2(1:knon) = alb1(1:knon)
[781]	286
	287
	288	!****************************************************************************************
	289	! Rugosity
	290	!
	291	!****************************************************************************************
[1146]	292	z0_new(:) = MAX(1.E-3,rugoro(:))
[1910]	293	END IF ! ok_snow
[781]	294
[1910]	295
[781]	296	!****************************************************************************************
	297	! Send run-off on land-ice to coupler if coupled ocean.
[1910]	298	! run_off_lic has been calculated in fonte_neige or surf_sisvat
[781]	299	!
	300	!****************************************************************************************
[996]	301	IF (type_ocean=='couple') THEN
[781]	302	CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
	303	ENDIF
[1910]	304
	305	! transfer runoff rate [kg/m2/s](!) to physiq for output
	306	runoff(1:knon)=run_off_lic(1:knon)/dtime
	307
[1334]	308
	309	!****************************************************************************************
	310	snow_o=0.
	311	zfra_o = 0.
	312	DO j = 1, knon
	313	i = knindex(j)
	314	snow_o(i) = snow(j)
	315	zfra_o(i) = zfra(j)
	316	ENDDO
[781]	317
[1403]	318	!****************************************************************************************
	319	snow_o=0.
	320	zfra_o = 0.
	321	DO j = 1, knon
	322	i = knindex(j)
	323	snow_o(i) = snow(j)
	324	zfra_o(i) = zfra(j)
	325	ENDDO
	326
	327
[2258]	328	!albedo SB >>>
	329	select case(NSW)
	330	case(2)
	331	alb_dir(1:knon,1)=alb1(1:knon)
	332	alb_dir(1:knon,2)=alb2(1:knon)
	333	case(4)
	334	alb_dir(1:knon,1)=alb1(1:knon)
	335	alb_dir(1:knon,2)=alb2(1:knon)
	336	alb_dir(1:knon,3)=alb2(1:knon)
	337	alb_dir(1:knon,4)=alb2(1:knon)
	338	case(6)
	339	alb_dir(1:knon,1)=alb1(1:knon)
	340	alb_dir(1:knon,2)=alb1(1:knon)
	341	alb_dir(1:knon,3)=alb1(1:knon)
	342	alb_dir(1:knon,4)=alb2(1:knon)
	343	alb_dir(1:knon,5)=alb2(1:knon)
	344	alb_dir(1:knon,6)=alb2(1:knon)
	345	end select
	346	alb_dif=alb_dir
	347	!albedo SB <<<
	348
	349
	350
	351
[781]	352	END SUBROUTINE surf_landice
	353	!
	354	!****************************************************************************************
	355	!
	356	END MODULE surf_landice_mod
	357
	358
	359

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

Download in other formats:

Original Format