peaks_and_pits_curvatures Subroutine

public subroutine peaks_and_pits_curvatures(heights, nx, ny, dx, dy, S_param_grad, S_param_curv, peak_curv, pits_curv)

Function to calculate and output the peaks and pits curvatures as well as then mean quadratic gradient value and the mean quadratic curvature value.

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(in), dimension(1:nx, 1:ny) :: heights

input 2D array
integer(kind=I4), intent(in) :: nx

number of pixels along x
integer(kind=I4), intent(in) :: ny

number of pixels along x
real(kind=R8), intent(in) :: dx

x lag
real(kind=R8), intent(in) :: dy

y lag
real(kind=R8), intent(out) :: S_param_grad

mean quadratic gradient value
real(kind=R8), intent(out) :: S_param_curv

mean quadratic curvature value
real(kind=R8), intent(out) :: peak_curv

3 first peaks mean curvature
real(kind=R8), intent(out) :: pits_curv

3 first pits mean curvature

Calls

proc~~peaks_and_pits_curvatures~~CallsGraph proc~peaks_and_pits_curvatures peaks_and_pits_curvatures proc~curvature curvature proc~peaks_and_pits_curvatures->proc~curvature proc~label_surf_summits label_surf_summits proc~peaks_and_pits_curvatures->proc~label_surf_summits sort_array2 sort_array2 proc~peaks_and_pits_curvatures->sort_array2 proc~gauss_curv gauss_curv proc~curvature->proc~gauss_curv proc~gradient gradient proc~curvature->proc~gradient proc~gradient_corner gradient_corner proc~label_surf_summits->proc~gradient_corner proc~labelize_point labelize_point proc~label_surf_summits->proc~labelize_point selectcase selectcase proc~label_surf_summits->selectcase proc~gauss_curv->proc~gradient proc~deriv_n deriv_N proc~labelize_point->proc~deriv_n

Called by

proc~~peaks_and_pits_curvatures~~CalledByGraph proc~peaks_and_pits_curvatures peaks_and_pits_curvatures proc~test_peaks_and_pits_curvatures test_peaks_and_pits_curvatures proc~test_peaks_and_pits_curvatures->proc~peaks_and_pits_curvatures program~test_grad_curv test_grad_curv program~test_grad_curv->proc~test_peaks_and_pits_curvatures

Source Code

   subroutine peaks_and_pits_curvatures(heights, nx, ny, dx, dy, S_param_grad, S_param_curv, peak_curv, pits_curv)
   !================================================================================================
   !! Function to calculate and output the peaks and pits curvatures as well as then mean quadratic
   !!        gradient value and the mean quadratic curvature value.
   implicit none
   integer(kind=I4), intent(in ) :: nx                              !! *number of pixels along x*
   integer(kind=I4), intent(in ) :: ny                              !! *number of pixels along x*
   real   (kind=R8), intent(in ) :: dx                              !! *x lag*
   real   (kind=R8), intent(in ) :: dy                              !! *y lag*
   real   (kind=R8), intent(out) :: peak_curv                       !! *3 first peaks mean curvature*
   real   (kind=R8), intent(out) :: pits_curv                       !! *3 first pits  mean curvature*
   real   (kind=R8), intent(out) :: S_param_grad                    !! *mean quadratic gradient value*
   real   (kind=R8), intent(out) :: S_param_curv                    !! *mean quadratic curvature value*
   real   (kind=R8), intent(in ), dimension(1:nx, 1:ny) :: heights  !! *input 2D array*

      integer(kind=I4) :: i, npeak, npits

      real(kind=R8) :: spg, spc, adim

      integer(kind=I4), allocatable, dimension(:,:) :: vall, peak, sadd

      integer(kind=I4), dimension(1:3) :: nb_extr

      real(kind=R8), dimension(1:nx*ny) :: tpits
      real(kind=R8), dimension(1:nx*ny) :: tpeak

      real(kind=R8), allocatable, dimension(:,:) :: cvt

      allocate( cvt(1:nx, 1:ny) )

      ! first determine the surface curvature
      call curvature(tab          = heights(1:nx, 1:ny),      & ! in
                     nx           = nx,                       & ! in
                     ny           = ny,                       & ! in
                     dx           = dx,                       & ! in
                     dy           = dy,                       & ! in
                     S_param_grad = spg,                      & ! out
                     S_param_curv = spc,                      & ! out
                     gcurvt       = cvt(1:nx, 1:ny))            ! out

      ! OUTPUT
      S_param_grad = spg
      S_param_curv = spc

      ! no need to carry very high/low values, so normalize curvature
      adim = maxval( abs(cvt(1:nx, 1:ny)) )

      cvt(1:nx, 1:ny) = cvt(1:nx, 1:ny) / adim

      call label_surf_summits(tab        = cvt(1:nx, 1:ny),     & ! in
                              nx         = nx,                  & ! in
                              ny         = ny,                  & ! in
                              valleys    = vall,                & ! out
                              peaks      = peak,                & ! out
                              saddles    = sadd,                & ! out
                              nb_summits = nb_extr(1:3))          ! out

      !.....................................................

      npits = nb_extr(1)

      do i = 1, npits

         tpits(i) = cvt( vall(i, 1), vall(i, 2) )     ! first values needed, so ascending sort is OK

      enddo

      call sort_array2( tab_inout = tpits(1:npits), &  ! inout
                        n         = npits )            ! in

      ! OUTPUT
      pits_curv = adim * sum( tpits(1:3) ) / 3.       ! mean of first 3 values, with the right dimension

      !.....................................................

      npeak = nb_extr(3)

      do i = 1, npeak

         tpeak(i) = -cvt( peak(i, 1), peak(i, 2) )    ! top values of peak needed, so reverse for ascending sort

      enddo

      call sort_array2( tab_inout = tpeak(1:npeak), &  ! inout
                        n         = npeak )            ! in

      ! OUTPUT
      peak_curv = - adim * sum( tpeak(1:3) ) / 3      ! mean of first 3 values, with the right dimension and the right sign


      deallocate( cvt, vall, peak, sadd )

   return
   endsubroutine peaks_and_pits_curvatures