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