coupling_icefluxn.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 coupling_iceflux_n(KI, PTA, PEXNA, PRHOA, PTICE, PEXNS,       &
                                pqa, prain, psnow, pwind, pzref, puref,  &
                                pps, ptwat, ptts, psfth, psftq,          &
                                ohandle_sic, pmask, pqsat, pz0,          &
                                pustar, pcd, pcdn, pch,                  &
                                pri, presa, pz0h )
!     #######################################################################
!
!!****  *COUPLING_ICEFLUX_n * - Driver of the ICE_FLUX scheme   
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     B. DECHARME 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    02/2010
!!      S.Senesi    01/2014 Add numerous optional output fields (transfer 
!!                           coeff, qsat...). Optionnaly use seaice cover
!!---------------------------------------------------------------------
!
USE modd_surf_par,   ONLY : xundef
!
USE modi_ice_sea_flux
! 
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
INTEGER,             INTENT(IN)  :: ki        ! number of points
!
REAL, DIMENSION(KI), INTENT(IN)  :: pta       ! air temperature forcing               (K)
REAL, DIMENSION(KI), INTENT(IN)  :: pexna     ! Exner function at atm. level
REAL, DIMENSION(KI), INTENT(IN)  :: prhoa     ! air density                           (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: ptice     ! Ice Surface Temperature
REAL, DIMENSION(KI), INTENT(IN)  :: pexns     ! Exner function at sea surface
REAL, DIMENSION(KI), INTENT(IN)  :: pqa       ! air humidity forcing                  (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: prain     ! liquid precipitation                  (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN)  :: psnow     ! snow precipitation                    (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN)  :: pwind     ! module of wind at atm. wind level
REAL, DIMENSION(KI), INTENT(IN)  :: pzref     ! atm. level for temp. and humidity
REAL, DIMENSION(KI), INTENT(IN)  :: puref     ! atm. level for wind
REAL, DIMENSION(KI), INTENT(IN)  :: pps       ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN)  :: ptwat     ! Sea surface temperature
REAL,                INTENT(IN)  :: ptts      ! Freezing point for sea water
REAL, DIMENSION(KI), INTENT(OUT) :: psfth     ! flux of heat                          (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: psftq     ! flux of water vapor                   (kg/m2/s)
!
LOGICAL, INTENT(IN) , OPTIONAL:: ohandle_sic  ! Should we output extended set of fields
REAL, DIMENSION(KI), INTENT(IN) , OPTIONAL :: pmask     ! Where to compute sea-ice fluxes (0./1.)  
!
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pqsat     ! humidity at saturation
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pz0       ! roughness length over the sea ice
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pustar    ! friction velocity (m/s)
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pcd       ! Drag coefficient
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pcdn      ! Neutral Drag coefficient
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pch       ! Heat transfer coefficient
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pri       ! Richardson number
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: presa     ! aerodynamical resistance
REAL, DIMENSION(KI), INTENT(OUT), OPTIONAL :: pz0h      ! heat roughness length over ice
!
!*      0.2    declarations of local variables
!
INTEGER, DIMENSION(KI)           :: imask
LOGICAL                          :: ghandle_sic
INTEGER                          :: jj, isize
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
! Preliminaries:
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COUPLING_ICEFLUX_N',0,zhook_handle)
psfth(:)=0.0
psftq(:)=0.0
IF (present(ohandle_sic)) THEN 
   ghandle_sic=ohandle_sic
ELSE
   ghandle_sic=.false.
ENDIF
!
imask(:)=0
isize   =0
DO jj=1,ki
   IF (ghandle_sic) THEN 
      IF(pmask(jj)>0.)THEN
         isize=isize+1
         imask(isize)=jj
      ENDIF
   ELSE
      IF(ptwat(jj)<ptts+10.)THEN
         isize=isize+1
         imask(isize)=jj
      ENDIF
   ENDIF
ENDDO
!
IF(isize==0)THEN
  IF (lhook) CALL dr_hook('COUPLING_ICEFLUX_N',1,zhook_handle)
  RETURN
ENDIF
!
 CALL treat_ice(isize,imask)
!
!=======================================================================================
!
IF (lhook) CALL dr_hook('COUPLING_ICEFLUX_N',1,zhook_handle)
 CONTAINS
!
!=======================================================================================
SUBROUTINE treat_ice(KSIZE,KMASK)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: ksize
INTEGER, INTENT(IN), DIMENSION(:) :: kmask
!
REAL, DIMENSION(KSIZE)  :: zta       ! air temperature forcing               (K)
REAL, DIMENSION(KSIZE)  :: zexna     ! Exner function at atm. level
REAL, DIMENSION(KSIZE)  :: zrhoa     ! air density                           (kg/m3)
REAL, DIMENSION(KSIZE)  :: ztice     ! Ice Surface Temperature
REAL, DIMENSION(KSIZE)  :: zexns     ! Exner function at sea surface
REAL, DIMENSION(KSIZE)  :: zqa       ! air humidity forcing                  (kg/m3)
REAL, DIMENSION(KSIZE)  :: zrr       ! liquid precipitation                  (kg/m2/s)
REAL, DIMENSION(KSIZE)  :: zrs       ! snow precipitation                    (kg/m2/s)
REAL, DIMENSION(KSIZE)  :: zwind     ! module of wind at atm. wind level
REAL, DIMENSION(KSIZE)  :: zzref     ! atm. level for temp. and humidity
REAL, DIMENSION(KSIZE)  :: zuref     ! atm. level for wind
REAL, DIMENSION(KSIZE)  :: zps       ! pressure at atmospheric model surface (Pa)
!
REAL, DIMENSION(KSIZE)  :: zsfth     ! flux of heat                          (W/m2)
REAL, DIMENSION(KSIZE)  :: zsftq     ! flux of water vapor                   (kg/m2/s)

!        
REAL, DIMENSION(KSIZE)  :: zz0        ! roughness length over the sea ice
REAL, DIMENSION(KSIZE)  :: zqsat      ! humidity at saturation
REAL, DIMENSION(KSIZE)  :: zustar     ! friction velocity (m/s)
REAL, DIMENSION(KSIZE)  :: zcd        ! Drag coefficient
REAL, DIMENSION(KSIZE)  :: zcdn       ! Neutral Drag coefficient
REAL, DIMENSION(KSIZE)  :: zch        ! Heat transfer coefficient
REAL, DIMENSION(KSIZE)  :: zri        ! Richardson number
REAL, DIMENSION(KSIZE)  :: zresa      ! aerodynamical resistance
REAL, DIMENSION(KSIZE)  :: zz0h       ! heat roughness length over ice
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('COUPLING_ICEFLUX_N:TREAT_ICE',0,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
DO jj=1, SIZE(zta)
   zta(jj) = pta(kmask(jj))
   zexna(jj) = pexna(kmask(jj))
   zrhoa(jj) = prhoa(kmask(jj))
   ztice(jj) = ptice(kmask(jj))
   zexns(jj) = pexns(kmask(jj))
   zqa(jj) = pqa(kmask(jj))
   zrr(jj) = prain(kmask(jj))
   zrs(jj) = psnow(kmask(jj))
   zwind(jj) = pwind(kmask(jj))
   zzref(jj) = pzref(kmask(jj))
   zuref(jj) = puref(kmask(jj))
   zps(jj) = pps(kmask(jj))
END DO
!
! Local variables :
!
zz0(:) = xundef
zqsat(:) = xundef
zustar(:) = xundef
zcd(:) = xundef    
zcdn(:) = xundef
zch(:) = xundef
zri(:) = xundef
zresa(:) = xundef
zz0h(:) = xundef
zsfth(:) = xundef
zsftq(:) = xundef
!
!-------------------------------------------------------------------------------------
! Fluxes over ice according to Charnock formulae (or constant Cd)
!--------------------------------------------------------------------------------------
!
 CALL ice_sea_flux(zz0, zta, zexna, zrhoa, ztice, zexns,      &
                    zqa, zrr, zrs, zwind, zzref, zuref, zps,  &
                    zqsat, zsfth, zsftq, zustar, zcd, zcdn,   &
                    zch, zri, zresa, zz0h                     )  
!                
!-------------------------------------------------------------------------------------
! Outputs:
!-------------------------------------------------------------------------------------
!
DO jj=1, SIZE(zsfth)
   psfth(kmask(jj)) = zsfth(jj)
   psftq(kmask(jj)) = zsftq(jj)
   IF (ghandle_sic) THEN 
      pqsat(kmask(jj)) = zqsat(jj)
      pz0(kmask(jj)) = zz0(jj)
      pustar(kmask(jj)) = zustar(jj)
      pcd(kmask(jj)) = zcd(jj)
      pcdn(kmask(jj)) = zcdn(jj)
      pch(kmask(jj)) = zch(jj)
      pri(kmask(jj)) = zri(jj)
      presa(kmask(jj)) = zresa(jj)
      pz0h(kmask(jj)) = zz0h(jj)
   ENDIF
END DO
!
IF (lhook) CALL dr_hook('COUPLING_ICEFLUX_N:TREAT_ICE',1,zhook_handle)
!
END SUBROUTINE treat_ice
!
!==========================================================================================
!
END SUBROUTINE coupling_iceflux_n