water_flux.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 water_flux(PZ0SEA,                                         &
                              pta, pexna, prhoa, psst, pexns, pqa, prr, prs,  &
                              ptt, pvmod, pzref, puref,                       &
                              pps, ohandle_sic, pqsat,                        &
                              psfth, psftq, pustar,                           &
                              pcd, pcdn, pch, pri, presa, pz0hsea             )  
!     #######################################################################
!
!
!!****  *WATER_FLUX*  
!!
!!    PURPOSE
!!    -------
!      Calculate the surface fluxes of heat, moisture, and momentum over
!      water surfaces.  
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original      01/09/95 
!!      (J.Stein)     16/11/95  use PUSLOPE and Theta to compute Ri
!!      (P.Lacarrere) 19/03/96  bug in the ZTHVI and ZTHVIS computations
!!      (J.Stein)     27/03/96  use only H and LE in the soil scheme
!!      (P.Jabouille) 12/11/96  bug in the Z0 computation
!!      (V.Masson)    01/02/00  detection of sea ice
!!      (P. Tulet)    01/10/03  aerodynamical resistance output
!!      (P. LeMoigne) 29/03/04  bug in the heat flux computation
!!      (P. LeMoigne) 29/03/04  use z0h for diagnostics (ice)
!!      (P. LeMoigne) 20/06/07  minimum wind speed and/or shear
!!      B. Decharme    06/2009 limitation of Ri
!!      B. Decharme    09/2012 limitation of Ri in surface_ri.F90
!!      B. Decharme    06/2013 Charnock number according to coare3.0
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_csts,       ONLY : xg, xcpd, xlstt
USE modd_surf_par,   ONLY : xundef
USE modd_snow_par,   ONLY : xz0sn, xz0hsn
!
USE modi_surface_ri
USE modi_surface_aero_cond
USE modi_surface_cd
USE modi_surface_cdch_1darp
USE modi_wind_threshold
!
USE mode_thermos
!
USE modd_surf_atm,    ONLY : ldrag_coef_arp, xvchrnk, xvz0cm, lvziustar0_arp, xvziustar0,  &
                               lrrgust_arp, xrrscale, xrrgamma, xutilgust, xrzhz0m
!
USE modd_reprod_oper,  ONLY : ccharnock
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
REAL, DIMENSION(:), INTENT(IN)       :: pta   ! air temperature at atm. level
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
REAL, DIMENSION(:), INTENT(IN)       :: pzref ! atm. level for temp. and humidity
REAL, DIMENSION(:), INTENT(IN)       :: puref ! atm. level for wind
REAL, DIMENSION(:), INTENT(IN)       :: psst  ! Sea Surface Temperature
REAL, DIMENSION(:), INTENT(IN)       :: pexns ! Exner function at sea surface
REAL, DIMENSION(:), INTENT(IN)       :: pps   ! air pressure at sea surface
LOGICAL,            INTENT(IN)       :: ohandle_sic ! if TRUE, do not care to detect seaice
REAL, DIMENSION(:), INTENT(IN)       :: prr   ! rain rate
REAL, DIMENSION(:), INTENT(IN)       :: prs   ! snow rate
REAL,               INTENT(IN)       :: ptt   ! temperature of freezing point
!
REAL, DIMENSION(:), INTENT(INOUT)    :: pz0sea! roughness length over the ocean
!                                         
!                                         
!  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)      :: pri   ! Richardson number
REAL, DIMENSION(:), INTENT(OUT)      :: presa ! aerodynamical resistance
REAL, DIMENSION(:), INTENT(OUT)      :: pz0hsea ! heat roughness length over the ocean
!
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(SIZE(PTA)) :: zvmod     ! wind modulus
REAL, DIMENSION(SIZE(PTA)) :: zustar2   ! square of friction velocity
REAL, DIMENSION(SIZE(PTA)) :: zac       ! Aerodynamical conductance
REAL, DIMENSION(SIZE(PTA)) :: zra       ! Aerodynamical resistance
REAL, DIMENSION(SIZE(PTA)) :: zdircoszw ! orography slope cosine (=1 on water!)
REAL, DIMENSION(SIZE(PTA)) :: zfp       ! working variable
REAL, DIMENSION(SIZE(PTA)) :: zrrcor    ! correction of CD, CH, CDN due to moist-gustiness
REAL, DIMENSION(SIZE(PTA)) :: zcharn    ! Charnock number
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!       1.     Initializations
!              ---------------
!
IF (lhook) CALL dr_hook('WATER_FLUX',0,zhook_handle)
zdircoszw=1.
!
pri(:) = xundef
pch(:) = xundef
pcd(:) = xundef
pcdn(:) = xundef
!
psfth(:)=xundef
psftq(:)=xundef
pustar(:)=xundef
presa(:)=xundef
!
!
!       1.1    Saturated specified humidity near the water surface
!              ---------------------------------------------------
!
pqsat(:) = qsat(psst(:),pps(:))
!
!
!       1.2    Wind speed threshold
!              --------------------
!
zvmod(:)=wind_threshold(pvmod(:),puref(:))
!
!       1.3    Charnock number
!              ---------------
!
IF(ccharnock=='OLD')THEN
  zcharn(:) = xvchrnk
ELSE
! vary between 0.011 et 0.018 according to Chris Fairall's data as in coare3.0        
  zcharn(:) = max(0.011,min(0.018,0.011+0.007*(zvmod(:)-10.)/8.))
ENDIF
!
!-------------------------------------------------------------------------------
!
!       2.     Calculate the drag coefficient for momentum (PCD)
!              -------------------------------------------------
!
!       2.1    Richardson number
!              -----------------
!
 CALL surface_ri(psst,pqsat,pexns,pexna,pta,pqa,  &
                pzref, puref, zdircoszw,pvmod,pri)
!
!       2.2    Detection of sea ice
!              --------------------
!
IF (lvziustar0_arp) THEN
   pz0hsea(:)=min(pz0sea(:),pz0sea(:)*xrzhz0m)
ELSE
   pz0hsea(:)=pz0sea(:)
ENDIF
!
IF (.NOT.ohandle_sic ) THEN 
   WHERE (psst(:) < ptt)
      pz0hsea(:) = xz0hsn
   END WHERE
ENDIF
!
!       2.3    Drag coefficient
!              ----------------
!
IF (ldrag_coef_arp) THEN
 
  CALL surface_cdch_1darp(pzref, pz0sea, pz0hsea, zvmod, pta, psst, &
                          pqa, pqsat, pcd, pcdn, pch                )  

  zra(:) = 1. / ( pch(:) * zvmod(:) )
!
ELSE
!
  CALL surface_cd(pri, pzref, puref, pz0sea, pz0hsea, pcd, pcdn)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!       3.     Calculate u* and the roughness length over the ocean
!              ----------------------------------------------------
!
!                              According to Charnock's expression...
!
zustar2(:) = pcd(:)*zvmod(:)*zvmod(:)
!
pz0sea(:) = zcharn(:) * zustar2(:) / xg + xvz0cm * pcd(:) / pcdn(:)
!
IF (lvziustar0_arp .AND. xvziustar0>0.) THEN
    pz0hsea(:)=pz0sea(:)*exp(-sqrt(zustar2(:))*xvziustar0)
ELSE
    pz0hsea(:)=pz0sea(:)
ENDIF
!
IF (.NOT.ohandle_sic ) THEN 
   WHERE (psst(:) < ptt)
          pz0sea(:) = xz0sn
   END WHERE
ENDIF
!
!-------------------------------------------------------------------------------
!
!       4.     Drag coefficient for heat and aerodynamical resistance
!              -------------------------------------------------------
!
IF (.NOT.ldrag_coef_arp) THEN
   CALL surface_aero_cond(pri, pzref, puref, zvmod, pz0sea, pz0hsea, zac, zra, pch)
ENDIF
!
IF (lrrgust_arp) THEN
  zfp(:)=max(0.0,prr(:)+prs(:))
  zrrcor(:)=sqrt(1.0+((((zfp(:)/(zfp(:)+xrrscale))**xrrgamma)*xutilgust)**2) &
      /(pcd(:)*zvmod(:)**2))  

  pcd  = pcd*zrrcor
  pch  = pch*zrrcor
  pcdn = pcdn*zrrcor
ENDIF
!
presa(:) = zra(:)
!
!-------------------------------------------------------------------------------
!
!       5.     The fluxes
!              ----------
!
psfth(:) =  xcpd * prhoa(:) * pch(:) * zvmod(:) * ( psst(:) -pta(:) * pexns(:) / pexna(:) ) / pexns(:)
psftq(:) =  prhoa(:) * pch(:) * zvmod(:) * ( pqsat(:)-pqa(:) )
pustar(:) = sqrt(zustar2(:))
!
IF (lhook) CALL dr_hook('WATER_FLUX',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE water_flux