Context Navigation

ocean_forced_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 `Id`
File size: 20.6 KB

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

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

Download in other formats:

Original Format