fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3-submodules:

Browse Source 
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_msort_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_msort_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_msort_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_msort_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_msort_impl.f90
 base/serial/sort/psb_z_qsort_impl.f90
 test/kernel/Makefile

Fixes for all types on SORT modules.
psblas3-submodules
Salvatore Filippone 10 years ago
parent 4963d11e95
commit caa30f647e
26 changed files with 10643 additions and 10921 deletions
Show Stats Download Patch File Download Diff File

142
base/modules/psb_c_sort_mod.f90
Unescape Escape View File

@ -71,8 +71,7 @@ module psb_c_sort_mod
interface psb_msort interface psb_msort
subroutine psb_cmsort(x,ix,dir,flag) module subroutine psb_cmsort(x,ix,dir,flag)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -80,29 +79,25 @@ module psb_c_sort_mod
end interface psb_msort end interface psb_msort
interface interface
subroutine psi_c_lmsort_up(n,k,l,iret) module subroutine psi_c_lmsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_lmsort_up end subroutine psi_c_lmsort_up
subroutine psi_c_lmsort_dw(n,k,l,iret) module subroutine psi_c_lmsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_lmsort_dw end subroutine psi_c_lmsort_dw
subroutine psi_c_almsort_up(n,k,l,iret) module subroutine psi_c_almsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_almsort_up end subroutine psi_c_almsort_up
subroutine psi_c_almsort_dw(n,k,l,iret) module subroutine psi_c_almsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
@ -110,26 +105,23 @@ module psb_c_sort_mod
end subroutine psi_c_almsort_dw end subroutine psi_c_almsort_dw
end interface end interface
interface interface
subroutine psi_c_amsort_up(n,k,l,iret) module subroutine psi_c_amsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_amsort_up end subroutine psi_c_amsort_up
subroutine psi_c_amsort_dw(n,k,l,iret) module subroutine psi_c_amsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n) complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_amsort_dw end subroutine psi_c_amsort_dw
end interface end interface
module
interface psb_qsort interface psb_qsort
subroutine psb_cqsort(x,ix,dir,flag) module subroutine psb_cqsort(x,ix,dir,flag)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -137,8 +129,7 @@ module psb_c_sort_mod
end interface psb_qsort end interface psb_qsort
interface psb_isort interface psb_isort
subroutine psb_cisort(x,ix,dir,flag) module subroutine psb_cisort(x,ix,dir,flag)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -147,8 +138,7 @@ module psb_c_sort_mod
interface psb_hsort interface psb_hsort
subroutine psb_chsort(x,ix,dir,flag) module subroutine psb_chsort(x,ix,dir,flag)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -156,36 +146,9 @@ module psb_c_sort_mod
end interface psb_hsort end interface psb_hsort
!!$ interface !psb_howmany_heap
!!$ module procedure psb_c_howmany, psb_c_idx_howmany
!!$ end interface
!!$
!!$
!!$ interface !psb_init_heap
!!$ module procedure psb_c_init_heap, psb_c_idx_init_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_dump_heap
!!$ module procedure psb_c_dump_heap, psb_dump_c_idx_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_insert_heap
!!$ module procedure psb_c_insert_heap, psb_c_idx_insert_heap
!!$ end interface
!!$
!!$ interface !psb_heap_get_first
!!$ module procedure psb_c_heap_get_first, psb_c_idx_heap_get_first
!!$ end interface
!!$
!!$ interface !psb_free_heap
!!$ module procedure psb_free_c_heap, psb_free_c_idx_heap
!!$ end interface
interface interface
subroutine psi_c_insert_heap(key,last,heap,dir,info) module subroutine psi_c_insert_heap(key,last,heap,dir,info)
import
implicit none implicit none
! !
@ -204,8 +167,7 @@ module psb_c_sort_mod
end interface end interface
interface interface
subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info) module subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
implicit none implicit none
! !
@ -227,8 +189,7 @@ module psb_c_sort_mod
interface interface
subroutine psi_c_heap_get_first(key,last,heap,dir,info) module subroutine psi_c_heap_get_first(key,last,heap,dir,info)
import
implicit none implicit none
complex(psb_spk_), intent(inout) :: key complex(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(inout) :: last
@ -239,8 +200,7 @@ module psb_c_sort_mod
end interface end interface
interface interface
subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info) module subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
complex(psb_spk_), intent(inout) :: key complex(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index integer(psb_ipk_), intent(out) :: index
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
@ -252,138 +212,114 @@ module psb_c_sort_mod
end interface end interface
interface interface
subroutine psi_clisrx_up(n,x,ix) module subroutine psi_clisrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clisrx_up end subroutine psi_clisrx_up
subroutine psi_clisrx_dw(n,x,ix) module subroutine psi_clisrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clisrx_dw end subroutine psi_clisrx_dw
subroutine psi_clisr_up(n,x) module subroutine psi_clisr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clisr_up end subroutine psi_clisr_up
subroutine psi_clisr_dw(n,x) module subroutine psi_clisr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clisr_dw end subroutine psi_clisr_dw
subroutine psi_calisrx_up(n,x,ix) module subroutine psi_calisrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calisrx_up end subroutine psi_calisrx_up
subroutine psi_calisrx_dw(n,x,ix) module subroutine psi_calisrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calisrx_dw end subroutine psi_calisrx_dw
subroutine psi_calisr_up(n,x) module subroutine psi_calisr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calisr_up end subroutine psi_calisr_up
subroutine psi_calisr_dw(n,x) module subroutine psi_calisr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calisr_dw end subroutine psi_calisr_dw
subroutine psi_caisrx_up(n,x,ix) module subroutine psi_caisrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caisrx_up end subroutine psi_caisrx_up
subroutine psi_caisrx_dw(n,x,ix) module subroutine psi_caisrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caisrx_dw end subroutine psi_caisrx_dw
subroutine psi_caisr_up(n,x) module subroutine psi_caisr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caisr_up end subroutine psi_caisr_up
subroutine psi_caisr_dw(n,x) module subroutine psi_caisr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caisr_dw end subroutine psi_caisr_dw
end interface end interface
interface interface
subroutine psi_clqsrx_up(n,x,ix) module subroutine psi_clqsrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clqsrx_up end subroutine psi_clqsrx_up
subroutine psi_clqsrx_dw(n,x,ix) module subroutine psi_clqsrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clqsrx_dw end subroutine psi_clqsrx_dw
subroutine psi_clqsr_up(n,x) module subroutine psi_clqsr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clqsr_up end subroutine psi_clqsr_up
subroutine psi_clqsr_dw(n,x) module subroutine psi_clqsr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_clqsr_dw end subroutine psi_clqsr_dw
subroutine psi_calqsrx_up(n,x,ix) module subroutine psi_calqsrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calqsrx_up end subroutine psi_calqsrx_up
subroutine psi_calqsrx_dw(n,x,ix) module subroutine psi_calqsrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calqsrx_dw end subroutine psi_calqsrx_dw
subroutine psi_calqsr_up(n,x) module subroutine psi_calqsr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calqsr_up end subroutine psi_calqsr_up
subroutine psi_calqsr_dw(n,x) module subroutine psi_calqsr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_calqsr_dw end subroutine psi_calqsr_dw
subroutine psi_caqsrx_up(n,x,ix) module subroutine psi_caqsrx_up(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caqsrx_up end subroutine psi_caqsrx_up
subroutine psi_caqsrx_dw(n,x,ix) module subroutine psi_caqsrx_dw(n,x,ix)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caqsrx_dw end subroutine psi_caqsrx_dw
subroutine psi_caqsr_up(n,x) module subroutine psi_caqsr_up(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caqsr_up end subroutine psi_caqsr_up
subroutine psi_caqsr_dw(n,x) module subroutine psi_caqsr_dw(n,x)
import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_caqsr_dw end subroutine psi_caqsr_dw

7
base/modules/psb_d_sort_mod.f90
Unescape Escape View File

@ -106,7 +106,7 @@ module psb_d_sort_mod
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_amsort_dw end subroutine psi_d_amsort_dw
end interface end interface
module
interface psb_qsort interface psb_qsort
module subroutine psb_dqsort(x,ix,dir,flag) module subroutine psb_dqsort(x,ix,dir,flag)
@ -134,6 +134,7 @@ module psb_d_sort_mod
end interface psb_hsort end interface psb_hsort
interface interface
module subroutine psi_d_insert_heap(key,last,heap,dir,info) module subroutine psi_d_insert_heap(key,last,heap,dir,info)
implicit none implicit none
@ -188,9 +189,9 @@ module psb_d_sort_mod
interface interface
module subroutine psi_d_idx_heap_get_first(key,index,last,heap,idxs,dir,info) module subroutine psi_d_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
real(psb_dpk_), intent(out) :: key real(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index integer(psb_ipk_), intent(out) :: index
real(psb_dpk_), intent(inout) :: heap(:) real(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(in) :: dir integer(psb_ipk_), intent(in) :: dir
integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(inout) :: last
integer(psb_ipk_), intent(inout) :: idxs(:) integer(psb_ipk_), intent(inout) :: idxs(:)

128
base/modules/psb_i_sort_mod.f90
Unescape Escape View File

@ -44,24 +44,21 @@ module psb_i_sort_mod
use psb_const_mod use psb_const_mod
interface psb_iblsrch interface psb_iblsrch
function psb_iblsrch(key,n,v) result(ipos) module function psb_iblsrch(key,n,v) result(ipos)
import :: psb_ipk_
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
end function psb_iblsrch end function psb_iblsrch
end interface psb_iblsrch end interface psb_iblsrch
interface psb_ibsrch interface psb_ibsrch
function psb_ibsrch(key,n,v) result(ipos) module function psb_ibsrch(key,n,v) result(ipos)
import :: psb_ipk_
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
end function psb_ibsrch end function psb_ibsrch
end interface psb_ibsrch end interface psb_ibsrch
interface psb_issrch interface psb_issrch
function psb_issrch(key,n,v) result(ipos) module function psb_issrch(key,n,v) result(ipos)
import :: psb_ipk_
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
@ -69,16 +66,15 @@ module psb_i_sort_mod
end interface psb_issrch end interface psb_issrch
interface psb_isaperm interface psb_isaperm
logical function psb_isaperm(n,eip) module function psb_isaperm(n,eip) result(res)
import :: psb_ipk_ logical :: res
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: eip(n) integer(psb_ipk_), intent(in) :: eip(n)
end function psb_isaperm end function psb_isaperm
end interface psb_isaperm end interface psb_isaperm
interface psb_msort_unique interface psb_msort_unique
subroutine psb_imsort_u(x,nout,dir) module subroutine psb_imsort_u(x,nout,dir)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir integer(psb_ipk_), optional, intent(in) :: dir
@ -112,8 +108,7 @@ module psb_i_sort_mod
interface psb_msort interface psb_msort
subroutine psb_imsort(x,ix,dir,flag) module subroutine psb_imsort(x,ix,dir,flag)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -121,15 +116,13 @@ module psb_i_sort_mod
end interface psb_msort end interface psb_msort
interface interface
subroutine psi_i_msort_up(n,k,l,iret) module subroutine psi_i_msort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n) integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_msort_up end subroutine psi_i_msort_up
subroutine psi_i_msort_dw(n,k,l,iret) module subroutine psi_i_msort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n) integer(psb_ipk_) :: k(n)
@ -137,26 +130,23 @@ module psb_i_sort_mod
end subroutine psi_i_msort_dw end subroutine psi_i_msort_dw
end interface end interface
interface interface
subroutine psi_i_amsort_up(n,k,l,iret) module subroutine psi_i_amsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n) integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_up end subroutine psi_i_amsort_up
subroutine psi_i_amsort_dw(n,k,l,iret) module subroutine psi_i_amsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n) integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_dw end subroutine psi_i_amsort_dw
end interface end interface
module
interface psb_qsort interface psb_qsort
subroutine psb_iqsort(x,ix,dir,flag) module subroutine psb_iqsort(x,ix,dir,flag)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -164,8 +154,7 @@ module psb_i_sort_mod
end interface psb_qsort end interface psb_qsort
interface psb_isort interface psb_isort
subroutine psb_iisort(x,ix,dir,flag) module subroutine psb_iisort(x,ix,dir,flag)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -174,8 +163,7 @@ module psb_i_sort_mod
interface psb_hsort interface psb_hsort
subroutine psb_ihsort(x,ix,dir,flag) module subroutine psb_ihsort(x,ix,dir,flag)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -183,36 +171,9 @@ module psb_i_sort_mod
end interface psb_hsort end interface psb_hsort
!!$ interface !psb_howmany_heap
!!$ module procedure psb_i_howmany, psb_i_idx_howmany
!!$ end interface
!!$
!!$
!!$ interface !psb_init_heap
!!$ module procedure psb_i_init_heap, psb_i_idx_init_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_dump_heap
!!$ module procedure psb_i_dump_heap, psb_dump_i_idx_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_insert_heap
!!$ module procedure psb_i_insert_heap, psb_i_idx_insert_heap
!!$ end interface
!!$
!!$ interface !psb_heap_get_first
!!$ module procedure psb_i_heap_get_first, psb_i_idx_heap_get_first
!!$ end interface
!!$
!!$ interface !psb_free_heap
!!$ module procedure psb_free_i_heap, psb_free_i_idx_heap
!!$ end interface
interface interface
subroutine psi_i_insert_heap(key,last,heap,dir,info) module subroutine psi_i_insert_heap(key,last,heap,dir,info)
import
implicit none implicit none
! !
@ -231,8 +192,7 @@ module psb_i_sort_mod
end interface end interface
interface interface
subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info) module subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
implicit none implicit none
! !
@ -254,8 +214,7 @@ module psb_i_sort_mod
interface interface
subroutine psi_i_heap_get_first(key,last,heap,dir,info) module subroutine psi_i_heap_get_first(key,last,heap,dir,info)
import
implicit none implicit none
integer(psb_ipk_), intent(inout) :: key integer(psb_ipk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(inout) :: last
@ -266,8 +225,7 @@ module psb_i_sort_mod
end interface end interface
interface interface
subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info) module subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
integer(psb_ipk_), intent(inout) :: key integer(psb_ipk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index integer(psb_ipk_), intent(out) :: index
integer(psb_ipk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: heap(:)
@ -279,94 +237,78 @@ module psb_i_sort_mod
end interface end interface
interface interface
subroutine psi_iisrx_up(n,x,ix) module subroutine psi_iisrx_up(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisrx_up end subroutine psi_iisrx_up
subroutine psi_iisrx_dw(n,x,ix) module subroutine psi_iisrx_dw(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisrx_dw end subroutine psi_iisrx_dw
subroutine psi_iisr_up(n,x) module subroutine psi_iisr_up(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisr_up end subroutine psi_iisr_up
subroutine psi_iisr_dw(n,x) module subroutine psi_iisr_dw(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisr_dw end subroutine psi_iisr_dw
subroutine psi_iaisrx_up(n,x,ix) module subroutine psi_iaisrx_up(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisrx_up end subroutine psi_iaisrx_up
subroutine psi_iaisrx_dw(n,x,ix) module subroutine psi_iaisrx_dw(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisrx_dw end subroutine psi_iaisrx_dw
subroutine psi_iaisr_up(n,x) module subroutine psi_iaisr_up(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisr_up end subroutine psi_iaisr_up
subroutine psi_iaisr_dw(n,x) module subroutine psi_iaisr_dw(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisr_dw end subroutine psi_iaisr_dw
end interface end interface
interface interface
subroutine psi_iqsrx_up(n,x,ix) module subroutine psi_iqsrx_up(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsrx_up end subroutine psi_iqsrx_up
subroutine psi_iqsrx_dw(n,x,ix) module subroutine psi_iqsrx_dw(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsrx_dw end subroutine psi_iqsrx_dw
subroutine psi_iqsr_up(n,x) module subroutine psi_iqsr_up(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsr_up end subroutine psi_iqsr_up
subroutine psi_iqsr_dw(n,x) module subroutine psi_iqsr_dw(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsr_dw end subroutine psi_iqsr_dw
subroutine psi_iaqsrx_up(n,x,ix) module subroutine psi_iaqsrx_up(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsrx_up end subroutine psi_iaqsrx_up
subroutine psi_iaqsrx_dw(n,x,ix) module subroutine psi_iaqsrx_dw(n,x,ix)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsrx_dw end subroutine psi_iaqsrx_dw
subroutine psi_iaqsr_up(n,x) module subroutine psi_iaqsr_up(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsr_up end subroutine psi_iaqsr_up
subroutine psi_iaqsr_dw(n,x) module subroutine psi_iaqsr_dw(n,x)
import
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsr_dw end subroutine psi_iaqsr_dw

112
base/modules/psb_s_sort_mod.f90
Unescape Escape View File

@ -71,8 +71,7 @@ module psb_s_sort_mod
interface psb_msort interface psb_msort
subroutine psb_smsort(x,ix,dir,flag) module subroutine psb_smsort(x,ix,dir,flag)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -80,15 +79,13 @@ module psb_s_sort_mod
end interface psb_msort end interface psb_msort
interface interface
subroutine psi_s_msort_up(n,k,l,iret) module subroutine psi_s_msort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n) real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_msort_up end subroutine psi_s_msort_up
subroutine psi_s_msort_dw(n,k,l,iret) module subroutine psi_s_msort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n) real(psb_spk_) :: k(n)
@ -96,26 +93,23 @@ module psb_s_sort_mod
end subroutine psi_s_msort_dw end subroutine psi_s_msort_dw
end interface end interface
interface interface
subroutine psi_s_amsort_up(n,k,l,iret) module subroutine psi_s_amsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n) real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_up end subroutine psi_s_amsort_up
subroutine psi_s_amsort_dw(n,k,l,iret) module subroutine psi_s_amsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n) real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_dw end subroutine psi_s_amsort_dw
end interface end interface
module
interface psb_qsort interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag) module subroutine psb_sqsort(x,ix,dir,flag)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -123,8 +117,7 @@ module psb_s_sort_mod
end interface psb_qsort end interface psb_qsort
interface psb_isort interface psb_isort
subroutine psb_sisort(x,ix,dir,flag) module subroutine psb_sisort(x,ix,dir,flag)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -133,8 +126,7 @@ module psb_s_sort_mod
interface psb_hsort interface psb_hsort
subroutine psb_shsort(x,ix,dir,flag) module subroutine psb_shsort(x,ix,dir,flag)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -142,36 +134,9 @@ module psb_s_sort_mod
end interface psb_hsort end interface psb_hsort
!!$ interface !psb_howmany_heap
!!$ module procedure psb_s_howmany, psb_s_idx_howmany
!!$ end interface
!!$
!!$
!!$ interface !psb_init_heap
!!$ module procedure psb_s_init_heap, psb_s_idx_init_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_dump_heap
!!$ module procedure psb_s_dump_heap, psb_dump_s_idx_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_insert_heap
!!$ module procedure psb_s_insert_heap, psb_s_idx_insert_heap
!!$ end interface
!!$
!!$ interface !psb_heap_get_first
!!$ module procedure psb_s_heap_get_first, psb_s_idx_heap_get_first
!!$ end interface
!!$
!!$ interface !psb_free_heap
!!$ module procedure psb_free_s_heap, psb_free_s_idx_heap
!!$ end interface
interface interface
subroutine psi_s_insert_heap(key,last,heap,dir,info) module subroutine psi_s_insert_heap(key,last,heap,dir,info)
import
implicit none implicit none
! !
@ -190,8 +155,7 @@ module psb_s_sort_mod
end interface end interface
interface interface
subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info) module subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
implicit none implicit none
! !
@ -213,8 +177,7 @@ module psb_s_sort_mod
interface interface
subroutine psi_s_heap_get_first(key,last,heap,dir,info) module subroutine psi_s_heap_get_first(key,last,heap,dir,info)
import
implicit none implicit none
real(psb_spk_), intent(inout) :: key real(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(inout) :: last
@ -225,8 +188,7 @@ module psb_s_sort_mod
end interface end interface
interface interface
subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info) module subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
real(psb_spk_), intent(inout) :: key real(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index integer(psb_ipk_), intent(out) :: index
real(psb_spk_), intent(inout) :: heap(:) real(psb_spk_), intent(inout) :: heap(:)
@ -238,94 +200,78 @@ module psb_s_sort_mod
end interface end interface
interface interface
subroutine psi_sisrx_up(n,x,ix) module subroutine psi_sisrx_up(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisrx_up end subroutine psi_sisrx_up
subroutine psi_sisrx_dw(n,x,ix) module subroutine psi_sisrx_dw(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisrx_dw end subroutine psi_sisrx_dw
subroutine psi_sisr_up(n,x) module subroutine psi_sisr_up(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisr_up end subroutine psi_sisr_up
subroutine psi_sisr_dw(n,x) module subroutine psi_sisr_dw(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisr_dw end subroutine psi_sisr_dw
subroutine psi_saisrx_up(n,x,ix) module subroutine psi_saisrx_up(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisrx_up end subroutine psi_saisrx_up
subroutine psi_saisrx_dw(n,x,ix) module subroutine psi_saisrx_dw(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisrx_dw end subroutine psi_saisrx_dw
subroutine psi_saisr_up(n,x) module subroutine psi_saisr_up(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisr_up end subroutine psi_saisr_up
subroutine psi_saisr_dw(n,x) module subroutine psi_saisr_dw(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisr_dw end subroutine psi_saisr_dw
end interface end interface
interface interface
subroutine psi_sqsrx_up(n,x,ix) module subroutine psi_sqsrx_up(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsrx_up end subroutine psi_sqsrx_up
subroutine psi_sqsrx_dw(n,x,ix) module subroutine psi_sqsrx_dw(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsrx_dw end subroutine psi_sqsrx_dw
subroutine psi_sqsr_up(n,x) module subroutine psi_sqsr_up(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsr_up end subroutine psi_sqsr_up
subroutine psi_sqsr_dw(n,x) module subroutine psi_sqsr_dw(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsr_dw end subroutine psi_sqsr_dw
subroutine psi_saqsrx_up(n,x,ix) module subroutine psi_saqsrx_up(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsrx_up end subroutine psi_saqsrx_up
subroutine psi_saqsrx_dw(n,x,ix) module subroutine psi_saqsrx_dw(n,x,ix)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsrx_dw end subroutine psi_saqsrx_dw
subroutine psi_saqsr_up(n,x) module subroutine psi_saqsr_up(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsr_up end subroutine psi_saqsr_up
subroutine psi_saqsr_dw(n,x) module subroutine psi_saqsr_dw(n,x)
import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsr_dw end subroutine psi_saqsr_dw

142
base/modules/psb_z_sort_mod.f90
Unescape Escape View File

@ -71,8 +71,7 @@ module psb_z_sort_mod
interface psb_msort interface psb_msort
subroutine psb_zmsort(x,ix,dir,flag) module subroutine psb_zmsort(x,ix,dir,flag)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -80,29 +79,25 @@ module psb_z_sort_mod
end interface psb_msort end interface psb_msort
interface interface
subroutine psi_z_lmsort_up(n,k,l,iret) module subroutine psi_z_lmsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_up end subroutine psi_z_lmsort_up
subroutine psi_z_lmsort_dw(n,k,l,iret) module subroutine psi_z_lmsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_dw end subroutine psi_z_lmsort_dw
subroutine psi_z_almsort_up(n,k,l,iret) module subroutine psi_z_almsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_almsort_up end subroutine psi_z_almsort_up
subroutine psi_z_almsort_dw(n,k,l,iret) module subroutine psi_z_almsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
@ -110,26 +105,23 @@ module psb_z_sort_mod
end subroutine psi_z_almsort_dw end subroutine psi_z_almsort_dw
end interface end interface
interface interface
subroutine psi_z_amsort_up(n,k,l,iret) module subroutine psi_z_amsort_up(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_up end subroutine psi_z_amsort_up
subroutine psi_z_amsort_dw(n,k,l,iret) module subroutine psi_z_amsort_dw(n,k,l,iret)
import
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n) complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1) integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_dw end subroutine psi_z_amsort_dw
end interface end interface
module
interface psb_qsort interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag) module subroutine psb_zqsort(x,ix,dir,flag)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -137,8 +129,7 @@ module psb_z_sort_mod
end interface psb_qsort end interface psb_qsort
interface psb_isort interface psb_isort
subroutine psb_zisort(x,ix,dir,flag) module subroutine psb_zisort(x,ix,dir,flag)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -147,8 +138,7 @@ module psb_z_sort_mod
interface psb_hsort interface psb_hsort
subroutine psb_zhsort(x,ix,dir,flag) module subroutine psb_zhsort(x,ix,dir,flag)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -156,36 +146,9 @@ module psb_z_sort_mod
end interface psb_hsort end interface psb_hsort
!!$ interface !psb_howmany_heap
!!$ module procedure psb_z_howmany, psb_z_idx_howmany
!!$ end interface
!!$
!!$
!!$ interface !psb_init_heap
!!$ module procedure psb_z_init_heap, psb_z_idx_init_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_dump_heap
!!$ module procedure psb_z_dump_heap, psb_dump_z_idx_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_insert_heap
!!$ module procedure psb_z_insert_heap, psb_z_idx_insert_heap
!!$ end interface
!!$
!!$ interface !psb_heap_get_first
!!$ module procedure psb_z_heap_get_first, psb_z_idx_heap_get_first
!!$ end interface
!!$
!!$ interface !psb_free_heap
!!$ module procedure psb_free_z_heap, psb_free_z_idx_heap
!!$ end interface
interface interface
subroutine psi_z_insert_heap(key,last,heap,dir,info) module subroutine psi_z_insert_heap(key,last,heap,dir,info)
import
implicit none implicit none
! !
@ -204,8 +167,7 @@ module psb_z_sort_mod
end interface end interface
interface interface
subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info) module subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
implicit none implicit none
! !
@ -227,8 +189,7 @@ module psb_z_sort_mod
interface interface
subroutine psi_z_heap_get_first(key,last,heap,dir,info) module subroutine psi_z_heap_get_first(key,last,heap,dir,info)
import
implicit none implicit none
complex(psb_dpk_), intent(inout) :: key complex(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last integer(psb_ipk_), intent(inout) :: last
@ -239,8 +200,7 @@ module psb_z_sort_mod
end interface end interface
interface interface
subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info) module subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
complex(psb_dpk_), intent(inout) :: key complex(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index integer(psb_ipk_), intent(out) :: index
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
@ -252,138 +212,114 @@ module psb_z_sort_mod
end interface end interface
interface interface
subroutine psi_zlisrx_up(n,x,ix) module subroutine psi_zlisrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisrx_up end subroutine psi_zlisrx_up
subroutine psi_zlisrx_dw(n,x,ix) module subroutine psi_zlisrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisrx_dw end subroutine psi_zlisrx_dw
subroutine psi_zlisr_up(n,x) module subroutine psi_zlisr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisr_up end subroutine psi_zlisr_up
subroutine psi_zlisr_dw(n,x) module subroutine psi_zlisr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisr_dw end subroutine psi_zlisr_dw
subroutine psi_zalisrx_up(n,x,ix) module subroutine psi_zalisrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisrx_up end subroutine psi_zalisrx_up
subroutine psi_zalisrx_dw(n,x,ix) module subroutine psi_zalisrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisrx_dw end subroutine psi_zalisrx_dw
subroutine psi_zalisr_up(n,x) module subroutine psi_zalisr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisr_up end subroutine psi_zalisr_up
subroutine psi_zalisr_dw(n,x) module subroutine psi_zalisr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisr_dw end subroutine psi_zalisr_dw
subroutine psi_zaisrx_up(n,x,ix) module subroutine psi_zaisrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisrx_up end subroutine psi_zaisrx_up
subroutine psi_zaisrx_dw(n,x,ix) module subroutine psi_zaisrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisrx_dw end subroutine psi_zaisrx_dw
subroutine psi_zaisr_up(n,x) module subroutine psi_zaisr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisr_up end subroutine psi_zaisr_up
subroutine psi_zaisr_dw(n,x) module subroutine psi_zaisr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisr_dw end subroutine psi_zaisr_dw
end interface end interface
interface interface
subroutine psi_zlqsrx_up(n,x,ix) module subroutine psi_zlqsrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsrx_up end subroutine psi_zlqsrx_up
subroutine psi_zlqsrx_dw(n,x,ix) module subroutine psi_zlqsrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsrx_dw end subroutine psi_zlqsrx_dw
subroutine psi_zlqsr_up(n,x) module subroutine psi_zlqsr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsr_up end subroutine psi_zlqsr_up
subroutine psi_zlqsr_dw(n,x) module subroutine psi_zlqsr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsr_dw end subroutine psi_zlqsr_dw
subroutine psi_zalqsrx_up(n,x,ix) module subroutine psi_zalqsrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsrx_up end subroutine psi_zalqsrx_up
subroutine psi_zalqsrx_dw(n,x,ix) module subroutine psi_zalqsrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsrx_dw end subroutine psi_zalqsrx_dw
subroutine psi_zalqsr_up(n,x) module subroutine psi_zalqsr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsr_up end subroutine psi_zalqsr_up
subroutine psi_zalqsr_dw(n,x) module subroutine psi_zalqsr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsr_dw end subroutine psi_zalqsr_dw
subroutine psi_zaqsrx_up(n,x,ix) module subroutine psi_zaqsrx_up(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsrx_up end subroutine psi_zaqsrx_up
subroutine psi_zaqsrx_dw(n,x,ix) module subroutine psi_zaqsrx_dw(n,x,ix)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsrx_dw end subroutine psi_zaqsrx_dw
subroutine psi_zaqsr_up(n,x) module subroutine psi_zaqsr_up(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsr_up end subroutine psi_zaqsr_up
subroutine psi_zaqsr_dw(n,x) module subroutine psi_zaqsr_dw(n,x)
import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsr_dw end subroutine psi_zaqsr_dw

2010
base/serial/sort/psb_c_hsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

809
base/serial/sort/psb_c_isort_impl.f90
Unescape Escape View File

@ -29,432 +29,423 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The insertion sort routines ! The insertion sort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_cisort(x,ix,dir,flag) submodule (psb_c_sort_mod) psb_c_isort_impl_mod
use psb_c_sort_mod, psb_protect_name => psb_cisort
use psb_error_mod contains
implicit none subroutine psb_cisort(x,ix,dir,flag)
complex(psb_spk_), intent(inout) :: x(:) use psb_error_mod
integer(psb_ipk_), optional, intent(in) :: dir, flag implicit none
integer(psb_ipk_), optional, intent(inout) :: ix(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_) :: dir_, flag_, n, err_act, i integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: dir_, flag_, n, err_act, i
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
name='psb_cisort' character(len=20) :: name
call psb_erractionsave(err_act)
name='psb_cisort'
if (present(flag)) then call psb_erractionsave(err_act)
flag_ = flag
else if (present(flag)) then
flag_ = psb_sort_ovw_idx_ flag_ = flag
end if else
select case(flag_) flag_ = psb_sort_ovw_idx_
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_asort_up_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if end if
if (flag_==psb_sort_ovw_idx_) then select case(flag_)
do i=1,n case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
ix(i) = i ! OK keep going
end do case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_asort_up_
end if end if
select case(dir_) n = size(x)
case (psb_lsort_up_)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_lsort_up_)
call psi_clisrx_up(n,x,ix) call psi_clisrx_up(n,x,ix)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_clisrx_dw(n,x,ix) call psi_clisrx_dw(n,x,ix)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_calisrx_up(n,x,ix) call psi_calisrx_up(n,x,ix)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_calisrx_dw(n,x,ix) call psi_calisrx_dw(n,x,ix)
case (psb_asort_up_) case (psb_asort_up_)
call psi_caisrx_up(n,x,ix) call psi_caisrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_caisrx_dw(n,x,ix) call psi_caisrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else else
select case(dir_) select case(dir_)
case (psb_lsort_up_) case (psb_lsort_up_)
call psi_clisr_up(n,x) call psi_clisr_up(n,x)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_clisr_dw(n,x) call psi_clisr_dw(n,x)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_calisr_up(n,x) call psi_calisr_up(n,x)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_calisr_dw(n,x) call psi_calisr_dw(n,x)
case (psb_asort_up_) case (psb_asort_up_)
call psi_caisr_up(n,x) call psi_caisr_up(n,x)
case (psb_asort_down_) case (psb_asort_down_)
call psi_caisr_dw(n,x) call psi_caisr_dw(n,x)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
end if end if
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_cisort end subroutine psb_cisort
subroutine psi_clisrx_up(n,x,idx) subroutine psi_clisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_clisrx_up use psb_error_mod
use psb_error_mod use psi_lcx_mod
use psi_lcx_mod implicit none
implicit none complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix complex(psb_spk_) :: xx
complex(psb_spk_) :: xx
do j=n-1,1,-1
do j=n-1,1,-1 if (x(j+1) < x(j)) then
if (x(j+1) < x(j)) then xx = x(j)
xx = x(j) ix = idx(j)
ix = idx(j) i=j+1
i=j+1 do
do x(i-1) = x(i)
x(i-1) = x(i) idx(i-1) = idx(i)
idx(i-1) = idx(i) i = i+1
i = i+1 if (i>n) exit
if (i>n) exit if (x(i) >= xx) exit
if (x(i) >= xx) exit end do
end do x(i-1) = xx
x(i-1) = xx idx(i-1) = ix
idx(i-1) = ix endif
endif enddo
enddo
end subroutine psi_clisrx_up
end subroutine psi_clisrx_up
subroutine psi_clisrx_dw(n,x,idx)
subroutine psi_clisrx_dw(n,x,idx) use psb_error_mod
use psb_c_sort_mod, psb_protect_name => psi_clisrx_dw use psi_lcx_mod
use psb_error_mod implicit none
use psi_lcx_mod complex(psb_spk_), intent(inout) :: x(:)
implicit none integer(psb_ipk_), intent(inout) :: idx(:)
complex(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_), intent(in) :: n complex(psb_spk_) :: xx
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx do j=n-1,1,-1
if (x(j+1) > x(j)) then
do j=n-1,1,-1 xx = x(j)
if (x(j+1) > x(j)) then ix = idx(j)
xx = x(j) i=j+1
ix = idx(j) do
i=j+1 x(i-1) = x(i)
do idx(i-1) = idx(i)
x(i-1) = x(i) i = i+1
idx(i-1) = idx(i) if (i>n) exit
i = i+1 if (x(i) <= xx) exit
if (i>n) exit end do
if (x(i) <= xx) exit x(i-1) = xx
end do idx(i-1) = ix
x(i-1) = xx endif
idx(i-1) = ix enddo
endif end subroutine psi_clisrx_dw
enddo
end subroutine psi_clisrx_dw subroutine psi_clisr_up(n,x)
use psb_error_mod
subroutine psi_clisr_up(n,x) use psi_lcx_mod
use psb_c_sort_mod, psb_protect_name => psi_clisr_up implicit none
use psb_error_mod complex(psb_spk_), intent(inout) :: x(:)
use psi_lcx_mod integer(psb_ipk_), intent(in) :: n
implicit none integer(psb_ipk_) :: i,j
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_) :: xx
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j do j=n-1,1,-1
complex(psb_spk_) :: xx if (x(j+1) < x(j)) then
xx = x(j)
do j=n-1,1,-1 i=j+1
if (x(j+1) < x(j)) then do
xx = x(j) x(i-1) = x(i)
i=j+1 i = i+1
do if (i>n) exit
x(i-1) = x(i) if (x(i) >= xx) exit
i = i+1 end do
if (i>n) exit x(i-1) = xx
if (x(i) >= xx) exit endif
end do enddo
x(i-1) = xx end subroutine psi_clisr_up
endif
enddo subroutine psi_clisr_dw(n,x)
end subroutine psi_clisr_up use psb_error_mod
use psi_lcx_mod
subroutine psi_clisr_dw(n,x) implicit none
use psb_c_sort_mod, psb_protect_name => psi_clisr_dw complex(psb_spk_), intent(inout) :: x(:)
use psb_error_mod integer(psb_ipk_), intent(in) :: n
use psi_lcx_mod integer(psb_ipk_) :: i,j
implicit none complex(psb_spk_) :: xx
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n do j=n-1,1,-1
integer(psb_ipk_) :: i,j if (x(j+1) > x(j)) then
complex(psb_spk_) :: xx xx = x(j)
i=j+1
do j=n-1,1,-1 do
if (x(j+1) > x(j)) then x(i-1) = x(i)
xx = x(j) i = i+1
i=j+1 if (i>n) exit
do if (x(i) <= xx) exit
x(i-1) = x(i) end do
i = i+1 x(i-1) = xx
if (i>n) exit endif
if (x(i) <= xx) exit enddo
end do end subroutine psi_clisr_dw
x(i-1) = xx
endif subroutine psi_calisrx_up(n,x,idx)
enddo use psb_error_mod
end subroutine psi_clisr_dw use psi_alcx_mod
implicit none
subroutine psi_calisrx_up(n,x,idx) complex(psb_spk_), intent(inout) :: x(:)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_up integer(psb_ipk_), intent(inout) :: idx(:)
use psb_error_mod integer(psb_ipk_), intent(in) :: n
use psi_alcx_mod integer(psb_ipk_) :: i,j,ix
implicit none complex(psb_spk_) :: xx
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:) do j=n-1,1,-1
integer(psb_ipk_), intent(in) :: n if (x(j+1) < x(j)) then
integer(psb_ipk_) :: i,j,ix xx = x(j)
complex(psb_spk_) :: xx ix = idx(j)
i=j+1
do j=n-1,1,-1 do
if (x(j+1) < x(j)) then x(i-1) = x(i)
xx = x(j) idx(i-1) = idx(i)
ix = idx(j) i = i+1
i=j+1 if (i>n) exit
do if (x(i) >= xx) exit
x(i-1) = x(i) end do
idx(i-1) = idx(i) x(i-1) = xx
i = i+1 idx(i-1) = ix
if (i>n) exit endif
if (x(i) >= xx) exit enddo
end do end subroutine psi_calisrx_up
x(i-1) = xx
idx(i-1) = ix subroutine psi_calisrx_dw(n,x,idx)
endif use psb_error_mod
enddo use psi_alcx_mod
end subroutine psi_calisrx_up implicit none
complex(psb_spk_), intent(inout) :: x(:)
subroutine psi_calisrx_dw(n,x,idx) integer(psb_ipk_), intent(inout) :: idx(:)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_dw integer(psb_ipk_), intent(in) :: n
use psb_error_mod integer(psb_ipk_) :: i,j,ix
use psi_alcx_mod complex(psb_spk_) :: xx
implicit none
complex(psb_spk_), intent(inout) :: x(:) do j=n-1,1,-1
integer(psb_ipk_), intent(inout) :: idx(:) if (x(j+1) > x(j)) then
integer(psb_ipk_), intent(in) :: n xx = x(j)
integer(psb_ipk_) :: i,j,ix ix = idx(j)
complex(psb_spk_) :: xx i=j+1
do
do j=n-1,1,-1 x(i-1) = x(i)
if (x(j+1) > x(j)) then idx(i-1) = idx(i)
xx = x(j) i = i+1
ix = idx(j) if (i>n) exit
i=j+1 if (x(i) <= xx) exit
do end do
x(i-1) = x(i) x(i-1) = xx
idx(i-1) = idx(i) idx(i-1) = ix
i = i+1 endif
if (i>n) exit enddo
if (x(i) <= xx) exit end subroutine psi_calisrx_dw
end do
x(i-1) = xx subroutine psi_calisr_up(n,x)
idx(i-1) = ix use psb_error_mod
endif use psi_alcx_mod
enddo implicit none
end subroutine psi_calisrx_dw complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
subroutine psi_calisr_up(n,x) integer(psb_ipk_) :: i,j
use psb_c_sort_mod, psb_protect_name => psi_calisr_up complex(psb_spk_) :: xx
use psb_error_mod
use psi_alcx_mod do j=n-1,1,-1
implicit none if (x(j+1) < x(j)) then
complex(psb_spk_), intent(inout) :: x(:) xx = x(j)
integer(psb_ipk_), intent(in) :: n i=j+1
integer(psb_ipk_) :: i,j do
complex(psb_spk_) :: xx x(i-1) = x(i)
i = i+1
do j=n-1,1,-1 if (i>n) exit
if (x(j+1) < x(j)) then if (x(i) >= xx) exit
xx = x(j) end do
i=j+1 x(i-1) = xx
do endif
x(i-1) = x(i) enddo
i = i+1 end subroutine psi_calisr_up
if (i>n) exit
if (x(i) >= xx) exit subroutine psi_calisr_dw(n,x)
end do use psb_error_mod
x(i-1) = xx use psi_alcx_mod
endif implicit none
enddo complex(psb_spk_), intent(inout) :: x(:)
end subroutine psi_calisr_up integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
subroutine psi_calisr_dw(n,x) complex(psb_spk_) :: xx
use psb_c_sort_mod, psb_protect_name => psi_calisr_dw
use psb_error_mod do j=n-1,1,-1
use psi_alcx_mod if (x(j+1) > x(j)) then
implicit none xx = x(j)
complex(psb_spk_), intent(inout) :: x(:) i=j+1
integer(psb_ipk_), intent(in) :: n do
integer(psb_ipk_) :: i,j x(i-1) = x(i)
complex(psb_spk_) :: xx i = i+1
if (i>n) exit
do j=n-1,1,-1 if (x(i) <= xx) exit
if (x(j+1) > x(j)) then end do
xx = x(j) x(i-1) = xx
i=j+1 endif
do enddo
x(i-1) = x(i) end subroutine psi_calisr_dw
i = i+1
if (i>n) exit subroutine psi_caisrx_up(n,x,idx)
if (x(i) <= xx) exit use psb_error_mod
end do implicit none
x(i-1) = xx complex(psb_spk_), intent(inout) :: x(:)
endif integer(psb_ipk_), intent(inout) :: idx(:)
enddo integer(psb_ipk_), intent(in) :: n
end subroutine psi_calisr_dw integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
subroutine psi_caisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caisrx_up do j=n-1,1,-1
use psb_error_mod if (abs(x(j+1)) < abs(x(j))) then
implicit none xx = x(j)
complex(psb_spk_), intent(inout) :: x(:) ix = idx(j)
integer(psb_ipk_), intent(inout) :: idx(:) i=j+1
integer(psb_ipk_), intent(in) :: n do
integer(psb_ipk_) :: i,j,ix x(i-1) = x(i)
complex(psb_spk_) :: xx idx(i-1) = idx(i)
i = i+1
do j=n-1,1,-1 if (i>n) exit
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(i)) >= abs(xx)) exit
xx = x(j) end do
ix = idx(j) x(i-1) = xx
i=j+1 idx(i-1) = ix
do endif
x(i-1) = x(i) enddo
idx(i-1) = idx(i) end subroutine psi_caisrx_up
i = i+1
if (i>n) exit subroutine psi_caisrx_dw(n,x,idx)
if (abs(x(i)) >= abs(xx)) exit use psb_error_mod
end do implicit none
x(i-1) = xx complex(psb_spk_), intent(inout) :: x(:)
idx(i-1) = ix integer(psb_ipk_), intent(inout) :: idx(:)
endif integer(psb_ipk_), intent(in) :: n
enddo integer(psb_ipk_) :: i,j,ix
end subroutine psi_caisrx_up complex(psb_spk_) :: xx
subroutine psi_caisrx_dw(n,x,idx) do j=n-1,1,-1
use psb_c_sort_mod, psb_protect_name => psi_caisrx_dw if (abs(x(j+1)) > abs(x(j))) then
use psb_error_mod xx = x(j)
implicit none ix = idx(j)
complex(psb_spk_), intent(inout) :: x(:) i=j+1
integer(psb_ipk_), intent(inout) :: idx(:) do
integer(psb_ipk_), intent(in) :: n x(i-1) = x(i)
integer(psb_ipk_) :: i,j,ix idx(i-1) = idx(i)
complex(psb_spk_) :: xx i = i+1
if (i>n) exit
do j=n-1,1,-1 if (abs(x(i)) <= abs(xx)) exit
if (abs(x(j+1)) > abs(x(j))) then end do
xx = x(j) x(i-1) = xx
ix = idx(j) idx(i-1) = ix
i=j+1 endif
do enddo
x(i-1) = x(i) end subroutine psi_caisrx_dw
idx(i-1) = idx(i)
i = i+1 subroutine psi_caisr_up(n,x)
if (i>n) exit use psb_error_mod
if (abs(x(i)) <= abs(xx)) exit implicit none
end do complex(psb_spk_), intent(inout) :: x(:)
x(i-1) = xx integer(psb_ipk_), intent(in) :: n
idx(i-1) = ix integer(psb_ipk_) :: i,j
endif complex(psb_spk_) :: xx
enddo
end subroutine psi_caisrx_dw do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
subroutine psi_caisr_up(n,x) xx = x(j)
use psb_c_sort_mod, psb_protect_name => psi_caisr_up i=j+1
use psb_error_mod do
implicit none x(i-1) = x(i)
complex(psb_spk_), intent(inout) :: x(:) i = i+1
integer(psb_ipk_), intent(in) :: n if (i>n) exit
integer(psb_ipk_) :: i,j if (abs(x(i)) >= abs(xx)) exit
complex(psb_spk_) :: xx end do
x(i-1) = xx
do j=n-1,1,-1 endif
if (abs(x(j+1)) < abs(x(j))) then enddo
xx = x(j) end subroutine psi_caisr_up
i=j+1
do subroutine psi_caisr_dw(n,x)
x(i-1) = x(i) use psb_error_mod
i = i+1 implicit none
if (i>n) exit complex(psb_spk_), intent(inout) :: x(:)
if (abs(x(i)) >= abs(xx)) exit integer(psb_ipk_), intent(in) :: n
end do integer(psb_ipk_) :: i,j
x(i-1) = xx complex(psb_spk_) :: xx
endif
enddo do j=n-1,1,-1
end subroutine psi_caisr_up if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
subroutine psi_caisr_dw(n,x) i=j+1
use psb_c_sort_mod, psb_protect_name => psi_caisr_dw do
use psb_error_mod x(i-1) = x(i)
implicit none i = i+1
complex(psb_spk_), intent(inout) :: x(:) if (i>n) exit
integer(psb_ipk_), intent(in) :: n if (abs(x(i)) <= abs(xx)) exit
integer(psb_ipk_) :: i,j end do
complex(psb_spk_) :: xx x(i-1) = xx
endif
do j=n-1,1,-1 enddo
if (abs(x(j+1)) > abs(x(j))) then end subroutine psi_caisr_dw
xx = x(j)
i=j+1 end submodule psb_c_isort_impl_mod
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_caisr_dw

5
base/serial/sort/psb_c_msort_impl.f90
Unescape Escape View File

@ -40,6 +40,9 @@
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_c_sort_mod) psb_c_msort_impl_mod
contains
@ -49,7 +52,6 @@
subroutine psb_cmsort(x,ix,dir,flag) subroutine psb_cmsort(x,ix,dir,flag)
use psb_c_sort_mod, psb_protect_name => psb_cmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
@ -780,3 +782,4 @@
end subroutine psi_c_almsort_dw end subroutine psi_c_almsort_dw
end submodule psb_c_msort_impl_mod

3421
base/serial/sort/psb_c_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

25
base/serial/sort/psb_d_hsort_impl.f90
Unescape Escape View File

@ -29,16 +29,18 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! References: ! The merge-sort and quicksort routines are implemented in the
! D. Knuth ! serial/aux directory
! The Art of Computer Programming, vol. 3 ! References:
! Addison-Wesley ! D. Knuth
! ! The Art of Computer Programming, vol. 3
! Aho, Hopcroft, Ullman ! Addison-Wesley
! Data Structures and Algorithms !
! Addison-Wesley ! Aho, Hopcroft, Ullman
! ! Data Structures and Algorithms
! Addison-Wesley
!
submodule (psb_d_sort_mod) psb_d_hsort_impl_mod submodule (psb_d_sort_mod) psb_d_hsort_impl_mod
contains contains
@ -670,6 +672,7 @@ contains
return return
end subroutine psi_d_idx_heap_get_first end subroutine psi_d_idx_heap_get_first
end submodule psb_d_hsort_impl_mod
end submodule psb_d_hsort_impl_mod

73
base/serial/sort/psb_d_isort_impl.f90
Unescape Escape View File

@ -29,18 +29,19 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The insertion sort routines ! The insertion sort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_d_sort_mod) psb_d_isort_impl_mod submodule (psb_d_sort_mod) psb_d_isort_impl_mod
contains contains
subroutine psb_disort(x,ix,dir,flag) subroutine psb_disort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
@ -130,56 +131,56 @@ contains
return return
end subroutine psb_disort end subroutine psb_disort
subroutine psi_disrx_up(n,x,ix) subroutine psi_disrx_up(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,lx integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) < x(j)) then if (x(j+1) < x(j)) then
xx = x(j) xx = x(j)
lx = ix(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
ix(i-1) = ix(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) >= xx) exit if (x(i) >= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
ix(i-1) = lx idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_disrx_up end subroutine psi_disrx_up
subroutine psi_disrx_dw(n,x,ix) subroutine psi_disrx_dw(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,lx integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) > x(j)) then if (x(j+1) > x(j)) then
xx = x(j) xx = x(j)
lx = ix(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
ix(i-1) = ix(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) <= xx) exit if (x(i) <= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
ix(i-1) = lx idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_disrx_dw end subroutine psi_disrx_dw
@ -231,56 +232,56 @@ contains
enddo enddo
end subroutine psi_disr_dw end subroutine psi_disr_dw
subroutine psi_daisrx_up(n,x,ix) subroutine psi_daisrx_up(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,lx integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(j+1)) < abs(x(j))) then
xx = x(j) xx = x(j)
lx = ix(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
ix(i-1) = ix(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit if (abs(x(i)) >= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
ix(i-1) = lx idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_daisrx_up end subroutine psi_daisrx_up
subroutine psi_daisrx_dw(n,x,ix) subroutine psi_daisrx_dw(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,lx integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then if (abs(x(j+1)) > abs(x(j))) then
xx = x(j) xx = x(j)
lx = ix(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
ix(i-1) = ix(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit if (abs(x(i)) <= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
ix(i-1) = lx idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_daisrx_dw end subroutine psi_daisrx_dw
@ -331,4 +332,4 @@ contains
enddo enddo
end subroutine psi_daisr_dw end subroutine psi_daisr_dw
end submodule psb_d_isort_impl_mod end submodule psb_d_isort_impl_mod

11
base/serial/sort/psb_d_msort_impl.f90
Unescape Escape View File

@ -41,7 +41,9 @@
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_d_sort_mod) psb_d_msort_impl_mod submodule (psb_d_sort_mod) psb_d_msort_impl_mod
contains contains
subroutine psb_dmsort(x,ix,dir,flag) subroutine psb_dmsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
@ -556,4 +558,11 @@ contains
end subroutine psi_d_amsort_dw end subroutine psi_d_amsort_dw
end submodule psb_d_msort_impl_mod
end submodule psb_d_msort_impl_mod

201
base/serial/sort/psb_d_qsort_impl.f90
Unescape Escape View File

@ -29,18 +29,19 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The quicksort routines ! The quicksort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_d_sort_mod) psb_d_qsort_impl_mod submodule (psb_d_sort_mod) psb_d_qsort_impl_mod
contains contains
subroutine psb_dqsort(x,ix,dir,flag) subroutine psb_dqsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
@ -130,12 +131,12 @@ contains
return return
end subroutine psb_dqsort end subroutine psb_dqsort
subroutine psi_dqsrx_up(n,x,ix) subroutine psi_dqsrx_up(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt real(psb_dpk_) :: piv, xk, xt
@ -168,39 +169,39 @@ contains
piv = x(lpiv) piv = x(lpiv)
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(j)) then if (piv > x(j)) then
xt = x(j) xt = x(j)
ixt = ix(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
ix(j) = ix(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -226,11 +227,11 @@ contains
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
ix(i) = ix(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
ix(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -252,14 +253,14 @@ contains
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_disrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_up(n2,x(i:iux),ix(i:iux)) call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -267,28 +268,28 @@ contains
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_up(n2,x(i:iux),ix(i:iux)) call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_disrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
endif endif
enddo enddo
else else
call psi_disrx_up(n,x,ix) call psi_disrx_up(n,x,idx)
endif endif
end subroutine psi_dqsrx_up end subroutine psi_dqsrx_up
subroutine psi_dqsrx_dw(n,x,ix) subroutine psi_dqsrx_dw(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt real(psb_dpk_) :: piv, xk, xt
@ -321,39 +322,39 @@ contains
piv = x(lpiv) piv = x(lpiv)
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(j)) then if (piv < x(j)) then
xt = x(j) xt = x(j)
ixt = ix(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
ix(j) = ix(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -379,11 +380,11 @@ contains
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
ix(i) = ix(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
ix(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -405,14 +406,14 @@ contains
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_disrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_dw(n2,x(i:iux),ix(i:iux)) call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -420,19 +421,19 @@ contains
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_dw(n2,x(i:iux),ix(i:iux)) call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_disrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
endif endif
enddo enddo
else else
call psi_disrx_dw(n,x,ix) call psi_disrx_dw(n,x,idx)
endif endif
end subroutine psi_dqsrx_dw end subroutine psi_dqsrx_dw
@ -717,12 +718,12 @@ contains
end subroutine psi_dqsr_dw end subroutine psi_dqsr_dw
subroutine psi_daqsrx_up(n,x,ix) subroutine psi_daqsrx_up(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk real(psb_dpk_) :: piv, xk
@ -756,39 +757,39 @@ contains
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(j))) then if (piv > abs(x(j))) then
xt = x(j) xt = x(j)
ixt = ix(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
ix(j) = ix(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -813,11 +814,11 @@ contains
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
ix(i) = ix(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
ix(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -839,14 +840,14 @@ contains
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_daisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_up(n2,x(i:iux),ix(i:iux)) call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -854,30 +855,30 @@ contains
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_up(n2,x(i:iux),ix(i:iux)) call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_daisrx_up(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
endif endif
enddo enddo
else else
call psi_daisrx_up(n,x,ix) call psi_daisrx_up(n,x,idx)
endif endif
end subroutine psi_daqsrx_up end subroutine psi_daqsrx_up
subroutine psi_daqsrx_dw(n,x,ix) subroutine psi_daqsrx_dw(n,x,idx)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk real(psb_dpk_) :: piv, xk
@ -910,39 +911,39 @@ contains
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(j))) then if (piv < abs(x(j))) then
xt = x(j) xt = x(j)
ixt = ix(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
ix(j) = ix(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
ix(i) = ix(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
ix(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -967,11 +968,11 @@ contains
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = ix(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
ix(i) = ix(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
ix(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -993,14 +994,14 @@ contains
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_daisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_dw(n2,x(i:iux),ix(i:iux)) call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -1008,19 +1009,19 @@ contains
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_dw(n2,x(i:iux),ix(i:iux)) call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else else
call psi_daisrx_dw(n1,x(ilx:i-1),ix(ilx:i-1)) call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif endif
endif endif
enddo enddo
else else
call psi_daisrx_dw(n,x,ix) call psi_daisrx_dw(n,x,idx)
endif endif
end subroutine psi_daqsrx_dw end subroutine psi_daqsrx_dw
@ -1304,4 +1305,4 @@ contains
end subroutine psi_daqsr_dw end subroutine psi_daqsr_dw
end submodule psb_d_qsort_impl_mod end submodule psb_d_qsort_impl_mod

1178
base/serial/sort/psb_i_hsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

543
base/serial/sort/psb_i_isort_impl.f90
Unescape Escape View File

@ -29,312 +29,307 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The insertion sort routines ! The insertion sort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_iisort(x,ix,dir,flag) submodule (psb_i_sort_mod) psb_i_isort_impl_mod
use psb_i_sort_mod, psb_protect_name => psb_iisort
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act, i contains
subroutine psb_iisort(x,ix,dir,flag)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: dir_, flag_, n, err_act, i
character(len=20) :: name
name='psb_iisort' integer(psb_ipk_) :: ierr(5)
call psb_erractionsave(err_act) character(len=20) :: name
if (present(flag)) then name='psb_iisort'
flag_ = flag call psb_erractionsave(err_act)
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then if (present(flag)) then
dir_ = dir flag_ = flag
else else
dir_= psb_sort_up_ flag_ = psb_sort_ovw_idx_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if end if
if (flag_==psb_sort_ovw_idx_) then select case(flag_)
do i=1,n case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
ix(i) = i ! OK keep going
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_iisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_iisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_iaisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_iaisrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) if (present(dir)) then
case (psb_sort_up_) dir_ = dir
call psi_iisr_up(n,x) else
case (psb_sort_down_) dir_= psb_sort_up_
call psi_iisr_dw(n,x) end if
case (psb_asort_up_)
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_iisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_iisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_iaisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_iaisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_iisr_up(n,x)
case (psb_sort_down_)
call psi_iisr_dw(n,x)
case (psb_asort_up_)
call psi_iaisr_up(n,x) call psi_iaisr_up(n,x)
case (psb_asort_down_) case (psb_asort_down_)
call psi_iaisr_dw(n,x) call psi_iaisr_dw(n,x)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
end if end if
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_iisort end subroutine psb_iisort
subroutine psi_iisrx_up(n,x,idx) subroutine psi_iisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_up use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) < x(j)) then if (x(j+1) < x(j)) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) >= xx) exit if (x(i) >= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_iisrx_up end subroutine psi_iisrx_up
subroutine psi_iisrx_dw(n,x,idx) subroutine psi_iisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_dw use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) > x(j)) then if (x(j+1) > x(j)) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) <= xx) exit if (x(i) <= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_iisrx_dw end subroutine psi_iisrx_dw
subroutine psi_iisr_up(n,x) subroutine psi_iisr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iisr_up use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) < x(j)) then if (x(j+1) < x(j)) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) >= xx) exit if (x(i) >= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_iisr_up end subroutine psi_iisr_up
subroutine psi_iisr_dw(n,x) subroutine psi_iisr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iisr_dw use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) > x(j)) then if (x(j+1) > x(j)) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) <= xx) exit if (x(i) <= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_iisr_dw end subroutine psi_iisr_dw
subroutine psi_iaisrx_up(n,x,idx) subroutine psi_iaisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_up use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(j+1)) < abs(x(j))) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit if (abs(x(i)) >= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_iaisrx_up end subroutine psi_iaisrx_up
subroutine psi_iaisrx_dw(n,x,idx) subroutine psi_iaisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_dw use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then if (abs(x(j+1)) > abs(x(j))) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit if (abs(x(i)) <= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_iaisrx_dw end subroutine psi_iaisrx_dw
subroutine psi_iaisr_up(n,x) subroutine psi_iaisr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaisr_up use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(j+1)) < abs(x(j))) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit if (abs(x(i)) >= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_iaisr_up end subroutine psi_iaisr_up
subroutine psi_iaisr_dw(n,x) subroutine psi_iaisr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaisr_dw use psb_error_mod
use psb_error_mod implicit none
implicit none integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j integer(psb_ipk_) :: xx
integer(psb_ipk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then if (abs(x(j+1)) > abs(x(j))) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit if (abs(x(i)) <= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_iaisr_dw end subroutine psi_iaisr_dw
end submodule psb_i_isort_impl_mod

10
base/serial/sort/psb_i_msort_impl.f90
Unescape Escape View File

@ -40,8 +40,10 @@
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_i_sort_mod) psb_i_msort_impl_mod
contains
logical function psb_isaperm(n,eip) logical function psb_isaperm(n,eip)
use psb_i_sort_mod, psb_protect_name => psb_isaperm
implicit none implicit none
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
@ -96,7 +98,6 @@
end function psb_isaperm end function psb_isaperm
function psb_iblsrch(key,n,v) result(ipos) function psb_iblsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_iblsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
@ -138,7 +139,6 @@
end function psb_iblsrch end function psb_iblsrch
function psb_ibsrch(key,n,v) result(ipos) function psb_ibsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_ibsrch
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
@ -164,7 +164,6 @@
end function psb_ibsrch end function psb_ibsrch
function psb_issrch(key,n,v) result(ipos) function psb_issrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_issrch
implicit none implicit none
integer(psb_ipk_) :: ipos, key, n integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:) integer(psb_ipk_) :: v(:)
@ -184,7 +183,6 @@
subroutine psb_imsort_u(x,nout,dir) subroutine psb_imsort_u(x,nout,dir)
use psb_i_sort_mod, psb_protect_name => psb_imsort_u
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
@ -233,7 +231,6 @@
subroutine psb_imsort(x,ix,dir,flag) subroutine psb_imsort(x,ix,dir,flag)
use psb_i_sort_mod, psb_protect_name => psb_imsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
@ -754,3 +751,4 @@
end submodule psb_i_msort_impl_mod

2335
base/serial/sort/psb_i_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

1178
base/serial/sort/psb_s_hsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

543
base/serial/sort/psb_s_isort_impl.f90
Unescape Escape View File

@ -29,312 +29,307 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The insertion sort routines ! The insertion sort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_sisort(x,ix,dir,flag) submodule (psb_s_sort_mod) psb_s_isort_impl_mod
use psb_s_sort_mod, psb_protect_name => psb_sisort
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act, i contains
subroutine psb_sisort(x,ix,dir,flag)
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: dir_, flag_, n, err_act, i
character(len=20) :: name
name='psb_sisort' integer(psb_ipk_) :: ierr(5)
call psb_erractionsave(err_act) character(len=20) :: name
if (present(flag)) then name='psb_sisort'
flag_ = flag call psb_erractionsave(err_act)
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then if (present(flag)) then
dir_ = dir flag_ = flag
else else
dir_= psb_sort_up_ flag_ = psb_sort_ovw_idx_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if end if
if (flag_==psb_sort_ovw_idx_) then select case(flag_)
do i=1,n case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
ix(i) = i ! OK keep going
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_sisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_sisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_saisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_saisrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) if (present(dir)) then
case (psb_sort_up_) dir_ = dir
call psi_sisr_up(n,x) else
case (psb_sort_down_) dir_= psb_sort_up_
call psi_sisr_dw(n,x) end if
case (psb_asort_up_)
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_sisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_sisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_saisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_saisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_sisr_up(n,x)
case (psb_sort_down_)
call psi_sisr_dw(n,x)
case (psb_asort_up_)
call psi_saisr_up(n,x) call psi_saisr_up(n,x)
case (psb_asort_down_) case (psb_asort_down_)
call psi_saisr_dw(n,x) call psi_saisr_dw(n,x)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
end if end if
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_sisort end subroutine psb_sisort
subroutine psi_sisrx_up(n,x,idx) subroutine psi_sisrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sisrx_up use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) < x(j)) then if (x(j+1) < x(j)) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) >= xx) exit if (x(i) >= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_sisrx_up end subroutine psi_sisrx_up
subroutine psi_sisrx_dw(n,x,idx) subroutine psi_sisrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sisrx_dw use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) > x(j)) then if (x(j+1) > x(j)) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) <= xx) exit if (x(i) <= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_sisrx_dw end subroutine psi_sisrx_dw
subroutine psi_sisr_up(n,x) subroutine psi_sisr_up(n,x)
use psb_s_sort_mod, psb_protect_name => psi_sisr_up use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) < x(j)) then if (x(j+1) < x(j)) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) >= xx) exit if (x(i) >= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_sisr_up end subroutine psi_sisr_up
subroutine psi_sisr_dw(n,x) subroutine psi_sisr_dw(n,x)
use psb_s_sort_mod, psb_protect_name => psi_sisr_dw use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (x(j+1) > x(j)) then if (x(j+1) > x(j)) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (x(i) <= xx) exit if (x(i) <= xx) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_sisr_dw end subroutine psi_sisr_dw
subroutine psi_saisrx_up(n,x,idx) subroutine psi_saisrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saisrx_up use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(j+1)) < abs(x(j))) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit if (abs(x(i)) >= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_saisrx_up end subroutine psi_saisrx_up
subroutine psi_saisrx_dw(n,x,idx) subroutine psi_saisrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saisrx_dw use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then if (abs(x(j+1)) > abs(x(j))) then
xx = x(j) xx = x(j)
ix = idx(j) ix = idx(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
idx(i-1) = idx(i) idx(i-1) = idx(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit if (abs(x(i)) <= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_saisrx_dw end subroutine psi_saisrx_dw
subroutine psi_saisr_up(n,x) subroutine psi_saisr_up(n,x)
use psb_s_sort_mod, psb_protect_name => psi_saisr_up use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(j+1)) < abs(x(j))) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit if (abs(x(i)) >= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_saisr_up end subroutine psi_saisr_up
subroutine psi_saisr_dw(n,x) subroutine psi_saisr_dw(n,x)
use psb_s_sort_mod, psb_protect_name => psi_saisr_dw use psb_error_mod
use psb_error_mod implicit none
implicit none real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: i,j real(psb_spk_) :: xx
real(psb_spk_) :: xx
do j=n-1,1,-1 do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then if (abs(x(j+1)) > abs(x(j))) then
xx = x(j) xx = x(j)
i=j+1 i=j+1
do do
x(i-1) = x(i) x(i-1) = x(i)
i = i+1 i = i+1
if (i>n) exit if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit if (abs(x(i)) <= abs(xx)) exit
end do end do
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_saisr_dw end subroutine psi_saisr_dw
end submodule psb_s_isort_impl_mod

5
base/serial/sort/psb_s_msort_impl.f90
Unescape Escape View File

@ -40,9 +40,11 @@
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_s_sort_mod) psb_s_msort_impl_mod
contains
subroutine psb_smsort(x,ix,dir,flag) subroutine psb_smsort(x,ix,dir,flag)
use psb_s_sort_mod, psb_protect_name => psb_smsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
@ -563,3 +565,4 @@
end submodule psb_s_msort_impl_mod

2335
base/serial/sort/psb_s_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

2010
base/serial/sort/psb_z_hsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

809
base/serial/sort/psb_z_isort_impl.f90
Unescape Escape View File

@ -29,432 +29,423 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The insertion sort routines ! The insertion sort routines
! References: ! References:
! D. Knuth ! D. Knuth
! The Art of Computer Programming, vol. 3 ! The Art of Computer Programming, vol. 3
! Addison-Wesley ! Addison-Wesley
! !
! Aho, Hopcroft, Ullman ! Aho, Hopcroft, Ullman
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
subroutine psb_zisort(x,ix,dir,flag) submodule (psb_z_sort_mod) psb_z_isort_impl_mod
use psb_z_sort_mod, psb_protect_name => psb_zisort
use psb_error_mod contains
implicit none subroutine psb_zisort(x,ix,dir,flag)
complex(psb_dpk_), intent(inout) :: x(:) use psb_error_mod
integer(psb_ipk_), optional, intent(in) :: dir, flag implicit none
integer(psb_ipk_), optional, intent(inout) :: ix(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_) :: dir_, flag_, n, err_act, i integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: dir_, flag_, n, err_act, i
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
name='psb_zisort' character(len=20) :: name
call psb_erractionsave(err_act)
name='psb_zisort'
if (present(flag)) then call psb_erractionsave(err_act)
flag_ = flag
else if (present(flag)) then
flag_ = psb_sort_ovw_idx_ flag_ = flag
end if else
select case(flag_) flag_ = psb_sort_ovw_idx_
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_asort_up_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if end if
if (flag_==psb_sort_ovw_idx_) then select case(flag_)
do i=1,n case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
ix(i) = i ! OK keep going
end do case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_asort_up_
end if end if
select case(dir_) n = size(x)
case (psb_lsort_up_)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_lsort_up_)
call psi_zlisrx_up(n,x,ix) call psi_zlisrx_up(n,x,ix)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_zlisrx_dw(n,x,ix) call psi_zlisrx_dw(n,x,ix)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_zalisrx_up(n,x,ix) call psi_zalisrx_up(n,x,ix)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_zalisrx_dw(n,x,ix) call psi_zalisrx_dw(n,x,ix)
case (psb_asort_up_) case (psb_asort_up_)
call psi_zaisrx_up(n,x,ix) call psi_zaisrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_zaisrx_dw(n,x,ix) call psi_zaisrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else else
select case(dir_) select case(dir_)
case (psb_lsort_up_) case (psb_lsort_up_)
call psi_zlisr_up(n,x) call psi_zlisr_up(n,x)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_zlisr_dw(n,x) call psi_zlisr_dw(n,x)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_zalisr_up(n,x) call psi_zalisr_up(n,x)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_zalisr_dw(n,x) call psi_zalisr_dw(n,x)
case (psb_asort_up_) case (psb_asort_up_)
call psi_zaisr_up(n,x) call psi_zaisr_up(n,x)
case (psb_asort_down_) case (psb_asort_down_)
call psi_zaisr_dw(n,x) call psi_zaisr_dw(n,x)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
end if end if
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_zisort end subroutine psb_zisort
subroutine psi_zlisrx_up(n,x,idx) subroutine psi_zlisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zlisrx_up use psb_error_mod
use psb_error_mod use psi_lcx_mod
use psi_lcx_mod implicit none
implicit none complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: i,j,ix complex(psb_dpk_) :: xx
complex(psb_dpk_) :: xx
do j=n-1,1,-1
do j=n-1,1,-1 if (x(j+1) < x(j)) then
if (x(j+1) < x(j)) then xx = x(j)
xx = x(j) ix = idx(j)
ix = idx(j) i=j+1
i=j+1 do
do x(i-1) = x(i)
x(i-1) = x(i) idx(i-1) = idx(i)
idx(i-1) = idx(i) i = i+1
i = i+1 if (i>n) exit
if (i>n) exit if (x(i) >= xx) exit
if (x(i) >= xx) exit end do
end do x(i-1) = xx
x(i-1) = xx idx(i-1) = ix
idx(i-1) = ix endif
endif enddo
enddo
end subroutine psi_zlisrx_up
end subroutine psi_zlisrx_up
subroutine psi_zlisrx_dw(n,x,idx)
subroutine psi_zlisrx_dw(n,x,idx) use psb_error_mod
use psb_z_sort_mod, psb_protect_name => psi_zlisrx_dw use psi_lcx_mod
use psb_error_mod implicit none
use psi_lcx_mod complex(psb_dpk_), intent(inout) :: x(:)
implicit none integer(psb_ipk_), intent(inout) :: idx(:)
complex(psb_dpk_), intent(inout) :: x(:) integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(inout) :: idx(:) integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_), intent(in) :: n complex(psb_dpk_) :: xx
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx do j=n-1,1,-1
if (x(j+1) > x(j)) then
do j=n-1,1,-1 xx = x(j)
if (x(j+1) > x(j)) then ix = idx(j)
xx = x(j) i=j+1
ix = idx(j) do
i=j+1 x(i-1) = x(i)
do idx(i-1) = idx(i)
x(i-1) = x(i) i = i+1
idx(i-1) = idx(i) if (i>n) exit
i = i+1 if (x(i) <= xx) exit
if (i>n) exit end do
if (x(i) <= xx) exit x(i-1) = xx
end do idx(i-1) = ix
x(i-1) = xx endif
idx(i-1) = ix enddo
endif end subroutine psi_zlisrx_dw
enddo
end subroutine psi_zlisrx_dw subroutine psi_zlisr_up(n,x)
use psb_error_mod
subroutine psi_zlisr_up(n,x) use psi_lcx_mod
use psb_z_sort_mod, psb_protect_name => psi_zlisr_up implicit none
use psb_error_mod complex(psb_dpk_), intent(inout) :: x(:)
use psi_lcx_mod integer(psb_ipk_), intent(in) :: n
implicit none integer(psb_ipk_) :: i,j
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_) :: xx
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j do j=n-1,1,-1
complex(psb_dpk_) :: xx if (x(j+1) < x(j)) then
xx = x(j)
do j=n-1,1,-1 i=j+1
if (x(j+1) < x(j)) then do
xx = x(j) x(i-1) = x(i)
i=j+1 i = i+1
do if (i>n) exit
x(i-1) = x(i) if (x(i) >= xx) exit
i = i+1 end do
if (i>n) exit x(i-1) = xx
if (x(i) >= xx) exit endif
end do enddo
x(i-1) = xx end subroutine psi_zlisr_up
endif
enddo subroutine psi_zlisr_dw(n,x)
end subroutine psi_zlisr_up use psb_error_mod
use psi_lcx_mod
subroutine psi_zlisr_dw(n,x) implicit none
use psb_z_sort_mod, psb_protect_name => psi_zlisr_dw complex(psb_dpk_), intent(inout) :: x(:)
use psb_error_mod integer(psb_ipk_), intent(in) :: n
use psi_lcx_mod integer(psb_ipk_) :: i,j
implicit none complex(psb_dpk_) :: xx
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n do j=n-1,1,-1
integer(psb_ipk_) :: i,j if (x(j+1) > x(j)) then
complex(psb_dpk_) :: xx xx = x(j)
i=j+1
do j=n-1,1,-1 do
if (x(j+1) > x(j)) then x(i-1) = x(i)
xx = x(j) i = i+1
i=j+1 if (i>n) exit
do if (x(i) <= xx) exit
x(i-1) = x(i) end do
i = i+1 x(i-1) = xx
if (i>n) exit endif
if (x(i) <= xx) exit enddo
end do end subroutine psi_zlisr_dw
x(i-1) = xx
endif subroutine psi_zalisrx_up(n,x,idx)
enddo use psb_error_mod
end subroutine psi_zlisr_dw use psi_alcx_mod
implicit none
subroutine psi_zalisrx_up(n,x,idx) complex(psb_dpk_), intent(inout) :: x(:)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_up integer(psb_ipk_), intent(inout) :: idx(:)
use psb_error_mod integer(psb_ipk_), intent(in) :: n
use psi_alcx_mod integer(psb_ipk_) :: i,j,ix
implicit none complex(psb_dpk_) :: xx
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:) do j=n-1,1,-1
integer(psb_ipk_), intent(in) :: n if (x(j+1) < x(j)) then
integer(psb_ipk_) :: i,j,ix xx = x(j)
complex(psb_dpk_) :: xx ix = idx(j)
i=j+1
do j=n-1,1,-1 do
if (x(j+1) < x(j)) then x(i-1) = x(i)
xx = x(j) idx(i-1) = idx(i)
ix = idx(j) i = i+1
i=j+1 if (i>n) exit
do if (x(i) >= xx) exit
x(i-1) = x(i) end do
idx(i-1) = idx(i) x(i-1) = xx
i = i+1 idx(i-1) = ix
if (i>n) exit endif
if (x(i) >= xx) exit enddo
end do end subroutine psi_zalisrx_up
x(i-1) = xx
idx(i-1) = ix subroutine psi_zalisrx_dw(n,x,idx)
endif use psb_error_mod
enddo use psi_alcx_mod
end subroutine psi_zalisrx_up implicit none
complex(psb_dpk_), intent(inout) :: x(:)
subroutine psi_zalisrx_dw(n,x,idx) integer(psb_ipk_), intent(inout) :: idx(:)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_dw integer(psb_ipk_), intent(in) :: n
use psb_error_mod integer(psb_ipk_) :: i,j,ix
use psi_alcx_mod complex(psb_dpk_) :: xx
implicit none
complex(psb_dpk_), intent(inout) :: x(:) do j=n-1,1,-1
integer(psb_ipk_), intent(inout) :: idx(:) if (x(j+1) > x(j)) then
integer(psb_ipk_), intent(in) :: n xx = x(j)
integer(psb_ipk_) :: i,j,ix ix = idx(j)
complex(psb_dpk_) :: xx i=j+1
do
do j=n-1,1,-1 x(i-1) = x(i)
if (x(j+1) > x(j)) then idx(i-1) = idx(i)
xx = x(j) i = i+1
ix = idx(j) if (i>n) exit
i=j+1 if (x(i) <= xx) exit
do end do
x(i-1) = x(i) x(i-1) = xx
idx(i-1) = idx(i) idx(i-1) = ix
i = i+1 endif
if (i>n) exit enddo
if (x(i) <= xx) exit end subroutine psi_zalisrx_dw
end do
x(i-1) = xx subroutine psi_zalisr_up(n,x)
idx(i-1) = ix use psb_error_mod
endif use psi_alcx_mod
enddo implicit none
end subroutine psi_zalisrx_dw complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
subroutine psi_zalisr_up(n,x) integer(psb_ipk_) :: i,j
use psb_z_sort_mod, psb_protect_name => psi_zalisr_up complex(psb_dpk_) :: xx
use psb_error_mod
use psi_alcx_mod do j=n-1,1,-1
implicit none if (x(j+1) < x(j)) then
complex(psb_dpk_), intent(inout) :: x(:) xx = x(j)
integer(psb_ipk_), intent(in) :: n i=j+1
integer(psb_ipk_) :: i,j do
complex(psb_dpk_) :: xx x(i-1) = x(i)
i = i+1
do j=n-1,1,-1 if (i>n) exit
if (x(j+1) < x(j)) then if (x(i) >= xx) exit
xx = x(j) end do
i=j+1 x(i-1) = xx
do endif
x(i-1) = x(i) enddo
i = i+1 end subroutine psi_zalisr_up
if (i>n) exit
if (x(i) >= xx) exit subroutine psi_zalisr_dw(n,x)
end do use psb_error_mod
x(i-1) = xx use psi_alcx_mod
endif implicit none
enddo complex(psb_dpk_), intent(inout) :: x(:)
end subroutine psi_zalisr_up integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
subroutine psi_zalisr_dw(n,x) complex(psb_dpk_) :: xx
use psb_z_sort_mod, psb_protect_name => psi_zalisr_dw
use psb_error_mod do j=n-1,1,-1
use psi_alcx_mod if (x(j+1) > x(j)) then
implicit none xx = x(j)
complex(psb_dpk_), intent(inout) :: x(:) i=j+1
integer(psb_ipk_), intent(in) :: n do
integer(psb_ipk_) :: i,j x(i-1) = x(i)
complex(psb_dpk_) :: xx i = i+1
if (i>n) exit
do j=n-1,1,-1 if (x(i) <= xx) exit
if (x(j+1) > x(j)) then end do
xx = x(j) x(i-1) = xx
i=j+1 endif
do enddo
x(i-1) = x(i) end subroutine psi_zalisr_dw
i = i+1
if (i>n) exit subroutine psi_zaisrx_up(n,x,idx)
if (x(i) <= xx) exit use psb_error_mod
end do implicit none
x(i-1) = xx complex(psb_dpk_), intent(inout) :: x(:)
endif integer(psb_ipk_), intent(inout) :: idx(:)
enddo integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisr_dw integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
subroutine psi_zaisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_up do j=n-1,1,-1
use psb_error_mod if (abs(x(j+1)) < abs(x(j))) then
implicit none xx = x(j)
complex(psb_dpk_), intent(inout) :: x(:) ix = idx(j)
integer(psb_ipk_), intent(inout) :: idx(:) i=j+1
integer(psb_ipk_), intent(in) :: n do
integer(psb_ipk_) :: i,j,ix x(i-1) = x(i)
complex(psb_dpk_) :: xx idx(i-1) = idx(i)
i = i+1
do j=n-1,1,-1 if (i>n) exit
if (abs(x(j+1)) < abs(x(j))) then if (abs(x(i)) >= abs(xx)) exit
xx = x(j) end do
ix = idx(j) x(i-1) = xx
i=j+1 idx(i-1) = ix
do endif
x(i-1) = x(i) enddo
idx(i-1) = idx(i) end subroutine psi_zaisrx_up
i = i+1
if (i>n) exit subroutine psi_zaisrx_dw(n,x,idx)
if (abs(x(i)) >= abs(xx)) exit use psb_error_mod
end do implicit none
x(i-1) = xx complex(psb_dpk_), intent(inout) :: x(:)
idx(i-1) = ix integer(psb_ipk_), intent(inout) :: idx(:)
endif integer(psb_ipk_), intent(in) :: n
enddo integer(psb_ipk_) :: i,j,ix
end subroutine psi_zaisrx_up complex(psb_dpk_) :: xx
subroutine psi_zaisrx_dw(n,x,idx) do j=n-1,1,-1
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_dw if (abs(x(j+1)) > abs(x(j))) then
use psb_error_mod xx = x(j)
implicit none ix = idx(j)
complex(psb_dpk_), intent(inout) :: x(:) i=j+1
integer(psb_ipk_), intent(inout) :: idx(:) do
integer(psb_ipk_), intent(in) :: n x(i-1) = x(i)
integer(psb_ipk_) :: i,j,ix idx(i-1) = idx(i)
complex(psb_dpk_) :: xx i = i+1
if (i>n) exit
do j=n-1,1,-1 if (abs(x(i)) <= abs(xx)) exit
if (abs(x(j+1)) > abs(x(j))) then end do
xx = x(j) x(i-1) = xx
ix = idx(j) idx(i-1) = ix
i=j+1 endif
do enddo
x(i-1) = x(i) end subroutine psi_zaisrx_dw
idx(i-1) = idx(i)
i = i+1 subroutine psi_zaisr_up(n,x)
if (i>n) exit use psb_error_mod
if (abs(x(i)) <= abs(xx)) exit implicit none
end do complex(psb_dpk_), intent(inout) :: x(:)
x(i-1) = xx integer(psb_ipk_), intent(in) :: n
idx(i-1) = ix integer(psb_ipk_) :: i,j
endif complex(psb_dpk_) :: xx
enddo
end subroutine psi_zaisrx_dw do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
subroutine psi_zaisr_up(n,x) xx = x(j)
use psb_z_sort_mod, psb_protect_name => psi_zaisr_up i=j+1
use psb_error_mod do
implicit none x(i-1) = x(i)
complex(psb_dpk_), intent(inout) :: x(:) i = i+1
integer(psb_ipk_), intent(in) :: n if (i>n) exit
integer(psb_ipk_) :: i,j if (abs(x(i)) >= abs(xx)) exit
complex(psb_dpk_) :: xx end do
x(i-1) = xx
do j=n-1,1,-1 endif
if (abs(x(j+1)) < abs(x(j))) then enddo
xx = x(j) end subroutine psi_zaisr_up
i=j+1
do subroutine psi_zaisr_dw(n,x)
x(i-1) = x(i) use psb_error_mod
i = i+1 implicit none
if (i>n) exit complex(psb_dpk_), intent(inout) :: x(:)
if (abs(x(i)) >= abs(xx)) exit integer(psb_ipk_), intent(in) :: n
end do integer(psb_ipk_) :: i,j
x(i-1) = xx complex(psb_dpk_) :: xx
endif
enddo do j=n-1,1,-1
end subroutine psi_zaisr_up if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
subroutine psi_zaisr_dw(n,x) i=j+1
use psb_z_sort_mod, psb_protect_name => psi_zaisr_dw do
use psb_error_mod x(i-1) = x(i)
implicit none i = i+1
complex(psb_dpk_), intent(inout) :: x(:) if (i>n) exit
integer(psb_ipk_), intent(in) :: n if (abs(x(i)) <= abs(xx)) exit
integer(psb_ipk_) :: i,j end do
complex(psb_dpk_) :: xx x(i-1) = xx
endif
do j=n-1,1,-1 enddo
if (abs(x(j+1)) > abs(x(j))) then end subroutine psi_zaisr_dw
xx = x(j)
i=j+1 end submodule psb_z_isort_impl_mod
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_zaisr_dw

5
base/serial/sort/psb_z_msort_impl.f90
Unescape Escape View File

@ -40,6 +40,9 @@
! Data Structures and Algorithms ! Data Structures and Algorithms
! Addison-Wesley ! Addison-Wesley
! !
submodule (psb_z_sort_mod) psb_z_msort_impl_mod
contains
@ -49,7 +52,6 @@
subroutine psb_zmsort(x,ix,dir,flag) subroutine psb_zmsort(x,ix,dir,flag)
use psb_z_sort_mod, psb_protect_name => psb_zmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
@ -780,3 +782,4 @@
end subroutine psi_z_almsort_dw end subroutine psi_z_almsort_dw
end submodule psb_z_msort_impl_mod

3421
base/serial/sort/psb_z_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

4
test/kernel/Makefile
Unescape Escape View File

@ -27,10 +27,6 @@ pdgenspmv: $(DPGOBJS)
$(F90LINK) $(LOPT) $(DPGOBJS) -o pdgenspmv $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) $(LOPT) $(DPGOBJS) -o pdgenspmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv pdgenspmv $(EXEDIR) /bin/mv pdgenspmv $(EXEDIR)
tt: tt.o
$(F90LINK) $(LOPT) tt.o -o tt $(PSBLAS_LIB) $(LDLIBS)
/bin/mv tt $(EXEDIR)
s_file_spmv: $(STOBJS) s_file_spmv: $(STOBJS)
$(F90LINK) $(LOPT) $(STOBJS) -o s_file_spmv $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) $(LOPT) $(STOBJS) -o s_file_spmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv s_file_spmv $(EXEDIR) /bin/mv s_file_spmv $(EXEDIR)

Write Preview
Loading…
Cancel
Save