get_z0rel.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 get_z0rel(ISS,OMASK  )
!     ######################################################################
!
!*    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 yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
TYPE(sso_t), INTENT(INOUT) :: ISS
!
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
                                                       ! are done
!
!*    0.2    Declaration of other local variables
!            ------------------------------------
!
REAL,    DIMENSION(SIZE(ISS%XAOSIP)) :: ZLOC
LOGICAL, DIMENSION(SIZE(ISS%XAOSIP)) :: GMASK
!
INTEGER :: JJ      ! loop counter on points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!----------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GET_Z0REL',0,zhook_handle)
!
IF (PRESENT(omask)) THEN
  gmask=omask
ELSE
  gmask=(iss%XAOSIP/=xundef)
END IF
!
iss%XZ0REL=xundef
!
zloc(:) = 0.
!
WHERE (gmask(:))
  zloc(:) = 0.25 * xcdz0eff/(2.*xkarman**2)                  &
                   * (iss%XAOSIP(:) + iss%XAOSIM(:) + iss%XAOSJP(:) + iss%XAOSJM(:))        
  WHERE ( zloc(:) > 0. )
    iss%XZ0REL(:) = 0.25 * (iss%XHO2IP(:) + iss%XHO2IM(:) + iss%XHO2JP(:) + iss%XHO2JM(:)) &
                     * exp(-sqrt(1./zloc(:)))
    iss%XZ0REL(:) = max(iss%XZ0REL(:),1e-10)
  ELSEWHERE
    iss%XZ0REL(:) = 0.
  END WHERE
END WHERE      
!
IF (lhook) CALL dr_hook('GET_Z0REL',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE get_z0rel
!