! ! $Id: surf_seaice_mod.F90 5889 2025-11-27 17:44:57Z ymeurdesoif $ ! MODULE surf_seaice_mod IMPLICIT NONE CONTAINS ! !**************************************************************************************** ! SUBROUTINE surf_seaice( & rlon, rlat, swnet, lwnet, alb1, fder, & itime, dtime, jour, knon, knindex, & lafin, & tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, & AcoefH, AcoefQ, BcoefH, BcoefQ, & AcoefU, AcoefV, BcoefU, BcoefV, & ps, u1, v1, gustiness, pctsrf, & snow, qsurf, qsol, agesno, tsoil, & z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & tsurf_new, dflux_s, dflux_l, & !GG flux_u1, flux_v1) flux_u1, flux_v1, hice, tice,bilg_cumul, & fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, & dtice_melt, dtice_snow2sic & !GG #ifdef ISO & ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, & & xtsnow,xtsol,xtevap,Rland_ice & #endif & ) !$gpum horizontal knon klon USE dimphy USE surface_data USE ocean_forced_mod, ONLY : ocean_forced_ice USE ocean_cpl_mod, ONLY : ocean_cpl_ice USE ocean_slab_mod, ONLY : ocean_slab_ice USE indice_sol_mod #ifdef ISO USE infotrac_phy, ONLY : ntiso,niso #endif USE clesphys_mod_h USE yomcst_mod_h USE dimsoil_mod_h, ONLY: nsoilmx USE print_control_mod, ONLY: lunout USE lmdz_checksum USE mod_phys_lmdz_para, ONLY : is_master ! ! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force, ! slab or couple). The calculation of rugosity for the sea-ice surface is also done ! in here because it is the same calculation for the different modes of ocean. ! ! for rd and retv ! Input arguments !**************************************************************************************** INTEGER, INTENT(IN) :: itime, jour, knon INTEGER, DIMENSION(knon), INTENT(IN) :: knindex LOGICAL, INTENT(IN) :: lafin REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat REAL, DIMENSION(knon), INTENT(IN) :: swnet ! net shortwave radiation at surface REAL, DIMENSION(knon), INTENT(IN) :: lwnet ! net longwave radiation at surface REAL, DIMENSION(knon), INTENT(IN) :: alb1 ! albedo in visible SW interval REAL, DIMENSION(knon), INTENT(IN) :: fder REAL, DIMENSION(knon), INTENT(IN) :: tsurf REAL, DIMENSION(knon), INTENT(IN) :: p1lay REAL, DIMENSION(knon), INTENT(IN) :: cdragh, cdragm REAL, DIMENSION(knon), INTENT(IN) :: precip_rain, precip_snow REAL, DIMENSION(knon), INTENT(IN) :: temp_air, spechum REAL, DIMENSION(knon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ REAL, DIMENSION(knon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV REAL, DIMENSION(knon), INTENT(IN) :: ps REAL, DIMENSION(knon), INTENT(IN) :: u1, v1, gustiness REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf #ifdef ISO REAL, DIMENSION(ntiso,knon), INTENT(IN) :: xtprecip_rain, xtprecip_snow REAL, DIMENSION(knon), INTENT(IN) :: xtspechum REAL, DIMENSION(niso,knon), INTENT(IN) :: Roce REAL, DIMENSION(niso,knon), INTENT(IN) :: Rland_ice #endif ! In/Output arguments !**************************************************************************************** REAL, DIMENSION(knon), INTENT(INOUT) :: snow, qsurf, qsol REAL, DIMENSION(knon), INTENT(INOUT) :: agesno REAL, DIMENSION(knon, nsoilmx), INTENT(INOUT) :: tsoil #ifdef ISO REAL, DIMENSION(niso,knon), INTENT(INOUT) :: xtsnow REAL, DIMENSION(niso,knon), INTENT(IN) :: xtsol #endif ! Output arguments !**************************************************************************************** REAL, DIMENSION(knon), INTENT(OUT) :: z0m, z0h !albedo SB >>> ! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval ! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval REAL, DIMENSION(6), INTENT(IN) :: SFRWL REAL, DIMENSION(knon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new !albedo SB <<< REAL, DIMENSION(knon), INTENT(OUT) :: evap, fluxsens, fluxlat REAL, DIMENSION(knon), INTENT(OUT) :: tsurf_new REAL, DIMENSION(knon), INTENT(OUT) :: dflux_s, dflux_l REAL, DIMENSION(knon), INTENT(OUT) :: flux_u1, flux_v1 !GG REAL, DIMENSION(klon), INTENT(INOUT) :: hice, tice, bilg_cumul !ym WARNING uncompressed REAL, DIMENSION(klon), INTENT(INOUT) :: fcds,fcdi, dh_basal_growth,dh_basal_melt !ym WARNING uncompressed REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt, dh_snow2sic, dtice_melt, dtice_snow2sic !ym WARNING uncompressed !GG #ifdef ISO REAL, DIMENSION(ntiso,knon), INTENT(OUT) :: xtevap #endif ! Local arguments !**************************************************************************************** REAL, DIMENSION(knon) :: radsol #ifdef ISO #ifdef ISOVERIF INTEGER :: j #endif #endif !albedo SB >>> REAL, DIMENSION(knon) :: alb1_new,alb2_new !albedo SB <<< real rhoa(knon) ! density of moist air (kg / m3) ! End definitions !**************************************************************************************** !**************************************************************************************** ! Calculate total net radiance at surface ! !**************************************************************************************** radsol(:) = 0.0 radsol(1:knon) = swnet(1:knon) + lwnet(1:knon) rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon))) !**************************************************************************************** ! Switch according to type of ocean (couple, slab or forced) ! !**************************************************************************************** IF (type_ocean == 'couple') THEN !$gpum nocall CALL ocean_cpl_ice( & rlon, rlat, swnet, lwnet, alb1, & fder, & itime, dtime, knon, knindex, & lafin,& p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,& AcoefH, AcoefQ, BcoefH, BcoefQ, & AcoefU, AcoefV, BcoefU, BcoefV, & ps, u1, v1, gustiness, pctsrf, & radsol, snow, qsurf, & alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, & tsurf_new, dflux_s, dflux_l, rhoa) ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN !$gpum nocall CALL ocean_slab_ice( & itime, dtime, jour, knon, knindex, & tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,& AcoefH, AcoefQ, BcoefH, BcoefQ, & AcoefU, AcoefV, BcoefU, BcoefV, & ps, u1, v1, gustiness, & radsol, snow, qsurf, qsol, agesno, & alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, & tsurf_new, dflux_s, dflux_l, swnet) ELSE ! type_ocean=force or slab +sicOBS or sicNO IF (is_master) WRITE(lunout,*) "******* CHECKSUM ==> ocean_forced IN *******" !$gpum nocall checksum CALL checksum("itime", itime) CALL checksum("dtime", dtime) CALL checksum("jour", jour) CALL checksum("knon", knon) CALL checksum("knindex", knindex(1:knon)) CALL checksum("tsurf", tsurf(1:knon)) CALL checksum("p1lay", p1lay(1:knon)) CALL checksum("cdragh", cdragh(1:knon)) CALL checksum("cdragm", cdragm(1:knon)) CALL checksum("precip_rain", precip_rain(1:knon)) CALL checksum("precip_snow", precip_snow(1:knon)) CALL checksum("temp_air", temp_air(1:knon)) CALL checksum("spechum", spechum(1:knon)) CALL checksum("AcoefH", AcoefH(1:knon)) CALL checksum("AcoefQ", AcoefQ(1:knon)) CALL checksum("BcoefH", BcoefH(1:knon)) CALL checksum("BcoefQ", BcoefQ(1:knon)) CALL checksum("AcoefU", AcoefU(1:knon)) CALL checksum("AcoefV", AcoefV(1:knon)) CALL checksum("BcoefU", BcoefU(1:knon)) CALL checksum("BcoefV", BcoefV(1:knon)) CALL checksum("ps", ps(1:knon)) CALL checksum("u1", u1(1:knon)) CALL checksum("v1", v1(1:knon)) CALL checksum("gustiness", gustiness(1:knon)) CALL checksum("pctsrf", pctsrf) CALL checksum("radsol", radsol(1:knon)) CALL checksum("snow", snow(1:knon)) CALL checksum("qsol", qsol(1:knon)) CALL checksum("agesno", agesno(1:knon)) CALL checksum("tsoil", tsoil(1:knon,:)) CALL checksum("qsurf", qsurf(1:knon)) CALL checksum("alb1_new", alb1_new(1:knon)) CALL checksum("alb2_new", alb2_new(1:knon)) CALL checksum("evap", evap(1:knon)) CALL checksum("fluxsens", fluxsens(1:knon)) CALL checksum("fluxlat", fluxlat(1:knon)) CALL checksum("flux_u1", flux_u1(1:knon)) CALL checksum("flux_v1", flux_v1(1:knon)) CALL checksum("tsurf_new", tsurf_new(1:knon)) CALL checksum("dflux_s", dflux_s(1:knon)) CALL checksum("dflux_l", dflux_l(1:knon)) CALL checksum("rhoa", rhoa(1:knon)) CALL checksum("swnet", swnet(1:knon)) CALL checksum("hice", hice) CALL checksum("tice", tice) CALL checksum("bilg_cumul", bilg_cumul) CALL checksum("fcds", fcds) CALL checksum("fcdi", fcdi) CALL checksum("dh_basal_growth", dh_basal_growth) CALL checksum("dh_basal_melt", dh_basal_melt) CALL checksum("dh_top_melt", dh_top_melt) CALL checksum("dh_snow2sic", dh_snow2sic) CALL checksum("dtice_melt", dtice_melt) CALL checksum("dtice_snow2sic", dtice_snow2sic) CALL ocean_forced_ice( & itime, dtime, jour, knon, knindex, & tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,& AcoefH, AcoefQ, BcoefH, BcoefQ, & AcoefU, AcoefV, BcoefU, BcoefV, & !GG ps, u1, v1, gustiness, & ps, u1, v1, gustiness,pctsrf, & !GG radsol, snow, qsol, agesno, tsoil, & qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, & !GG tsurf_new, dflux_s, dflux_l, rhoa) tsurf_new, dflux_s, dflux_l,rhoa,swnet,hice, tice, bilg_cumul, & fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, & dtice_melt, dtice_snow2sic & !GG #ifdef ISO ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, & xtsnow, xtsol,xtevap,Rland_ice & #endif ) IF (is_master) WRITE(lunout,*) "******* CHECKSUM ==> ocean_forced OUT *******" CALL checksum("itime", itime) CALL checksum("dtime", dtime) CALL checksum("jour", jour) CALL checksum("knon", knon) CALL checksum("knindex", knindex(1:knon)) CALL checksum("tsurf", tsurf(1:knon)) CALL checksum("p1lay", p1lay(1:knon)) CALL checksum("cdragh", cdragh(1:knon)) CALL checksum("cdragm", cdragm(1:knon)) CALL checksum("precip_rain", precip_rain(1:knon)) CALL checksum("precip_snow", precip_snow(1:knon)) CALL checksum("temp_air", temp_air(1:knon)) CALL checksum("spechum", spechum(1:knon)) CALL checksum("AcoefH", AcoefH(1:knon)) CALL checksum("AcoefQ", AcoefQ(1:knon)) CALL checksum("BcoefH", BcoefH(1:knon)) CALL checksum("BcoefQ", BcoefQ(1:knon)) CALL checksum("AcoefU", AcoefU(1:knon)) CALL checksum("AcoefV", AcoefV(1:knon)) CALL checksum("BcoefU", BcoefU(1:knon)) CALL checksum("BcoefV", BcoefV(1:knon)) CALL checksum("ps", ps(1:knon)) CALL checksum("u1", u1(1:knon)) CALL checksum("v1", v1(1:knon)) CALL checksum("gustiness", gustiness(1:knon)) CALL checksum("pctsrf", pctsrf) CALL checksum("radsol", radsol(1:knon)) CALL checksum("snow", snow(1:knon)) CALL checksum("qsol", qsol(1:knon)) CALL checksum("agesno", agesno(1:knon)) CALL checksum("tsoil", tsoil(1:knon,:)) CALL checksum("qsurf", qsurf(1:knon)) CALL checksum("alb1_new", alb1_new(1:knon)) CALL checksum("alb2_new", alb2_new(1:knon)) CALL checksum("evap", evap(1:knon)) CALL checksum("fluxsens", fluxsens(1:knon)) CALL checksum("fluxlat", fluxlat(1:knon)) CALL checksum("flux_u1", flux_u1(1:knon)) CALL checksum("flux_v1", flux_v1(1:knon)) CALL checksum("tsurf_new", tsurf_new(1:knon)) CALL checksum("dflux_s", dflux_s(1:knon)) CALL checksum("dflux_l", dflux_l(1:knon)) CALL checksum("rhoa", rhoa(1:knon)) CALL checksum("swnet", swnet(1:knon)) CALL checksum("hice", hice) CALL checksum("tice", tice) CALL checksum("bilg_cumul", bilg_cumul) CALL checksum("fcds", fcds) CALL checksum("fcdi", fcdi) CALL checksum("dh_basal_growth", dh_basal_growth) CALL checksum("dh_basal_melt", dh_basal_melt) CALL checksum("dh_top_melt", dh_top_melt) CALL checksum("dh_snow2sic", dh_snow2sic) CALL checksum("dtice_melt", dtice_melt) CALL checksum("dtice_snow2sic", dtice_snow2sic) IF (is_master) WRITE(lunout,*) "******* CHECKSUM **************************" END IF !**************************************************************************************** ! Calculate rugosity ! !**************************************************************************************** z0m=z0m_seaice z0h = z0h_seaice !albedo SB >>> select case(NSW) case(2) alb_dir_new(1:knon,1)=alb1_new(1:knon) alb_dir_new(1:knon,2)=alb2_new(1:knon) case(4) alb_dir_new(1:knon,1)=alb1_new(1:knon) alb_dir_new(1:knon,2)=alb2_new(1:knon) alb_dir_new(1:knon,3)=alb2_new(1:knon) alb_dir_new(1:knon,4)=alb2_new(1:knon) case(6) alb_dir_new(1:knon,1)=alb1_new(1:knon) alb_dir_new(1:knon,2)=alb1_new(1:knon) alb_dir_new(1:knon,3)=alb1_new(1:knon) alb_dir_new(1:knon,4)=alb2_new(1:knon) alb_dir_new(1:knon,5)=alb2_new(1:knon) alb_dir_new(1:knon,6)=alb2_new(1:knon) end select alb_dif_new=alb_dir_new !albedo SB <<< END SUBROUTINE surf_seaice ! !**************************************************************************************** ! END MODULE surf_seaice_mod