cls_tq.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 cls_tq( PTA, PQA, PPA, PPS, PHT,    &
                            pcd, pch, pri,              &
                            pts, phu, pz0h, ph,         &
                            ptnm, pqnm, phunm           )  
!     #####################################################################
!
!!****  *PARAMCLS*  
!!
!!    PURPOSE
!!    -------
!
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    USE MODD_CST
!!    USE MODD_GROUND_PAR
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original    26/10/98
!!      S. Riette   06/2009 CLS_2M becomes CLS_TQ, height now is an argument
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_csts,     ONLY : xg, xcpd, xkarman
USE modd_surf_par, ONLY : xundef
!
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    ! atmospheric temperature
REAL, DIMENSION(:), INTENT(IN)       :: pqa    ! atmospheric humidity (kg/kg)
REAL, DIMENSION(:), INTENT(IN)       :: ppa    ! atmospheric level pressure
REAL, DIMENSION(:), INTENT(IN)       :: pps    ! surface pressure
REAL, DIMENSION(:), INTENT(IN)       :: pht    ! atmospheric level height (temp)
REAL, DIMENSION(:), INTENT(IN)       :: pcd    ! drag coefficient for momentum
REAL, DIMENSION(:), INTENT(IN)       :: pch    ! drag coefficient for heat
REAL, DIMENSION(:), INTENT(IN)       :: pri    ! Richardson number
REAL, DIMENSION(:), INTENT(IN)       :: pts    ! surface temperature
REAL, DIMENSION(:), INTENT(IN)       :: phu    ! near-surface humidity (%)
REAL, DIMENSION(:), INTENT(IN)       :: pz0h   ! roughness length for heat
REAL, DIMENSION(:), INTENT(IN)       :: ph     ! height of diagnostic
!
REAL, DIMENSION(:), INTENT(OUT)      :: ptnm   ! temperature at n meters
REAL, DIMENSION(:), INTENT(OUT)      :: pqnm   ! specific humidity at n meters
REAL, DIMENSION(:), INTENT(OUT)      :: phunm  ! relative humidity at n meters
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PTA)) :: zbnh,zbh,zrs
REAL, DIMENSION(SIZE(PTA)) :: zlogs,zcors,ziv
REAL, DIMENSION(SIZE(PTA)) :: zqsata, zhua
REAL, DIMENSION(SIZE(PTA)) :: zqsatnm, zpnm, zqs, zqsats
 CHARACTER(LEN=2)           :: yhumidity
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CLS_TQ',0,zhook_handle)
ptnm(:) = xundef
pqnm(:)  = xundef
phunm(:) = xundef
!
zbnh(:) = 0.
zbh(:) = 0.
zrs(:) = 0.
zlogs(:) = 0.
zcors(:) = 0.
ziv(:) = 0.
zqsata(:) = 0.
zhua(:) = 0.
zqsats(:) = 0.
zpnm(:) = 0.
zqsatnm(:) = 0.
zqs(:) = 0.
!
!*      1.     preparatory calculations
!              ------------------------
!
zbnh(:)=log( pht(:)/pz0h(:))
!
zbh(:)=xkarman*sqrt( pcd(:) )/pch(:) 
!
zrs(:)=min(ph/pht(:),1.)
!
zlogs(:)=log(1.+zrs(:)*(exp(zbnh(:)) -1.))
!
!*      2.     Stability effects
!              -----------------
!
WHERE (pri(:)>=0.)
  zcors(:)=zrs(:)*(zbnh(:)-zbh(:))
END WHERE
!
WHERE (pri(:)< 0.)
  zcors(:)=log(1.+zrs(:)*(exp(max(0.,zbnh(:)-zbh(:)))-1.))
END WHERE
!
!*      3.     Interpolation of thermodynamical variables
!              ------------------------------------------
!
ziv=max(0.,min(1.,(zlogs(:)-zcors(:))/zbh(:)))
ptnm(:)=pts(:)+ziv(:)*(pta(:)-pts(:))
!
!*      4.     Interpolation of relative humidity
!              ----------------------------------
!
!* choice of interpolated variable
!
yhumidity='Q '
!
zpnm(:) = pps(:) + ph/pht(:) * (ppa(:)-pps(:))
zqsatnm(:) = qsat(ptnm(:),zpnm(:))
!
IF (yhumidity=='Q ') THEN
!        
  zqsats(:) = qsat(pts(:),pps(:))
  zqs(:)    = phu(:)*zqsats(:)
  pqnm(:)   = zqs(:)+ziv(:)*(pqa(:)-zqs(:))
  pqnm(:)   = min(zqsatnm(:),pqnm(:)) !must be below saturation
  phunm(:)  = pqnm(:) / zqsatnm(:)
!
ELSE IF (yhumidity=='HU') THEN
!        
  zqsata(:) = qsat(pta(:),ppa(:))
  zhua(:)   = pqa(:) / zqsata(:)
  phunm(:)  = phu(:)+ziv(:)*(zhua(:)-phu(:))
  pqnm(:)   = phunm(:) * zqsatnm(:)
!
END IF
IF (lhook) CALL dr_hook('CLS_TQ',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE cls_tq