subscale_z0eff_1d.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 subscale_z0eff_1d(PAOSIP,PAOSIM,PAOSJP,PAOSJM,            &
                                pho2ip,pho2im,pho2jp,pho2jm,pz0veg,        &
                                pz0effip,pz0effim,pz0effjp,pz0effjm,       &
                                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
!!                24/08/12 (B Decharme) optimization (loop into subroutine)
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_surf_par, ONLY : xundef
USE modd_csts,     ONLY : xkarman
USE modd_isba_par, ONLY : xcdz0eff
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
REAL, DIMENSION(:), INTENT(IN)  :: paosip  ! A/S for increasing x
REAL, DIMENSION(:), INTENT(IN)  :: paosim  ! A/S for decreasing x
REAL, DIMENSION(:), INTENT(IN)  :: paosjp  ! A/S for increasing y
REAL, DIMENSION(:), INTENT(IN)  :: paosjm  ! A/S for decreasing y
REAL, DIMENSION(:), INTENT(IN)  :: pho2ip  ! h/2 for increasing x
REAL, DIMENSION(:), INTENT(IN)  :: pho2im  ! h/2 for decreasing x
REAL, DIMENSION(:), INTENT(IN)  :: pho2jp  ! h/2 for increasing y
REAL, DIMENSION(:), INTENT(IN)  :: pho2jm  ! h/2 for decreasing y
REAL, DIMENSION(:), INTENT(IN)  :: pz0veg  ! vegetation roughness length
!
REAL, DIMENSION(:), INTENT(INOUT) :: pz0effip! roughness length for increasing x
REAL, DIMENSION(:), INTENT(INOUT) :: pz0effim! roughness length for decreasing x
REAL, DIMENSION(:), INTENT(INOUT) :: pz0effjp! roughness length for increasing y
REAL, DIMENSION(:), INTENT(INOUT) :: pz0effjm! roughness length for decreasing y
!
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: omask ! mask where computations
                                                       ! are done
!
!*    0.2    Declaration of other local variables
!            ------------------------------------
!
LOGICAL, DIMENSION(SIZE(PZ0EFFIM)) :: gmask
!
REAL(KIND=JPRB) :: zhook_handle
!----------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF_1D',0,zhook_handle)
IF (present(omask)) THEN
  gmask=omask
ELSE
  gmask=(paosip/=xundef)    ! computations always performed where SSO data exist
  pz0effip = xundef
  pz0effim = xundef
  pz0effjp = xundef
  pz0effjm = xundef
END IF
!
!*    1.     Computations from A/S and h/2
!            -----------------------------
!      
 CALL get_z0eff(gmask(:),pz0veg(:),pho2jp(:),paosjp(:),pz0effjp(:))
 CALL get_z0eff(gmask(:),pz0veg(:),pho2jm(:),paosjm(:),pz0effjm(:))
 CALL get_z0eff(gmask(:),pz0veg(:),pho2im(:),paosim(:),pz0effim(:))
 CALL get_z0eff(gmask(:),pz0veg(:),pho2ip(:),paosip(:),pz0effip(:))
!
IF (lhook) CALL dr_hook('SUBSCALE_Z0EFF_1D',1,zhook_handle)
!-------------------------------------------------------------------------------
 CONTAINS
!
SUBROUTINE get_z0eff(OCOMPUT,PZ0,PHO,PAO,PZ0EFF)
!
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(OUT):: 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_1D: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_1D:GET_ZOEFF',1,zhook_handle)
!
END SUBROUTINE get_z0eff
! 
END SUBROUTINE subscale_z0eff_1d