forcing_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 forcing_vert_shift(PZS_ATM,PZS_SURF,PTA_ATM,PQA_ATM,PPA_ATM, &
                                     prhoa_atm,plw_atm,prain_atm,psnow_atm,    &
                                     pta_surf,pqa_surf,ppa_surf,prhoa_surf,    &
                                     plw_surf,prain_surf,psnow_surf            )  
!      #########################################
!
!
!!****   *FORCING_VERT_SHIFT* - routine to shift atmospheric forcing to another altitude
!!
!!
!!     PURPOSE
!!     -------
!
!!**   METHOD
!!     ------
!!                      
!!     EXTERNAL
!!     --------
!!
!!       NONE
!!
!!     IMPLICIT ARGUMENTS
!!     ------------------
!!
!!     REFERENCE
!!     ---------
!!
!!     AUTHOR
!!     ------
!!       V. Masson
!! 
!!     MODIFICATIONS
!!     -------------
!!       Original        07/2003
!!       B. Decharme     06/2013 bug : qa_surf must be <= qsat_surf 
!!                               add longwave raditions and rain snow partition
!! ---------------------------------------------------------------------
!
!*       0. DECLARATIONS
!
USE modd_csts,      ONLY : xrd, xg, xrv, xtt
USE modd_atm_cst,   ONLY : xclim_t_grad
USE modd_surf_atm,  ONLY : lvshift_lw, lvshift_prcp
!
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_atm     ! orography of atmospheric grid
REAL,    DIMENSION(:), INTENT(IN)  :: pzs_surf    ! orography of surface     grid
REAL,    DIMENSION(:), INTENT(IN)  :: pta_atm     ! temperature at atmospheric altitude
REAL,    DIMENSION(:), INTENT(IN)  :: pqa_atm     ! humidity    at atmospheric altitude (kg/m3)
REAL,    DIMENSION(:), INTENT(IN)  :: ppa_atm     ! pressure    at atmospheric altitude
REAL,    DIMENSION(:), INTENT(IN)  :: prhoa_atm   ! density     at atmospheric altitude
REAL,    DIMENSION(:), INTENT(IN)  :: plw_atm     ! lw rad      at atmospheric altitude
REAL,    DIMENSION(:), INTENT(IN)  :: prain_atm   ! rainfall    at atmospheric altitude
REAL,    DIMENSION(:), INTENT(IN)  :: psnow_atm   ! snowfall    at atmospheric altitude
!
REAL,    DIMENSION(:), INTENT(OUT) :: pta_surf    ! temperature at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: pqa_surf    ! humidity    at surface     altitude (kg/m3)
REAL,    DIMENSION(:), INTENT(OUT) :: ppa_surf    ! pressure    at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: prhoa_surf  ! density     at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: plw_surf    ! lw rad      at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: prain_surf  ! rainfall    at surface     altitude
REAL,    DIMENSION(:), INTENT(OUT) :: psnow_surf  ! snowfall    at surface     altitude
!
!*       0.2 declarations of local variables
!
REAL, PARAMETER                  :: zvapcoef  = 0.622
REAL, PARAMETER                  :: zemiscoef = 1.08
REAL, PARAMETER                  :: ztempcoef = 2016.0
!
REAL, DIMENSION(SIZE(PQA_ATM  )) :: zqa_atm    ! air humidity (kg/kg)
REAL, DIMENSION(SIZE(PQA_ATM  )) :: zqa_surf   ! air humidity (kg/kg)
REAL, DIMENSION(SIZE(PQA_ATM  )) :: zqsat_atm  ! air humidity at saturation (kg/kg)
REAL, DIMENSION(SIZE(PQA_ATM  )) :: zqsat_surf ! air humidity at saturation (kg/kg)
REAL, DIMENSION(SIZE(PRHOA_ATM)) :: zrhoa_atm  ! approximated density
REAL, DIMENSION(SIZE(PRHOA_ATM)) :: zrhoa_surf ! approximated density
!
REAL, DIMENSION(SIZE(PLW_ATM  )) :: zvap_atm   ! approximated vapour pressure
REAL, DIMENSION(SIZE(PLW_ATM  )) :: zvap_surf  ! approximated vapour pressure
REAL, DIMENSION(SIZE(PLW_ATM  )) :: zemis_atm  ! approximated emissivity
REAL, DIMENSION(SIZE(PLW_ATM  )) :: zemis_surf ! approximated emissivity
!
REAL(KIND=JPRB) :: zhook_handle
!
! ---------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('FORCING_VERT_SHIFT',0,zhook_handle)
!
!*       1.  climatological gradient for temperature
!            ---------------------------------------
!
pta_surf(:) = pta_atm(:) + xclim_t_grad * (pzs_surf(:) - pzs_atm(:))
!
!-------------------------------------------------------------------------------
!
!*       2.  hydrostatism for pressure
!            -------------------------
!
zqsat_atm(:) = qsat(pta_atm(:),ppa_atm(:))
!
zqa_atm(:) = min(pqa_atm(:)/prhoa_atm(:),zqsat_atm(:))
!
ppa_surf(:) = ppa_atm(:) * exp( - xg/xrd/(0.5*(pta_atm(:)+pta_surf(:))*(1.+((xrv/xrd)-1.)*zqa_atm(:))) &
                              * (pzs_surf(:)-pzs_atm(:))                                              )  
!
!-------------------------------------------------------------------------------
!
!*       3.  conservation of relative humidity for humidity
!            ----------------------------------------------
!
!
zqsat_surf(:) = qsat(pta_surf(:),ppa_surf(:))
!
zqa_surf(:) = min(zqa_atm(:)*zqsat_surf(:)/zqsat_atm(:),zqsat_surf(:))
!
!-------------------------------------------------------------------------------
!
!*       4.  estimation of air density from temperature and humidity
!            -------------------------------------------------------
!
zrhoa_atm(:) = ppa_atm(:) / xrd /  pta_atm(:) / ( 1.+((xrv/xrd)-1.)*zqa_atm(:) )
zrhoa_surf(:) = ppa_surf(:) / xrd /  pta_surf(:) / ( 1.+((xrv/xrd)-1.)*zqa_surf(:) )
!
prhoa_surf(:) = prhoa_atm(:) * zrhoa_surf(:) / zrhoa_atm(:)
!
!-------------------------------------------------------------------------------
!
!*       5.  new humidity in kg/m3
!            ---------------------
!
pqa_surf(:) = zqa_surf(:) * prhoa_surf(:)
!
!-------------------------------------------------------------------------------
!
!*       6.  new longwave radiations
!            -----------------------
!
IF(lvshift_lw)THEN
!        
! Vapour pressures and emissivities (Cosgrove et al., JGR, 2003)
!
  zvap_atm(:) = zqa_atm(:) * ppa_atm(:)  / zvapcoef
  zvap_surf(:) = zqa_surf(:) * ppa_surf(:) / zvapcoef
!
  zvap_atm(:) = exp(log(zvap_atm(:))*(pta_atm(:)/ztempcoef))
  zvap_surf(:) = exp(log(zvap_surf(:))*(pta_surf(:)/ztempcoef))
!
  zemis_atm(:) = (1.0-exp(zvap_atm(:)))
  zemis_surf(:) = (1.0-exp(zvap_surf(:)))
!
! Radiations
!
  plw_surf(:) = plw_atm(:) * (zemis_surf(:)/zemis_atm(:)) * (pta_surf(:)/pta_atm(:))**4
!
ELSE
!
  plw_surf(:) = plw_atm(:)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       7.  new rain/snow partition
!            -----------------------
!
IF(lvshift_prcp)THEN
!
  WHERE(pta_surf(:)>=xtt+1.0)
        prain_surf(:) = prain_atm(:) + psnow_atm(:)
        psnow_surf(:) = 0.0
  ELSEWHERE
        prain_surf(:) = 0.0
        psnow_surf(:) = prain_atm(:) + psnow_atm(:)
  ENDWHERE
!
ELSE
!
  prain_surf(:) = prain_atm(:)
  psnow_surf(:) = psnow_atm(:)
!
ENDIF
!
IF (lhook) CALL dr_hook('FORCING_VERT_SHIFT',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE forcing_vert_shift