subscale_z0eff.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.
!     ######spl
      SUBROUTINE subscale_z0eff(ISSK,PZ0VEG,OZ0REL,OMASK  )
!     ######################################################################
!
!!*SUBSCALE_Z0EFF  computes an effective roughness lenght deduced
!!                 from the subgrid-scale orography.
!!
!!
!!    METHOD
!!    ------
!!    See M.Georgelin and al. July 1994, Monthly Weather Review.
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    M. Georgelin      Laboratoire d'Aerologie
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    18/12/95
!!                22/12/97 (V Masson) call with dummy arguments
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_csts,       ONLY : xkarman
USE modd_isba_par,   ONLY : xcdz0eff
USE modd_surf_par,   ONLY : xundef
!
USE modd_sso_n, ONLY : sso_t
!
USE modi_get_z0rel
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
TYPE(sso_t), INTENT(INOUT) :: ISSK
REAL, DIMENSION(:), INTENT(IN)  :: PZ0VEG  ! vegetation roughness length
!
LOGICAL, INTENT(IN) :: OZ0REL
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
                                                       ! are done
!
!*    0.2    Declaration of other local variables
!            ------------------------------------
!
REAL,    DIMENSION(SIZE(ISSK%XAOSIP)) :: ZLOC
LOGICAL, DIMENSION(SIZE(ISSK%XZ0EFFIM)) :: GMASK
!
INTEGER :: JJ      ! loop counter on points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF',0,zhook_handle)
!
IF (.NOT.PRESENT(omask)) THEN
  issk%XZ0EFFIP = xundef
  issk%XZ0EFFIM = xundef
  issk%XZ0EFFJP = xundef
  issk%XZ0EFFJM = xundef
ENDIF
!
!----------------------------------------------------------------------------
!
IF (PRESENT(omask)) THEN
  gmask=omask
ELSEIF (all(pz0veg(:)==0.)) THEN
  gmask = (issk%XAOSIP/=xundef)    ! computations always performed where SSO data exist
ELSE
  gmask=pz0veg(:) /= xundef    ! computations always performed where defined
END IF
!
!*    1.     Computations from A/S and h/2
!            -----------------------------
!      
 CALL get_z0eff(gmask(:),pz0veg(:),issk%XHO2JP(:),issk%XAOSJP(:),issk%XZ0EFFJP(:))
 CALL get_z0eff(gmask(:),pz0veg(:),issk%XHO2JM(:),issk%XAOSJM(:),issk%XZ0EFFJM(:))
 CALL get_z0eff(gmask(:),pz0veg(:),issk%XHO2IM(:),issk%XAOSIM(:),issk%XZ0EFFIM(:))
 CALL get_z0eff(gmask(:),pz0veg(:),issk%XHO2IP(:),issk%XAOSIP(:),issk%XZ0EFFIP(:))
!
IF (oz0rel) CALL get_z0rel(issk,gmask)
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF',1,zhook_handle)
!
!-------------------------------------------------------------------------------
CONTAINS
!
SUBROUTINE get_z0eff(OCOMPUT,PZ0,PHO,PAO,PZ0EFF)
!
USE modd_isba_par,   ONLY : xcdz0eff
USE modd_csts,       ONLY : xkarman
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
LOGICAL, DIMENSION(:), INTENT(IN) :: OCOMPUT
REAL,    DIMENSION(:), INTENT(IN) :: PZ0
REAL,    DIMENSION(:), INTENT(IN) :: PHO
REAL,    DIMENSION(:), INTENT(IN) :: PAO
REAL,    DIMENSION(:), INTENT(INOUT):: PZ0EFF
!
LOGICAL, DIMENSION(SIZE(PZ0)) :: LWORK1
!
REAL    :: ZLOC1,ZLOC2,ZLOC3
INTEGER :: JJ, INI
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF:GET_ZOEFF',0,zhook_handle)
!
ini=SIZE(pz0)
!
lwork1(:)=(pho(:)>pz0(:).AND.(pz0(:)/=0.0.OR.pao(:)/=0.0))
!
DO jj=1,ini
  IF (ocomput(jj)) THEN
    IF (lwork1(jj)) THEN 
      zloc1  = (xcdz0eff/(2.*xkarman**2))*pao(jj)
      IF ( pz0(jj) > 0. ) THEN
        zloc2 = 1./(alog(pho(jj)/pz0(jj)))**2
      ELSE
        zloc2 = 0.
      ENDIF 
      zloc3  = sqrt(1./(zloc1+zloc2))
      pz0eff(jj) = pho(jj) * exp(-zloc3)
    ELSE
      pz0eff(jj) = pz0(jj) 
    ENDIF
  ENDIF
ENDDO
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF:GET_ZOEFF',1,zhook_handle)
!
END SUBROUTINE get_z0eff

END SUBROUTINE subscale_z0eff