get_sfx_sea.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE get_sfx_sea (S, U, W, &
                              ocpl_seaice,owater,                       &
                              psea_fwsu,psea_fwsv,psea_heat,psea_snet, &
                              psea_wind,psea_fwsm,psea_evap,psea_rain, &
                              psea_snow,psea_watf,                     &
                              pseaice_heat,pseaice_snet,pseaice_evap   )  
!     ############################################################################
!
!!****  *GET_SFX_SEA* - routine to get some variables from surfex to
!                        a oceanic general circulation model
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      B. Decharme      *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2013
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_seaflux_n, ONLY : seaflux_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_watflux_n, ONLY : watflux_t
!
USE modd_surf_par,   ONLY : xundef
!
!
!
!
USE modi_unpack_same_rank
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(seaflux_t), INTENT(INOUT) :: s
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(watflux_t), INTENT(INOUT) :: w
!
LOGICAL,            INTENT(IN)  :: ocpl_seaice ! sea-ice / ocean key
LOGICAL,            INTENT(IN)  :: owater      ! water included in sea smask
!
REAL, DIMENSION(:), INTENT(OUT) :: psea_fwsu  ! Cumulated zonal wind stress       (Pa.s)
REAL, DIMENSION(:), INTENT(OUT) :: psea_fwsv  ! Cumulated meridian wind stress    (Pa.s)
REAL, DIMENSION(:), INTENT(OUT) :: psea_heat  ! Cumulated Non solar net heat flux (J/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psea_snet  ! Cumulated Solar net heat flux     (J/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psea_wind  ! Cumulated 10m wind speed          (m)
REAL, DIMENSION(:), INTENT(OUT) :: psea_fwsm  ! Cumulated wind stress             (Pa.s)
REAL, DIMENSION(:), INTENT(OUT) :: psea_evap  ! Cumulated Evaporation             (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psea_rain  ! Cumulated Rainfall rate           (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psea_snow  ! Cumulated Snowfall rate           (kg/m2)
REAL, DIMENSION(:), INTENT(OUT) :: psea_watf  ! Cumulated Net water flux (kg/m2)
!
REAL, DIMENSION(:), INTENT(OUT) :: pseaice_heat ! Cumulated Sea-ice non solar net heat flux (J/m2)
REAL, DIMENSION(:), INTENT(OUT) :: pseaice_snet ! Cumulated Sea-ice solar net heat flux     (J/m2)
REAL, DIMENSION(:), INTENT(OUT) :: pseaice_evap ! Cumulated Sea-ice sublimation             (kg/m2)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zwind
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zfwsu
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zfwsv
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zsnet
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zheat
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zevap
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zrain
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zsnow
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zfwsm
!
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zsnet_ice
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zheat_ice
REAL, DIMENSION(SIZE(PSEA_HEAT))  :: zevap_ice
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFX_SEA',0,zhook_handle)
!-------------------------------------------------------------------------------
!
!*       1.0   Initialization
!              --------------
!
psea_fwsu(:) = xundef
psea_fwsv(:) = xundef
psea_heat(:) = xundef
psea_snet(:) = xundef
psea_wind(:) = xundef
psea_fwsm(:) = xundef
psea_evap(:) = xundef
psea_rain(:) = xundef
psea_snow(:) = xundef
psea_watf(:) = xundef
!
pseaice_heat(:) = xundef
pseaice_snet(:) = xundef
pseaice_evap(:) = xundef
!
zfwsu(:) = xundef
zfwsv(:) = xundef
zheat(:) = xundef
zsnet(:) = xundef
zwind(:) = xundef
zfwsm(:) = xundef
zevap(:) = xundef
zrain(:) = xundef
zsnow(:) = xundef
!
zheat_ice(:) = xundef
zsnet_ice(:) = xundef
zevap_ice(:) = xundef
!
!*       2.0   Get variable over sea
!              ---------------------
!
IF(u%NSIZE_SEA>0)THEN
!
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_WIND(:),psea_wind(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_FWSU(:),psea_fwsu(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_FWSV(:),psea_fwsv(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_SNET(:),psea_snet(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_HEAT(:),psea_heat(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_EVAP(:),psea_evap(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_RAIN(:),psea_rain(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_SNOW(:),psea_snow(:),xundef)
  CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEA_FWSM(:),psea_fwsm(:),xundef)
  s%XCPL_SEA_WIND(:) = 0.0
  s%XCPL_SEA_EVAP(:) = 0.0
  s%XCPL_SEA_HEAT(:) = 0.0
  s%XCPL_SEA_SNET(:) = 0.0
  s%XCPL_SEA_FWSU(:) = 0.0
  s%XCPL_SEA_FWSV(:) = 0.0
  s%XCPL_SEA_RAIN(:) = 0.0
  s%XCPL_SEA_SNOW(:) = 0.0
  s%XCPL_SEA_FWSM(:) = 0.0
!
  IF (ocpl_seaice) THEN
    CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEAICE_SNET(:),pseaice_snet(:),xundef)
    CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEAICE_HEAT(:),pseaice_heat(:),xundef)
    CALL unpack_same_rank(u%NR_SEA(:),s%XCPL_SEAICE_EVAP(:),pseaice_evap(:),xundef)
    s%XCPL_SEAICE_SNET(:) = 0.0
    s%XCPL_SEAICE_EVAP(:) = 0.0
    s%XCPL_SEAICE_HEAT(:) = 0.0  
  ENDIF
!
ENDIF
!
!*       3.0   Get variable over water without Flake
!              -------------------------------------
!
IF (owater.AND.u%NSIZE_WATER>0) THEN
!
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_WIND(:),zwind(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_FWSU(:),zfwsu(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_FWSV(:),zfwsv(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_SNET(:),zsnet(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_HEAT(:),zheat(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_EVAP(:),zevap(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_RAIN(:),zrain(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_SNOW(:),zsnow(:),xundef)
  CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATER_FWSM(:),zfwsm(:),xundef)
!
  WHERE(u%XWATER(:)>0.0) 
    psea_wind(:) = (u%XSEA(:)*psea_wind(:)+u%XWATER(:)*zwind(:))/(u%XSEA(:)+u%XWATER(:))
    psea_fwsu(:) = (u%XSEA(:)*psea_fwsu(:)+u%XWATER(:)*zfwsu(:))/(u%XSEA(:)+u%XWATER(:))
    psea_fwsv(:) = (u%XSEA(:)*psea_fwsv(:)+u%XWATER(:)*zfwsv(:))/(u%XSEA(:)+u%XWATER(:))
    psea_snet(:) = (u%XSEA(:)*psea_snet(:)+u%XWATER(:)*zsnet(:))/(u%XSEA(:)+u%XWATER(:))
    psea_heat(:) = (u%XSEA(:)*psea_heat(:)+u%XWATER(:)*zheat(:))/(u%XSEA(:)+u%XWATER(:))
    psea_evap(:) = (u%XSEA(:)*psea_evap(:)+u%XWATER(:)*zevap(:))/(u%XSEA(:)+u%XWATER(:))
    psea_rain(:) = (u%XSEA(:)*psea_rain(:)+u%XWATER(:)*zrain(:))/(u%XSEA(:)+u%XWATER(:))
    psea_snow(:) = (u%XSEA(:)*psea_snow(:)+u%XWATER(:)*zsnow(:))/(u%XSEA(:)+u%XWATER(:))
    psea_fwsm(:) = (u%XSEA(:)*psea_fwsm(:)+u%XWATER(:)*zfwsm(:))/(u%XSEA(:)+u%XWATER(:))
  ENDWHERE 
!
  w%XCPL_WATER_WIND(:) = 0.0
  w%XCPL_WATER_EVAP(:) = 0.0
  w%XCPL_WATER_HEAT(:) = 0.0
  w%XCPL_WATER_SNET(:) = 0.0
  w%XCPL_WATER_FWSU(:) = 0.0
  w%XCPL_WATER_FWSV(:) = 0.0
  w%XCPL_WATER_RAIN(:) = 0.0
  w%XCPL_WATER_SNOW(:) = 0.0
  w%XCPL_WATER_FWSM(:) = 0.0
!
  IF (ocpl_seaice) THEN
    CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATERICE_SNET(:),zsnet_ice(:),xundef)
    CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATERICE_HEAT(:),zheat_ice(:),xundef)
    CALL unpack_same_rank(u%NR_WATER(:),w%XCPL_WATERICE_EVAP(:),zevap_ice(:),xundef)
    WHERE(u%XWATER(:)>0.0)     
      pseaice_snet(:) = (u%XSEA(:)*pseaice_snet(:)+u%XWATER(:)*zsnet_ice(:))/(u%XSEA(:)+u%XWATER(:))
      pseaice_heat(:) = (u%XSEA(:)*pseaice_heat(:)+u%XWATER(:)*zheat_ice(:))/(u%XSEA(:)+u%XWATER(:))
      pseaice_evap(:) = (u%XSEA(:)*pseaice_evap(:)+u%XWATER(:)*zevap_ice(:))/(u%XSEA(:)+u%XWATER(:))
    ENDWHERE  
    w%XCPL_WATERICE_SNET(:) = 0.0
    w%XCPL_WATERICE_EVAP(:) = 0.0
    w%XCPL_WATERICE_HEAT(:) = 0.0
  ENDIF  
! 
ENDIF
!
!*       4.0   Net water flux
!              -----------------------
!
IF(u%NSIZE_SEA>0)THEN
!
  psea_watf(:) = psea_rain(:) + psea_snow(:) - psea_evap(:)
!
ENDIF
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GET_SFX_SEA',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE get_sfx_sea