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