Context Navigation

ocean_forced_mod.F90 @ 5456

Last change on this file since 5456 was 5301, checked in by abarral, 8 weeks ago
Turn tsoilnudge.h fcg_gcssold.h flux_arp.h into 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 `Id`
File size: 19.0 KB

Rev	Line
[781]	1	!
[2538]	2	! $Id: ocean_forced_mod.F90 5301 2024-10-30 13:54:51Z aborella $
	3	!
[781]	4	MODULE ocean_forced_mod
	5	!
	6	! This module is used for both the sub-surfaces ocean and sea-ice for the case of a
	7	! forced ocean, "ocean=force".
	8	!
	9	IMPLICIT NONE
	10
	11	CONTAINS
	12	!
	13	!****************************************************************************************
	14	!
[1067]	15	SUBROUTINE ocean_forced_noice( &
	16	itime, dtime, jour, knon, knindex, &
[2254]	17	p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, &
[781]	18	temp_air, spechum, &
[1067]	19	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	20	AcoefU, AcoefV, BcoefU, BcoefV, &
[3815]	21	ps, u1, v1, gustiness, tsurf_in, &
[888]	22	radsol, snow, agesno, &
[1067]	23	qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[5022]	24	tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
	25	#ifdef ISO
	26	,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
	27	xtsnow,xtevap,h1 &
	28	#endif
	29	)
[781]	30	!
	31	! This subroutine treats the "open ocean", all grid points that are not entierly covered
	32	! by ice.
[996]	33	! The routine receives data from climatologie file limit.nc and does some calculations at the
[781]	34	! surface.
	35	!
[1067]	36	USE dimphy
	37	USE calcul_fluxs_mod
[996]	38	USE limit_read_mod
[1961]	39	USE mod_grid_phy_lmdz
[1785]	40	USE indice_sol_mod
[2538]	41	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
[3815]	42	use config_ocean_skin_m, only: activate_ocean_skin
[5022]	43	#ifdef ISO
	44	USE infotrac_phy, ONLY: ntiso,niso
	45	USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall
	46	#ifdef ISOVERIF
	47	USE isotopes_mod, ONLY: iso_eau,ridicule
	48	!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
	49	USE isotopes_verif_mod
	50	#endif
	51	#endif
[5301]	52	USE flux_arp_mod_h
	53	USE clesphys_mod_h
[5285]	54	USE yomcst_mod_h
[781]	55
	56	! Input arguments
	57	!****************************************************************************************
	58	INTEGER, INTENT(IN) :: itime, jour, knon
	59	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	60	REAL, INTENT(IN) :: dtime
	61	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[2254]	62	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragq, cdragm
[781]	63	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	64	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	65	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	66	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[781]	67	REAL, DIMENSION(klon), INTENT(IN) :: ps
[2240]	68	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[3815]	69	REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in
	70	real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3)
[781]	71
[5022]	72	#ifdef ISO
	73	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	74	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
	75	REAL, DIMENSION(klon), INTENT(IN) :: rlat
	76	#endif
	77
[781]	78	! In/Output arguments
	79	!****************************************************************************************
	80	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
	81	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
	82	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno !? put to 0 in ocean
[5022]	83	#ifdef ISO
	84	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsnow
	85	REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce
	86	#endif
	87
[781]	88	! Output arguments
	89	!****************************************************************************************
	90	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
	91	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[1067]	92	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[781]	93	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
	94	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[3815]	95	REAL, intent(out):: sens_prec_liq(:) ! (knon)
[781]	96
[5022]	97	#ifdef ISO
	98	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
	99	REAL, DIMENSION(klon), INTENT(OUT) :: h1 ! just a diagnostic, not useful for the simulation
	100	#endif
	101
[781]	102	! Local variables
	103	!****************************************************************************************
[2538]	104	INTEGER :: i, j
[781]	105	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
	106	REAL, DIMENSION(klon) :: alb_neig, tsurf_lim, zx_sl
[1067]	107	REAL, DIMENSION(klon) :: u0, v0
	108	REAL, DIMENSION(klon) :: u1_lay, v1_lay
[781]	109	LOGICAL :: check=.FALSE.
[5022]	110	REAL, DIMENSION(knon) :: sens_prec_sol
	111	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
	112	#ifdef ISO
	113	REAL, PARAMETER :: t_coup = 273.15
	114	#endif
[781]	115
[5022]	116
[781]	117	!****************************************************************************************
	118	! Start calculation
	119	!****************************************************************************************
	120	IF (check) WRITE(,)' Entering ocean_forced_noice'
[5022]	121
	122	#ifdef ISO
	123	#ifdef ISOVERIF
	124	DO i = 1, knon
	125	IF (iso_eau > 0) THEN
	126	CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
	127	& spechum(i),'ocean_forced_mod 111', &
	128	& errmax,errmaxrel)
	129	CALL iso_verif_egalite_choix(snow(i), &
	130	& xtsnow(iso_eau,i),'ocean_forced_mod 117', &
	131	& errmax,errmaxrel)
	132	ENDIF !IF (iso_eau > 0) THEN
	133	ENDDO !DO i=1,knon
	134	#endif
	135	#endif
	136
[781]	137	!****************************************************************************************
	138	! 1)
[996]	139	! Read sea-surface temperature from file limit.nc
[781]	140	!
	141	!****************************************************************************************
[1961]	142	!--sb:
	143	!!jyg if (knon.eq.1) then ! single-column model
	144	if (klon_glo.eq.1) then ! single-column model
[3780]	145	! EV: now surface Tin flux_arp.h
	146	!CALL read_tsurf1d(knon,tsurf_lim) ! new
	147	DO i = 1, knon
	148	tsurf_lim(i) = tg
	149	ENDDO
	150
[1961]	151	else ! GCM
[5022]	152	CALL limit_read_sst(knon,knindex,tsurf_lim &
	153	#ifdef ISO
	154	& ,Roce,rlat &
	155	#endif
	156	& )
[1961]	157	endif ! knon
	158	!sb--
[996]	159
[781]	160	!****************************************************************************************
	161	! 2)
	162	! Flux calculation
	163	!
	164	!****************************************************************************************
	165	! Set some variables for calcul_fluxs
[3780]	166	!cal = 0.
	167	!beta = 1.
	168	!dif_grnd = 0.
[3784]	169
	170
[3780]	171	! EV: use calbeta to calculate beta
[3784]	172	! Need to initialize qsurf for calbeta but it is not modified by this routine
	173	qsurf(:)=0.
	174	CALL calbeta(dtime, is_oce, knon, snow, qsurf, beta, cal, dif_grnd)
[3780]	175
	176
[781]	177	alb_neig(:) = 0.
	178	agesno(:) = 0.
[3815]	179	lat_prec_liq = 0.; lat_prec_sol = 0.
[2538]	180
[1067]	181	! Suppose zero surface speed
	182	u0(:)=0.0
	183	v0(:)=0.0
	184	u1_lay(:) = u1(:) - u0(:)
	185	v1_lay(:) = v1(:) - v0(:)
	186
[781]	187	! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf
	188	CALL calcul_fluxs(knon, is_oce, dtime, &
[3815]	189	merge(tsurf_in, tsurf_lim, activate_ocean_skin == 2), p1lay, cal, &
	190	beta, cdragh, cdragq, ps, &
[781]	191	precip_rain, precip_snow, snow, qsurf, &
[2240]	192	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
[2254]	193	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2538]	194	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
[3815]	195	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
	196	if (activate_ocean_skin == 2) tsurf_new = tsurf_lim
[781]	197
[2538]	198	do j = 1, knon
	199	i = knindex(j)
	200	sens_prec_liq_o(i,1) = sens_prec_liq(j)
	201	sens_prec_sol_o(i,1) = sens_prec_sol(j)
	202	lat_prec_liq_o(i,1) = lat_prec_liq(j)
	203	lat_prec_sol_o(i,1) = lat_prec_sol(j)
	204	enddo
	205
	206
[1067]	207	! - Flux calculation at first modele level for U and V
	208	CALL calcul_flux_wind(knon, dtime, &
[2240]	209	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	210	AcoefU, AcoefV, BcoefU, BcoefV, &
	211	p1lay, temp_air, &
	212	flux_u1, flux_v1)
[781]	213
[5022]	214	#ifdef ISO
	215	CALL calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
	216	& ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, &
	217	& evap, Roce,xtevap,h1 &
	218	#ifdef ISOTRAC
	219	& ,knindex &
	220	#endif
	221	& )
	222	#endif
	223
	224	#ifdef ISO
	225	#ifdef ISOVERIF
	226	! write(,) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
	227	IF (iso_eau > 0) THEN
	228	DO i = 1, knon
	229	CALL iso_verif_egalite_choix(snow(i), &
	230	& xtsnow(iso_eau,i),'ocean_forced_mod 180', &
	231	& errmax,errmaxrel)
	232	ENDDO ! DO j=1,knon
	233	ENDIF !IF (iso_eau > 0) THEN
	234	#endif
	235	#endif
	236
[781]	237	END SUBROUTINE ocean_forced_noice
	238	!
[1067]	239	!***************************************************************************************
[781]	240	!
[1067]	241	SUBROUTINE ocean_forced_ice( &
	242	itime, dtime, jour, knon, knindex, &
[4523]	243	tsurf_in, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air,spechum, &
[1067]	244	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	245	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	246	ps, u1, v1, gustiness, &
[888]	247	radsol, snow, qsol, agesno, tsoil, &
[1067]	248	qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[5022]	249	tsurf_new, dflux_s, dflux_l, rhoa &
	250	#ifdef ISO
	251	,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
	252	xtsnow, xtsol,xtevap,Rland_ice &
	253	#endif
	254	)
[781]	255	!
	256	! This subroutine treats the ocean where there is ice.
	257	! The routine reads data from climatologie file and does flux calculations at the
	258	! surface.
[996]	259	!
[1067]	260	USE dimphy
[3974]	261	USE geometry_mod, ONLY: longitude,latitude
[1067]	262	USE calcul_fluxs_mod
[3327]	263	USE surface_data, ONLY : calice, calsno
[996]	264	USE limit_read_mod
[1067]	265	USE fonte_neige_mod, ONLY : fonte_neige
[1785]	266	USE indice_sol_mod
[2538]	267	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
[5022]	268	#ifdef ISO
	269	USE infotrac_phy, ONLY: niso, ntiso
	270	USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall
	271	#ifdef ISOVERIF
	272	USE isotopes_mod, ONLY: iso_eau,ridicule
	273	!USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
	274	USE isotopes_verif_mod
	275	#endif
	276	#endif
[5301]	277	USE flux_arp_mod_h
	278	USE clesphys_mod_h
[5285]	279	USE yomcst_mod_h
[5274]	280	USE dimsoil_mod_h, ONLY: nsoilmx
[996]	281
[3784]	282	! INCLUDE "indicesol.h"
[5274]	283
[781]	284
	285	! Input arguments
	286	!****************************************************************************************
	287	INTEGER, INTENT(IN) :: itime, jour, knon
	288	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	289	REAL, INTENT(IN) :: dtime
	290	REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in
	291	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1067]	292	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[781]	293	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	294	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	295	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	296	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[781]	297	REAL, DIMENSION(klon), INTENT(IN) :: ps
[2240]	298	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[3815]	299	real, intent(in):: rhoa(:) ! (knon) density of moist air (kg / m3)
[5022]	300	#ifdef ISO
	301	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	302	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
	303	REAL, DIMENSION(niso,klon), INTENT(IN) :: Roce
	304	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
	305	#endif
[781]	306
	307	! In/Output arguments
	308	!****************************************************************************************
	309	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
	310	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol
	311	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	312	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
[5022]	313	#ifdef ISO
	314	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow
	315	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsol
	316	#endif
[781]	317
	318	! Output arguments
	319	!****************************************************************************************
	320	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
[888]	321	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
	322	REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
[781]	323	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[1067]	324	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[888]	325	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	326	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[5022]	327	#ifdef ISO
	328	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
	329	#endif
[781]	330
	331	! Local variables
	332	!****************************************************************************************
	333	LOGICAL :: check=.FALSE.
[2538]	334	INTEGER :: i, j
[781]	335	REAL :: zfra
	336	REAL, PARAMETER :: t_grnd=271.35
	337	REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol
	338	REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp
	339	REAL, DIMENSION(klon) :: soilcap, soilflux
[1067]	340	REAL, DIMENSION(klon) :: u0, v0
	341	REAL, DIMENSION(klon) :: u1_lay, v1_lay
[5022]	342	REAL, DIMENSION(knon) :: sens_prec_liq, sens_prec_sol
[2538]	343	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
[781]	344
[5022]	345	#ifdef ISO
	346	REAL, PARAMETER :: t_coup = 273.15
	347	REAL, DIMENSION(klon) :: fq_fonte_diag
	348	REAL, DIMENSION(klon) :: fqfonte_diag
	349	REAL, DIMENSION(klon) :: snow_evap_diag
	350	REAL, DIMENSION(klon) :: fqcalving_diag
	351	REAL, DIMENSION(klon) :: run_off_lic_diag
	352	REAL :: coeff_rel_diag
	353	REAL :: max_eau_sol_diag
	354	REAL, DIMENSION(klon) :: runoff_diag
	355	INTEGER IXT
	356	REAL, DIMENSION(niso,klon) :: xtsnow_prec, xtsol_prec
	357	REAL, DIMENSION(klon) :: snow_prec, qsol_prec
	358	#endif
[2538]	359
[781]	360	!****************************************************************************************
	361	! Start calculation
	362	!****************************************************************************************
	363	IF (check) WRITE(,)'Entering surface_seaice, knon=',knon
	364
	365	!****************************************************************************************
[996]	366	! 1)
[1067]	367	! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, flux_u1, flux_v1
[781]	368	! dflux_s, dflux_l and qsurf
	369	!****************************************************************************************
[2538]	370
[996]	371	tsurf_tmp(:) = tsurf_in(:)
[781]	372
[3780]	373	! calculate the parameters cal, beta, capsol and dif_grnd and then recalculate cal
[3784]	374	CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd)
[781]	375
	376
	377	IF (soil_model) THEN
	378	! update tsoil and calculate soilcap and soilflux
[3974]	379	CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, qsol, &
	380	& longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil,soilcap, soilflux)
[781]	381	cal(1:knon) = RCPD / soilcap(1:knon)
	382	radsol(1:knon) = radsol(1:knon) + soilflux(1:knon)
	383	dif_grnd = 1.0 / tau_gl
	384	ELSE
	385	dif_grnd = 1.0 / tau_gl
	386	cal = RCPD * calice
	387	WHERE (snow > 0.0) cal = RCPD * calsno
	388	ENDIF
	389
[3784]	390	! beta = 1.0
[3815]	391	lat_prec_liq = 0.; lat_prec_sol = 0.
[2538]	392
[1067]	393	! Suppose zero surface speed
	394	u0(:)=0.0
	395	v0(:)=0.0
	396	u1_lay(:) = u1(:) - u0(:)
	397	v1_lay(:) = v1(:) - v0(:)
[781]	398	CALL calcul_fluxs(knon, is_sic, dtime, &
[2254]	399	tsurf_tmp, p1lay, cal, beta, cdragh, cdragh, ps, &
[781]	400	precip_rain, precip_snow, snow, qsurf, &
[2240]	401	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
[2254]	402	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2538]	403	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
[3815]	404	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
[2538]	405	do j = 1, knon
	406	i = knindex(j)
	407	sens_prec_liq_o(i,2) = sens_prec_liq(j)
	408	sens_prec_sol_o(i,2) = sens_prec_sol(j)
	409	lat_prec_liq_o(i,2) = lat_prec_liq(j)
	410	lat_prec_sol_o(i,2) = lat_prec_sol(j)
	411	enddo
[781]	412
[1067]	413	! - Flux calculation at first modele level for U and V
	414	CALL calcul_flux_wind(knon, dtime, &
[2240]	415	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	416	AcoefU, AcoefV, BcoefU, BcoefV, &
	417	p1lay, temp_air, &
	418	flux_u1, flux_v1)
	419
[781]	420	!****************************************************************************************
[996]	421	! 2)
[781]	422	! Calculations due to snow and runoff
	423	!
	424	!****************************************************************************************
[5022]	425	#ifdef ISO
	426	! verif
	427	#ifdef ISOVERIF
	428	DO i = 1, knon
	429	IF (iso_eau > 0) THEN
	430	IF (snow(i) > ridicule) THEN
	431	CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
	432	& 'interfsurf 964',errmax,errmaxrel)
	433	ENDIF !IF ((snow(i) > ridicule)) THEN
	434	ENDIF !IF (iso_eau > 0) THEN
	435	ENDDO !DO i=1,knon
	436	#endif
	437	! end verif
	438
	439	DO i = 1, knon
	440	snow_prec(i) = snow(i)
	441	DO ixt = 1, niso
	442	xtsnow_prec(ixt,i) = xtsnow(ixt,i)
	443	ENDDO !DO ixt=1,niso
	444	! initialisation:
	445	fq_fonte_diag(i) = 0.0
	446	fqfonte_diag(i) = 0.0
	447	snow_evap_diag(i)= 0.0
	448	ENDDO !DO i=1,knon
	449	#endif
	450
	451
[781]	452	CALL fonte_neige( knon, is_sic, knindex, dtime, &
	453	tsurf_tmp, precip_rain, precip_snow, &
[5022]	454	snow, qsol, tsurf_new, evap &
	455	#ifdef ISO
	456	& ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag &
	457	& ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
	458	#endif
	459	& )
	460
	461
	462	#ifdef ISO
	463	! isotopes: tout est externalisé
	464	!#ifdef ISOVERIF
	465	! write(,) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
	466	! write(,) 'klon,knon=',klon,knon
	467	!#endif
	468	CALL calcul_iso_surf_sic_vectall(klon,knon, &
	469	& evap,snow_evap_diag,Tsurf_new,Roce,snow, &
	470	& fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
	471	& precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, &
	472	& xtspechum,spechum,ps, &
	473	& xtevap,xtsnow,fqcalving_diag, &
	474	& knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice &
	475	& )
	476	#ifdef ISOVERIF
	477	!write(,) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
	478	IF (iso_eau > 0) THEN
	479	DO i = 1, knon
	480	CALL iso_verif_egalite_choix(snow(i), &
	481	& xtsnow(iso_eau,i),'ocean_forced_mod 396', &
	482	& errmax,errmaxrel)
	483	ENDDO ! DO j=1,knon
	484	ENDIF !IF (iso_eau > 0) then
	485	#endif
	486	!#ifdef ISOVERIF
	487	#endif
	488	!#ifdef ISO
[781]	489
	490	! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)
	491	!
	492	CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:))
	493
	494	WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0.
	495
[888]	496	alb1_new(:) = 0.0
[781]	497	DO i=1, knon
	498	zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0)))
[888]	499	alb1_new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra)
[781]	500	ENDDO
	501
[888]	502	alb2_new(:) = alb1_new(:)
	503
[781]	504	END SUBROUTINE ocean_forced_ice
[1961]	505
[3784]	506	!************************************************************************
	507	! 1D case
	508	!************************************************************************
	509	! SUBROUTINE read_tsurf1d(knon,sst_out)
[781]	510	!
[3784]	511	! This subroutine specifies the surface temperature to be used in 1D simulations
	512	!
	513	! USE dimphy, ONLY : klon
	514	!
	515	! INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid
	516	! REAL, DIMENSION(klon), INTENT(OUT) :: sst_out ! tsurf used to force the single-column model
	517	!
	518	! INTEGER :: i
	519	! COMMON defined in lmdz1d.F:
	520	! real ts_cur
	521	! common /sst_forcing/ts_cur
	522	!
	523	! DO i = 1, knon
	524	! sst_out(i) = ts_cur
	525	! ENDDO
	526	!
	527	! END SUBROUTINE read_tsurf1d
	528	!
	529	!
[1961]	530	!************************************************************************
[781]	531	END MODULE ocean_forced_mod
	532
	533
	534
	535
	536
	537

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

Download in other formats:

Original Format