ecume_seaflux.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 ecume_seaflux(S,PMASK,KSIZE_WATER,KSIZE_ICE,       &
                              PTA,PEXNA,PRHOA,PSST,PEXNS,PQA,     &
                              PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS,PPA,   &
                              PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,       &
                              PCDN,PCH,PCE,PRI,PRESA,PZ0HSEA      ) 
!     #######################################################################
!
!
!!****  *ECUME_SEAFLUX*  
!!
!!    PURPOSE
!!    -------
!     
!      Calculate the sea surface fluxes with modified bulk algorithm COARE:  
!
!      Calculates the surface fluxes of heat, moisture, and momentum over
!      sea surface with Unified Turbulent fluxes parameterization with calibration 
!      multi-campaign of neutral transfer coefficient from
!      ALBATROS dataset (exp. POMME, CATCH, FETCH, SEMAPHORE, EQUALANT99)
! 
!      based on water_flux computation for sea ice
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    REFERENCE
!!    ---------
!!     
!!    AUTHOR
!!    ------
!!     C. Lebeaupin  *Météo-France* 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original     18/03/2005
!!      Modified        08/2009 B. Decharme
!!      Modified        01/2014 S. Senesi : handle sea ice cover, discard 
!!                                computing fluxes on seaice when done elsewhere
!!      Modified        05/2014 S. Belamari NEW ECUME : Include salinity & atm. pressure impact
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_seaflux_n, ONLY : seaflux_t
!
USE modd_surf_par,   ONLY : xundef
!!
USE modi_ice_sea_flux
USE modi_ecumev6_flux
USE modi_ecume_flux
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(seaflux_t), INTENT(INOUT) :: S
!
REAL, DIMENSION(:), INTENT(IN)   :: PMASK        ! Either a mask positive for open sea, or a seaice fraction
INTEGER           , INTENT(IN)   :: KSIZE_WATER  ! number of points with some sea water 
INTEGER           , INTENT(IN)   :: KSIZE_ICE    ! number of points with some sea ice
!
REAL, DIMENSION(:), INTENT(IN)    :: PTA   ! air temperature at atm. level (K)
REAL, DIMENSION(:), INTENT(IN)    :: PQA   ! air humidity at atm. level (kg/kg)
REAL, DIMENSION(:), INTENT(IN)    :: PEXNA ! Exner function at atm. level
REAL, DIMENSION(:), INTENT(IN)    :: PRHOA ! air density at atm. level
REAL, DIMENSION(:), INTENT(IN)    :: PVMOD ! module of wind at atm. wind level (m/s)
REAL, DIMENSION(:), INTENT(IN)    :: PZREF ! atm. level for temp. and humidity (m)
REAL, DIMENSION(:), INTENT(IN)    :: PUREF ! atm. level for wind (m)
REAL, DIMENSION(:), INTENT(IN)    :: PSST  ! Sea Surface Temperature (K)
REAL, DIMENSION(:), INTENT(IN)    :: PEXNS ! Exner function at sea surface
REAL, DIMENSION(:), INTENT(IN)    :: PPS   ! air pressure at sea surface (Pa)
REAL, DIMENSION(:), INTENT(IN)    :: PPA   ! air pressure at atm. level (Pa)
REAL, DIMENSION(:), INTENT(IN)    :: PRAIN ! precipitation rate (kg/s/m2)
REAL, DIMENSION(:), INTENT(IN)    :: PSNOW ! snow rate (kg/s/m2)
!                                                                                 
!  surface fluxes : latent heat, sensible heat, friction fluxes
REAL, DIMENSION(:), INTENT(OUT)      :: PSFTH ! heat flux (W/m2)
REAL, DIMENSION(:), INTENT(OUT)      :: PSFTQ ! water flux (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT)      :: PUSTAR! friction velocity (m/s)
!
! diagnostics
REAL, DIMENSION(:), INTENT(OUT)      :: PQSAT ! humidity at saturation
REAL, DIMENSION(:), INTENT(OUT)      :: PCD   ! heat drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: PCDN  ! momentum drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: PCH   ! neutral momentum drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: PCE   !transfer coef. for latent heat flux
REAL, DIMENSION(:), INTENT(OUT)      :: PRI   ! Richardson number
REAL, DIMENSION(:), INTENT(OUT)      :: PRESA ! aerodynamical resistance
REAL, DIMENSION(:), INTENT(OUT)      :: PZ0HSEA ! heat roughness length
!
!*      0.2    declarations of local variables
!
INTEGER, DIMENSION(KSIZE_WATER) :: IR_WATER
INTEGER, DIMENSION(KSIZE_ICE)   :: IR_ICE
INTEGER                         :: J1,J2,JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!       1.     Create Masks for ice and water sea
!              ------------------------------------
IF (lhook) CALL dr_hook('ECUME_SEAFLUX',0,zhook_handle)
!
ir_water(:)=0
ir_ice(:)=0
j1=0
j2=0
!
IF (s%LHANDLE_SIC) THEN 
   ! Must compute open sea fluxes even over fully ice-covered sea, which may melt partly
   DO jj=1,SIZE(psst(:))
      ir_water(jj)= jj
   END DO
   ! Do not compute on sea-ice (done in coupling_iceflux)
ELSE
   ! PMASK = XSST -XTTS
   DO jj=1,SIZE(psst(:))
      IF (pmask(jj) >=0.0 ) THEN
         j1 = j1 + 1
         ir_water(j1)= jj
      ELSE
         j2 = j2 + 1
         ir_ice(j2)= jj
      ENDIF
   END DO
ENDIF
!
!-------------------------------------------------------------------------------
!
!       2.      water sea : call to ECUME_FLUX
!              ------------------------------------------------
!
IF (ksize_water > 0 ) CALL treat_surf(ir_water,'W') 
!
!-------------------------------------------------------------------------------
!
!       3.      sea ice : call to ICE_SEA_FLUX
!              ------------------------------------
!
IF ( (ksize_ice > 0 ) .AND. (.NOT. s%LHANDLE_SIC) ) CALL treat_surf(ir_ice,'I')
!
!
IF (lhook) CALL dr_hook('ECUME_SEAFLUX',1,zhook_handle)
!-------------------------------------------------------------------------------
!
CONTAINS

SUBROUTINE treat_surf(KMASK,YTYPE)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN), DIMENSION(:) :: KMASK
 CHARACTER(LEN=1), INTENT(IN) :: YTYPE
!
REAL, DIMENSION(SIZE(KMASK))      :: ZW_TA   ! air temperature at atm. level (K)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_QA   ! air humidity at atm. level (kg/kg)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_EXNA ! Exner function at atm. level
REAL, DIMENSION(SIZE(KMASK))      :: ZW_RHOA ! air density at atm. level
REAL, DIMENSION(SIZE(KMASK))      :: ZW_VMOD ! module of wind at atm. wind level (m/s)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_ZREF ! atm. level for temp. and humidity (m)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_UREF ! atm. level for wind (m)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_SST  ! Sea Surface Temperature (K)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_SSS  ! Sea Surface Salinity (g/kg)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_EXNS ! Exner function at sea surface
REAL, DIMENSION(SIZE(KMASK))      :: ZW_PS   ! air pressure at sea surface (Pa)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_PA   ! air pressure at atm. level (Pa)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_RAIN !precipitation rate (kg/s/m2)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_SNOW !snow rate (kg/s/m2)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_PERTFLUX !stochastic flux perturbation pattern
!
REAL, DIMENSION(SIZE(KMASK))      :: ZW_Z0SEA! roughness length over the ocean
!                                                                                 
!  surface fluxes : latent heat, sensible heat, friction fluxes
REAL, DIMENSION(SIZE(KMASK))      :: ZW_SFTH ! heat flux (W/m2)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_SFTQ ! water flux (kg/m2/s)
REAL, DIMENSION(SIZE(KMASK))      :: ZW_USTAR! friction velocity (m/s)
!
! diagnostics
REAL, DIMENSION(SIZE(KMASK))      :: ZW_QSAT ! humidity at saturation
REAL, DIMENSION(SIZE(KMASK))      :: ZW_CD   ! heat drag coefficient
REAL, DIMENSION(SIZE(KMASK))      :: ZW_CDN  ! momentum drag coefficient
REAL, DIMENSION(SIZE(KMASK))      :: ZW_CH   ! neutral momentum drag coefficient
REAL, DIMENSION(SIZE(KMASK))      :: ZW_CE   !transfer coef. for latent heat flux
REAL, DIMENSION(SIZE(KMASK))      :: ZW_RI   ! Richardson number
REAL, DIMENSION(SIZE(KMASK))      :: ZW_RESA ! aerodynamical resistance
REAL, DIMENSION(SIZE(KMASK))      :: ZW_Z0HSEA ! heat roughness length
REAL ::  ZCOEFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('ECUME_SEAFLUX:TREAT_SURF',0,zhook_handle)
DO jj=1, SIZE(kmask)
  zw_ta(jj)   = pta(kmask(jj))
  zw_qa(jj)   = pqa(kmask(jj))
  zw_exna(jj) = pexna(kmask(jj))
  zw_rhoa(jj) = prhoa(kmask(jj))
  zw_vmod(jj) = pvmod(kmask(jj))
  zw_zref(jj) = pzref(kmask(jj)) 
  zw_uref(jj) = puref(kmask(jj))
  zw_sst(jj)  = psst(kmask(jj))
  zw_sss(jj)  = s%XSSS(kmask(jj))
  zw_exns(jj) = pexns(kmask(jj)) 
  zw_ps(jj)   = pps(kmask(jj))
  zw_pa(jj)   = ppa(kmask(jj))
  zw_rain(jj) = prain(kmask(jj))
  zw_snow(jj) = psnow(kmask(jj))
  zw_pertflux(jj) = s%XPERTFLUX(kmask(jj))
  zw_z0sea(jj)= s%XZ0(kmask(jj))
END DO
!
zw_sfth(:)   = xundef
zw_sftq(:)   = xundef
zw_ustar(:)  = xundef
zw_qsat(:)   = xundef
zw_cd(:)     = xundef
zw_cdn(:)    = xundef
zw_ch(:)     = xundef
zw_ce(:)     = xundef
zw_ri(:)     = xundef
zw_resa(:)   = xundef
zw_z0hsea(:) = xundef
!
IF (ytype=='W') THEN
  !
  IF(s%CSEA_FLUX=='ECUME6')THEN
    !new ecume scheme
    CALL ecumev6_flux(zw_z0sea,zw_ta,zw_exna,zw_rhoa,zw_sst,zw_sss,zw_exns,  &
             zw_qa,zw_vmod,zw_zref,zw_uref,zw_ps,zw_pa,s%XICHCE,s%LPRECIP,s%LPWEBB,&
             zw_qsat,zw_sfth,zw_sftq,zw_ustar,zw_cd,zw_cdn,zw_ch,zw_ce,      &
             zw_ri,zw_resa,zw_rain,s%NZ0,zw_z0hsea,s%LPERTFLUX,zw_pertflux)    
  ELSE
    !old ecume scheme
    CALL ecume_flux(zw_z0sea,zw_ta,zw_exna,zw_rhoa,zw_sst,zw_exns,        &
           zw_qa,zw_vmod,zw_zref,zw_uref,zw_ps,s%XICHCE,s%LPRECIP,s%LPWEBB,s%LPWG,&
           zw_qsat,zw_sfth,zw_sftq,zw_ustar,zw_cd,zw_cdn,zw_ch,zw_ce,     &
           zw_ri,zw_resa,zw_rain,zw_z0hsea,s%LPERTFLUX,zw_pertflux)
  ENDIF
  !
ELSEIF ( (ytype=='I') .AND. (.NOT. s%LHANDLE_SIC)) THEN
  !
  CALL ice_sea_flux(zw_z0sea,zw_ta,zw_exna,zw_rhoa,zw_sst,zw_exns,zw_qa,zw_rain,zw_snow,  &
          zw_vmod,zw_zref,zw_uref,zw_ps,zw_qsat,zw_sfth,zw_sftq,zw_ustar,zw_cd, &
          zw_cdn,zw_ch,zw_ri,zw_resa,zw_z0hsea)   
  !
ENDIF
!
DO jj=1, SIZE(kmask)
   pqsat(kmask(jj)) =  zw_qsat(jj) 
   s%XZ0(kmask(jj))=  zw_z0sea(jj)
   pustar(kmask(jj))=  zw_ustar(jj)
   psfth(kmask(jj)) =  zw_sfth(jj) 
   psftq(kmask(jj)) =  zw_sftq(jj) 
   pcd(kmask(jj))   =  zw_cd(jj) 
   pcdn(kmask(jj))  =  zw_cdn(jj) 
   pch(kmask(jj))   =  zw_ch(jj)
   pce(kmask(jj))   =  zw_ce(jj)
   pri(kmask(jj))   =  zw_ri(jj) 
   presa(kmask(jj)) =  zw_resa(jj) 
   pz0hsea(kmask(jj))= zw_z0hsea(jj) 
END DO
IF (lhook) CALL dr_hook('ECUME_SEAFLUX:TREAT_SURF',1,zhook_handle)
END SUBROUTINE treat_surf
!  
END SUBROUTINE ecume_seaflux