cls_t.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_t( PTA, PQA, PPA, PPS, PHT,    &
                            pcd, pch, pri,              &
                            pts, pz0h, ph,         &
                            ptnm            )  
!     #####################################################################
!
!!****  *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)       :: pz0h   ! roughness length for heat
REAL, DIMENSION(:), INTENT(IN)       :: ph     ! height of diagnostic
!
REAL, DIMENSION(:), INTENT(OUT)      :: ptnm   ! temperature at n meters
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PTA)) :: zbnh,zbh,zrs
REAL, DIMENSION(SIZE(PTA)) :: zlogs,zcors,ziv
 CHARACTER(LEN=2)           :: yhumidity
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CLS_T',0,zhook_handle)
ptnm(:) = xundef
!
zbnh(:) = 0.
zbh(:) = 0.
zrs(:) = 0.
zlogs(:) = 0.
zcors(:) = 0.
ziv(:) = 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(:))
!
IF (lhook) CALL dr_hook('CLS_T',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE cls_t