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