Context Navigation

surf_seaice_mod.F90 @ 5875

Last change on this file since 5875 was 5662, checked in by Laurent Fairhead, 6 months ago
Ajout du modèle thermodynamique de glace de mer interactive améliorant les flux échangés à la surface de la banquise (Doctorat de Nicolas Michalezyk, Contact : Nicolas Michaleyk, Guillaume Gastineau)
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: 8.8 KB

Rev	Line
[781]	1	!
[2227]	2	! $Id: surf_seaice_mod.F90 5662 2025-05-20 14:24:41Z ymeurdesoif $
	3	!
[781]	4	MODULE surf_seaice_mod
	5
	6	IMPLICIT NONE
	7
	8	CONTAINS
	9	!
	10	!****************************************************************************************
	11	!
	12	SUBROUTINE surf_seaice( &
[888]	13	rlon, rlat, swnet, lwnet, alb1, fder, &
[781]	14	itime, dtime, jour, knon, knindex, &
[1067]	15	lafin, &
	16	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
	17	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	18	AcoefU, AcoefV, BcoefU, BcoefV, &
[2244]	19	ps, u1, v1, gustiness, pctsrf, &
[888]	20	snow, qsurf, qsol, agesno, tsoil, &
[2243]	21	z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
[1067]	22	tsurf_new, dflux_s, dflux_l, &
[5662]	23	!GG flux_u1, flux_v1)
	24	flux_u1, flux_v1, hice, tice,bilg_cumul, &
	25	fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
	26	dtice_melt, dtice_snow2sic &
	27	!GG
[5022]	28	#ifdef ISO
	29	& ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
	30	& xtsnow,xtsol,xtevap,Rland_ice &
	31	#endif
	32	& )
[1067]	33
	34	USE dimphy
	35	USE surface_data
	36	USE ocean_forced_mod, ONLY : ocean_forced_ice
	37	USE ocean_cpl_mod, ONLY : ocean_cpl_ice
[2209]	38	USE ocean_slab_mod, ONLY : ocean_slab_ice
[1785]	39	USE indice_sol_mod
[5022]	40	#ifdef ISO
	41	USE infotrac_phy, ONLY : ntiso,niso
	42	#endif
[5282]	43	USE clesphys_mod_h
[5285]	44	USE yomcst_mod_h
[5274]	45	USE dimsoil_mod_h, ONLY: nsoilmx
[1067]	46
[781]	47	!
[5274]	48	! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
[781]	49	! slab or couple). The calculation of rugosity for the sea-ice surface is also done
	50	! in here because it is the same calculation for the different modes of ocean.
	51	!
	52
[5274]	53
[3815]	54	! for rd and retv
	55
[781]	56	! Input arguments
	57	!****************************************************************************************
	58	INTEGER, INTENT(IN) :: itime, jour, knon
	59	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
[1067]	60	LOGICAL, INTENT(IN) :: lafin
[781]	61	REAL, INTENT(IN) :: dtime
	62	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
[888]	63	REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiation at surface
	64	REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiation at surface
	65	REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
[781]	66	REAL, DIMENSION(klon), INTENT(IN) :: fder
	67	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
	68	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1072]	69	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[781]	70	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	71	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	72	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	73	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[781]	74	REAL, DIMENSION(klon), INTENT(IN) :: ps
[2240]	75	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[781]	76	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[5022]	77	#ifdef ISO
	78	REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
	79	REAL, DIMENSION(klon), INTENT(IN) :: xtspechum
	80	REAL, DIMENSION(niso,klon), INTENT(IN) :: Roce
	81	REAL, DIMENSION(niso,klon), INTENT(IN) :: Rland_ice
	82	#endif
[781]	83
	84	! In/Output arguments
	85	!****************************************************************************************
	86	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsurf, qsol
	87	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	88	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
[5022]	89	#ifdef ISO
	90	REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsnow
	91	REAL, DIMENSION(niso,klon), INTENT(IN) :: xtsol
	92	#endif
[781]	93
	94	! Output arguments
	95	!****************************************************************************************
[2243]	96	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
[2227]	97	!albedo SB >>>
	98	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
	99	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
	100	REAL, DIMENSION(6), INTENT(IN) :: SFRWL
	101	REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new
	102	!albedo SB <<<
[781]	103	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[888]	104	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[781]	105	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[1067]	106	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[5662]	107	!GG
	108	REAL, DIMENSION(klon), INTENT(INOUT) :: hice, tice, bilg_cumul
	109	REAL, DIMENSION(klon), INTENT(INOUT) :: fcds,fcdi, dh_basal_growth,dh_basal_melt
	110	REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt, dh_snow2sic, dtice_melt, dtice_snow2sic
	111	!GG
[5022]	112	#ifdef ISO
	113	REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
	114	#endif
[781]	115
[888]	116	! Local arguments
	117	!****************************************************************************************
	118	REAL, DIMENSION(klon) :: radsol
[5022]	119	#ifdef ISO
	120	#ifdef ISOVERIF
	121	INTEGER :: j
	122	#endif
	123	#endif
[1067]	124
[2227]	125	!albedo SB >>>
	126	REAL, DIMENSION(klon) :: alb1_new,alb2_new
	127	!albedo SB <<<
[3815]	128
	129	real rhoa(knon) ! density of moist air (kg / m3)
	130
[781]	131	! End definitions
	132	!****************************************************************************************
	133
[888]	134
[781]	135	!****************************************************************************************
[888]	136	! Calculate total net radiance at surface
	137	!
	138	!****************************************************************************************
	139	radsol(:) = 0.0
	140	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
	141
[3815]	142	rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
	143
[888]	144	!****************************************************************************************
[781]	145	! Switch according to type of ocean (couple, slab or forced)
	146	!
	147	!****************************************************************************************
[996]	148	IF (type_ocean == 'couple') THEN
	149
[781]	150	CALL ocean_cpl_ice( &
[996]	151	rlon, rlat, swnet, lwnet, alb1, &
	152	fder, &
	153	itime, dtime, knon, knindex, &
	154	lafin,&
[1067]	155	p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
	156	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	157	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	158	ps, u1, v1, gustiness, pctsrf, &
[996]	159	radsol, snow, qsurf, &
[1067]	160	alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[3815]	161	tsurf_new, dflux_s, dflux_l, rhoa)
[996]	162
[2209]	163	ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
	164	CALL ocean_slab_ice( &
	165	itime, dtime, jour, knon, knindex, &
	166	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
	167	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	168	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	169	ps, u1, v1, gustiness, &
[2209]	170	radsol, snow, qsurf, qsol, agesno, &
	171	alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
	172	tsurf_new, dflux_s, dflux_l, swnet)
	173
[2057]	174	ELSE ! type_ocean=force or slab +sicOBS or sicNO
[1067]	175	CALL ocean_forced_ice( &
	176	itime, dtime, jour, knon, knindex, &
	177	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
	178	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	179	AcoefU, AcoefV, BcoefU, BcoefV, &
[5662]	180	!GG ps, u1, v1, gustiness, &
	181	ps, u1, v1, gustiness,pctsrf, &
	182	!GG
[996]	183	radsol, snow, qsol, agesno, tsoil, &
[1067]	184	qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[5662]	185	!GG tsurf_new, dflux_s, dflux_l, rhoa)
	186	tsurf_new, dflux_s, dflux_l,rhoa,swnet,hice, tice, bilg_cumul, &
	187	fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, &
	188	dtice_melt, dtice_snow2sic &
	189	!GG
[5022]	190	#ifdef ISO
	191	,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
	192	xtsnow, xtsol,xtevap,Rland_ice &
	193	#endif
	194	)
[781]	195
[996]	196	END IF
	197
[781]	198	!****************************************************************************************
	199	! Calculate rugosity
	200	!
	201	!****************************************************************************************
	202
[2243]	203	z0m=z0m_seaice
	204	z0h = z0h_seaice
[2227]	205
	206	!albedo SB >>>
	207	select case(NSW)
	208	case(2)
	209	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	210	alb_dir_new(1:knon,2)=alb2_new(1:knon)
	211	case(4)
	212	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	213	alb_dir_new(1:knon,2)=alb2_new(1:knon)
	214	alb_dir_new(1:knon,3)=alb2_new(1:knon)
	215	alb_dir_new(1:knon,4)=alb2_new(1:knon)
	216	case(6)
	217	alb_dir_new(1:knon,1)=alb1_new(1:knon)
	218	alb_dir_new(1:knon,2)=alb1_new(1:knon)
	219	alb_dir_new(1:knon,3)=alb1_new(1:knon)
	220	alb_dir_new(1:knon,4)=alb2_new(1:knon)
	221	alb_dir_new(1:knon,5)=alb2_new(1:knon)
	222	alb_dir_new(1:knon,6)=alb2_new(1:knon)
	223	end select
	224	alb_dif_new=alb_dir_new
	225	!albedo SB <<<
	226
	227
	228
	229
[781]	230	END SUBROUTINE surf_seaice
	231	!
	232	!****************************************************************************************
	233	!
	234	END MODULE surf_seaice_mod
	235

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

Download in other formats:

Original Format