! ! $Header$ ! MODULE ocean_forced_mod ! ! This module is used for both the sub-surfaces ocean and sea-ice for the case of a ! forced ocean, "ocean=force". ! USE surface_data, ONLY : calice, calsno, tau_gl USE fonte_neige_mod, ONLY : fonte_neige USE calcul_fluxs_mod, ONLY : calcul_fluxs USE dimphy IMPLICIT NONE CONTAINS ! !**************************************************************************************** ! SUBROUTINE ocean_forced_noice(itime, dtime, jour, knon, knindex, & debut, & p1lay, tq_cdrag, precip_rain, precip_snow, & temp_air, spechum, & petAcoef, peqAcoef, petBcoef, peqBcoef, & ps, u1_lay, v1_lay, & radsol, snow, agesno, & qsurf, evap, fluxsens, fluxlat, & tsurf_new, dflux_s, dflux_l) ! ! This subroutine treats the "open ocean", all grid points that are not entierly covered ! by ice. ! The routine receives data from climatologie file limit.nc and does some calculations at the ! surface. ! USE limit_read_mod INCLUDE "indicesol.h" INCLUDE "YOMCST.h" ! Input arguments !**************************************************************************************** INTEGER, INTENT(IN) :: itime, jour, knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex LOGICAL, INTENT(IN) :: debut REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: p1lay REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef REAL, DIMENSION(klon), INTENT(IN) :: ps REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay ! In/Output arguments !**************************************************************************************** REAL, DIMENSION(klon), INTENT(INOUT) :: radsol REAL, DIMENSION(klon), INTENT(INOUT) :: snow REAL, DIMENSION(klon), INTENT(INOUT) :: agesno !? put to 0 in ocean ! Output arguments !**************************************************************************************** REAL, DIMENSION(klon), INTENT(OUT) :: qsurf REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l ! Local variables !**************************************************************************************** INTEGER :: i REAL, DIMENSION(klon) :: cal, beta, dif_grnd REAL, DIMENSION(klon) :: alb_neig, tsurf_lim, zx_sl LOGICAL :: check=.FALSE. !**************************************************************************************** ! Start calculation !**************************************************************************************** IF (check) WRITE(*,*)' Entering ocean_forced_noice' !**************************************************************************************** ! 1) ! Read sea-surface temperature from file limit.nc ! !**************************************************************************************** CALL limit_read_sst(knon,knindex,tsurf_lim) !**************************************************************************************** ! 2) ! Flux calculation ! !**************************************************************************************** ! Set some variables for calcul_fluxs cal = 0. beta = 1. dif_grnd = 0. alb_neig(:) = 0. agesno(:) = 0. ! Calcul de tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l and qsurf CALL calcul_fluxs(knon, is_oce, dtime, & tsurf_lim, p1lay, cal, beta, tq_cdrag, ps, & precip_rain, precip_snow, snow, qsurf, & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & petAcoef, peqAcoef, petBcoef, peqBcoef, & tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l) END SUBROUTINE ocean_forced_noice ! !**************************************************************************************** ! SUBROUTINE ocean_forced_ice(itime, dtime, jour, knon, knindex, & debut, & tsurf_in, p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, & petAcoef, peqAcoef, petBcoef, peqBcoef, & ps, u1_lay, v1_lay, & radsol, snow, qsol, agesno, tsoil, & qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, & tsurf_new, dflux_s, dflux_l) ! ! This subroutine treats the ocean where there is ice. ! The routine reads data from climatologie file and does flux calculations at the ! surface. ! USE limit_read_mod INCLUDE "indicesol.h" INCLUDE "dimsoil.h" INCLUDE "YOMCST.h" INCLUDE "clesphys.h" ! Input arguments !**************************************************************************************** INTEGER, INTENT(IN) :: itime, jour, knon INTEGER, DIMENSION(klon), INTENT(IN) :: knindex LOGICAL, INTENT(IN) :: debut REAL, INTENT(IN) :: dtime REAL, DIMENSION(klon), INTENT(IN) :: tsurf_in REAL, DIMENSION(klon), INTENT(IN) :: p1lay REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef REAL, DIMENSION(klon), INTENT(IN) :: ps REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay ! In/Output arguments !**************************************************************************************** REAL, DIMENSION(klon), INTENT(INOUT) :: radsol REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsol REAL, DIMENSION(klon), INTENT(INOUT) :: agesno REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil ! Output arguments !**************************************************************************************** REAL, DIMENSION(klon), INTENT(OUT) :: qsurf 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(klon), INTENT(OUT) :: evap, fluxsens, fluxlat REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l ! Local variables !**************************************************************************************** LOGICAL :: check=.FALSE. INTEGER :: i REAL :: zfra REAL, PARAMETER :: t_grnd=271.35 REAL, DIMENSION(klon) :: cal, beta, dif_grnd, capsol REAL, DIMENSION(klon) :: alb_neig, tsurf_tmp REAL, DIMENSION(klon) :: soilcap, soilflux !**************************************************************************************** ! Start calculation !**************************************************************************************** IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon !**************************************************************************************** ! 1) ! Flux calculation : tsurf_new, evap, fluxlat, fluxsens, ! dflux_s, dflux_l and qsurf !**************************************************************************************** tsurf_tmp(:) = tsurf_in(:) ! calculate the parameters cal, beta, capsol and dif_grnd CALL calbeta(dtime, is_sic, knon, snow, qsol, beta, capsol, dif_grnd) IF (soil_model) THEN ! update tsoil and calculate soilcap and soilflux CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux) cal(1:knon) = RCPD / soilcap(1:knon) radsol(1:knon) = radsol(1:knon) + soilflux(1:knon) dif_grnd = 1.0 / tau_gl ELSE dif_grnd = 1.0 / tau_gl cal = RCPD * calice WHERE (snow > 0.0) cal = RCPD * calsno ENDIF beta = 1.0 CALL calcul_fluxs(knon, is_sic, dtime, & tsurf_tmp, p1lay, cal, beta, tq_cdrag, ps, & precip_rain, precip_snow, snow, qsurf, & radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, & petAcoef, peqAcoef, petBcoef, peqBcoef, & tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l) !**************************************************************************************** ! 2) ! Calculations due to snow and runoff ! !**************************************************************************************** CALL fonte_neige( knon, is_sic, knindex, dtime, & tsurf_tmp, precip_rain, precip_snow, & snow, qsol, tsurf_new, evap) ! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno) ! CALL albsno(klon, knon, dtime, agesno(:), alb_neig(:), precip_snow(:)) WHERE (snow(1:knon) .LT. 0.0001) agesno(1:knon) = 0. alb1_new(:) = 0.0 DO i=1, knon zfra = MAX(0.0,MIN(1.0,snow(i)/(snow(i)+10.0))) alb1_new(i) = alb_neig(i) * zfra + 0.6 * (1.0-zfra) ENDDO alb2_new(:) = alb1_new(:) END SUBROUTINE ocean_forced_ice ! !**************************************************************************************** ! END MODULE ocean_forced_mod