From 7e5d678161d103ba5156496f1b51adb5b1e257a2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 1 Jul 2015 14:16:54 +0000 Subject: [PATCH] psblas-submodules: base/modules/psb_c_sort_mod.f90 base/modules/psb_d_sort_mod.f90 base/modules/psb_i_sort_mod.f90 base/modules/psb_s_sort_mod.f90 base/modules/psb_z_sort_mod.f90 base/serial/sort/psb_c_hsort_impl.f90 base/serial/sort/psb_c_isort_impl.f90 base/serial/sort/psb_c_qsort_impl.f90 base/serial/sort/psb_d_hsort_impl.f90 base/serial/sort/psb_d_isort_impl.f90 base/serial/sort/psb_d_qsort_impl.f90 base/serial/sort/psb_i_hsort_impl.f90 base/serial/sort/psb_i_isort_impl.f90 base/serial/sort/psb_i_qsort_impl.f90 base/serial/sort/psb_s_hsort_impl.f90 base/serial/sort/psb_s_isort_impl.f90 base/serial/sort/psb_s_qsort_impl.f90 base/serial/sort/psb_z_hsort_impl.f90 base/serial/sort/psb_z_isort_impl.f90 base/serial/sort/psb_z_qsort_impl.f90 interface/implementation minor mismatch fixes --- base/modules/psb_c_sort_mod.f90 | 2 +- base/modules/psb_d_sort_mod.f90 | 2 +- base/modules/psb_i_sort_mod.f90 | 2 +- base/modules/psb_s_sort_mod.f90 | 2 +- base/modules/psb_z_sort_mod.f90 | 2 +- base/serial/sort/psb_c_hsort_impl.f90 | 14 +- base/serial/sort/psb_c_isort_impl.f90 | 72 +++---- base/serial/sort/psb_c_qsort_impl.f90 | 264 +++++++++++++------------- base/serial/sort/psb_d_hsort_impl.f90 | 4 +- base/serial/sort/psb_d_isort_impl.f90 | 48 ++--- base/serial/sort/psb_d_qsort_impl.f90 | 176 ++++++++--------- base/serial/sort/psb_i_hsort_impl.f90 | 4 +- base/serial/sort/psb_i_isort_impl.f90 | 48 ++--- base/serial/sort/psb_i_qsort_impl.f90 | 176 ++++++++--------- base/serial/sort/psb_s_hsort_impl.f90 | 4 +- base/serial/sort/psb_s_isort_impl.f90 | 48 ++--- base/serial/sort/psb_s_qsort_impl.f90 | 176 ++++++++--------- base/serial/sort/psb_z_hsort_impl.f90 | 14 +- base/serial/sort/psb_z_isort_impl.f90 | 72 +++---- base/serial/sort/psb_z_qsort_impl.f90 | 264 +++++++++++++------------- 20 files changed, 697 insertions(+), 697 deletions(-) diff --git a/base/modules/psb_c_sort_mod.f90 b/base/modules/psb_c_sort_mod.f90 index 0d457a94..9fc84d3a 100644 --- a/base/modules/psb_c_sort_mod.f90 +++ b/base/modules/psb_c_sort_mod.f90 @@ -190,7 +190,7 @@ module psb_c_sort_mod interface module subroutine psi_c_heap_get_first(key,last,heap,dir,info) implicit none - complex(psb_spk_), intent(inout) :: key + complex(psb_spk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir complex(psb_spk_), intent(inout) :: heap(:) diff --git a/base/modules/psb_d_sort_mod.f90 b/base/modules/psb_d_sort_mod.f90 index e9043983..720130a9 100644 --- a/base/modules/psb_d_sort_mod.f90 +++ b/base/modules/psb_d_sort_mod.f90 @@ -178,7 +178,7 @@ module psb_d_sort_mod interface module subroutine psi_d_heap_get_first(key,last,heap,dir,info) implicit none - real(psb_dpk_), intent(inout) :: key + real(psb_dpk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir real(psb_dpk_), intent(inout) :: heap(:) diff --git a/base/modules/psb_i_sort_mod.f90 b/base/modules/psb_i_sort_mod.f90 index 95d1aad7..0afdacde 100644 --- a/base/modules/psb_i_sort_mod.f90 +++ b/base/modules/psb_i_sort_mod.f90 @@ -215,7 +215,7 @@ module psb_i_sort_mod interface module subroutine psi_i_heap_get_first(key,last,heap,dir,info) implicit none - integer(psb_ipk_), intent(inout) :: key + integer(psb_ipk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir integer(psb_ipk_), intent(inout) :: heap(:) diff --git a/base/modules/psb_s_sort_mod.f90 b/base/modules/psb_s_sort_mod.f90 index 54d10755..bce216e4 100644 --- a/base/modules/psb_s_sort_mod.f90 +++ b/base/modules/psb_s_sort_mod.f90 @@ -178,7 +178,7 @@ module psb_s_sort_mod interface module subroutine psi_s_heap_get_first(key,last,heap,dir,info) implicit none - real(psb_spk_), intent(inout) :: key + real(psb_spk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir real(psb_spk_), intent(inout) :: heap(:) diff --git a/base/modules/psb_z_sort_mod.f90 b/base/modules/psb_z_sort_mod.f90 index 8295c36c..b05230d2 100644 --- a/base/modules/psb_z_sort_mod.f90 +++ b/base/modules/psb_z_sort_mod.f90 @@ -190,7 +190,7 @@ module psb_z_sort_mod interface module subroutine psi_z_heap_get_first(key,last,heap,dir,info) implicit none - complex(psb_dpk_), intent(inout) :: key + complex(psb_dpk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir complex(psb_dpk_), intent(inout) :: heap(:) diff --git a/base/serial/sort/psb_c_hsort_impl.f90 b/base/serial/sort/psb_c_hsort_impl.f90 index 85385881..1644583d 100644 --- a/base/serial/sort/psb_c_hsort_impl.f90 +++ b/base/serial/sort/psb_c_hsort_impl.f90 @@ -42,7 +42,7 @@ ! Addison-Wesley ! submodule (psb_c_sort_mod) psb_c_hsort_impl_mod - + contains subroutine psb_chsort(x,ix,dir,flag) @@ -402,9 +402,9 @@ contains ! heap: the heap ! dir: sorting direction - complex(psb_spk_), intent(inout) :: key - integer(psb_ipk_), intent(in) :: dir - complex(psb_spk_), intent(inout) :: heap(:) + complex(psb_spk_), intent(out) :: key + integer(psb_ipk_), intent(in) :: dir + complex(psb_spk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(out) :: info @@ -878,9 +878,9 @@ contains ! heap: the heap ! dir: sorting direction - complex(psb_spk_), intent(inout) :: key - integer(psb_ipk_), intent(out) :: index - integer(psb_ipk_), intent(in) :: dir + complex(psb_spk_), intent(out) :: key + integer(psb_ipk_), intent(out) :: index + integer(psb_ipk_), intent(in) :: dir complex(psb_spk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: idxs(:) integer(psb_ipk_), intent(inout) :: last diff --git a/base/serial/sort/psb_c_isort_impl.f90 b/base/serial/sort/psb_c_isort_impl.f90 index 07defa61..7914b3a8 100644 --- a/base/serial/sort/psb_c_isort_impl.f90 +++ b/base/serial/sort/psb_c_isort_impl.f90 @@ -139,59 +139,59 @@ contains return end subroutine psb_cisort - subroutine psi_clisrx_up(n,x,idx) + subroutine psi_clisrx_up(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_clisrx_up - subroutine psi_clisrx_dw(n,x,idx) + subroutine psi_clisrx_dw(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_clisrx_dw @@ -244,58 +244,58 @@ contains enddo end subroutine psi_clisr_dw - subroutine psi_calisrx_up(n,x,idx) + subroutine psi_calisrx_up(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_calisrx_up - subroutine psi_calisrx_dw(n,x,idx) + subroutine psi_calisrx_dw(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_calisrx_dw @@ -348,56 +348,56 @@ contains enddo end subroutine psi_calisr_dw - subroutine psi_caisrx_up(n,x,idx) + subroutine psi_caisrx_up(n,x,ix) use psb_error_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) < abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) >= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_caisrx_up - subroutine psi_caisrx_dw(n,x,idx) + subroutine psi_caisrx_dw(n,x,ix) use psb_error_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_spk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) > abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) <= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_caisrx_dw diff --git a/base/serial/sort/psb_c_qsort_impl.f90 b/base/serial/sort/psb_c_qsort_impl.f90 index a04e7b05..75ac2067 100644 --- a/base/serial/sort/psb_c_qsort_impl.f90 +++ b/base/serial/sort/psb_c_qsort_impl.f90 @@ -140,13 +140,13 @@ contains end subroutine psb_cqsort - subroutine psi_clqsrx_up(n,x,idx) + subroutine psi_clqsrx_up(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_spk_) :: piv, xk, xt @@ -179,39 +179,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -237,11 +237,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -263,14 +263,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_clisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_clisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_clisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_clisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -278,30 +278,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_clisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_clisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_clisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_clisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_clisrx_up(n,x,idx) + call psi_clisrx_up(n,x,ix) endif end subroutine psi_clqsrx_up - subroutine psi_clqsrx_dw(n,x,idx) + subroutine psi_clqsrx_dw(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_spk_) :: piv, xk, xt @@ -334,39 +334,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -392,11 +392,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -418,14 +418,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_clisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_clisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_clisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_clisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -433,19 +433,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_clisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_clisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_clisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_clisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_clisrx_dw(n,x,idx) + call psi_clisrx_dw(n,x,ix) endif end subroutine psi_clqsrx_dw @@ -730,13 +730,13 @@ contains end subroutine psi_clqsr_dw - subroutine psi_calqsrx_up(n,x,idx) + subroutine psi_calqsrx_up(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_spk_) :: piv, xk, xt @@ -769,39 +769,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -827,11 +827,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -853,14 +853,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_calisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_calisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_calisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_calisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -868,29 +868,29 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_calisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_calisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_calisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_calisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_calisrx_up(n,x,idx) + call psi_calisrx_up(n,x,ix) endif end subroutine psi_calqsrx_up - subroutine psi_calqsrx_dw(n,x,idx) + subroutine psi_calqsrx_dw(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_spk_) :: piv, xk, xt @@ -923,39 +923,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -981,11 +981,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -1007,14 +1007,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_calisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_calisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_calisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_calisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1022,19 +1022,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_calisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_calisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_calisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_calisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_calisrx_dw(n,x,idx) + call psi_calisrx_dw(n,x,ix) endif end subroutine psi_calqsrx_dw @@ -1317,12 +1317,12 @@ contains endif end subroutine psi_calqsr_dw - subroutine psi_caqsrx_up(n,x,idx) + subroutine psi_caqsrx_up(n,x,ix) use psb_error_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk @@ -1356,39 +1356,39 @@ contains piv = abs(x(lpiv)) if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -1413,11 +1413,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -1439,14 +1439,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_caisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_caisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_caisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_caisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1454,30 +1454,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_caisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_caisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_caisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_caisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_caisrx_up(n,x,idx) + call psi_caisrx_up(n,x,ix) endif end subroutine psi_caqsrx_up - subroutine psi_caqsrx_dw(n,x,idx) + subroutine psi_caqsrx_dw(n,x,ix) use psb_error_mod implicit none complex(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk @@ -1510,39 +1510,39 @@ contains piv = abs(x(lpiv)) if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -1567,11 +1567,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -1593,14 +1593,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_caisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_caisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_caisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_caisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1608,19 +1608,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_caisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_caisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_caisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_caisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_caisrx_dw(n,x,idx) + call psi_caisrx_dw(n,x,ix) endif end subroutine psi_caqsrx_dw diff --git a/base/serial/sort/psb_d_hsort_impl.f90 b/base/serial/sort/psb_d_hsort_impl.f90 index d8e1364a..91c09eb5 100644 --- a/base/serial/sort/psb_d_hsort_impl.f90 +++ b/base/serial/sort/psb_d_hsort_impl.f90 @@ -42,7 +42,7 @@ ! Addison-Wesley ! submodule (psb_d_sort_mod) psb_d_hsort_impl_mod - + contains subroutine psb_dhsort(x,ix,dir,flag) @@ -295,7 +295,7 @@ contains subroutine psi_d_heap_get_first(key,last,heap,dir,info) implicit none - real(psb_dpk_), intent(inout) :: key + real(psb_dpk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir real(psb_dpk_), intent(inout) :: heap(:) diff --git a/base/serial/sort/psb_d_isort_impl.f90 b/base/serial/sort/psb_d_isort_impl.f90 index 242fbbd3..c89e4771 100644 --- a/base/serial/sort/psb_d_isort_impl.f90 +++ b/base/serial/sort/psb_d_isort_impl.f90 @@ -131,56 +131,56 @@ contains return end subroutine psb_disort - subroutine psi_disrx_up(n,x,idx) + subroutine psi_disrx_up(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_disrx_up - subroutine psi_disrx_dw(n,x,idx) + subroutine psi_disrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_disrx_dw @@ -232,56 +232,56 @@ contains enddo end subroutine psi_disr_dw - subroutine psi_daisrx_up(n,x,idx) + subroutine psi_daisrx_up(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_dpk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) < abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) >= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_daisrx_up - subroutine psi_daisrx_dw(n,x,idx) + subroutine psi_daisrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_dpk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) > abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) <= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_daisrx_dw diff --git a/base/serial/sort/psb_d_qsort_impl.f90 b/base/serial/sort/psb_d_qsort_impl.f90 index 99a36295..3f97d392 100644 --- a/base/serial/sort/psb_d_qsort_impl.f90 +++ b/base/serial/sort/psb_d_qsort_impl.f90 @@ -131,12 +131,12 @@ contains return end subroutine psb_dqsort - subroutine psi_dqsrx_up(n,x,idx) + subroutine psi_dqsrx_up(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk, xt @@ -169,39 +169,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -227,11 +227,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -253,14 +253,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_disrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_disrx_up(n2,x(i:iux),idx(i:iux)) + call psi_disrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -268,28 +268,28 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_disrx_up(n2,x(i:iux),idx(i:iux)) + call psi_disrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_disrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_disrx_up(n,x,idx) + call psi_disrx_up(n,x,ix) endif end subroutine psi_dqsrx_up - subroutine psi_dqsrx_dw(n,x,idx) + subroutine psi_dqsrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk, xt @@ -322,39 +322,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -380,11 +380,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -406,14 +406,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_disrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_disrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_disrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -421,19 +421,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_disrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_disrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_disrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_disrx_dw(n,x,idx) + call psi_disrx_dw(n,x,ix) endif end subroutine psi_dqsrx_dw @@ -718,12 +718,12 @@ contains end subroutine psi_dqsr_dw - subroutine psi_daqsrx_up(n,x,idx) + subroutine psi_daqsrx_up(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk @@ -757,39 +757,39 @@ contains piv = abs(x(lpiv)) if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -814,11 +814,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -840,14 +840,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_daisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_daisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_daisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -855,30 +855,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_daisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_daisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_daisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_daisrx_up(n,x,idx) + call psi_daisrx_up(n,x,ix) endif end subroutine psi_daqsrx_up - subroutine psi_daqsrx_dw(n,x,idx) + subroutine psi_daqsrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk @@ -911,39 +911,39 @@ contains piv = abs(x(lpiv)) if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -968,11 +968,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -994,14 +994,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_daisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_daisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_daisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1009,19 +1009,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_daisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_daisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_daisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_daisrx_dw(n,x,idx) + call psi_daisrx_dw(n,x,ix) endif end subroutine psi_daqsrx_dw diff --git a/base/serial/sort/psb_i_hsort_impl.f90 b/base/serial/sort/psb_i_hsort_impl.f90 index cbf5d800..aa6a38e2 100644 --- a/base/serial/sort/psb_i_hsort_impl.f90 +++ b/base/serial/sort/psb_i_hsort_impl.f90 @@ -42,7 +42,7 @@ ! Addison-Wesley ! submodule (psb_i_sort_mod) psb_i_hsort_impl_mod - + contains subroutine psb_ihsort(x,ix,dir,flag) @@ -295,7 +295,7 @@ contains subroutine psi_i_heap_get_first(key,last,heap,dir,info) implicit none - integer(psb_ipk_), intent(inout) :: key + integer(psb_ipk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir integer(psb_ipk_), intent(inout) :: heap(:) diff --git a/base/serial/sort/psb_i_isort_impl.f90 b/base/serial/sort/psb_i_isort_impl.f90 index 047deebf..d0b0fbd1 100644 --- a/base/serial/sort/psb_i_isort_impl.f90 +++ b/base/serial/sort/psb_i_isort_impl.f90 @@ -131,56 +131,56 @@ contains return end subroutine psb_iisort - subroutine psi_iisrx_up(n,x,idx) + subroutine psi_iisrx_up(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx integer(psb_ipk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_iisrx_up - subroutine psi_iisrx_dw(n,x,idx) + subroutine psi_iisrx_dw(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx integer(psb_ipk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_iisrx_dw @@ -232,56 +232,56 @@ contains enddo end subroutine psi_iisr_dw - subroutine psi_iaisrx_up(n,x,idx) + subroutine psi_iaisrx_up(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx integer(psb_ipk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) < abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) >= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_iaisrx_up - subroutine psi_iaisrx_dw(n,x,idx) + subroutine psi_iaisrx_dw(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx integer(psb_ipk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) > abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) <= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_iaisrx_dw diff --git a/base/serial/sort/psb_i_qsort_impl.f90 b/base/serial/sort/psb_i_qsort_impl.f90 index 170f7c32..7aecd502 100644 --- a/base/serial/sort/psb_i_qsort_impl.f90 +++ b/base/serial/sort/psb_i_qsort_impl.f90 @@ -131,12 +131,12 @@ contains return end subroutine psb_iqsort - subroutine psi_iqsrx_up(n,x,idx) + subroutine psi_iqsrx_up(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. integer(psb_ipk_) :: piv, xk, xt @@ -169,39 +169,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -227,11 +227,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -253,14 +253,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_iisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_iisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -268,28 +268,28 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_iisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_iisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_iisrx_up(n,x,idx) + call psi_iisrx_up(n,x,ix) endif end subroutine psi_iqsrx_up - subroutine psi_iqsrx_dw(n,x,idx) + subroutine psi_iqsrx_dw(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. integer(psb_ipk_) :: piv, xk, xt @@ -322,39 +322,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -380,11 +380,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -406,14 +406,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_iisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_iisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -421,19 +421,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_iisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_iisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_iisrx_dw(n,x,idx) + call psi_iisrx_dw(n,x,ix) endif end subroutine psi_iqsrx_dw @@ -718,12 +718,12 @@ contains end subroutine psi_iqsr_dw - subroutine psi_iaqsrx_up(n,x,idx) + subroutine psi_iaqsrx_up(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. integer(psb_ipk_) :: piv, xk @@ -757,39 +757,39 @@ contains piv = abs(x(lpiv)) if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -814,11 +814,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -840,14 +840,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iaisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_iaisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_iaisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -855,30 +855,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_iaisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_iaisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iaisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_iaisrx_up(n,x,idx) + call psi_iaisrx_up(n,x,ix) endif end subroutine psi_iaqsrx_up - subroutine psi_iaqsrx_dw(n,x,idx) + subroutine psi_iaqsrx_dw(n,x,ix) use psb_error_mod implicit none integer(psb_ipk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. integer(psb_ipk_) :: piv, xk @@ -911,39 +911,39 @@ contains piv = abs(x(lpiv)) if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -968,11 +968,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -994,14 +994,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iaisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_iaisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1009,19 +1009,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_iaisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_iaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_iaisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_iaisrx_dw(n,x,idx) + call psi_iaisrx_dw(n,x,ix) endif end subroutine psi_iaqsrx_dw diff --git a/base/serial/sort/psb_s_hsort_impl.f90 b/base/serial/sort/psb_s_hsort_impl.f90 index cf3afeb1..bd8c1fd7 100644 --- a/base/serial/sort/psb_s_hsort_impl.f90 +++ b/base/serial/sort/psb_s_hsort_impl.f90 @@ -42,7 +42,7 @@ ! Addison-Wesley ! submodule (psb_s_sort_mod) psb_s_hsort_impl_mod - + contains subroutine psb_shsort(x,ix,dir,flag) @@ -295,7 +295,7 @@ contains subroutine psi_s_heap_get_first(key,last,heap,dir,info) implicit none - real(psb_spk_), intent(inout) :: key + real(psb_spk_), intent(out) :: key integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(in) :: dir real(psb_spk_), intent(inout) :: heap(:) diff --git a/base/serial/sort/psb_s_isort_impl.f90 b/base/serial/sort/psb_s_isort_impl.f90 index dbc2ffa3..fb67fbaf 100644 --- a/base/serial/sort/psb_s_isort_impl.f90 +++ b/base/serial/sort/psb_s_isort_impl.f90 @@ -131,56 +131,56 @@ contains return end subroutine psb_sisort - subroutine psi_sisrx_up(n,x,idx) + subroutine psi_sisrx_up(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_sisrx_up - subroutine psi_sisrx_dw(n,x,idx) + subroutine psi_sisrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_spk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_sisrx_dw @@ -232,56 +232,56 @@ contains enddo end subroutine psi_sisr_dw - subroutine psi_saisrx_up(n,x,idx) + subroutine psi_saisrx_up(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_spk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) < abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) >= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_saisrx_up - subroutine psi_saisrx_dw(n,x,idx) + subroutine psi_saisrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx real(psb_spk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) > abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) <= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_saisrx_dw diff --git a/base/serial/sort/psb_s_qsort_impl.f90 b/base/serial/sort/psb_s_qsort_impl.f90 index 62f15784..a200c3fd 100644 --- a/base/serial/sort/psb_s_qsort_impl.f90 +++ b/base/serial/sort/psb_s_qsort_impl.f90 @@ -131,12 +131,12 @@ contains return end subroutine psb_sqsort - subroutine psi_sqsrx_up(n,x,idx) + subroutine psi_sqsrx_up(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk, xt @@ -169,39 +169,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -227,11 +227,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -253,14 +253,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_sisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_sisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_sisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_sisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -268,28 +268,28 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_sisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_sisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_sisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_sisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_sisrx_up(n,x,idx) + call psi_sisrx_up(n,x,ix) endif end subroutine psi_sqsrx_up - subroutine psi_sqsrx_dw(n,x,idx) + subroutine psi_sqsrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk, xt @@ -322,39 +322,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -380,11 +380,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -406,14 +406,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_sisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_sisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_sisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_sisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -421,19 +421,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_sisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_sisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_sisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_sisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_sisrx_dw(n,x,idx) + call psi_sisrx_dw(n,x,ix) endif end subroutine psi_sqsrx_dw @@ -718,12 +718,12 @@ contains end subroutine psi_sqsr_dw - subroutine psi_saqsrx_up(n,x,idx) + subroutine psi_saqsrx_up(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk @@ -757,39 +757,39 @@ contains piv = abs(x(lpiv)) if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -814,11 +814,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -840,14 +840,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_saisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_saisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_saisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_saisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -855,30 +855,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_saisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_saisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_saisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_saisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_saisrx_up(n,x,idx) + call psi_saisrx_up(n,x,ix) endif end subroutine psi_saqsrx_up - subroutine psi_saqsrx_dw(n,x,idx) + subroutine psi_saqsrx_dw(n,x,ix) use psb_error_mod implicit none real(psb_spk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_spk_) :: piv, xk @@ -911,39 +911,39 @@ contains piv = abs(x(lpiv)) if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -968,11 +968,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -994,14 +994,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_saisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_saisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_saisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_saisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1009,19 +1009,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_saisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_saisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_saisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_saisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_saisrx_dw(n,x,idx) + call psi_saisrx_dw(n,x,ix) endif end subroutine psi_saqsrx_dw diff --git a/base/serial/sort/psb_z_hsort_impl.f90 b/base/serial/sort/psb_z_hsort_impl.f90 index b908ff56..3f98f8fa 100644 --- a/base/serial/sort/psb_z_hsort_impl.f90 +++ b/base/serial/sort/psb_z_hsort_impl.f90 @@ -42,7 +42,7 @@ ! Addison-Wesley ! submodule (psb_z_sort_mod) psb_z_hsort_impl_mod - + contains subroutine psb_zhsort(x,ix,dir,flag) @@ -402,9 +402,9 @@ contains ! heap: the heap ! dir: sorting direction - complex(psb_dpk_), intent(inout) :: key - integer(psb_ipk_), intent(in) :: dir - complex(psb_dpk_), intent(inout) :: heap(:) + complex(psb_dpk_), intent(out) :: key + integer(psb_ipk_), intent(in) :: dir + complex(psb_dpk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(out) :: info @@ -878,9 +878,9 @@ contains ! heap: the heap ! dir: sorting direction - complex(psb_dpk_), intent(inout) :: key - integer(psb_ipk_), intent(out) :: index - integer(psb_ipk_), intent(in) :: dir + complex(psb_dpk_), intent(out) :: key + integer(psb_ipk_), intent(out) :: index + integer(psb_ipk_), intent(in) :: dir complex(psb_dpk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: idxs(:) integer(psb_ipk_), intent(inout) :: last diff --git a/base/serial/sort/psb_z_isort_impl.f90 b/base/serial/sort/psb_z_isort_impl.f90 index e49e806e..cef3a0c8 100644 --- a/base/serial/sort/psb_z_isort_impl.f90 +++ b/base/serial/sort/psb_z_isort_impl.f90 @@ -139,59 +139,59 @@ contains return end subroutine psb_zisort - subroutine psi_zlisrx_up(n,x,idx) + subroutine psi_zlisrx_up(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zlisrx_up - subroutine psi_zlisrx_dw(n,x,idx) + subroutine psi_zlisrx_dw(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zlisrx_dw @@ -244,58 +244,58 @@ contains enddo end subroutine psi_zlisr_dw - subroutine psi_zalisrx_up(n,x,idx) + subroutine psi_zalisrx_up(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) < x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) >= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zalisrx_up - subroutine psi_zalisrx_dw(n,x,idx) + subroutine psi_zalisrx_dw(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (x(j+1) > x(j)) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (x(i) <= xx) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zalisrx_dw @@ -348,56 +348,56 @@ contains enddo end subroutine psi_zalisr_dw - subroutine psi_zaisrx_up(n,x,idx) + subroutine psi_zaisrx_up(n,x,ix) use psb_error_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) < abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) >= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zaisrx_up - subroutine psi_zaisrx_dw(n,x,idx) + subroutine psi_zaisrx_dw(n,x,ix) use psb_error_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n - integer(psb_ipk_) :: i,j,ix + integer(psb_ipk_) :: i,j,itx complex(psb_dpk_) :: xx do j=n-1,1,-1 if (abs(x(j+1)) > abs(x(j))) then xx = x(j) - ix = idx(j) + itx = ix(j) i=j+1 do x(i-1) = x(i) - idx(i-1) = idx(i) + ix(i-1) = ix(i) i = i+1 if (i>n) exit if (abs(x(i)) <= abs(xx)) exit end do x(i-1) = xx - idx(i-1) = ix + ix(i-1) = itx endif enddo end subroutine psi_zaisrx_dw diff --git a/base/serial/sort/psb_z_qsort_impl.f90 b/base/serial/sort/psb_z_qsort_impl.f90 index 1a241004..e1b4b29a 100644 --- a/base/serial/sort/psb_z_qsort_impl.f90 +++ b/base/serial/sort/psb_z_qsort_impl.f90 @@ -140,13 +140,13 @@ contains end subroutine psb_zqsort - subroutine psi_zlqsrx_up(n,x,idx) + subroutine psi_zlqsrx_up(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_dpk_) :: piv, xk, xt @@ -179,39 +179,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -237,11 +237,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -263,14 +263,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zlisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zlisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zlisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zlisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -278,30 +278,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zlisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zlisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zlisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zlisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zlisrx_up(n,x,idx) + call psi_zlisrx_up(n,x,ix) endif end subroutine psi_zlqsrx_up - subroutine psi_zlqsrx_dw(n,x,idx) + subroutine psi_zlqsrx_dw(n,x,ix) use psb_error_mod use psi_lcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_dpk_) :: piv, xk, xt @@ -334,39 +334,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -392,11 +392,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -418,14 +418,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zlisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zlisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zlisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zlisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -433,19 +433,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zlisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zlisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zlisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zlisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zlisrx_dw(n,x,idx) + call psi_zlisrx_dw(n,x,ix) endif end subroutine psi_zlqsrx_dw @@ -730,13 +730,13 @@ contains end subroutine psi_zlqsr_dw - subroutine psi_zalqsrx_up(n,x,idx) + subroutine psi_zalqsrx_up(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_dpk_) :: piv, xk, xt @@ -769,39 +769,39 @@ contains piv = x(lpiv) if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -827,11 +827,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -853,14 +853,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zalisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zalisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zalisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zalisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -868,29 +868,29 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zalisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zalisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zalisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zalisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zalisrx_up(n,x,idx) + call psi_zalisrx_up(n,x,ix) endif end subroutine psi_zalqsrx_up - subroutine psi_zalqsrx_dw(n,x,idx) + subroutine psi_zalqsrx_dw(n,x,ix) use psb_error_mod use psi_alcx_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. complex(psb_dpk_) :: piv, xk, xt @@ -923,39 +923,39 @@ contains piv = x(lpiv) if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -981,11 +981,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -1007,14 +1007,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zalisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zalisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zalisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zalisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1022,19 +1022,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zalisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zalisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zalisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zalisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zalisrx_dw(n,x,idx) + call psi_zalisrx_dw(n,x,ix) endif end subroutine psi_zalqsrx_dw @@ -1317,12 +1317,12 @@ contains endif end subroutine psi_zalqsr_dw - subroutine psi_zaqsrx_up(n,x,idx) + subroutine psi_zaqsrx_up(n,x,ix) use psb_error_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk @@ -1356,39 +1356,39 @@ contains piv = abs(x(lpiv)) if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -1413,11 +1413,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_up end if @@ -1439,14 +1439,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zaisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zaisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zaisrx_up(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1454,30 +1454,30 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zaisrx_up(n2,x(i:iux),idx(i:iux)) + call psi_zaisrx_up(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zaisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zaisrx_up(n,x,idx) + call psi_zaisrx_up(n,x,ix) endif end subroutine psi_zaqsrx_up - subroutine psi_zaqsrx_dw(n,x,idx) + subroutine psi_zaqsrx_dw(n,x,ix) use psb_error_mod implicit none complex(psb_dpk_), intent(inout) :: x(:) - integer(psb_ipk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(in) :: n ! .. Local Scalars .. real(psb_dpk_) :: piv, xk @@ -1510,39 +1510,39 @@ contains piv = abs(x(lpiv)) if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv < abs(x(j))) then xt = x(j) - ixt = idx(j) + ixt = ix(j) x(j) = x(lpiv) - idx(j) = idx(lpiv) + ix(j) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif if (piv > abs(x(i))) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt piv = abs(x(lpiv)) endif ! ! now piv is correct; place it into first location xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(lpiv) - idx(i) = idx(lpiv) + ix(i) = ix(lpiv) x(lpiv) = xt - idx(lpiv) = ixt + ix(lpiv) = ixt i = ilx - 1 j = iux + 1 @@ -1567,11 +1567,11 @@ contains if (j > i) then xt = x(i) - ixt = idx(i) + ixt = ix(i) x(i) = x(j) - idx(i) = idx(j) + ix(i) = ix(j) x(j) = xt - idx(j) = ixt + ix(j) = ixt else exit outer_dw end if @@ -1593,14 +1593,14 @@ contains istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zaisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif if (n2 > ithrs) then istp = istp + 1 istack(1,istp) = i istack(2,istp) = iux else - call psi_zaisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zaisrx_dw(n2,x(i:iux),ix(i:iux)) endif else if (n2 > ithrs) then @@ -1608,19 +1608,19 @@ contains istack(1,istp) = i istack(2,istp) = iux else - call psi_zaisrx_dw(n2,x(i:iux),idx(i:iux)) + call psi_zaisrx_dw(n2,x(i:iux),ix(i:iux)) endif if (n1 > ithrs) then istp = istp + 1 istack(1,istp) = ilx istack(2,istp) = i-1 else - call psi_zaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1)) + call psi_zaisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) endif endif enddo else - call psi_zaisrx_dw(n,x,idx) + call psi_zaisrx_dw(n,x,ix) endif end subroutine psi_zaqsrx_dw