SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/forcing_vert

Go to the documentation of this file.
00001 !     #########
00002        SUBROUTINE FORCING_VERT_SHIFT(PZS_ATM,PZS_SURF,PTA_ATM,PQA_ATM,PPA_ATM,PRHOA_ATM, &
00003                                        PTA_SURF,PQA_SURF,PPA_SURF,PRHOA_SURF               )  
00004 !      #########################################
00005 !
00006 !
00007 !!****   *FORCING_VERT_SHIFT* - routine to shith atmospheric forcing to another altitude
00008 !!
00009 !!
00010 !!     PURPOSE
00011 !!     -------
00012 !
00013 !!**   METHOD
00014 !!     ------
00015 !!                      
00016 !!     EXTERNAL
00017 !!     --------
00018 !!
00019 !!       NONE
00020 !!
00021 !!     IMPLICIT ARGUMENTS
00022 !!     ------------------
00023 !!
00024 !!     REFERENCE
00025 !!     ---------
00026 !!
00027 !!     AUTHOR
00028 !!     ------
00029 !!       V. Masson
00030 !! 
00031 !!     MODIFICATIONS
00032 !!     -------------
00033 !!       Original        07/2003
00034 !! ---------------------------------------------------------------------
00035 !
00036 !*       0. DECLARATIONS
00037 !
00038 USE MODD_CSTS,    ONLY : XRD, XG, XRV
00039 USE MODD_ATM_CST, ONLY : XCLIM_T_GRAD
00040 !
00041 USE MODE_THERMOS
00042 !
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !
00050 !*       0.1 declarations of arguments
00051 !
00052 REAL,    DIMENSION(:), INTENT(IN)  :: PZS_ATM     ! orography of atmospheric grid
00053 REAL,    DIMENSION(:), INTENT(IN)  :: PZS_SURF    ! orography of surface     grid
00054 REAL,    DIMENSION(:), INTENT(IN)  :: PTA_ATM     ! temperature at atmospheric altitude
00055 REAL,    DIMENSION(:), INTENT(IN)  :: PQA_ATM     ! humidity    at atmospheric altitude (kg/m3)
00056 REAL,    DIMENSION(:), INTENT(IN)  :: PPA_ATM     ! pressure    at atmospheric altitude
00057 REAL,    DIMENSION(:), INTENT(IN)  :: PRHOA_ATM   ! density     at atmospheric altitude
00058 REAL,    DIMENSION(:), INTENT(OUT) :: PTA_SURF    ! temperature at surface     altitude
00059 REAL,    DIMENSION(:), INTENT(OUT) :: PQA_SURF    ! humidity    at surface     altitude (kg/m3)
00060 REAL,    DIMENSION(:), INTENT(OUT) :: PPA_SURF    ! pressure    at surface     altitude
00061 REAL,    DIMENSION(:), INTENT(OUT) :: PRHOA_SURF  ! density     at surface     altitude
00062 !
00063 !*       0.2 declarations of local variables
00064 !
00065 REAL, DIMENSION(SIZE(PQA_ATM  )) :: ZQA_ATM    ! air humidity (kg/kg)
00066 REAL, DIMENSION(SIZE(PQA_ATM  )) :: ZQA_SURF   ! air humidity (kg/kg)
00067 REAL, DIMENSION(SIZE(PRHOA_ATM)) :: ZRHOA_ATM  ! approximated density
00068 REAL, DIMENSION(SIZE(PRHOA_ATM)) :: ZRHOA_SURF ! approximated density
00069 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00070 !
00071 ! ---------------------------------------------------------------------------
00072 !
00073 IF (LHOOK) CALL DR_HOOK('FORCING_VERT_SHIFT',0,ZHOOK_HANDLE)
00074 ZQA_ATM = PQA_ATM / PRHOA_ATM
00075 !
00076 !*       1.  climatological gradient for temperature
00077 !            ---------------------------------------
00078 !
00079 PTA_SURF = PTA_ATM + XCLIM_T_GRAD * (PZS_SURF - PZS_ATM)
00080 !
00081 !-------------------------------------------------------------------------------
00082 !
00083 !*       2.  hydrostatism for pressure
00084 !            -------------------------
00085 !
00086 PPA_SURF = PPA_ATM * EXP ( - XG/XRD/(0.5*(PTA_ATM+PTA_SURF)*( 1.+((XRV/XRD)-1.)*ZQA_ATM(:) )) &
00087                               * (PZS_SURF-PZS_ATM)                                              )  
00088 !
00089 !-------------------------------------------------------------------------------
00090 !
00091 !*       3.  conservation of relative humidity for humidity
00092 !            ----------------------------------------------
00093 !
00094 ZQA_SURF = ZQA_ATM / QSAT(PTA_ATM, PPA_ATM) * QSAT(PTA_SURF,PPA_SURF)
00095 !
00096 !-------------------------------------------------------------------------------
00097 !
00098 !*       4.  estimation of air density from temperature and humidity
00099 !            -------------------------------------------------------
00100 !
00101 ZRHOA_ATM (:) = PPA_ATM (:) / XRD /  PTA_ATM (:) / ( 1.+((XRV/XRD)-1.)*ZQA_ATM (:) )
00102 ZRHOA_SURF(:) = PPA_SURF(:) / XRD /  PTA_SURF(:) / ( 1.+((XRV/XRD)-1.)*ZQA_SURF(:) )
00103 !
00104 PRHOA_SURF(:) = PRHOA_ATM(:) * ZRHOA_SURF(:) / ZRHOA_ATM (:)
00105 !
00106 !-------------------------------------------------------------------------------
00107 !
00108 !*       5.  new humidity in kg/m3
00109 !            ---------------------
00110 !
00111 PQA_SURF = ZQA_SURF * PRHOA_ATM
00112 IF (LHOOK) CALL DR_HOOK('FORCING_VERT_SHIFT',1,ZHOOK_HANDLE)
00113 !
00114 !-------------------------------------------------------------------------------
00115 !
00116 END SUBROUTINE FORCING_VERT_SHIFT