Context Navigation

surf_landice_mod.F90 @ 3069

Last change on this file since 3069 was 2787, checked in by Laurent Fairhead, 8 years ago
Merged trunk changes r2727:2785 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: 14.6 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, &
[2298]	17	ps, u1, v1, gustiness, rugoro, pctsrf, &
[888]	18	snow, qsurf, qsol, agesno, &
[2298]	19	tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
[1067]	20	tsurf_new, dflux_s, dflux_l, &
[1910]	21	slope, cloudf, &
	22	snowhgt, qsnow, to_ice, sissnow, &
	23	alb3, runoff, &
[1067]	24	flux_u1, flux_v1)
[781]	25
[1067]	26	USE dimphy
[1910]	27	USE surface_data, ONLY : type_ocean, calice, calsno, ok_snow
[1067]	28	USE fonte_neige_mod, ONLY : fonte_neige, run_off_lic
	29	USE cpl_mod, ONLY : cpl_send_landice_fields
	30	USE calcul_fluxs_mod
[1334]	31	USE phys_output_var_mod
[2787]	32	!FC
	33	USE ioipsl_getin_p_mod, ONLY : getin_p
	34
[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
[2298]	61	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[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
[2298]	84	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
[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
[2787]	126
[2258]	127	!albedo SB >>>
	128	real,dimension(klon) :: alb1,alb2
	129	!albedo SB <<<
	130
[781]	131	! End definition
	132	!****************************************************************************************
[2787]	133	!FC
	134	!FC
	135	REAL,SAVE :: alb_vis_sno_lic
	136	!$OMP THREADPRIVATE(alb_vis_sno_lic)
	137	REAL,SAVE :: alb_nir_sno_lic
	138	!$OMP THREADPRIVATE(alb_nir_sno_lic)
	139	LOGICAL, SAVE :: firstcall = .TRUE.
	140	!$OMP THREADPRIVATE(firstcall)
	141	!FC
	142
	143
	144	IF (firstcall) THEN
	145	alb_vis_sno_lic=0.77
	146	CALL getin_p('alb_vis_sno_lic',alb_vis_sno_lic)
	147	PRINT*, 'alb_vis_sno_lic',alb_vis_sno_lic
	148	alb_nir_sno_lic=0.77
	149	CALL getin_p('alb_nir_sno_lic',alb_nir_sno_lic)
	150	PRINT*, 'alb_nir_sno_lic',alb_nir_sno_lic
	151	firstcall=.false.
	152	ENDIF
[781]	153	!
	154	! Initialize output variables
[1910]	155	alb3(:) = 999999.
[888]	156	alb2(:) = 999999.
	157	alb1(:) = 999999.
[1910]	158
	159	runoff(:) = 0.
[888]	160	!****************************************************************************************
	161	! Calculate total absorbed radiance at surface
	162	!
	163	!****************************************************************************************
	164	radsol(:) = 0.0
	165	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
[781]	166
	167	!****************************************************************************************
[1910]	168	! ok_snow = TRUE : prepare and call SISVAT snow model
	169	! ok_snow = FALSE : soil_model, calcul_flux, fonte_neige, ...
	170	!
	171	!****************************************************************************************
	172	IF (ok_snow) THEN
	173	#ifdef CPP_SISVAT
	174	! Prepare for calling SISVAT
	175
	176	! Calculate incoming flux for SW and LW interval: swdown, lwdown
	177	swdown(:) = 0.0
	178	lwdown(:) = 0.0
	179	DO i = 1, knon
	180	swdown(i) = swnet(i)/(1-albedo(i))
	181	lwdown(i) = lwdownm(i)
	182	END DO
	183
	184	! Set constants and compute some input for SISVAT
	185	snow_adv(:) = 0. ! no snow blown in for now
	186	snow_cont_air(:) = 0.
	187	alb_soil(:) = albedo(:)
	188	pref = 100000. ! = 1000 hPa
	189	DO i = 1, knon
	190	wind_velo(i) = u1(i)2 + v1(i)2
	191	wind_velo(i) = wind_velo(i)**0.5
	192	pexner(i) = (p1lay(i)/pref)**(RD/RCPD)
	193	dens_air(i) = p1lay(i)/RD/temp_air(i) ! dry air density
	194	bl_height(i) = pphi1(i)/RG
	195	END DO
	196
	197	!****************************************************************************************
	198	! CALL to SISVAT interface
	199	!
	200	!****************************************************************************************
	201	! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
	202	DO i = 1, knon
	203	tsoil0(i,:)=tsoil(i,:)
	204	END DO
[2298]	205	! Martin
	206	PRINT*, 'on appelle surf_sisvat'
	207	! Martin
[1910]	208	CALL surf_sisvat(knon, rlon, rlat, knindex, itime, dtime, debut, lafin, &
	209	rmu0, swdown, lwdown, pexner, ps, p1lay, &
	210	precip_rain, precip_snow, precip_snow_adv, snow_adv, &
	211	bl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
	212	rugoro, snow_cont_air, alb_soil, slope, cloudf, &
	213	radsol, qsol, tsoil0, snow, snowhgt, qsnow, to_ice,sissnow, agesno, &
	214	AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
	215	run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &
	216	tsurf_new, alb1, alb2, alb3, &
[2298]	217	emis_new, z0m, qsurf)
	218	z0h(1:knon)=z0m(1:knon) ! en attendant mieux
[1910]	219
	220	! Suppose zero surface speed
	221	u0(:) = 0.0
	222	v0(:) = 0.0
	223	! The calculation of heat/water fluxes, otherwise done by "CALL calcul_fluxs" is
	224	! integrated in SISVAT, using the same method. It can be found in "sisvat.f", in the
	225	! subroutine "SISVAT_TS2".
	226	! u0, v0=0., dif_grnd=0. and beta=1 are assumed there!
	227
	228	CALL calcul_flux_wind(knon, dtime, &
[2298]	229	u0, v0, u1, v1, gustiness, cdragm, &
[1910]	230	AcoefU, AcoefV, BcoefU, BcoefV, &
	231	p1lay, temp_air, &
	232	flux_u1, flux_v1)
	233	#else
	234	abort_message='Pb de coherence: ok_snow = .true. mais CPP_SISVAT = .false.'
[2408]	235	CALL abort_physic(modname,abort_message,1)
[1910]	236	#endif
	237	ELSE ! ok_snow=FALSE
	238
	239	!****************************************************************************************
[781]	240	! Soil calculations
	241	!
	242	!****************************************************************************************
	243	IF (soil_model) THEN
	244	CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
	245	cal(1:knon) = RCPD / soilcap(1:knon)
	246	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
	247	ELSE
	248	cal = RCPD * calice
	249	WHERE (snow > 0.0) cal = RCPD * calsno
	250	ENDIF
	251
	252
	253	!****************************************************************************************
	254	! Calulate fluxes
	255	!
	256	!****************************************************************************************
	257	beta(:) = 1.0
	258	dif_grnd(:) = 0.0
	259
[1067]	260	! Suppose zero surface speed
	261	u0(:)=0.0
	262	v0(:)=0.0
	263	u1_lay(:) = u1(:) - u0(:)
	264	v1_lay(:) = v1(:) - v0(:)
	265
[781]	266	CALL calcul_fluxs(knon, is_lic, dtime, &
[2298]	267	tsurf, p1lay, cal, beta, cdragh, cdragh, ps, &
[781]	268	precip_rain, precip_snow, snow, qsurf, &
[2298]	269	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
	270	1.,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[781]	271	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
	272
[1067]	273	CALL calcul_flux_wind(knon, dtime, &
[2298]	274	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	275	AcoefU, AcoefV, BcoefU, BcoefV, &
	276	p1lay, temp_air, &
	277	flux_u1, flux_v1)
[781]	278
	279	!****************************************************************************************
	280	! Calculate snow height, age, run-off,..
	281	!
	282	!****************************************************************************************
	283	CALL fonte_neige( knon, is_lic, knindex, dtime, &
	284	tsurf, precip_rain, precip_snow, &
	285	snow, qsol, tsurf_new, evap)
	286
	287
	288	!****************************************************************************************
	289	! Calculate albedo
	290	!
	291	!****************************************************************************************
	292	CALL albsno(klon,knon,dtime,agesno(:),alb_neig(:), precip_snow(:))
	293	WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.
	294	zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0)))
[888]	295	alb1(1:knon) = alb_neig(1:knon)*zfra(1:knon) + &
[781]	296	0.6 * (1.0-zfra(1:knon))
	297	!
	298	!IM: plusieurs choix/tests sur l'albedo des "glaciers continentaux"
[888]	299	! alb1(1 : knon) = 0.6 !IM cf FH/GK
	300	! alb1(1 : knon) = 0.82
	301	! alb1(1 : knon) = 0.77 !211003 Ksta0.77
	302	! alb1(1 : knon) = 0.8 !KstaTER0.8 & LMD_ARMIP5
[781]	303	!IM: KstaTER0.77 & LMD_ARMIP6
	304
[888]	305	! Attantion: alb1 and alb2 are the same!
[2787]	306	alb1(1:knon) = alb_vis_sno_lic
	307	alb2(1:knon) = alb_nir_sno_lic
[781]	308
	309
	310	!****************************************************************************************
	311	! Rugosity
	312	!
	313	!****************************************************************************************
[2298]	314	z0m=1.e-3
	315	z0h = z0m
	316	z0m = SQRT(z0m2+rugoro2)
	317
[1910]	318	END IF ! ok_snow
[781]	319
[1910]	320
[781]	321	!****************************************************************************************
	322	! Send run-off on land-ice to coupler if coupled ocean.
[1910]	323	! run_off_lic has been calculated in fonte_neige or surf_sisvat
[781]	324	!
	325	!****************************************************************************************
[996]	326	IF (type_ocean=='couple') THEN
[781]	327	CALL cpl_send_landice_fields(itime, knon, knindex, run_off_lic)
	328	ENDIF
[1910]	329
	330	! transfer runoff rate [kg/m2/s](!) to physiq for output
	331	runoff(1:knon)=run_off_lic(1:knon)/dtime
	332
[1334]	333
	334	!****************************************************************************************
	335	snow_o=0.
	336	zfra_o = 0.
	337	DO j = 1, knon
	338	i = knindex(j)
	339	snow_o(i) = snow(j)
	340	zfra_o(i) = zfra(j)
	341	ENDDO
[781]	342
[1403]	343	!****************************************************************************************
	344	snow_o=0.
	345	zfra_o = 0.
	346	DO j = 1, knon
	347	i = knindex(j)
	348	snow_o(i) = snow(j)
	349	zfra_o(i) = zfra(j)
	350	ENDDO
	351
	352
[2258]	353	!albedo SB >>>
	354	select case(NSW)
	355	case(2)
	356	alb_dir(1:knon,1)=alb1(1:knon)
	357	alb_dir(1:knon,2)=alb2(1:knon)
	358	case(4)
	359	alb_dir(1:knon,1)=alb1(1:knon)
	360	alb_dir(1:knon,2)=alb2(1:knon)
	361	alb_dir(1:knon,3)=alb2(1:knon)
	362	alb_dir(1:knon,4)=alb2(1:knon)
	363	case(6)
	364	alb_dir(1:knon,1)=alb1(1:knon)
	365	alb_dir(1:knon,2)=alb1(1:knon)
	366	alb_dir(1:knon,3)=alb1(1:knon)
	367	alb_dir(1:knon,4)=alb2(1:knon)
	368	alb_dir(1:knon,5)=alb2(1:knon)
	369	alb_dir(1:knon,6)=alb2(1:knon)
	370	end select
	371	alb_dif=alb_dir
	372	!albedo SB <<<
	373
	374
	375
	376
[781]	377	END SUBROUTINE surf_landice
	378	!
	379	!****************************************************************************************
	380	!
	381	END MODULE surf_landice_mod
	382
	383
	384

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

Download in other formats:

Original Format