def_masque Subroutine

public subroutine def_masque(msk, tab, long, larg, crit1, crit2, top)

Height mask without deepest pits and highest peaks

Arguments

Type IntentOptional Attributes Name
integer(kind=I4), intent(out), dimension(1:long, 1:larg) :: msk

mask
real(kind=R8), intent(in), dimension(1:long, 1:larg) :: tab

heights 2D array
integer(kind=I4), intent(in) :: long

2D array length
integer(kind=I4), intent(in) :: larg

2D array height
real(kind=R8), intent(in) :: crit1

%age for deepest pits to remove
real(kind=R8), intent(in) :: crit2

%age for highest peaks to remove
real(kind=R8), intent(out) :: top

%age of surface masked

Called by

proc~~def_masque~~CalledByGraph proc~def_masque def_masque proc~topology topology proc~topology->proc~def_masque program~test_morpho test_morpho program~test_morpho->proc~def_masque

Source Code

   subroutine def_masque(msk, tab, long, larg, crit1, crit2, top)
   !================================================================================================
   !! Height mask without deepest pits and highest peaks
   !------------------------------------------------------------------------------------------------
   implicit none
   integer(kind=I4), intent(in )                            :: long     !! *2D array length*
   integer(kind=I4), intent(in )                            :: larg     !! *2D array height*
   real   (kind=R8), intent(in )                            :: crit1    !! *%age for deepest pits to remove*
   real   (kind=R8), intent(in )                            :: crit2    !! *%age for highest peaks to remove*
   real   (kind=R8), intent(out)                            :: top      !! *%age of surface masked*
   real   (kind=R8), intent(in ), dimension(1:long, 1:larg) :: tab      !! *heights 2D array*
   integer(kind=I4), intent(out), dimension(1:long, 1:larg) :: msk      !! *mask*

      msk(1:long, 1:larg) = 0
      ! height masked : height above c1 + c2 * (1 - c1)
      ! ex: c1 = 15 %, c2 = 85 % -> heights that are above 85 % of the (1 - 15 %) core are masked
      where( tab > crit1 + crit2 - crit1 * crit2 ) msk = 1
      top = 100 * real( sum( msk(1:long, 1:larg) ), kind=R8 ) / ( long * larg )

   return
   endsubroutine def_masque