minzs_vert_shift.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 minzs_vert_shift(PZS_MOY,PZS_MIN,PTA_2M,PQA_2M,PPA_2M,PRHOA_2M, &
                                   pta_2m_min,pqa_2m_min,ppa_2m_min,prhoa_2m_min  )  
!      #########################################
!
!
!!****   *MINZS_VERT_SHIFT* - routine to shift 2m variables to 2m variables 
!!                            above the minimum orography of the grid mesh
!!
!!
!!     PURPOSE
!!     -------
!
!!**   METHOD
!!     ------
!!
!!     Same method like in forcing_vert_shift.F90
!!
!!     EXTERNAL
!!     --------
!!
!!       NONE
!!
!!     IMPLICIT ARGUMENTS
!!     ------------------
!!
!!     REFERENCE
!!     ---------
!!
!!     AUTHOR
!!     ------
!!       B. Decharme
!! 
!!     MODIFICATIONS
!!     -------------
!!       Original        06/2013
!! ---------------------------------------------------------------------
!
!*       0. DECLARATIONS
!
USE modd_csts,    ONLY : xrd, xg, xrv
USE modd_atm_cst, ONLY : xclim_t_grad
!
USE mode_thermos
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
!*       0.1 declarations of arguments
!
REAL,    DIMENSION(:), INTENT(IN)  :: pzs_moy    ! mean orography of atmospheric grid
REAL,    DIMENSION(:), INTENT(IN)  :: pzs_min    ! min orography of atmospheric grid
REAL,    DIMENSION(:), INTENT(IN)  :: pta_2m     ! temperature at 2m
REAL,    DIMENSION(:), INTENT(IN)  :: pqa_2m     ! humidity    at 2m (kg/m3)
REAL,    DIMENSION(:), INTENT(IN)  :: ppa_2m     ! pressure    at 2m
REAL,    DIMENSION(:), INTENT(IN)  :: prhoa_2m   ! density     at 2m
!
REAL,    DIMENSION(:), INTENT(OUT) :: pta_2m_min    ! temperature at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: pqa_2m_min    ! humidity    at surface     altitude (kg/m3)
REAL,    DIMENSION(:), INTENT(OUT) :: ppa_2m_min    ! pressure    at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: prhoa_2m_min  ! density     at surface     altitude
!
!*       0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PQA_2M  )) :: zqa_2m       ! air humidity (kg/kg)
REAL, DIMENSION(SIZE(PQA_2M  )) :: zqa_2m_min   ! air humidity (kg/kg)
REAL, DIMENSION(SIZE(PRHOA_2M)) :: zrhoa_2m     ! approximated density
REAL, DIMENSION(SIZE(PRHOA_2M)) :: zrhoa_2m_min ! approximated density
!
REAL(KIND=JPRB) :: zhook_handle
!
! ---------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MINZS_VERT_SHIFT',0,zhook_handle)
!
zqa_2m = pqa_2m / prhoa_2m
!
!*       1.  climatological gradient for temperature
!            ---------------------------------------
!
pta_2m_min = pta_2m + xclim_t_grad * (pzs_min - pzs_moy)
!
!-------------------------------------------------------------------------------
!
!*       2.  hydrostatism for pressure
!            -------------------------
!
ppa_2m_min = ppa_2m * exp( - xg/xrd/(0.5*(pta_2m+pta_2m_min)*( 1.+((xrv/xrd)-1.)*zqa_2m(:) )) &
                              * (pzs_min-pzs_moy)                                              )  
!
!-------------------------------------------------------------------------------
!
!*       3.  conservation of relative humidity for humidity
!            ----------------------------------------------
!
zqa_2m_min = zqa_2m / qsat(pta_2m, ppa_2m) * qsat(pta_2m_min,ppa_2m_min)
!
!-------------------------------------------------------------------------------
!
!*       4.  estimation of air density from temperature and humidity
!            -------------------------------------------------------
!
zrhoa_2m(:) = ppa_2m(:) / xrd /  pta_2m(:) / ( 1.+((xrv/xrd)-1.)*zqa_2m(:) )
zrhoa_2m_min(:) = ppa_2m_min(:) / xrd /  pta_2m_min(:) / ( 1.+((xrv/xrd)-1.)*zqa_2m_min(:) )
!
prhoa_2m_min(:) = prhoa_2m(:) * zrhoa_2m_min(:) / zrhoa_2m(:)
!
!-------------------------------------------------------------------------------
!
!*       5.  new humidity in kg/m3
!            ---------------------
!
pqa_2m_min = zqa_2m_min * prhoa_2m_min
!
IF (lhook) CALL dr_hook('MINZS_VERT_SHIFT',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE minzs_vert_shift