mode_sbls.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.
!     ############### 
      MODULE mode_sbls 
!     ###############
!
!!****  *MODE_SBLS * - contains Surface Boundary Layer characteristics functions
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!    
!!    
!!
!!    EXTERNAL
!!    --------
!!       
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    REFERENCE
!!    ---------
!!
!!    Businger et al 1971,   Wyngaard and Cote 1974
!!      
!!
!!    AUTHOR
!!    ------
!!      V. Masson       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original        13/10/99
!!      V. Masson       06/11/02 optimization and add Businger fonction for TKE
!!      J. EScobar      28/11/2013 really avoid / 0 in test in real*4 
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
INTERFACE businger_phim
  MODULE PROCEDURE businger_phim_0d
  MODULE PROCEDURE businger_phim_1d
  MODULE PROCEDURE businger_phim_2d
  MODULE PROCEDURE businger_phim_3d
END INTERFACE
INTERFACE businger_phih
  MODULE PROCEDURE businger_phih_0d
  MODULE PROCEDURE businger_phih_1d
  MODULE PROCEDURE businger_phih_2d
  MODULE PROCEDURE businger_phih_3d
END INTERFACE
INTERFACE businger_phie
  MODULE PROCEDURE businger_phie_0d
  MODULE PROCEDURE businger_phie_1d
  MODULE PROCEDURE businger_phie_2d
  MODULE PROCEDURE businger_phie_3d
END INTERFACE
INTERFACE paulson_psim
  MODULE PROCEDURE paulson_psim_0d
  MODULE PROCEDURE paulson_psim_1d
  MODULE PROCEDURE paulson_psim_2d
  MODULE PROCEDURE paulson_psim_3d
END INTERFACE
INTERFACE paulson_psih
  MODULE PROCEDURE paulson_psih_0d
  MODULE PROCEDURE paulson_psih_1d
  MODULE PROCEDURE paulson_psih_2d
  MODULE PROCEDURE paulson_psih_3d
END INTERFACE
INTERFACE lmo
  MODULE PROCEDURE lmo_0d
  MODULE PROCEDURE lmo_1d
  MODULE PROCEDURE lmo_2d
END INTERFACE
INTERFACE ustar
  MODULE PROCEDURE ustar_0d
  MODULE PROCEDURE ustar_1d
  MODULE PROCEDURE ustar_2d
END INTERFACE
!
!-------------------------------------------------------------------------------
CONTAINS
!-------------------------------------------------------------------------------
!
FUNCTION businger_phim_3d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:,:), INTENT(IN)                 :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIM_3D  
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_3D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:,:) < 0. )
    businger_phim_3d(:,:,:) = (1.-15.*pz_o_lmo)**(-0.25)
  ELSEWHERE
    businger_phim_3d(:,:,:) = 1. + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_3D',1,zhook_handle)
END FUNCTION businger_phim_3d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phim_2d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:), INTENT(IN)                   :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIM_2D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_2D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:) < 0. )
    businger_phim_2d(:,:) = (1.-15.*pz_o_lmo)**(-0.25)
  ELSEWHERE
    businger_phim_2d(:,:) = 1. + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_2D',1,zhook_handle)
END FUNCTION businger_phim_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phim_1d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:), INTENT(IN)  :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIM_1D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_1D',0,zhook_handle)
  WHERE ( pz_o_lmo(:) < 0. )
    businger_phim_1d(:) = (1.-15.*pz_o_lmo)**(-0.25)
  ELSEWHERE
    businger_phim_1d(:) = 1. + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_1D',1,zhook_handle)
END FUNCTION businger_phim_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phim_0d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, INTENT(IN)                   :: PZ_O_LMO
  REAL                               :: BUSINGER_PHIM_0D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_0D',0,zhook_handle)
  IF ( pz_o_lmo < 0. ) THEN
    businger_phim_0d = (1.-15.*pz_o_lmo)**(-0.25)
  ELSE
    businger_phim_0d = 1. + 4.7 * pz_o_lmo
  END IF
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIM_0D',1,zhook_handle)
END FUNCTION businger_phim_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
FUNCTION businger_phih_3d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:,:), INTENT(IN)                 :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIH_3D  
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_3D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:,:) < 0. )
    businger_phih_3d(:,:,:) = 0.74 * (1.-9.*pz_o_lmo)**(-0.5)
  ELSEWHERE
    businger_phih_3d(:,:,:) = 0.74 + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_3D',1,zhook_handle)
END FUNCTION businger_phih_3d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phih_2d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:), INTENT(IN)                   :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIH_2D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_2D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:) < 0. )
    businger_phih_2d(:,:) = 0.74 * (1.-9.*pz_o_lmo)**(-0.5)
  ELSEWHERE
    businger_phih_2d(:,:) = 0.74 + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_2D',1,zhook_handle)
END FUNCTION businger_phih_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phih_1d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:), INTENT(IN)  :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO)) :: BUSINGER_PHIH_1D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_1D',0,zhook_handle)
  WHERE ( pz_o_lmo(:) < 0. )
    businger_phih_1d(:) = 0.74 * (1.-9.*pz_o_lmo)**(-0.5)
  ELSEWHERE
    businger_phih_1d(:) = 0.74 + 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_1D',1,zhook_handle)
END FUNCTION businger_phih_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION businger_phih_0d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, INTENT(IN)                   :: PZ_O_LMO
  REAL                               :: BUSINGER_PHIH_0D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_0D',0,zhook_handle)
  IF ( pz_o_lmo < 0. ) THEN
    businger_phih_0d = 0.74 * (1.-9.*pz_o_lmo)**(-0.5)
  ELSE
    businger_phih_0d = 0.74 + 4.7 * pz_o_lmo
  END IF
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIH_0D',1,zhook_handle)
END FUNCTION businger_phih_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
FUNCTION businger_phie_3d(PZ_O_LMO)
  USE modd_canopy_turb, ONLY : xalpsbl
  IMPLICIT NONE  
  REAL, DIMENSION(:,:,:), INTENT(IN)                 :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: BUSINGER_PHIE_3D  
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_3D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:,:) < 0. )
    businger_phie_3d(:,:,:) =   (1.+(-pz_o_lmo)**(2./3.)/xalpsbl) &
                                * (1.-15.*pz_o_lmo)**(0.5)  
  ELSEWHERE
    businger_phie_3d(:,:,:) = 1./(1. + 4.7 * pz_o_lmo)**2
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_3D',1,zhook_handle)
END FUNCTION businger_phie_3d

!-------------------------------------------------------------------------------
!
FUNCTION businger_phie_2d(PZ_O_LMO)
  USE modd_canopy_turb, ONLY : xalpsbl
  IMPLICIT NONE  
  REAL, DIMENSION(:,:), INTENT(IN)                   :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: BUSINGER_PHIE_2D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_2D',0,zhook_handle)
  WHERE ( pz_o_lmo(:,:) < 0. )
    businger_phie_2d(:,:) =   (1.+(-pz_o_lmo)**(2./3.)/xalpsbl) &
                              * (1.-15.*pz_o_lmo)**(0.5)  
  ELSEWHERE
    businger_phie_2d(:,:) = 1./(1. + 4.7 * pz_o_lmo)**2
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_2D',1,zhook_handle)
END FUNCTION businger_phie_2d

!-------------------------------------------------------------------------------
!
FUNCTION businger_phie_1d(PZ_O_LMO)
  USE modd_canopy_turb, ONLY : xalpsbl
  IMPLICIT NONE  
  REAL, DIMENSION(:), INTENT(IN)    :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: BUSINGER_PHIE_1D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_1D',0,zhook_handle)
  WHERE ( pz_o_lmo(:) < 0. )
    businger_phie_1d(:) =   (1.+(-pz_o_lmo)**(2./3.)/xalpsbl) &
                            * (1.-15.*pz_o_lmo)**(0.5)  
  ELSEWHERE
    businger_phie_1d(:) = 1./(1. + 4.7 * pz_o_lmo)**2
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_1D',1,zhook_handle)
END FUNCTION businger_phie_1d

!-------------------------------------------------------------------------------
!
FUNCTION businger_phie_0d(PZ_O_LMO)
  USE modd_canopy_turb, ONLY : xalpsbl
  IMPLICIT NONE  
  REAL, INTENT(IN):: PZ_O_LMO
  REAL            :: BUSINGER_PHIE_0D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
  IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_0D',0,zhook_handle)
  IF ( pz_o_lmo < 0. ) THEN
    businger_phie_0d =   (1.+(-pz_o_lmo)**(2./3.)/xalpsbl) &
                         * (1.-15.*pz_o_lmo)**(0.5)  
  ELSE
    businger_phie_0d = 1./(1. + 4.7 * pz_o_lmo)**2
  END IF
IF (lhook) CALL dr_hook('MODE_SBLS:BUSINGER_PHIE_0D',1,zhook_handle)
END FUNCTION businger_phie_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psim_3d(PZ_O_LMO)
  USE modd_csts
  IMPLICIT NONE  
  REAL, DIMENSION(:,:,:), INTENT(IN)                 :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: PAULSON_PSIM_3D  
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: ZX  
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_3D',0,zhook_handle)
  zx=1.
  WHERE ( pz_o_lmo(:,:,:) < 0. )
    zx=(1.-15.*pz_o_lmo)**(0.25)
    paulson_psim_3d(:,:,:) = log( (1.+zx**2)*(1+zx)**2/8. ) - 2.*atan(zx) + xpi/2.
  ELSEWHERE
    paulson_psim_3d(:,:,:) = - 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_3D',1,zhook_handle)
END FUNCTION paulson_psim_3d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psim_2d(PZ_O_LMO)
  USE modd_csts
  IMPLICIT NONE  
  REAL, DIMENSION(:,:), INTENT(IN)                   :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: PAULSON_PSIM_2D
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZX
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_2D',0,zhook_handle)
  zx=1.
  WHERE ( pz_o_lmo(:,:) < 0. )
    zx=(1.-15.*pz_o_lmo)**(0.25)
    paulson_psim_2d(:,:) = log( (1.+zx**2)*(1+zx)**2/8. ) - 2.*atan(zx) + xpi/2.
  ELSEWHERE
    paulson_psim_2d(:,:) = - 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_2D',1,zhook_handle)
END FUNCTION paulson_psim_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psim_1d(PZ_O_LMO)
  USE modd_csts
  IMPLICIT NONE  
  REAL, DIMENSION(:), INTENT(IN)    :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: PAULSON_PSIM_1D
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZX
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_1D',0,zhook_handle)
  zx=1.
  WHERE ( pz_o_lmo(:) < 0. )
    zx=(1.-15.*pz_o_lmo)**(0.25)
    paulson_psim_1d(:) = log( (1.+zx**2)*(1+zx)**2/8. ) - 2.*atan(zx) + xpi/2.
  ELSEWHERE
    paulson_psim_1d(:) = - 4.7 * pz_o_lmo
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_1D',1,zhook_handle)
END FUNCTION paulson_psim_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psim_0d(PZ_O_LMO)
  USE modd_csts
  IMPLICIT NONE  
  REAL, INTENT(IN)    :: PZ_O_LMO
  REAL                :: PAULSON_PSIM_0D
!
  REAL                :: ZX
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_0D',0,zhook_handle)
  zx=1.
  IF ( pz_o_lmo < 0. ) THEN
    zx=(1.-15.*pz_o_lmo)**(0.25)
    paulson_psim_0d = log( (1.+zx**2)*(1+zx)**2/8. ) - 2.*atan(zx) + xpi/2.
  ELSE
    paulson_psim_0d = - 4.7 * pz_o_lmo
  END IF
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIM_0D',1,zhook_handle)
END FUNCTION paulson_psim_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psih_3d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:,:), INTENT(IN)                 :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: PAULSON_PSIH_3D  
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1), &
                    SIZE(PZ_O_LMO,2),SIZE(PZ_O_LMO,3)) :: ZY  
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_3D',0,zhook_handle)
  zy=1.
  WHERE ( pz_o_lmo(:,:,:) < 0. )
    zy=(1.-9.*pz_o_lmo)**(0.5)
    paulson_psih_3d(:,:,:) = log( (1.+zy)/2. )
  ELSEWHERE
    paulson_psih_3d(:,:,:) = - 4.7 * pz_o_lmo / 0.74
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_3D',1,zhook_handle)
END FUNCTION paulson_psih_3d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psih_2d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:,:), INTENT(IN)                   :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: PAULSON_PSIH_2D
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1),SIZE(PZ_O_LMO,2)) :: ZY
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_2D',0,zhook_handle)
  zy=1.
  WHERE ( pz_o_lmo(:,:) < 0. )
    zy=(1.-9.*pz_o_lmo)**(0.5)
    paulson_psih_2d(:,:) = log( (1.+zy)/2. )
  ELSEWHERE
    paulson_psih_2d(:,:) = - 4.7 * pz_o_lmo / 0.74
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_2D',1,zhook_handle)
END FUNCTION paulson_psih_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psih_1d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, DIMENSION(:), INTENT(IN)    :: PZ_O_LMO
  REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: PAULSON_PSIH_1D
!
  REAL, DIMENSION(SIZE(PZ_O_LMO,1)) :: ZY
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_1D',0,zhook_handle)
  zy=1.
  WHERE ( pz_o_lmo(:) < 0. )
    zy=(1.-9.*pz_o_lmo)**(0.5)
    paulson_psih_1d(:) = log( (1.+zy)/2. )
  ELSEWHERE
    paulson_psih_1d(:) = - 4.7 * pz_o_lmo / 0.74
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_1D',1,zhook_handle)
END FUNCTION paulson_psih_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION paulson_psih_0d(PZ_O_LMO)
  IMPLICIT NONE
  REAL, INTENT(IN)    :: PZ_O_LMO
  REAL                :: PAULSON_PSIH_0D
!
  REAL                :: ZY
  REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_0D',0,zhook_handle)
  zy=1.
  IF ( pz_o_lmo < 0. ) THEN
    zy=(1.-9.*pz_o_lmo)**(0.5)
    paulson_psih_0d = log( (1.+zy)/2. )
  ELSE
    paulson_psih_0d = - 4.7 * pz_o_lmo / 0.74
  END IF
IF (lhook) CALL dr_hook('MODE_SBLS:PAULSON_PSIH_0D',1,zhook_handle)
END FUNCTION paulson_psih_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
!
FUNCTION lmo_2d(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
  USE modd_csts
  USE modd_surf_par,   ONLY : xundef
  IMPLICIT NONE  
  REAL, DIMENSION(:,:), INTENT(IN)               :: PUSTAR
  REAL, DIMENSION(:,:), INTENT(IN)               :: PTHETA
  REAL, DIMENSION(:,:), INTENT(IN)               :: PRV
  REAL, DIMENSION(:,:), INTENT(IN)               :: PSFTH
  REAL, DIMENSION(:,:), INTENT(IN)               :: PSFRV
  REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: LMO_2D
!
  REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZTHETAV
  REAL, DIMENSION(SIZE(PUSTAR,1),SIZE(PUSTAR,2)) :: ZQ0
  REAL                                           :: ZEPS
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
  IF (lhook) CALL dr_hook('MODE_SBLS:LMO_2D',0,zhook_handle)
  zeps=(xrv-xrd)/xrd
  zthetav(:,:) = ptheta(:,:) * ( 1. +zeps * prv(:,:))
  zq0(:,:) = psfth(:,:) + zthetav(:,:) * zeps * psfrv(:,:) 
!
  lmo_2d(:,:) = xundef
  WHERE ( zq0(:,:) /=0.  )                                   &
      lmo_2d(:,:) = - max(pustar(:,:),1.e-6)**3                &
                    / ( xkarman * xg / zthetav(:,:) *zq0(:,:) )  
!
  WHERE(abs(lmo_2d)>10000.) lmo_2d=xundef
IF (lhook) CALL dr_hook('MODE_SBLS:LMO_2D',1,zhook_handle)

END FUNCTION lmo_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION lmo_1d(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
  USE modd_csts
  USE modd_surf_par,  ONLY : xundef
  IMPLICIT NONE  
  REAL, DIMENSION(:), INTENT(IN)  :: PUSTAR
  REAL, DIMENSION(:), INTENT(IN)  :: PTHETA
  REAL, DIMENSION(:), INTENT(IN)  :: PRV
  REAL, DIMENSION(:), INTENT(IN)  :: PSFTH
  REAL, DIMENSION(:), INTENT(IN)  :: PSFRV
  REAL, DIMENSION(SIZE(PUSTAR))   :: LMO_1D
!
  REAL, DIMENSION(SIZE(PUSTAR))   :: ZTHETAV
  REAL                                           :: ZEPS
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
  IF (lhook) CALL dr_hook('MODE_SBLS:LMO_1D',0,zhook_handle)
  zeps=(xrv-xrd)/xrd
!
  zthetav(:) = ptheta(:) * ( 1. +zeps * prv(:))
!
  lmo_1d(:) = xundef
  WHERE ( psfth(:)/zthetav(:)+zeps*psfrv(:)/=0. )                  &
      lmo_1d(:) = - max(pustar(:),1.e-6)**3                          &
                / ( xkarman * xg   &
                    * (  psfth(:) / zthetav(:) + zeps * psfrv(:) )  )  

  WHERE(abs(lmo_1d)>10000.) lmo_1d=xundef
IF (lhook) CALL dr_hook('MODE_SBLS:LMO_1D',1,zhook_handle)

END FUNCTION lmo_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION lmo_0d(PUSTAR,PTHETA,PRV,PSFTH,PSFRV)
  USE modd_csts
  USE modd_surf_par,  ONLY : xundef
  IMPLICIT NONE  
  REAL, INTENT(IN)  :: PUSTAR
  REAL, INTENT(IN)  :: PTHETA
  REAL, INTENT(IN)  :: PRV
  REAL, INTENT(IN)  :: PSFTH
  REAL, INTENT(IN)  :: PSFRV
  REAL              :: LMO_0D
!
  REAL              :: ZTHETAV
  REAL              :: ZEPS
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!
  IF (lhook) CALL dr_hook('MODE_SBLS:LMO_0D',0,zhook_handle)
  zeps=(xrv-xrd)/xrd
!
!
  zthetav = ptheta * ( 1. +zeps * prv)
!
  lmo_0d = xundef
  IF ( psfth/zthetav+zeps*psfrv/=0. )                      &
    lmo_0d = - max(pustar,1.e-6)**3                          &
             / ( xkarman * (  xg / zthetav       * psfth     &
                            + xg * zeps * psfrv )  )  

  IF(abs(lmo_0d)>10000.) lmo_0d=xundef
IF (lhook) CALL dr_hook('MODE_SBLS:LMO_0D',1,zhook_handle)

END FUNCTION lmo_0d
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
FUNCTION ustar_2d(PWIND,PZ,PZ0,PLMO)
  USE modd_csts
  USE modd_surf_par,  ONLY : xundef
  IMPLICIT NONE  
  REAL, DIMENSION(:,:), INTENT(IN)               :: PWIND
  REAL, DIMENSION(:,:), INTENT(IN)               :: PZ
  REAL, DIMENSION(:,:), INTENT(IN)               :: PZ0
  REAL, DIMENSION(:,:), INTENT(IN)               :: PLMO
  REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2))         :: USTAR_2D

  REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2))         :: ZZ_O_LMO
  REAL, DIMENSION(SIZE(PZ,1),SIZE(PZ,2))         :: ZZ0_O_LMO
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* purely unstable case
  IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_2D',0,zhook_handle)
  ustar_2d(:,:) = 0.
  zz_o_lmo(:,:) = xundef
  zz0_o_lmo(:,:) = xundef
!
!* general case
  WHERE(abs(plmo) > 1.e-20 .AND. plmo/=xundef)
    zz_o_lmo  = pz(:,:)  / plmo(:,:)
    zz0_o_lmo = pz0(:,:) / plmo(:,:)
    ustar_2d(:,:) = pwind(:,:)                                &
                    * xkarman / ( log(pz(:,:)/pz0(:,:))         &
                                 - paulson_psim(zz_o_lmo(:,:))  &
                                 + paulson_psim(zz0_o_lmo(:,:)) )  
  END WHERE
!
!* purely neutral case
  WHERE(plmo==xundef)
    zz_o_lmo = 0.
    ustar_2d(:,:) = pwind(:,:)     &
                    * xkarman / log(pz(:,:)/pz0(:,:))  
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_2D',1,zhook_handle)
!
END FUNCTION ustar_2d
!
!-------------------------------------------------------------------------------
!
FUNCTION ustar_1d(PWIND,PZ,PZ0,PLMO)
  USE modd_csts
  USE modd_surf_par,  ONLY : xundef
  IMPLICIT NONE  
  REAL, DIMENSION(:), INTENT(IN)               :: PWIND
  REAL, DIMENSION(:), INTENT(IN)               :: PZ
  REAL, DIMENSION(:), INTENT(IN)               :: PZ0
  REAL, DIMENSION(:), INTENT(IN)               :: PLMO
  REAL, DIMENSION(SIZE(PZ))                    :: USTAR_1D

  REAL, DIMENSION(SIZE(PZ))                    :: ZZ_O_LMO
  REAL, DIMENSION(SIZE(PZ))                    :: ZZ0_O_LMO
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* purely unstable case
  IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_1D',0,zhook_handle)
  ustar_1d(:) = 0.
  zz_o_lmo(:) = xundef
  zz0_o_lmo(:) = xundef
!
!* general case
  WHERE(abs(plmo) > 1.e-20 .AND. plmo/=xundef)
    zz_o_lmo  = pz(:)  / plmo(:)
    zz0_o_lmo = pz0(:) / plmo(:)
    ustar_1d(:) = pwind                                   &
                  * xkarman / ( log(pz(:)/pz0(:))           &
                               - paulson_psim(zz_o_lmo(:))  &
                               + paulson_psim(zz0_o_lmo(:)) )  
  END WHERE
!
!* purely neutral case
  WHERE(plmo==xundef)
    zz_o_lmo = 0.
    ustar_1d(:) = pwind     &
                    * xkarman / log(pz(:)/pz0(:))  
  END WHERE
IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_1D',1,zhook_handle)
!
END FUNCTION ustar_1d
!
!-------------------------------------------------------------------------------
!
FUNCTION ustar_0d(PWIND,PZ,PZ0,PLMO)
  USE modd_csts
  USE modd_surf_par,  ONLY : xundef
  IMPLICIT NONE  
  REAL, INTENT(IN)               :: PWIND
  REAL, INTENT(IN)               :: PZ
  REAL, INTENT(IN)               :: PZ0
  REAL, INTENT(IN)               :: PLMO
  REAL                           :: USTAR_0D
  REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!* purely unstable case
  IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_0D',0,zhook_handle)
  ustar_0d = 0.
!
!* general case
  IF ( abs(plmo) >= 1.e-20 .AND. plmo/=xundef)    &
    ustar_0d = pwind * xkarman / ( log(pz/pz0) - paulson_psim(pz/plmo) + paulson_psim(pz0/plmo) )  
!
!* purely neutral case
  IF (plmo==xundef)                  &
    ustar_0d = pwind * xkarman / log(pz/pz0)  
IF (lhook) CALL dr_hook('MODE_SBLS:USTAR_0D',1,zhook_handle)

END FUNCTION ustar_0d
!
!-------------------------------------------------------------------------------
!
END MODULE mode_sbls

---

Generated on Tue Jan 16 2018 16:23:29 for SURFEX v8.1 by   1.8.13