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

Go to the documentation of this file.
00001 !##################
00002 MODULE MODE_PSYCHRO
00003 !##################
00004 !
00005 !!****  *MODE_PSYCHRO* -
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !      
00010 !
00011 !!
00012 !!**  IMPLICIT ARGUMENTS
00013 !!    ------------------
00014 !!       NONE          
00015 !!
00016 !!    REFERENCE
00017 !!    ---------
00018 !!
00019 !!
00020 !!    AUTHOR
00021 !!    ------
00022 !!      
00023 !!
00024 !!    MODIFICATIONS
00025 !!    -------------
00026 !!      Original    12/04/11 
00027 !
00028 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00029 USE PARKIND1  ,ONLY : JPRB
00030 !
00031 interface PE_FROM_PQ
00032         module procedure PE_FROM_PQ_0D
00033         module procedure PE_FROM_PQ_1D
00034 end interface
00035 interface TD_FROM_TQ
00036         module procedure TD_FROM_TQ_0D
00037         module procedure TD_FROM_TQ_1D
00038 end interface
00039 interface RV_FROM_TPTWB
00040         module procedure RV_FROM_TPTWB_0D
00041         module procedure RV_FROM_TPTWB_1D
00042 end interface
00043 interface TWB_FROM_TPQ
00044         module procedure TWB_FROM_TPQ_0D
00045         module procedure TWB_FROM_TPQ_1D
00046 end interface
00047 INTERFACE ENTH_FN_T_Q
00048   MODULE PROCEDURE ENTH_FN_T_Q
00049 END INTERFACE
00050 INTERFACE Q_FN_T_ENTH
00051   MODULE PROCEDURE Q_FN_T_ENTH
00052 END INTERFACE
00053 
00054 contains
00055 !PE_FROM_PQ
00056 !----------
00057 function PE_FROM_PQ_0D(PP, PQ) RESULT(PE) 
00058 !arguments and result
00059 REAL, INTENT(IN) :: PP !atmos. pressure (Pa)
00060 REAL, INTENT(IN) :: PQ !specific humidity (kg/kg)
00061 REAL :: PE !water vapour pressure (Pa)
00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00063 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:PE_FROM_PQ_0D',0,ZHOOK_HANDLE)
00064 PE = PQ * PP /(0.622 + 0.378 * PQ)
00065 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:PE_FROM_PQ_0D',1,ZHOOK_HANDLE)
00066 end function PE_FROM_PQ_0D
00067 
00068 function PE_FROM_PQ_1D(PP, PQ) RESULT(PE) 
00069 !arguments and result
00070 REAL, DIMENSION(:), INTENT(IN) :: PP !atmos. pressure (Pa)
00071 REAL, DIMENSION(:), INTENT(IN) :: PQ !specific humidity (kg/kg)
00072 REAL, DIMENSION(SIZE(PQ))      :: PE !water vapour pressure (Pa)
00073 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00074 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:PE_FROM_PQ_1D',0,ZHOOK_HANDLE)
00075 PE(:) = PQ(:) * PP(:) /(0.622 + 0.378 * PQ(:))
00076 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:PE_FROM_PQ_1D',1,ZHOOK_HANDLE)
00077 end function PE_FROM_PQ_1D
00078 !-------------------------
00079 
00080 !TD_FROM_TQ
00081 function TD_FROM_TQ_0D(PT, PQ) RESULT(PTD)
00082 USE MODD_CSTS
00083 USE MODD_SURF_PAR, ONLY: XUNDEF
00084 !arguments and result
00085 REAL, INTENT(IN) :: PT !Air Temp. (K)
00086 REAL, INTENT(IN) :: PQ !Specific humidity (kg/kg)
00087 REAL :: PTD !Dew Point Air Temp. (K)
00088 !local variables
00089 REAL :: ALPHA
00090 REAL :: ZPE !water vapour pressure
00091 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00092 
00093 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TD_FROM_TQ_0D',0,ZHOOK_HANDLE)
00094 ZPE = PE_FROM_PQ(PT, PQ)
00095 ALPHA = LOG(ZPE/1000.)
00096 IF (PT .GE. XTT .AND. PT .GE. 93.+XTT) THEN
00097         PTD = XTT+6.54+14.526*ALPHA+0.7389*ALPHA*ALPHA+0.09486*ALPHA**3 &
00098               +0.4569*(ZPE/1000.)**0.1984
00099 ELSE IF (PT .LT. XTT) THEN
00100         PTD = XTT+6.09+12.608*ALPHA+0.4959*ALPHA*ALPHA
00101 ELSE
00102         PTD = XUNDEF
00103 ENDIF
00104 PTD = MIN(PTD, PT)
00105 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TD_FROM_TQ_0D',1,ZHOOK_HANDLE)
00106 end function TD_FROM_TQ_0D
00107 
00108 function TD_FROM_TQ_1D(PT, PQ) RESULT(PTD)
00109 USE MODD_CSTS
00110 USE MODD_SURF_PAR, ONLY: XUNDEF
00111 !arguments and result
00112 REAL, DIMENSION(:), INTENT(IN) :: PT !Air Temp. (K)
00113 REAL, DIMENSION(:), INTENT(IN) :: PQ !Specific humidity (kg/kg)
00114 REAL, DIMENSION(SIZE(PQ))      :: PTD !Dew Point Air Temp. (K)
00115 !local variables
00116 REAL, DIMENSION(SIZE(PQ)) :: ALPHA
00117 REAL, DIMENSION(SIZE(PQ)) :: ZPE !water vapour pressure
00118 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00119 
00120 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TD_FROM_TQ_1D',0,ZHOOK_HANDLE)
00121 ZPE = PE_FROM_PQ(PT, PQ)
00122 ALPHA(:) = LOG(ZPE(:)/1000.)
00123 WHERE (PT .GE. XTT .AND. PT .GE. 93.+XTT)
00124         PTD = XTT+6.54+14.526*ALPHA+0.7389*ALPHA*ALPHA+0.09486*ALPHA**3 &
00125               +0.4569*(ZPE/1000.)**0.1984
00126       ELSE WHERE (PT .LT. XTT)
00127         PTD = XTT+6.09+12.608*ALPHA+0.4959*ALPHA*ALPHA
00128 ELSE WHERE
00129         PTD = XUNDEF
00130 END WHERE
00131 PTD(:) = MIN(PTD(:), PT(:))
00132 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TD_FROM_TQ_1D',1,ZHOOK_HANDLE)
00133 end function TD_FROM_TQ_1D
00134 !-------------------------
00135 
00136 !RV_FROM_TPTWB
00137 function RV_FROM_TPTWB_0D(PT, PP, PTWB) RESULT(PRV)
00138 USE MODE_THERMOS
00139 USE MODD_CSTS
00140 !arguments and result
00141 REAL, INTENT(IN) :: PT !Air temperature (K)
00142 REAL, INTENT(IN) :: PP !Atmos. Pressure (Pa)
00143 REAL, INTENT(IN) :: PTWB !Wet Bulb Temp. (K)
00144 REAL :: PRV !water vapor mixing ratio (kg/kg)
00145 REAL :: ZRVSAT !saturation water vapor mixing ratio
00146 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00147 
00148 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:RV_FROM_TPTWB_0D',0,ZHOOK_HANDLE)
00149 ZRVSAT = QSAT(PT, PP) / (1 - QSAT(PT, PP))
00150 PRV = ((2501. - 2.326*(PTWB-XTT))*ZRVSAT - 1.006*(PT - PTWB)) &
00151        / (2501. + 1.86*(PT - XTT) -4.186*(PTWB - XTT))
00152 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:RV_FROM_TPTWB_0D',1,ZHOOK_HANDLE)
00153 end function RV_FROM_TPTWB_0D
00154 
00155 function RV_FROM_TPTWB_1D(PT, PP, PTWB) RESULT(PRV)
00156 USE MODE_THERMOS
00157 USE MODD_CSTS
00158 !arguments and result
00159 REAL, DIMENSION(:), INTENT(IN) :: PT !Air temperature (K)
00160 REAL, DIMENSION(:),INTENT(IN) :: PP !Atmos. Pressure (Pa)
00161 REAL, DIMENSION(:),INTENT(IN) :: PTWB !Wet Bulb Temp. (K)
00162 REAL, DIMENSION(SIZE(PT)) :: PRV !water vapor mixing ratio (kg/kg)
00163 REAL, DIMENSION(SIZE(PT)) :: ZRVSAT !saturation water vapor mixing ratio
00164 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00165 
00166 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:RV_FROM_TPTWB_1D',0,ZHOOK_HANDLE)
00167 ZRVSAT = QSAT(PT, PP) / (1 - QSAT(PT, PP))
00168 PRV(:) = ((2501. - 2.326*(PTWB(:)-XTT))*ZRVSAT(:) - 1.006*(PT(:) - PTWB(:))) &
00169        / (2501. + 1.86*(PT(:) - XTT) -4.186*(PTWB(:) - XTT))
00170 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:RV_FROM_TPTWB_1D',1,ZHOOK_HANDLE)       
00171 end function RV_FROM_TPTWB_1D
00172 !----------------------------
00173 
00174 !TWB_FROM_TPQ
00175 !------------
00176 function TWB_FROM_TPQ_0D(PT, PP, PQ) RESULT(PTWB)
00177 !arguments and results
00178 REAL, INTENT(IN) :: PT !air temperature (K)
00179 REAL, INTENT(IN) :: PQ !mixing ratio (kg/kg)
00180 REAL, INTENT(IN) :: PP !atmos. pressure (Pa)
00181 REAL :: PTWB !Wet Bulb Temp. (K)
00182 !local variable
00183 REAL :: ZTD !Dew Point Temp. (K)
00184 REAL :: ZTWBINF, ZTWBSUP, ZRV
00185 INTEGER :: JITER
00186 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00187 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TWB_FROM_TPQ_0D',0,ZHOOK_HANDLE)
00188 JITER = 1
00189 ZTD = TD_FROM_TQ(PT, PQ) 
00190 !initial guess
00191 ZTWBSUP = PT
00192 ZTWBINF = ZTD
00193 PTWB = 0.5 * (ZTWBSUP + ZTWBINF)
00194 DO WHILE (ZTWBSUP - ZTWBINF > 0.001 .OR. JITER .LE. 50)
00195    ZRV = RV_FROM_TPTWB(PT, PP, PTWB)
00196    IF (ZRV .GT. PQ/(1 - PQ)) THEN
00197            ZTWBSUP = PTWB
00198    ELSE
00199            ZTWBINF = PTWB
00200    ENDIF
00201    PTWB = 0.5 * (ZTWBINF + ZTWBSUP)
00202    JITER = JITER + 1
00203 END DO
00204 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TWB_FROM_TPQ_0D',1,ZHOOK_HANDLE)
00205 end function TWB_FROM_TPQ_0D
00206 
00207 function TWB_FROM_TPQ_1D(PT, PP, PQ) RESULT(PTWB)
00208 !arguments and results
00209 REAL, DIMENSION(:), INTENT(IN) :: PT !air temperature (K)
00210 REAL, DIMENSION(:), INTENT(IN) :: PQ !humidity content (kg/kg)
00211 REAL, DIMENSION(:), INTENT(IN) :: PP !atmos. pressure (Pa)
00212 REAL, DIMENSION(SIZE(PT)) :: PTWB !Wet Bulb Temp. (K)
00213 !local variable
00214 REAL, DIMENSION(SIZE(PT)) :: ZTD !Dew Point Temp. (K)
00215 REAL, DIMENSION(SIZE(PT)) :: ZTWBINF, ZTWBSUP, ZRV
00216 INTEGER :: JITER, JI
00217 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00218 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TWB_FROM_TPQ_1D',0,ZHOOK_HANDLE)
00219 ZTD = TD_FROM_TQ(PT, PQ) 
00220 !initial guess
00221 ZTWBSUP = PT
00222 ZTWBINF = ZTD
00223 PTWB = 0.5 * (ZTWBSUP + ZTWBINF)
00224 DO JI=1,SIZE(PT)
00225    JITER = 1
00226    DO WHILE (ZTWBSUP(JI) - ZTWBINF(JI) > 0.001 .OR. JITER .LE. 50)
00227       ZRV(JI) = RV_FROM_TPTWB(PT(JI), PP(JI), PTWB(JI))
00228       IF (ZRV(JI) .GT. PQ(JI)/(1 - PQ(JI))) THEN
00229               ZTWBSUP(JI) = PTWB(JI)
00230       ELSE
00231               ZTWBINF(JI) = PTWB(JI)
00232       ENDIF
00233       PTWB(JI) = 0.5 * (ZTWBINF(JI) + ZTWBSUP(JI))
00234    END DO
00235 END DO
00236 IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:TWB_FROM_TPQ_1D',1,ZHOOK_HANDLE)
00237 end function TWB_FROM_TPQ_1D
00238 !-------------------------------------------------------------------------------
00239 !
00240 !     ######################################
00241       FUNCTION ENTH_FN_T_Q(PT,PQ) RESULT(PENTH)
00242 !     ######################################
00243 !
00244 !!
00245 !!    PURPOSE
00246 !!    -------
00247 !       The purpose of this function is to compute the enthalpy function
00248 !       of temperature and humidity content
00249 !      
00250 !
00251 !!**  METHOD
00252 !!    ------
00253 !!  
00254 !!
00255 !!    EXTERNAL
00256 !!    --------
00257 !!      NONE
00258 !!
00259 !!    IMPLICIT ARGUMENTS
00260 !!    ------------------  
00261 !!      
00262 !!    REFERENCE
00263 !!    ---------
00264 !!      
00265 !!
00266 !!
00267 !!    AUTHOR
00268 !!    ------
00269 !!      
00270 !!
00271 !!    MODIFICATIONS
00272 !!    -------------
00273 !!      Original    12/04/11 
00274 !-------------------------------------------------------------------------------
00275 !
00276 !*       0.    DECLARATIONS
00277 !              ------------
00278 !
00279 IMPLICIT NONE
00280 !
00281 !*       0.1   Declarations of arguments and results
00282 !
00283 !
00284 REAL, INTENT(IN)                :: PT     ! Temperature (K)
00285 REAL, INTENT(IN)                :: PQ     ! Humidity content (kg/kg)
00286 REAL                           :: PENTH  ! Enthalpy (J/kg)
00287 !
00288 !*       0.2   Declarations of local variables
00289 !
00290 REAL        :: ZT                          ! Temperature (C)
00291 REAL        :: ZRV                         ! Mixing ratio (kg/kg_da)
00292 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00293 !
00294       IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:ENTH_FN_T_Q',0,ZHOOK_HANDLE)
00295 ! calculate enthalpy
00296       ZT = PT - 273.15
00297       ZRV=MAX(PQ/(1-PQ),1.0d-5)
00298       PENTH=1.00484d3*ZT+ZRV*(2.50094d6+1.85895d3*ZT)
00299 !
00300       IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:ENTH_FN_T_Q',1,ZHOOK_HANDLE)
00301 !-------------------------------------------------------------------------------
00302 !
00303 END FUNCTION ENTH_FN_T_Q
00304 !
00305 !-------------------------------------------------------------------------------
00306 !-------------------------------------------------------------------------------
00307 !-------------------------------------------------------------------------------
00308 !
00309 !     ######################################
00310       FUNCTION Q_FN_T_ENTH(PT,PENTH) RESULT(PQ)
00311 !     ######################################
00312 !
00313 !!
00314 !!    PURPOSE
00315 !!    -------
00316 !       The purpose of this function is to compute the humidity content
00317 !       as a function of temperature and enthalpy
00318 !      
00319 !
00320 !!**  METHOD
00321 !!    ------
00322 !!  
00323 !!
00324 !!    EXTERNAL
00325 !!    --------
00326 !!      NONE
00327 !!
00328 !!    IMPLICIT ARGUMENTS
00329 !!    ------------------  
00330 !!      
00331 !!    REFERENCE
00332 !!    ---------
00333 !!      
00334 !!
00335 !!
00336 !!    AUTHOR
00337 !!    ------
00338 !!      
00339 !!
00340 !!    MODIFICATIONS
00341 !!    -------------
00342 !!      Original    12/04/11 
00343 !-------------------------------------------------------------------------------
00344 !
00345 !*       0.    DECLARATIONS
00346 !              ------------
00347 !
00348 IMPLICIT NONE
00349 !
00350 !*       0.1   Declarations of arguments and results
00351 !
00352 !
00353 REAL, INTENT(IN)                :: PT     ! Temperature (K)
00354 REAL, INTENT(IN)                :: PENTH  ! Enthalpy (J/kg)
00355 REAL                           :: PQ     ! Humidity content (kg/kg)
00356 !
00357 !*       0.2   Declarations of local variables
00358 !
00359 REAL        :: ZT                          ! Temperature (C)
00360 REAL        :: ZRV                         ! Mixing ratio (kg/kg_da)
00361 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00362 !
00363       IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:Q_FN_T_ENTH',0,ZHOOK_HANDLE)
00364 !
00365       ZT = PT - 273.15
00366 !
00367 !    calculate mixing ratio
00368       ZRV=(PENTH-1.00484d3*ZT)/(2.50094d6+1.85895d3*ZT)
00369 !
00370 !    validity test
00371       IF (ZRV < 0.0d0) THEN
00372         ZRV=1.d-5
00373       ENDIF
00374 !
00375 !    calculate humidity content
00376       PQ = ZRV/(1+ZRV)
00377 !
00378      IF (LHOOK) CALL DR_HOOK('MODE_PSYCHRO:Q_FN_T_ENTH',1,ZHOOK_HANDLE)
00379 !
00380 !-------------------------------------------------------------------------------
00381 !
00382 END FUNCTION Q_FN_T_ENTH
00383 
00384 END MODULE MODE_PSYCHRO