param_cls.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 param_cls(PTA, PTS, PQA, PPA, PRHOA, PZONA, PMERA, PH, PHW, &
                              psfth, psftq, psfzon, psfmer,                      &
                              pt2m, pq2m, phu2m, pzon10m, pmer10m               )  
!     #####################################################################
!
!!****  *PARAMCLS*  interpolates wind at 10m and temperature/humidity at 2m
!!
!!    PURPOSE
!!    -------
!
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!   Rui Salgado
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original    26/10/98
!!                  06/2003  (V. Masson) use of Paulson functions and
!!                                       atmospheric level only
!!                  11/2006  (P. LeMoigne) min value for LMO for unstable case
!!                  01/2010  (S. Riette) XUNDEF is sent for wind where forcing
!!                                       level is below heigt of diagnostic
!!                                       (no extrapolation, only interpolation)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_surf_par,   ONLY : xundef
USE modd_csts,       ONLY : xkarman, xrd, xcpd, xp00, xrv, xg
!
USE mode_sbls
USE mode_thermos
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
REAL, DIMENSION(:), INTENT(IN)       :: pta    ! atmospheric temperature
REAL, DIMENSION(:), INTENT(IN)       :: pts    ! surface temperature
REAL, DIMENSION(:), INTENT(IN)       :: pqa    ! atmospheric specific humidity
REAL, DIMENSION(:), INTENT(IN)       :: ppa    ! atmospheric level pressure
REAL, DIMENSION(:), INTENT(IN)       :: prhoa  ! air density
REAL, DIMENSION(:), INTENT(IN)       :: pzona  ! zonal wind
REAL, DIMENSION(:), INTENT(IN)       :: pmera  ! meridian wind
REAL, DIMENSION(:), INTENT(IN)       :: ph     ! atmospheric level height
REAL, DIMENSION(:), INTENT(IN)       :: phw    ! atmospheric level height for wind
REAL, DIMENSION(:), INTENT(IN)       :: psfzon ! zonal friction
REAL, DIMENSION(:), INTENT(IN)       :: psfmer ! meridian friction
REAL, DIMENSION(:), INTENT(IN)       :: psfth  ! heat flux  (W/m2)
REAL, DIMENSION(:), INTENT(IN)       :: psftq  ! vapor flux (kg/m2/s)
!
REAL, DIMENSION(:), INTENT(OUT)      :: pt2m   ! temperature at 2 meters
REAL, DIMENSION(:), INTENT(OUT)      :: pq2m   ! specific humidity at 2 meters
REAL, DIMENSION(:), INTENT(OUT)      :: phu2m  ! relative humidity at 2 meters
REAL, DIMENSION(:), INTENT(OUT)      :: pzon10m! zonal wind component at 10 meters
REAL, DIMENSION(:), INTENT(OUT)      :: pmer10m! meridian wind component at 10 meters
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PTA)) :: zustar     ! friction
REAL, DIMENSION(SIZE(PTA)) :: zth        ! potential temperature
REAL, DIMENSION(SIZE(PTA)) :: zrv        ! H2O mixing ratio
REAL, DIMENSION(SIZE(PTA)) :: zlmo       ! Monin Obhukov length
REAL, DIMENSION(SIZE(PTA)) :: zh_o_lmo   ! h/LMO
REAL, DIMENSION(SIZE(PTA)) :: z10m_o_lmo ! 10m/LMO
REAL, DIMENSION(SIZE(PTA)) :: z2m_o_lmo  ! 2m/LMO
REAL, DIMENSION(SIZE(PTA)) :: ztstar     ! Scale of Temperature
REAL, DIMENSION(SIZE(PTA)) :: zqstar     ! Scale of humidity
REAL, DIMENSION(SIZE(PTA)) :: zth2m      ! Potential temperature at 2m
REAL, DIMENSION(SIZE(PTA)) :: zp2m       ! Pressure at 2m
REAL, DIMENSION(SIZE(PTA)) :: zqsat2m    ! saturation specific humidity at 2m
REAL                       :: z10m       ! 10m
REAL                       :: z2m        ! 2m
REAL, DIMENSION(SIZE(PTA)) :: zwt        ! potential temperature flux (Km/s)
REAL, DIMENSION(SIZE(PTA)) :: zwq        ! water vapor flux           (kg/kg*m/s)
REAL, DIMENSION(SIZE(PTA)) :: zexn       ! Exner function
REAL                       :: zlmomin    ! Minimum value of ZLMO for unstable cases
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PARAM_CLS',0,zhook_handle)
z10m = 10.
z2m  = 2.
!
!* friction
!
zustar(:) = sqrt(sqrt(psfzon(:)**2+psfmer(:)**2))
!
!* Exner function
!
zexn(:) =  (ppa(:)/xp00)**(xrd/xcpd)
!
!* Potential temperature
!
zth(:) = pta(:) / zexn(:)
!
!* Vapor mixing ratio
!
WHERE (pqa(:)/=0.)
  zrv = 1./(1./pqa(:) - 1.)
ELSEWHERE
  zrv = 0.
END WHERE
!
!* Kinematic fluxes
!
zwt(:) = psfth(:) / (prhoa(:) * xcpd / zexn(:))
zwq(:) = psftq(:) /  prhoa(:)
!
!
!* Monin Obhukov length
!
zlmo = lmo(zustar,zth,zrv,zwt,zwq)
!
! min value of 1 meter for ZLMO for unstable case
!
zlmomin = 1.
zlmo    = zlmo * (1.-sign(1.,zlmo))/2. + max(zlmomin,zlmo) * (1.+sign(1.,zlmo))/2.
!
!* h/LMO; 10m/LMO; 2m/LMO
!
zh_o_lmo   = 0.
z10m_o_lmo = 0.
z2m_o_lmo  = 0.
!
WHERE (zlmo/=xundef)
  z10m_o_lmo = z10m/zlmo
  z2m_o_lmo  = z2m/zlmo
END WHERE
!
!-------------------------------------------------------------------------------
!
!* use of wind forcing height
!
WHERE (zlmo/=xundef)
  zh_o_lmo   = phw/zlmo
END WHERE
!
!* Wind at 10m
!
!* note : is set to zero value where the law does not apply correctly
!  (e.g. over high mountains)
!         and is set to XUNDEF when forcing level is below 10m diagnostic level
pzon10m(:) = xundef
pmer10m(:) = xundef
WHERE(phw(:)>=z10m)
WHERE (psfzon(:)>=0.) 
  pzon10m(:) = pzona(:) - sqrt( psfzon(:))/xkarman *(   log( z10m/phw)           &
                                                        - paulson_psim(z10m_o_lmo)  &
                                                        + paulson_psim(zh_o_lmo)    )  
  pzon10m(:) = min( 0., pzon10m(:) )
END WHERE
!
WHERE (psfzon(:)< 0.) 
  pzon10m(:) = pzona(:) + sqrt(-psfzon(:))/xkarman *(   log( z10m/phw)           &
                                                        - paulson_psim(z10m_o_lmo)  &
                                                        + paulson_psim(zh_o_lmo)    )  
  pzon10m(:) = max( 0., pzon10m(:) )
END WHERE
!
WHERE (psfmer(:)>=0.) 
  pmer10m(:) = pmera(:) - sqrt( psfmer(:))/xkarman *(   log( z10m/phw)           &
                                                        - paulson_psim(z10m_o_lmo)  &
                                                        + paulson_psim(zh_o_lmo)    )  
  pmer10m(:) = min( 0., pmer10m(:) )
END WHERE
!
WHERE (psfmer(:)< 0.) 
  pmer10m(:) = pmera(:) + sqrt(-psfmer(:))/xkarman *(   log( z10m/phw)           &
                                                        - paulson_psim(z10m_o_lmo)  &
                                                        + paulson_psim(zh_o_lmo)    )  
  pmer10m(:) = max( 0., pmer10m(:) )
END WHERE
END WHERE
!
!-------------------------------------------------------------------------------
!
!* use of temperature forcing height
!
WHERE (zlmo/=xundef)
  zh_o_lmo   = ph/zlmo
END WHERE
!
!* Temperature scale
!
ztstar(:) = - zwt(:) / max(zustar,0.01)
!
!* Potential Temperature at 2m
!
zth2m(:) = zth(:) + 0.74 * ztstar(:)/xkarman *(  log( z2m/ph)             &
                                                 - paulson_psih(z2m_o_lmo)   &
                                                 + paulson_psih(zh_o_lmo)    )  
!
!* Pressure at 2m
!
zp2m(:) = ppa(:) - xg * prhoa(:) * (z2m-ph(:))
!
!* Temperature at 2m
!
WHERE (zwt(:) > 0. .OR. pts(:) == xundef)
  ! Businger formulation in unstable case
  pt2m(:) = zth2m(:) * (zp2m(:)/xp00)**(xrd/xcpd)
ELSEWHERE 
  ! Linear interpolation between Ts and Ta in stable case
  pt2m(:) = pts(:) + (pta(:)-pts(:))*z2m/ph(:)
END WHERE
!
!-------------------------------------------------------------------------------
!
!* Humidity scale
!
zqstar(:) = - zwq(:) / max(zustar,0.01)
!
!* Specific humidity at 2m
!
pq2m(:) = pqa(:) + 0.74 * zqstar(:)/xkarman *(  log( z2m/ph)             &
                                                - paulson_psih(z2m_o_lmo)   &
                                                + paulson_psih(zh_o_lmo)    )  
!
!* must be below saturation
!
zqsat2m(:) = qsat(pt2m(:),zp2m(:))
pq2m(:) = min(zqsat2m(:),pq2m(:))
!
phu2m(:) = pq2m(:) / zqsat2m(:)
IF (lhook) CALL dr_hook('PARAM_CLS',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE param_cls