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