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