PSAT_2D Function

public function PSAT_2D(PT, KMASK) result(PPSAT)

Arguments

Type IntentOptional AttributesName
real, intent(in), DIMENSION(:,:):: PT
integer, intent(in), DIMENSION(:):: KMASK

Return Value real, DIMENSION(SIZE(PT,1),SIZE(PT,2))


Contents

Source Code


Source Code

      FUNCTION PSAT_2D(PT,KMASK) RESULT(PPSAT)
!     ######################################
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CSTS
USE MODD_REPROD_OPER, ONLY : CQSAT
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments and results
!
!
REAL, DIMENSION(:,:), INTENT(IN)              :: PT     ! Temperature (Kelvin)
INTEGER, DIMENSION(:), INTENT(IN)             :: KMASK
!
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2))        :: PPSAT  ! saturation vapor pressure (Pa)
!
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2))        :: ZALP, ZBETA, ZGAM
!
INTEGER         :: JJ, JL, INI, INL, IWORK !loop index
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:PSAT_2D',0,ZHOOK_HANDLE)
!
!*       1.    COMPUTE SATURATION VAPOR PRESSURE
!              ---------------------------------
!
INI=SIZE(PT,1)
INL=SIZE(PT,2)
!
PPSAT(:,:) = 0.0
!
ZALP (:,:) = XALPW
ZBETA(:,:) = XBETAW
ZGAM (:,:) = XGAMW
!
IF(CQSAT=='NEW')THEN
 WHERE(PT(:,:)<=XTT)
   ZALP  (:,:) = XALPI
   ZBETA (:,:) = XBETAI
   ZGAM  (:,:) = XGAMI 
 ENDWHERE
ENDIF
!
DO JL=1,INL
  DO JJ=1,INI
     IWORK=KMASK(JJ)
     IF(JL<=IWORK)THEN
       PPSAT(JJ,JL) = EXP( ZALP(JJ,JL) - ZBETA(JJ,JL)/PT(JJ,JL) - ZGAM(JJ,JL)*LOG(PT(JJ,JL)) )
     ENDIF
  ENDDO
ENDDO
!
!-------------------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('MODE_THERMOS:PSAT_2D',1,ZHOOK_HANDLE)
!
END FUNCTION PSAT_2D