Very classical smoothing
Type | Intent | Optional | 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 |
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