median_smooth Subroutine

public subroutine median_smooth(tab, long, larg, kernel, omp)

Very classical smoothing

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(inout), dimension(1:long, 1:larg) :: tab

2D array

integer(kind=I4), intent(in) :: long

2D array length

integer(kind=I4), intent(in) :: larg

2D array width

integer(kind=I4), intent(in) :: kernel

kernel size

logical(kind=I4), intent(in) :: omp

if multithreading


Calls

proc~~median_smooth~~CallsGraph proc~median_smooth median_smooth omp_get_num_procs omp_get_num_procs proc~median_smooth->omp_get_num_procs proc~calc_median calc_median proc~median_smooth->proc~calc_median sort_array2 sort_array2 proc~median_smooth->sort_array2 proc~calc_median->sort_array2

Called by

proc~~median_smooth~~CalledByGraph proc~median_smooth median_smooth proc~median_filter median_filter proc~median_filter->proc~median_smooth program~test_smooth test_smooth program~test_smooth->proc~median_smooth program~test_smooth->proc~median_filter

Source Code

   subroutine median_smooth(tab, long, larg, kernel, omp)
   !================================================================================================
   !! Very classical smoothing
   !------------------------------------------------------------------------------------------------
   implicit none
   integer(kind=I4), intent(in   )                            :: long   !! *2D array length*
   integer(kind=I4), intent(in   )                            :: larg   !! *2D array width*
   integer(kind=I4), intent(in   )                            :: kernel !! *kernel size*
   logical(kind=I4), intent(in   )                            :: omp    !! *if multithreading*
   real   (kind=R8), intent(inout), dimension(1:long, 1:larg) :: tab    !! *2D array*

      integer(kind=I4) :: i, j, k, ii, jj, nt, nk, nb_th
      real(kind=R8)    :: md

      real(kind=R8), allocatable, dimension(:,:) :: tab_tmp, t
      real(kind=R8), allocatable, dimension(:)   :: vt

      allocate( tab_tmp(1:long, 1:larg) ) ; tab_tmp = HIG_R8

      k  = kernel
      nt = ( 2*k + 1 )*( 2*k + 1 )

      allocate( t(-k:k, -k:k), vt(1:(2*k+1)*(2*k+1)) )

      nb_th = 1
      if (omp) then
         nb_th = omp_get_num_procs()
      endif

      !$OMP PARALLEL DEFAULT(SHARED) NUM_THREADS(nb_th) IF (omp)
      !$OMP DO SCHEDULE (STATIC,larg/nb_th) PRIVATE(i, t, nk, ii, jj, vt, md)

      do j = 1, larg
      do i = 1, long

         t(-k:k, -k:k) = -HIG_R8/10
         nk = 0

         do jj = -k, +k

            if (j +jj < 1 .or. j +jj > larg) cycle

            do ii = -k, +k
               if (i +ii < 1 .or. i +ii > long) cycle
               nk = nk +1
               t(ii, jj) = tab(i +ii, j +jj)
            enddo

         enddo

         vt(1:nt) = reshape(t(-k:k, -k:k), [nt])
         call sort_array2(tab_inout = vt(1:nt), n = nt)

         call calc_median(tab = vt(nt -nk +1:nt), md = md)

         tab_tmp(i, j) = md

      enddo
      enddo

      !$OMP END DO
      !$OMP END PARALLEL

      tab(1:long, 1:larg) = tab_tmp(1:long, 1:larg)

      deallocate( tab_tmp, t, vt )

   return
   endsubroutine median_smooth