topology Subroutine

public subroutine topology(tab, long, larg, res)

Note

The function performs the following operations on a surface:

  • mask the heights heights that are above 85 % of the (100% - 15 %) core, to avoid pits and peaks
  • erode then dilate (opening) the mask
  • count cells and the median size

Reproduce the preceding steps with thresholds 15% and 95%.

The results are put in the vector ‘res’

Arguments

Type IntentOptional Attributes Name
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(out), dimension(1:6) :: res

results

Calls

proc~~topology~~CallsGraph proc~topology topology proc~count_cell count_cell proc~topology->proc~count_cell proc~def_masque def_masque proc~topology->proc~def_masque proc~erode_dilate erode_dilate proc~topology->proc~erode_dilate proc~calc_median calc_median proc~count_cell->proc~calc_median proc~flood flood proc~count_cell->proc~flood sort_array2 sort_array2 proc~calc_median->sort_array2

Source Code

   subroutine topology(tab, long, larg, res)
   !================================================================================================
   !< @note
   !<
   !< The function performs the following operations on a surface:
   !<
   !< + mask the heights heights that are above 85 % of the (100% - 15 %) core, to avoid pits and peaks
   !< + erode then dilate (opening) the mask
   !< + count cells and the median size
   !<
   !< Reproduce the preceding steps with thresholds 15% and 95%.
   !<
   !< The results are put in the vector 'res'
   !<
   !< @endnote
   !------------------------------------------------------------------------------------------------
   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 ), dimension(1:long, 1:larg)  :: tab   !! *heights 2D array*
   real   (kind=R8), intent(out), dimension(1:6)             :: res   !! *results*

      real   (kind=R8), dimension(1:long, 1:larg) :: tab_tmp1
      integer(kind=I4), dimension(1:long, 1:larg) :: msk

      real   (kind=R8) :: mintab, maxtab, top01, top02, med_cell01, med_cell02
      integer(kind=I4) :: nbr_cell01, nbr_cell02

      mintab = minval( tab(1:long, 1:larg) )
      maxtab = maxval( tab(1:long, 1:larg) )

      tab_tmp1(1:long, 1:larg) = ( tab(1:long, 1:larg) - mintab )/( maxtab - mintab )

      call def_masque(msk = msk,          &  ! OUT
                      tab = tab_tmp1,     &  ! IN
                     long = long,         &  ! IN
                     larg = larg,         &  ! IN
                    crit1 = 0.15_R8,      &  ! IN
                    crit2 = 0.85_R8,      &  ! IN
                      top = top01)           ! OUT
      !......................................!
      call erode_dilate(msk = msk,        &  ! INOUT
                       long = long,       &  ! IN
                       larg = larg,       &  ! IN
                        val = 5,          &  ! IN
                        act = "erode")       ! IN

      call erode_dilate(msk = msk,        &  ! INOUT
                       long = long,       &  ! IN
                       larg = larg,       &  ! IN
                        val = 5,          &  ! IN
                        act = "dilat")       ! IN

      call count_cell(msk = msk,          &  ! INOUT
                     long = long,         &  ! IN
                     larg = larg,         &  ! IN
                 nbr_cell = nbr_cell01,   &  ! IN
                 med_cell = med_cell01)      ! IN
      !......................................!
      call def_masque(msk = msk,          &  ! OUT
                      tab = tab_tmp1,     &  ! IN
                     long = long,         &  ! IN
                     larg = larg,         &  ! IN
                    crit1 = 0.15_R8,      &  ! IN
                    crit2 = 0.95_R8,      &  ! IN
                      top = top02)           ! OUT

      call erode_dilate(msk = msk,        &  ! INOUT
                       long = long,       &  ! IN
                       larg = larg,       &  ! IN
                        val = 5,          &  ! IN
                        act = "erode")       ! IN

      call erode_dilate(msk = msk,        &  ! INOUT
                       long = long,       &  ! IN
                       larg = larg,       &  ! IN
                        val = 5,          &  ! IN
                        act = "dilat")       ! IN

      call count_cell(msk = msk,          &  ! INOUT
                     long = long,         &  ! IN
                     larg = larg,         &  ! IN
                 nbr_cell = nbr_cell02,   &  ! OUT
                 med_cell = med_cell02)      ! OUT

      res(1:6) = [real(nbr_cell01, kind=R8), med_cell01, top01, &  !
                  real(nbr_cell02, kind=R8), med_cell02, top02]

   return
   endsubroutine topology