surface_cdch_1darp.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 surface_cdch_1darp (PZREF, PZ0EFF, PZ0H, PVMOD, PTA, PTG, &
                                 pqa, pqs, pcd, pcdn, pch              )    
!   ###################################################################
!     Purpose :
!     ------

!     - CALCUL DES COEFFICIENTS D'ECHANGE TURBULENT Cd ET Ch
!       DE LA MEME FACON QU'ARPEGE. (cf ACHMT)

!-----------------------------------------------------------------------
!     -------
!     Auteur.
!     -------
!  Dec 2007 : M. Jidane      * MAROC METEO *
!
!-----------------------------------------------------------------------

! -   ARGUMENTS D'ENTREE.
!     -------------------
! PZ0EFF     : LA LONGUEUR DE RUGOSITE COURANTE.
! PZ0H       : LONGUEUR DE RUGOSITE THERMIQUE COURANTE
! PTA        : TEMPERATURE.
! PTG        : TEMPERATURE DE SURFACE.
! PQA        : specific humidity
! PQS        : humidity at surface

!-----------------------------------------------------------------------

! -   ARGUMENTS DE SORTIE.
!     --------------------
! PCD        : COEFFICIENT D'ECHANGE EN SURFACE POUR U ET V.
! PCDN       : COEFFICIENT NEUTRE D'ECHANGE EN SURFACE.
! PCH        : COEFFICIENT D'ECHANGE EN SURFACE POUR T ET Q

USE modd_csts,        ONLY : xg, xrd, xrv, xcpd, xkarman
USE modd_surf_atm,    ONLY : xedb, xedc, xedd, xedk, xusuric, xusurid, xusuricl

!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE

REAL, DIMENSION(:), INTENT(IN)  :: pzref
REAL, DIMENSION(:), INTENT(IN)  :: pz0eff
REAL, DIMENSION(:), INTENT(IN)  :: pz0h
REAL, DIMENSION(:), INTENT(IN)  :: pvmod
REAL, DIMENSION(:), INTENT(IN)  :: pta
REAL, DIMENSION(:), INTENT(IN)  :: ptg
REAL, DIMENSION(:), INTENT(IN)  :: pqa
REAL, DIMENSION(:), INTENT(IN)  :: pqs
REAL, DIMENSION(:), INTENT(OUT) :: pcd
REAL, DIMENSION(:), INTENT(OUT) :: pcdn
REAL, DIMENSION(:), INTENT(OUT) :: pch

INTEGER         :: jlon

REAL, DIMENSION(0:3,1:4) :: gcz0h

REAL, DIMENSION(SIZE(PTA))     :: zstab
!                         ZSTAB : INDICE DE STABILITE A LA SURFACE.
REAL, DIMENSION(SIZE(PTA))     :: zcdnh, zrti, zu

REAL :: zr, zrs
!                         ZR  : CONSTANTE DES GAZ POUR L'AIR.
!                         ZRS : CONSTANTE DES GAZ POUR L'AIR AU SOL.

REAL :: z2b, z3b, z3bc, zcd, zcd0, zch, zch0, zcis, zdid, &
          zdih, zds, zloi, zlos, zmu, zpd, zph, zrzd, zrzh, &
          zusuric, zsta, zixp, zstah, zhs  
REAL(KIND=JPRB) :: zhook_handle

!*
!     ------------------------------------------------------------------
!     I - CONSTANTES AUXILIAIRES.
!  ISBA - roughness length
IF (lhook) CALL dr_hook('SURFACE_CDCH_1DARP',0,zhook_handle)
gcz0h(0,1)=7.5
gcz0h(1,1)=2.39037
gcz0h(2,1)=-.28583
gcz0h(3,1)=.01074
gcz0h(0,2)=0.5
gcz0h(1,2)=-.07028
gcz0h(2,2)=.01023
gcz0h(3,2)=-.00067
gcz0h(0,3)=5.0
gcz0h(1,3)=4.51268
gcz0h(2,3)=.34012
gcz0h(3,3)=-.05330
gcz0h(0,4)=0.5
gcz0h(1,4)=-.09421
gcz0h(2,4)=.01463
gcz0h(3,4)=-.00099


zusuric=xusuric*xusuricl

!*
!     ------------------------------------------------------------------
!     II - CALCUL DES PARAMETRES DERIVES ET CONSTANTE DE SECURITE (POUR
!     LE CARRE DU CISAILLEMENT DE VENT).

!          COMPUTATION OF DERIVED PARAMETERS AND SECURITY CONSTANT (FOR
!     THE SQUARE OF THE WIND SHEAR).

z2b=2.0*xedb
z3b=3.*xedb
z3bc=3.*xedb*xedc

!*
!     ------------------------------------------------------------------
!     IV - CALCUL DE L EPAISSEUR DE LA CLS (EN GEOPOTENTIEL).

!          COMPUTATION OF THE THICKNESS OF THE SBL (IN GEOPOTENTIAL).

! - TEMPORAIRE(S) 1D .

!*
!     ------------------------------------------------------------------
!     VI - CALCULS PROPREMENT DITS DES CARACTERISTIQUES DE SURFACE.

!          EFFECTIVE CALCULATIONS OF THE SURFACE CHARACTERISTICS.

IF(xusurid == 0.0) THEN
  zixp=1.0
ELSE
  zixp=3.
ENDIF

DO jlon=1, SIZE(pta)

  zr  = xrd + (xrv-xrd)*pqa(jlon)
  zrs = xrd + (xrv-xrd)*pqs(jlon)

!     CALCULS GEOMETRIQUES.
!     GEOMETRIC CALCULATIONS.

  zrzd=1.0+pzref(jlon)/pz0eff(jlon)
  pcdn(jlon)=(xkarman/log(zrzd))**2

!     CALCUL PRELIMINAIRES NECESSAIRES A LA DETERMINATION DES
!     COEFFICIENTS D'ECHANGE CD ET CH DANS LE CAS DE DEUX RUGOSITES
!     DYNAMIQUE Z0 ET THERMIQUE ZOH.

!     PRELIMINARY COMPUTATIONS NECESSARY FOR THE DETERMINATION OF
!     EXCHANGE COEFFICIENTS CD AND CH IN THE CASE OF TWO ROUGHNESS
!     LENGTHS Z0 DYNAMICAL AND ZOH THERMAL.

! - TEMPORAIRE(S) 1D .

! ZCDNH     : COEFFICIENT THERMIQUE NEUTRE D'ECHANGE EN SURFACE.
!           : NEUTRAL SURFACE THERMAL EXCHANGE COEFFICIENT.

  zrzh=1.0+pzref(jlon)/pz0h(jlon)
  zcdnh(jlon)=xkarman**2/(log(zrzh)*log(zrzd))
  zmu=log(pz0eff(jlon)/pz0h(jlon))
  zcd0=(gcz0h(0,1)+zmu*(gcz0h(1,1)+zmu*(gcz0h(2,1)+zmu &
        *gcz0h(3,1))))/(1.5*xedc)    
  zpd=(gcz0h(0,2)+zmu*(gcz0h(1,2)+zmu*(gcz0h(2,2)+zmu*gcz0h(3,2))))-0.5
  zch0=(gcz0h(0,3)+zmu*(gcz0h(1,3)+zmu*(gcz0h(2,3)+zmu*gcz0h(3,3))))/xedc
  zph=(gcz0h(0,4)+zmu*(gcz0h(1,4)+zmu*(gcz0h(2,4)+zmu*gcz0h(3,4))))-0.5
  zcd=zcd0*zrzd**zpd
  zch=zch0*zrzh**zph

!     CISAILLEMENT DE VENT.
!     WIND SHEAR.

! - TEMPORAIRE(S) 1D .

! ZU        : MODULE DU VENT DE SURFACE.
!           : SURFACE WIND SPEED.

  zcis=pvmod(jlon)**2
  zu(jlon)=pvmod(jlon)

!     CALCUL DE STABILITE.
!     STABILITY COMPUTATION.

! - TEMPORAIRE(S) 1D .

! ZRTI      : INVERSE DE R*T.
!           : INVERSE OF R*T.
! ZSTA      : APPROXIMATION DE DELTA(PHI)*DELTA(LN(THETA)).
!           : APPROXIMATION OF DELTA(PHI)*DELTA(LN(THETA)).

  zrti(jlon)=2.0/(zr*pta(jlon)+(xrd/xcpd)*xg*pzref(jlon)&
        +zrs*ptg(jlon))    
  zsta=xg*pzref(jlon)*(zr*pta(jlon)+(xrd/xcpd) &
        *xg*pzref(jlon)-zrs*ptg(jlon))*zrti(jlon)    
  zstah=zsta/(1.0+zixp*zusuric*max(0.0,zsta)/zcis)**(1.0/zixp)
  zsta=zsta/(1.0+zusuric*max(0.0,zsta)/zcis)
  zstab(jlon)=max(0.0,sign(1.0,zsta))

!     CALCULS COMMUNS POUR QUANTITE DE MOUVEMENT ET ENERGIE.
!     COMMON COMPUTATIONS FOR MOMENTUM AND ENERGY.

  zds=sqrt(zcis+xedd/xedk*abs(zsta))
  zhs=sqrt(zcis+xedd*xedk*abs(zstah))
  zdid=1.0/(zu(jlon)+zcd*z3bc*pcdn(jlon)*sqrt(abs(zsta)*zrzd))
  zdih=1.0/(zu(jlon)+zch*z3bc*zcdnh(jlon)*sqrt(abs(zsta)*zrzh))

!     CALCULS POUR LES COMPOSANTES DU VENT DE CD ET DE SON PRODUIT PAR
!     DENSITE FOIS MODULE DU VENT.
!     COMPUTATIONS FOR MOMENTUM OF CD AND OF ITS PRODUCT BY DENSITY
!     TIME WIND SPEED.

  zlos=zcis*zds/(zu(jlon)*zds+z2b*abs(zsta))
  zloi=zu(jlon)-z2b*zsta*zdid
  pcd(jlon)=(zloi+zstab(jlon)*(zlos-zloi))*pcdn(jlon)/zu(jlon)

!     IDEM POUR LA TEMPERATURE ET L'HUMIDITE.
!     THE SAME FOR TEMPERATURE AND HUMIDITY.

  zlos=zcis**2/(zu(jlon)*zcis+z3b*abs(zstah)*zhs)
  zloi=zu(jlon)-z3b*zsta*zdih
  pch(jlon)=(zloi+zstab(jlon)*(zlos-zloi))*zcdnh(jlon)/zu(jlon)

ENDDO
IF (lhook) CALL dr_hook('SURFACE_CDCH_1DARP',1,zhook_handle)

END SUBROUTINE surface_cdch_1darp