ice_sea_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 ice_sea_flux(PZ0ICE,                                       &
                              pta, pexna, prhoa, ptice, pexns, pqa, prr, prs, &
                              pvmod, pzref, puref,                            &
                              pps, pqsat,                                     &
                              psfth, psftq, pustar,                           &
                              pcd, pcdn, pch, pri, presa, pz0hice             )  
!     #######################################################################
!
!
!!****  *ICE_SEA_FLUX*  
!!
!!    PURPOSE
!!    -------
!      Calculate the surface fluxes of heat, moisture, and momentum over
!       sea ice. adapted from WATER_FLUX  
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!    XCD_ICE_CST, from MODD_SEAFLUX
!!
!!      
!!    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) 09/02/06  Z0H as output
!!      B. Decharme    06/2009  limitation of Ri
!!      Modified       09/2009  B. Decharme: limitation of Ri in surface_ri.F90
!!      S.Senesi       01/2014  use XCD_ICE_CST (if /= 0) as value for for Cd, Cdn and Ch
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_csts,       ONLY : xg, xcpd
USE modd_surf_par,   ONLY : xundef
USE modd_surf_atm,   ONLY : ldrag_coef_arp, lrrgust_arp, xrrscale, &
                            xrrgamma, xutilgust     
USE modd_snow_par,   ONLY : xz0sn, xz0hsn
USE modn_seaflux_n,  ONLY : xcd_ice_cst
!
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 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)       :: ptice ! Sea ice Surface Temperature
REAL, DIMENSION(:), INTENT(IN)       :: pexns ! Exner function at sea surface
REAL, DIMENSION(:), INTENT(IN)       :: pps   ! air pressure at sea surface
REAL, DIMENSION(:), INTENT(IN)       :: prr   ! rain rate
REAL, DIMENSION(:), INTENT(IN)       :: prs   ! snow rate
!
REAL, DIMENSION(:), INTENT(INOUT)    :: pz0ice! roughness length over the sea ice
!                                         
!                                         
!  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   ! momentum drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: pcdn  ! neutral momentum drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: pch   ! heat drag coefficient
REAL, DIMENSION(:), INTENT(OUT)      :: pri   ! Richardson number
REAL, DIMENSION(:), INTENT(OUT)      :: presa     ! aerodynamical resistance
REAL, DIMENSION(:), INTENT(OUT)      :: pz0hice    ! heat roughness length
!
!
!*      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 od CD, CH, CDN due to moist-gustiness
REAL(KIND=JPRB) :: zhook_handle

!
!-------------------------------------------------------------------------------
!
!       1.     Initializations
!              ---------------
!
IF (lhook) CALL dr_hook('ICE_SEA_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(ptice(:),pps(:))
!
!-------------------------------------------------------------------------------
!
!       2.     Calculate the drag coefficient for momentum (PCD)
!              -------------------------------------------------
!
!       2.1    Richardson number
!              -----------------
!

 CALL surface_ri(ptice,pqsat,pexns,pexna,pta,pqa, &
                  pzref, puref, zdircoszw,pvmod,pri)
!                  
!
!       2.2    Z0 for  sea ice
!              --------------------
!
pz0hice(:) = xz0hsn
!
pz0ice(:) = xz0sn
!
!-------------------------------------------------------------------------------
!
!       3.     Drag coefficient for heat and aerodynamical resistance
!              ----------------
!
zvmod(:)=wind_threshold(pvmod(:),puref(:))
!
IF ( xcd_ice_cst == 0.0 ) THEN 
!
  IF (ldrag_coef_arp) THEN
!
     CALL surface_cdch_1darp(pzref, pz0ice, pz0hice , zvmod, pta, ptice, &
                             pqa, pqsat, pcd, pcdn, pch                 )  
!
     zra(:) = 1. / ( pch(:) * zvmod(:) )
!
  ELSE

     CALL surface_cd(pri, pzref, puref, pz0ice, pz0hice, pcd, pcdn)
!
     CALL surface_aero_cond(pri, pzref, puref, zvmod, pz0ice, pz0hice, zac, zra, pch)
!
  ENDIF
!
ELSE
!
! Using variable transfer coefficients is not appropriate on seaice 
! with simple bulk functions.
! A constant value (e.g. 1.5.e-3 ) is preferable, and used except if the  
! user request backward compatibility by setting XCD_ICE_CST to 0 (DEFAULT). 
!
   pcd(:)=xcd_ice_cst
   pcdn(:)=xcd_ice_cst
   pch(:)=xcd_ice_cst
   zra(:)=1./(pch(:)*zvmod(:))
!
ENDIF
!
zustar2(:) = pcd(:)*zvmod(:)*zvmod(:)
!
presa(:) = zra(:)
!
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
!
!-------------------------------------------------------------------------------
!
!       4.     The fluxes
!              ----------
!
psfth(:) =  xcpd * prhoa(:) * pch(:) * zvmod(:) * ( ptice(:) -pta(:) * pexns(:) / pexna(:) ) / pexns(:)
! Using Heat transfer coefficient CH for vapor transfer coefficient CE !
psftq(:) =  prhoa(:) * pch(:) * zvmod(:) * ( pqsat(:)-pqa(:) )
pustar(:) = sqrt(zustar2(:))
!
IF (lhook) CALL dr_hook('ICE_SEA_FLUX',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ice_sea_flux