coare30_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 coare30_seaflux (S, &
                                pmask,ksize_water,ksize_ice,     &
                                pta,pexna,prhoa,psst,pexns,pqa,        & 
                                prain,psnow,pvmod,pzref,puref,pps,     &
                                pqsat,psfth,psftq,pustar,  &
                                pcd,pcdn,pch,pce,pri,presa,pz0hsea     )
!     ##################################################################
!
!
!!****  *COARE30_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 the simplified COARE 3.0 bulk algorithm from Fairall et al 
!      2003
!   
!      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
!!      B. Decharme     04/2013 : Pack only input variables
!!      S. Senesi       01/2014 : When handling sea ice cover, compute open sea flux, 
!!                                and only where ice cover < 1.
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
!
USE modd_seaflux_n, ONLY : seaflux_t
!
USE modd_surf_par,   ONLY : xundef
!
USE modi_ice_sea_flux
USE modi_coare30_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)    :: 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('MODI_COARE30_SEAFLUX:COARE30_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 COARE30_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('MODI_COARE30_SEAFLUX:COARE30_SEAFLUX',1,zhook_handle)
!-------------------------------------------------------------------------------
!
 CONTAINS
!
SUBROUTINE treat_surf(KMASK,YTYPE)
!
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_exns ! Exner function at sea surface
REAL, DIMENSION(SIZE(KMASK))      :: zw_ps   ! air pressure at sea surface (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_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(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('COARE30_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_exns(jj) = pexns(kmask(jj)) 
  zw_ps(jj)   = pps(kmask(jj))
  zw_rain(jj) = prain(kmask(jj))
  zw_snow(jj) = psnow(kmask(jj))
  zw_z0sea(jj)= s%XZ0(kmask(jj))
ENDDO
!  
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
  !
  CALL coare30_flux(s, &
                    zw_z0sea,zw_ta,zw_exna,zw_rhoa,zw_sst,zw_exns,&
        zw_qa,zw_vmod,zw_zref,zw_uref,zw_ps,zw_qsat,zw_sfth,zw_sftq,zw_ustar,&
        zw_cd,zw_cdn,zw_ch,zw_ce,zw_ri,zw_resa,zw_rain,zw_z0hsea)   
  !
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)
   s%XZ0(kmask(jj))  =  zw_z0sea(jj)
   psfth(kmask(jj))   =  zw_sfth(jj) 
   psftq(kmask(jj))   =  zw_sftq(jj) 
   pustar(kmask(jj))  =  zw_ustar(jj)
   pqsat(kmask(jj))   =  zw_qsat(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('COARE30_SEAFLUX:TREAT_SURF',1,zhook_handle)
!
END SUBROUTINE treat_surf
! 
END SUBROUTINE coare30_seaflux