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

5
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,7 +189,7 @@ 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

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

122
base/serial/sort/psb_c_hsort_impl.f90
Unescape Escape View File

@ -29,20 +29,23 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The merge-sort and quicksort routines are implemented in the ! The merge-sort and quicksort routines are implemented in the
! serial/aux directory ! serial/aux directory
! 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_chsort(x,ix,dir,flag) submodule (psb_c_sort_mod) psb_c_hsort_impl_mod
use psb_c_sort_mod, psb_protect_name => psb_chsort
contains
subroutine psb_chsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -153,39 +156,38 @@ subroutine psb_chsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_chsort end subroutine psb_chsort
! !
! These are packaged so that they can be used to implement ! These are packaged so that they can be used to implement
! a heapsort, should the need arise ! a heapsort, should the need arise
! !
! !
! Programming note: ! Programming note:
! In the implementation of the heap_get_first function ! In the implementation of the heap_get_first function
! we have code like this ! we have code like this
! !
! if ( ( heap(2*i) < heap(2*i+1) ) .or.& ! if ( ( heap(2*i) < heap(2*i+1) ) .or.&
! & (2*i == last)) then ! & (2*i == last)) then
! j = 2*i ! j = 2*i
! else ! else
! j = 2*i + 1 ! j = 2*i + 1
! end if ! end if
! !
! It looks like the 2*i+1 could overflow the array, but this ! It looks like the 2*i+1 could overflow the array, but this
! is not true because there is a guard statement ! is not true because there is a guard statement
! if (i>last/2) exit ! if (i>last/2) exit
! and because last has just been reduced by 1 when defining the return value, ! and because last has just been reduced by 1 when defining the return value,
! therefore 2*i+1 may be greater than the current value of last, ! therefore 2*i+1 may be greater than the current value of last,
! but cannot be greater than the value of last when the routine was entered ! but cannot be greater than the value of last when the routine was entered
! hence it is safe. ! hence it is safe.
! !
! !
! !
subroutine psi_c_insert_heap(key,last,heap,dir,info) subroutine psi_c_insert_heap(key,last,heap,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_insert_heap
implicit none implicit none
! !
@ -247,7 +249,7 @@ subroutine psi_c_insert_heap(key,last,heap,dir,info)
return return
contains contains
subroutine fix_aup(last,heap) subroutine fix_aup(last,heap)
use psi_acx_mod use psi_acx_mod
@ -388,10 +390,9 @@ contains
end do end do
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_c_insert_heap end subroutine psi_c_insert_heap
subroutine psi_c_heap_get_first(key,last,heap,dir,info) subroutine psi_c_heap_get_first(key,last,heap,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_heap_get_first
implicit none implicit none
! !
@ -447,7 +448,7 @@ subroutine psi_c_heap_get_first(key,last,heap,dir,info)
end select end select
return return
contains contains
subroutine fix_aup(last,heap) subroutine fix_aup(last,heap)
use psi_acx_mod use psi_acx_mod
@ -630,10 +631,9 @@ contains
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_c_heap_get_first end subroutine psi_c_heap_get_first
subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info) subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_idx_insert_heap
implicit none implicit none
! !
@ -699,7 +699,7 @@ subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info)
return return
contains contains
subroutine fix_aup(last,heap,idxs) subroutine fix_aup(last,heap,idxs)
use psi_acx_mod use psi_acx_mod
@ -864,12 +864,11 @@ contains
end do end do
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_c_idx_insert_heap end subroutine psi_c_idx_insert_heap
subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info) subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_idx_heap_get_first
implicit none implicit none
! !
@ -927,7 +926,7 @@ subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end select end select
return return
contains contains
subroutine fix_aup(last,heap,idxs) subroutine fix_aup(last,heap,idxs)
use psi_acx_mod use psi_acx_mod
@ -1134,7 +1133,8 @@ contains
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_c_idx_heap_get_first end subroutine psi_c_idx_heap_get_first
end submodule psb_c_hsort_impl_mod

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

@ -29,19 +29,21 @@
!!$ 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
contains
subroutine psb_cisort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -135,10 +137,9 @@ subroutine psb_cisort(x,ix,dir,flag)
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
@ -165,10 +166,9 @@ subroutine psi_clisrx_up(n,x,idx)
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_c_sort_mod, psb_protect_name => psi_clisrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -194,10 +194,9 @@ subroutine psi_clisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_clisrx_dw end subroutine psi_clisrx_dw
subroutine psi_clisr_up(n,x) subroutine psi_clisr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_clisr_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -219,10 +218,9 @@ subroutine psi_clisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_clisr_up end subroutine psi_clisr_up
subroutine psi_clisr_dw(n,x) subroutine psi_clisr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_clisr_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -244,10 +242,9 @@ subroutine psi_clisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_clisr_dw end subroutine psi_clisr_dw
subroutine psi_calisrx_up(n,x,idx) subroutine psi_calisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -273,10 +270,9 @@ subroutine psi_calisrx_up(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_calisrx_up end subroutine psi_calisrx_up
subroutine psi_calisrx_dw(n,x,idx) subroutine psi_calisrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -302,10 +298,9 @@ subroutine psi_calisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_calisrx_dw end subroutine psi_calisrx_dw
subroutine psi_calisr_up(n,x) subroutine psi_calisr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_calisr_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -327,10 +322,9 @@ subroutine psi_calisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_calisr_up end subroutine psi_calisr_up
subroutine psi_calisr_dw(n,x) subroutine psi_calisr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_calisr_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -352,10 +346,9 @@ subroutine psi_calisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_calisr_dw end subroutine psi_calisr_dw
subroutine psi_caisrx_up(n,x,idx) subroutine psi_caisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -380,10 +373,9 @@ subroutine psi_caisrx_up(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_caisrx_up end subroutine psi_caisrx_up
subroutine psi_caisrx_dw(n,x,idx) subroutine psi_caisrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -408,10 +400,9 @@ subroutine psi_caisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_caisrx_dw end subroutine psi_caisrx_dw
subroutine psi_caisr_up(n,x) subroutine psi_caisr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_caisr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -432,10 +423,9 @@ subroutine psi_caisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_caisr_up end subroutine psi_caisr_up
subroutine psi_caisr_dw(n,x) subroutine psi_caisr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_caisr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -456,5 +446,6 @@ subroutine psi_caisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_caisr_dw end subroutine psi_caisr_dw
end submodule psb_c_isort_impl_mod

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

91
base/serial/sort/psb_c_qsort_impl.f90
Unescape Escape View File

@ -29,19 +29,21 @@
!!$ 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
! !
subroutine psb_cqsort(x,ix,dir,flag) submodule (psb_c_sort_mod) psb_c_qsort_impl_mod
use psb_c_sort_mod, psb_protect_name => psb_cqsort
contains
subroutine psb_cqsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
@ -135,11 +137,10 @@ subroutine psb_cqsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_cqsort end subroutine psb_cqsort
subroutine psi_clqsrx_up(n,x,idx) subroutine psi_clqsrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_clqsrx_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -292,10 +293,9 @@ subroutine psi_clqsrx_up(n,x,idx)
call psi_clisrx_up(n,x,idx) call psi_clisrx_up(n,x,idx)
endif endif
end subroutine psi_clqsrx_up end subroutine psi_clqsrx_up
subroutine psi_clqsrx_dw(n,x,idx) subroutine psi_clqsrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_clqsrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -447,10 +447,9 @@ subroutine psi_clqsrx_dw(n,x,idx)
else else
call psi_clisrx_dw(n,x,idx) call psi_clisrx_dw(n,x,idx)
endif endif
end subroutine psi_clqsrx_dw end subroutine psi_clqsrx_dw
subroutine psi_clqsr_up(n,x) subroutine psi_clqsr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_clqsr_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -589,10 +588,9 @@ subroutine psi_clqsr_up(n,x)
call psi_clisr_up(n,x) call psi_clisr_up(n,x)
endif endif
end subroutine psi_clqsr_up end subroutine psi_clqsr_up
subroutine psi_clqsr_dw(n,x) subroutine psi_clqsr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_clqsr_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -730,10 +728,9 @@ subroutine psi_clqsr_dw(n,x)
call psi_clisr_dw(n,x) call psi_clisr_dw(n,x)
endif endif
end subroutine psi_clqsr_dw end subroutine psi_clqsr_dw
subroutine psi_calqsrx_up(n,x,idx) subroutine psi_calqsrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calqsrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -885,10 +882,9 @@ subroutine psi_calqsrx_up(n,x,idx)
else else
call psi_calisrx_up(n,x,idx) call psi_calisrx_up(n,x,idx)
endif endif
end subroutine psi_calqsrx_up end subroutine psi_calqsrx_up
subroutine psi_calqsrx_dw(n,x,idx) subroutine psi_calqsrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calqsrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1040,10 +1036,9 @@ subroutine psi_calqsrx_dw(n,x,idx)
else else
call psi_calisrx_dw(n,x,idx) call psi_calisrx_dw(n,x,idx)
endif endif
end subroutine psi_calqsrx_dw end subroutine psi_calqsrx_dw
subroutine psi_calqsr_up(n,x) subroutine psi_calqsr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_calqsr_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1181,10 +1176,9 @@ subroutine psi_calqsr_up(n,x)
else else
call psi_calisr_up(n,x) call psi_calisr_up(n,x)
endif endif
end subroutine psi_calqsr_up end subroutine psi_calqsr_up
subroutine psi_calqsr_dw(n,x) subroutine psi_calqsr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_calqsr_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1321,10 +1315,9 @@ subroutine psi_calqsr_dw(n,x)
else else
call psi_calisr_dw(n,x) call psi_calisr_dw(n,x)
endif endif
end subroutine psi_calqsr_dw end subroutine psi_calqsr_dw
subroutine psi_caqsrx_up(n,x,idx) subroutine psi_caqsrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1477,10 +1470,9 @@ subroutine psi_caqsrx_up(n,x,idx)
endif endif
end subroutine psi_caqsrx_up end subroutine psi_caqsrx_up
subroutine psi_caqsrx_dw(n,x,idx) subroutine psi_caqsrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1631,10 +1623,9 @@ subroutine psi_caqsrx_dw(n,x,idx)
call psi_caisrx_dw(n,x,idx) call psi_caisrx_dw(n,x,idx)
endif endif
end subroutine psi_caqsrx_dw end subroutine psi_caqsrx_dw
subroutine psi_caqsr_up(n,x) subroutine psi_caqsr_up(n,x)
use psb_c_sort_mod, psb_protect_name => psi_caqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1771,10 +1762,9 @@ subroutine psi_caqsr_up(n,x)
call psi_caisr_up(n,x) call psi_caisr_up(n,x)
endif endif
end subroutine psi_caqsr_up end subroutine psi_caqsr_up
subroutine psi_caqsr_dw(n,x) subroutine psi_caqsr_dw(n,x)
use psb_c_sort_mod, psb_protect_name => psi_caqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1911,6 +1901,7 @@ subroutine psi_caqsr_dw(n,x)
call psi_caisr_dw(n,x) call psi_caisr_dw(n,x)
endif endif
end subroutine psi_caqsr_dw end subroutine psi_caqsr_dw
end submodule psb_c_qsort_impl_mod

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

71
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

9
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

199
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

114
base/serial/sort/psb_i_hsort_impl.f90
Unescape Escape View File

@ -29,20 +29,23 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The merge-sort and quicksort routines are implemented in the ! The merge-sort and quicksort routines are implemented in the
! serial/aux directory ! serial/aux directory
! 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_ihsort(x,ix,dir,flag) submodule (psb_i_sort_mod) psb_i_hsort_impl_mod
use psb_i_sort_mod, psb_protect_name => psb_ihsort
contains
subroutine psb_ihsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
@ -153,39 +156,38 @@ subroutine psb_ihsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_ihsort end subroutine psb_ihsort
! !
! These are packaged so that they can be used to implement ! These are packaged so that they can be used to implement
! a heapsort, should the need arise ! a heapsort, should the need arise
! !
! !
! Programming note: ! Programming note:
! In the implementation of the heap_get_first function ! In the implementation of the heap_get_first function
! we have code like this ! we have code like this
! !
! if ( ( heap(2*i) < heap(2*i+1) ) .or.& ! if ( ( heap(2*i) < heap(2*i+1) ) .or.&
! & (2*i == last)) then ! & (2*i == last)) then
! j = 2*i ! j = 2*i
! else ! else
! j = 2*i + 1 ! j = 2*i + 1
! end if ! end if
! !
! It looks like the 2*i+1 could overflow the array, but this ! It looks like the 2*i+1 could overflow the array, but this
! is not true because there is a guard statement ! is not true because there is a guard statement
! if (i>last/2) exit ! if (i>last/2) exit
! and because last has just been reduced by 1 when defining the return value, ! and because last has just been reduced by 1 when defining the return value,
! therefore 2*i+1 may be greater than the current value of last, ! therefore 2*i+1 may be greater than the current value of last,
! but cannot be greater than the value of last when the routine was entered ! but cannot be greater than the value of last when the routine was entered
! hence it is safe. ! hence it is safe.
! !
! !
! !
subroutine psi_i_insert_heap(key,last,heap,dir,info) subroutine psi_i_insert_heap(key,last,heap,dir,info)
use psb_i_sort_mod, psb_protect_name => psi_i_insert_heap
implicit none implicit none
! !
@ -287,11 +289,10 @@ subroutine psi_i_insert_heap(key,last,heap,dir,info)
end select end select
return return
end subroutine psi_i_insert_heap end subroutine psi_i_insert_heap
subroutine psi_i_heap_get_first(key,last,heap,dir,info) subroutine psi_i_heap_get_first(key,last,heap,dir,info)
use psb_i_sort_mod, psb_protect_name => psi_i_heap_get_first
implicit none implicit none
integer(psb_ipk_), intent(inout) :: key integer(psb_ipk_), intent(inout) :: key
@ -411,11 +412,10 @@ subroutine psi_i_heap_get_first(key,last,heap,dir,info)
end select end select
return return
end subroutine psi_i_heap_get_first end subroutine psi_i_heap_get_first
subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info) subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_i_sort_mod, psb_protect_name => psi_i_idx_insert_heap
implicit none implicit none
! !
@ -534,10 +534,9 @@ subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info)
end select end select
return return
end subroutine psi_i_idx_insert_heap end subroutine psi_i_idx_insert_heap
subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info) subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_i_sort_mod, psb_protect_name => psi_i_idx_heap_get_first
implicit none implicit none
integer(psb_ipk_), intent(inout) :: heap(:) integer(psb_ipk_), intent(inout) :: heap(:)
@ -671,8 +670,9 @@ subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end select end select
return return
end subroutine psi_i_idx_heap_get_first end subroutine psi_i_idx_heap_get_first
end submodule psb_i_hsort_impl_mod

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

@ -29,19 +29,21 @@
!!$ 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
contains
subroutine psb_iisort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
@ -127,10 +129,9 @@ subroutine psb_iisort(x,ix,dir,flag)
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(:)
@ -155,10 +156,9 @@ subroutine psi_iisrx_up(n,x,idx)
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(:)
@ -183,11 +183,10 @@ subroutine psi_iisrx_dw(n,x,idx)
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(:)
@ -208,10 +207,9 @@ subroutine psi_iisr_up(n,x)
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(:)
@ -232,10 +230,9 @@ subroutine psi_iisr_dw(n,x)
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(:)
@ -260,10 +257,9 @@ subroutine psi_iaisrx_up(n,x,idx)
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(:)
@ -288,10 +284,9 @@ subroutine psi_iaisrx_dw(n,x,idx)
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(:)
@ -312,10 +307,9 @@ subroutine psi_iaisr_up(n,x)
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(:)
@ -336,5 +330,6 @@ subroutine psi_iaisr_dw(n,x)
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

71
base/serial/sort/psb_i_qsort_impl.f90
Unescape Escape View File

@ -29,19 +29,21 @@
!!$ 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
! !
subroutine psb_iqsort(x,ix,dir,flag) submodule (psb_i_sort_mod) psb_i_qsort_impl_mod
use psb_i_sort_mod, psb_protect_name => psb_iqsort
contains
subroutine psb_iqsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
@ -127,10 +129,9 @@ subroutine psb_iqsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_iqsort end subroutine psb_iqsort
subroutine psi_iqsrx_up(n,x,idx) subroutine psi_iqsrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -281,10 +282,9 @@ subroutine psi_iqsrx_up(n,x,idx)
else else
call psi_iisrx_up(n,x,idx) call psi_iisrx_up(n,x,idx)
endif endif
end subroutine psi_iqsrx_up end subroutine psi_iqsrx_up
subroutine psi_iqsrx_dw(n,x,idx) subroutine psi_iqsrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -436,10 +436,9 @@ subroutine psi_iqsrx_dw(n,x,idx)
call psi_iisrx_dw(n,x,idx) call psi_iisrx_dw(n,x,idx)
endif endif
end subroutine psi_iqsrx_dw end subroutine psi_iqsrx_dw
subroutine psi_iqsr_up(n,x) subroutine psi_iqsr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -577,10 +576,9 @@ subroutine psi_iqsr_up(n,x)
call psi_iisr_up(n,x) call psi_iisr_up(n,x)
endif endif
end subroutine psi_iqsr_up end subroutine psi_iqsr_up
subroutine psi_iqsr_dw(n,x) subroutine psi_iqsr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -718,10 +716,9 @@ subroutine psi_iqsr_dw(n,x)
call psi_iisr_dw(n,x) call psi_iisr_dw(n,x)
endif endif
end subroutine psi_iqsr_dw end subroutine psi_iqsr_dw
subroutine psi_iaqsrx_up(n,x,idx) subroutine psi_iaqsrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -874,10 +871,9 @@ subroutine psi_iaqsrx_up(n,x,idx)
endif endif
end subroutine psi_iaqsrx_up end subroutine psi_iaqsrx_up
subroutine psi_iaqsrx_dw(n,x,idx) subroutine psi_iaqsrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1028,10 +1024,9 @@ subroutine psi_iaqsrx_dw(n,x,idx)
call psi_iaisrx_dw(n,x,idx) call psi_iaisrx_dw(n,x,idx)
endif endif
end subroutine psi_iaqsrx_dw end subroutine psi_iaqsrx_dw
subroutine psi_iaqsr_up(n,x) subroutine psi_iaqsr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1168,10 +1163,9 @@ subroutine psi_iaqsr_up(n,x)
call psi_iaisr_up(n,x) call psi_iaisr_up(n,x)
endif endif
end subroutine psi_iaqsr_up end subroutine psi_iaqsr_up
subroutine psi_iaqsr_dw(n,x) subroutine psi_iaqsr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1308,6 +1302,7 @@ subroutine psi_iaqsr_dw(n,x)
call psi_iaisr_dw(n,x) call psi_iaisr_dw(n,x)
endif endif
end subroutine psi_iaqsr_dw end subroutine psi_iaqsr_dw
end submodule psb_i_qsort_impl_mod

114
base/serial/sort/psb_s_hsort_impl.f90
Unescape Escape View File

@ -29,20 +29,23 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The merge-sort and quicksort routines are implemented in the ! The merge-sort and quicksort routines are implemented in the
! serial/aux directory ! serial/aux directory
! 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_shsort(x,ix,dir,flag) submodule (psb_s_sort_mod) psb_s_hsort_impl_mod
use psb_s_sort_mod, psb_protect_name => psb_shsort
contains
subroutine psb_shsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -153,39 +156,38 @@ subroutine psb_shsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_shsort end subroutine psb_shsort
! !
! These are packaged so that they can be used to implement ! These are packaged so that they can be used to implement
! a heapsort, should the need arise ! a heapsort, should the need arise
! !
! !
! Programming note: ! Programming note:
! In the implementation of the heap_get_first function ! In the implementation of the heap_get_first function
! we have code like this ! we have code like this
! !
! if ( ( heap(2*i) < heap(2*i+1) ) .or.& ! if ( ( heap(2*i) < heap(2*i+1) ) .or.&
! & (2*i == last)) then ! & (2*i == last)) then
! j = 2*i ! j = 2*i
! else ! else
! j = 2*i + 1 ! j = 2*i + 1
! end if ! end if
! !
! It looks like the 2*i+1 could overflow the array, but this ! It looks like the 2*i+1 could overflow the array, but this
! is not true because there is a guard statement ! is not true because there is a guard statement
! if (i>last/2) exit ! if (i>last/2) exit
! and because last has just been reduced by 1 when defining the return value, ! and because last has just been reduced by 1 when defining the return value,
! therefore 2*i+1 may be greater than the current value of last, ! therefore 2*i+1 may be greater than the current value of last,
! but cannot be greater than the value of last when the routine was entered ! but cannot be greater than the value of last when the routine was entered
! hence it is safe. ! hence it is safe.
! !
! !
! !
subroutine psi_s_insert_heap(key,last,heap,dir,info) subroutine psi_s_insert_heap(key,last,heap,dir,info)
use psb_s_sort_mod, psb_protect_name => psi_s_insert_heap
implicit none implicit none
! !
@ -287,11 +289,10 @@ subroutine psi_s_insert_heap(key,last,heap,dir,info)
end select end select
return return
end subroutine psi_s_insert_heap end subroutine psi_s_insert_heap
subroutine psi_s_heap_get_first(key,last,heap,dir,info) subroutine psi_s_heap_get_first(key,last,heap,dir,info)
use psb_s_sort_mod, psb_protect_name => psi_s_heap_get_first
implicit none implicit none
real(psb_spk_), intent(inout) :: key real(psb_spk_), intent(inout) :: key
@ -411,11 +412,10 @@ subroutine psi_s_heap_get_first(key,last,heap,dir,info)
end select end select
return return
end subroutine psi_s_heap_get_first end subroutine psi_s_heap_get_first
subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info) subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_s_sort_mod, psb_protect_name => psi_s_idx_insert_heap
implicit none implicit none
! !
@ -534,10 +534,9 @@ subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info)
end select end select
return return
end subroutine psi_s_idx_insert_heap end subroutine psi_s_idx_insert_heap
subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info) subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_s_sort_mod, psb_protect_name => psi_s_idx_heap_get_first
implicit none implicit none
real(psb_spk_), intent(inout) :: heap(:) real(psb_spk_), intent(inout) :: heap(:)
@ -671,8 +670,9 @@ subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end select end select
return return
end subroutine psi_s_idx_heap_get_first end subroutine psi_s_idx_heap_get_first
end submodule psb_s_hsort_impl_mod

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

@ -29,19 +29,21 @@
!!$ 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
contains
subroutine psb_sisort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -127,10 +129,9 @@ subroutine psb_sisort(x,ix,dir,flag)
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(:)
@ -155,10 +156,9 @@ subroutine psi_sisrx_up(n,x,idx)
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(:)
@ -183,11 +183,10 @@ subroutine psi_sisrx_dw(n,x,idx)
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(:)
@ -208,10 +207,9 @@ subroutine psi_sisr_up(n,x)
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(:)
@ -232,10 +230,9 @@ subroutine psi_sisr_dw(n,x)
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(:)
@ -260,10 +257,9 @@ subroutine psi_saisrx_up(n,x,idx)
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(:)
@ -288,10 +284,9 @@ subroutine psi_saisrx_dw(n,x,idx)
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(:)
@ -312,10 +307,9 @@ subroutine psi_saisr_up(n,x)
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(:)
@ -336,5 +330,6 @@ subroutine psi_saisr_dw(n,x)
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

71
base/serial/sort/psb_s_qsort_impl.f90
Unescape Escape View File

@ -29,19 +29,21 @@
!!$ 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
! !
subroutine psb_sqsort(x,ix,dir,flag) submodule (psb_s_sort_mod) psb_s_qsort_impl_mod
use psb_s_sort_mod, psb_protect_name => psb_sqsort
contains
subroutine psb_sqsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -127,10 +129,9 @@ subroutine psb_sqsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_sqsort end subroutine psb_sqsort
subroutine psi_sqsrx_up(n,x,idx) subroutine psi_sqsrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -281,10 +282,9 @@ subroutine psi_sqsrx_up(n,x,idx)
else else
call psi_sisrx_up(n,x,idx) call psi_sisrx_up(n,x,idx)
endif endif
end subroutine psi_sqsrx_up end subroutine psi_sqsrx_up
subroutine psi_sqsrx_dw(n,x,idx) subroutine psi_sqsrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -436,10 +436,9 @@ subroutine psi_sqsrx_dw(n,x,idx)
call psi_sisrx_dw(n,x,idx) call psi_sisrx_dw(n,x,idx)
endif endif
end subroutine psi_sqsrx_dw end subroutine psi_sqsrx_dw
subroutine psi_sqsr_up(n,x) subroutine psi_sqsr_up(n,x)
use psb_s_sort_mod, psb_protect_name => psi_sqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -577,10 +576,9 @@ subroutine psi_sqsr_up(n,x)
call psi_sisr_up(n,x) call psi_sisr_up(n,x)
endif endif
end subroutine psi_sqsr_up end subroutine psi_sqsr_up
subroutine psi_sqsr_dw(n,x) subroutine psi_sqsr_dw(n,x)
use psb_s_sort_mod, psb_protect_name => psi_sqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -718,10 +716,9 @@ subroutine psi_sqsr_dw(n,x)
call psi_sisr_dw(n,x) call psi_sisr_dw(n,x)
endif endif
end subroutine psi_sqsr_dw end subroutine psi_sqsr_dw
subroutine psi_saqsrx_up(n,x,idx) subroutine psi_saqsrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -874,10 +871,9 @@ subroutine psi_saqsrx_up(n,x,idx)
endif endif
end subroutine psi_saqsrx_up end subroutine psi_saqsrx_up
subroutine psi_saqsrx_dw(n,x,idx) subroutine psi_saqsrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1028,10 +1024,9 @@ subroutine psi_saqsrx_dw(n,x,idx)
call psi_saisrx_dw(n,x,idx) call psi_saisrx_dw(n,x,idx)
endif endif
end subroutine psi_saqsrx_dw end subroutine psi_saqsrx_dw
subroutine psi_saqsr_up(n,x) subroutine psi_saqsr_up(n,x)
use psb_s_sort_mod, psb_protect_name => psi_saqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1168,10 +1163,9 @@ subroutine psi_saqsr_up(n,x)
call psi_saisr_up(n,x) call psi_saisr_up(n,x)
endif endif
end subroutine psi_saqsr_up end subroutine psi_saqsr_up
subroutine psi_saqsr_dw(n,x) subroutine psi_saqsr_dw(n,x)
use psb_s_sort_mod, psb_protect_name => psi_saqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1308,6 +1302,7 @@ subroutine psi_saqsr_dw(n,x)
call psi_saisr_dw(n,x) call psi_saisr_dw(n,x)
endif endif
end subroutine psi_saqsr_dw end subroutine psi_saqsr_dw
end submodule psb_s_qsort_impl_mod

122
base/serial/sort/psb_z_hsort_impl.f90
Unescape Escape View File

@ -29,20 +29,23 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! !
! The merge-sort and quicksort routines are implemented in the ! The merge-sort and quicksort routines are implemented in the
! serial/aux directory ! serial/aux directory
! 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_zhsort(x,ix,dir,flag) submodule (psb_z_sort_mod) psb_z_hsort_impl_mod
use psb_z_sort_mod, psb_protect_name => psb_zhsort
contains
subroutine psb_zhsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -153,39 +156,38 @@ subroutine psb_zhsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_zhsort end subroutine psb_zhsort
! !
! These are packaged so that they can be used to implement ! These are packaged so that they can be used to implement
! a heapsort, should the need arise ! a heapsort, should the need arise
! !
! !
! Programming note: ! Programming note:
! In the implementation of the heap_get_first function ! In the implementation of the heap_get_first function
! we have code like this ! we have code like this
! !
! if ( ( heap(2*i) < heap(2*i+1) ) .or.& ! if ( ( heap(2*i) < heap(2*i+1) ) .or.&
! & (2*i == last)) then ! & (2*i == last)) then
! j = 2*i ! j = 2*i
! else ! else
! j = 2*i + 1 ! j = 2*i + 1
! end if ! end if
! !
! It looks like the 2*i+1 could overflow the array, but this ! It looks like the 2*i+1 could overflow the array, but this
! is not true because there is a guard statement ! is not true because there is a guard statement
! if (i>last/2) exit ! if (i>last/2) exit
! and because last has just been reduced by 1 when defining the return value, ! and because last has just been reduced by 1 when defining the return value,
! therefore 2*i+1 may be greater than the current value of last, ! therefore 2*i+1 may be greater than the current value of last,
! but cannot be greater than the value of last when the routine was entered ! but cannot be greater than the value of last when the routine was entered
! hence it is safe. ! hence it is safe.
! !
! !
! !
subroutine psi_z_insert_heap(key,last,heap,dir,info) subroutine psi_z_insert_heap(key,last,heap,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_insert_heap
implicit none implicit none
! !
@ -247,7 +249,7 @@ subroutine psi_z_insert_heap(key,last,heap,dir,info)
return return
contains contains
subroutine fix_aup(last,heap) subroutine fix_aup(last,heap)
use psi_acx_mod use psi_acx_mod
@ -388,10 +390,9 @@ contains
end do end do
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_z_insert_heap end subroutine psi_z_insert_heap
subroutine psi_z_heap_get_first(key,last,heap,dir,info) subroutine psi_z_heap_get_first(key,last,heap,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_heap_get_first
implicit none implicit none
! !
@ -447,7 +448,7 @@ subroutine psi_z_heap_get_first(key,last,heap,dir,info)
end select end select
return return
contains contains
subroutine fix_aup(last,heap) subroutine fix_aup(last,heap)
use psi_acx_mod use psi_acx_mod
@ -630,10 +631,9 @@ contains
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_z_heap_get_first end subroutine psi_z_heap_get_first
subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info) subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_idx_insert_heap
implicit none implicit none
! !
@ -699,7 +699,7 @@ subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
return return
contains contains
subroutine fix_aup(last,heap,idxs) subroutine fix_aup(last,heap,idxs)
use psi_acx_mod use psi_acx_mod
@ -864,12 +864,11 @@ contains
end do end do
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_z_idx_insert_heap end subroutine psi_z_idx_insert_heap
subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info) subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_idx_heap_get_first
implicit none implicit none
! !
@ -927,7 +926,7 @@ subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end select end select
return return
contains contains
subroutine fix_aup(last,heap,idxs) subroutine fix_aup(last,heap,idxs)
use psi_acx_mod use psi_acx_mod
@ -1134,7 +1133,8 @@ contains
end subroutine fix_aldw end subroutine fix_aldw
end subroutine psi_z_idx_heap_get_first end subroutine psi_z_idx_heap_get_first
end submodule psb_z_hsort_impl_mod

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

@ -29,19 +29,21 @@
!!$ 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
contains
subroutine psb_zisort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -135,10 +137,9 @@ subroutine psb_zisort(x,ix,dir,flag)
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
@ -165,10 +166,9 @@ subroutine psi_zlisrx_up(n,x,idx)
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_z_sort_mod, psb_protect_name => psi_zlisrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -194,10 +194,9 @@ subroutine psi_zlisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_zlisrx_dw end subroutine psi_zlisrx_dw
subroutine psi_zlisr_up(n,x) subroutine psi_zlisr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zlisr_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -219,10 +218,9 @@ subroutine psi_zlisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zlisr_up end subroutine psi_zlisr_up
subroutine psi_zlisr_dw(n,x) subroutine psi_zlisr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zlisr_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -244,10 +242,9 @@ subroutine psi_zlisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zlisr_dw end subroutine psi_zlisr_dw
subroutine psi_zalisrx_up(n,x,idx) subroutine psi_zalisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -273,10 +270,9 @@ subroutine psi_zalisrx_up(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_zalisrx_up end subroutine psi_zalisrx_up
subroutine psi_zalisrx_dw(n,x,idx) subroutine psi_zalisrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -302,10 +298,9 @@ subroutine psi_zalisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_zalisrx_dw end subroutine psi_zalisrx_dw
subroutine psi_zalisr_up(n,x) subroutine psi_zalisr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zalisr_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -327,10 +322,9 @@ subroutine psi_zalisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zalisr_up end subroutine psi_zalisr_up
subroutine psi_zalisr_dw(n,x) subroutine psi_zalisr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zalisr_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -352,10 +346,9 @@ subroutine psi_zalisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zalisr_dw end subroutine psi_zalisr_dw
subroutine psi_zaisrx_up(n,x,idx) subroutine psi_zaisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -380,10 +373,9 @@ subroutine psi_zaisrx_up(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_zaisrx_up end subroutine psi_zaisrx_up
subroutine psi_zaisrx_dw(n,x,idx) subroutine psi_zaisrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -408,10 +400,9 @@ subroutine psi_zaisrx_dw(n,x,idx)
idx(i-1) = ix idx(i-1) = ix
endif endif
enddo enddo
end subroutine psi_zaisrx_dw end subroutine psi_zaisrx_dw
subroutine psi_zaisr_up(n,x) subroutine psi_zaisr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zaisr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -432,10 +423,9 @@ subroutine psi_zaisr_up(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zaisr_up end subroutine psi_zaisr_up
subroutine psi_zaisr_dw(n,x) subroutine psi_zaisr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zaisr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -456,5 +446,6 @@ subroutine psi_zaisr_dw(n,x)
x(i-1) = xx x(i-1) = xx
endif endif
enddo enddo
end subroutine psi_zaisr_dw end subroutine psi_zaisr_dw
end submodule psb_z_isort_impl_mod

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

91
base/serial/sort/psb_z_qsort_impl.f90
Unescape Escape View File

@ -29,19 +29,21 @@
!!$ 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
! !
subroutine psb_zqsort(x,ix,dir,flag) submodule (psb_z_sort_mod) psb_z_qsort_impl_mod
use psb_z_sort_mod, psb_protect_name => psb_zqsort
contains
subroutine psb_zqsort(x,ix,dir,flag)
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
@ -135,11 +137,10 @@ subroutine psb_zqsort(x,ix,dir,flag)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psb_zqsort end subroutine psb_zqsort
subroutine psi_zlqsrx_up(n,x,idx) subroutine psi_zlqsrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zlqsrx_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -292,10 +293,9 @@ subroutine psi_zlqsrx_up(n,x,idx)
call psi_zlisrx_up(n,x,idx) call psi_zlisrx_up(n,x,idx)
endif endif
end subroutine psi_zlqsrx_up end subroutine psi_zlqsrx_up
subroutine psi_zlqsrx_dw(n,x,idx) subroutine psi_zlqsrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zlqsrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -447,10 +447,9 @@ subroutine psi_zlqsrx_dw(n,x,idx)
else else
call psi_zlisrx_dw(n,x,idx) call psi_zlisrx_dw(n,x,idx)
endif endif
end subroutine psi_zlqsrx_dw end subroutine psi_zlqsrx_dw
subroutine psi_zlqsr_up(n,x) subroutine psi_zlqsr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zlqsr_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -589,10 +588,9 @@ subroutine psi_zlqsr_up(n,x)
call psi_zlisr_up(n,x) call psi_zlisr_up(n,x)
endif endif
end subroutine psi_zlqsr_up end subroutine psi_zlqsr_up
subroutine psi_zlqsr_dw(n,x) subroutine psi_zlqsr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zlqsr_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -730,10 +728,9 @@ subroutine psi_zlqsr_dw(n,x)
call psi_zlisr_dw(n,x) call psi_zlisr_dw(n,x)
endif endif
end subroutine psi_zlqsr_dw end subroutine psi_zlqsr_dw
subroutine psi_zalqsrx_up(n,x,idx) subroutine psi_zalqsrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalqsrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -885,10 +882,9 @@ subroutine psi_zalqsrx_up(n,x,idx)
else else
call psi_zalisrx_up(n,x,idx) call psi_zalisrx_up(n,x,idx)
endif endif
end subroutine psi_zalqsrx_up end subroutine psi_zalqsrx_up
subroutine psi_zalqsrx_dw(n,x,idx) subroutine psi_zalqsrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalqsrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1040,10 +1036,9 @@ subroutine psi_zalqsrx_dw(n,x,idx)
else else
call psi_zalisrx_dw(n,x,idx) call psi_zalisrx_dw(n,x,idx)
endif endif
end subroutine psi_zalqsrx_dw end subroutine psi_zalqsrx_dw
subroutine psi_zalqsr_up(n,x) subroutine psi_zalqsr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zalqsr_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1181,10 +1176,9 @@ subroutine psi_zalqsr_up(n,x)
else else
call psi_zalisr_up(n,x) call psi_zalisr_up(n,x)
endif endif
end subroutine psi_zalqsr_up end subroutine psi_zalqsr_up
subroutine psi_zalqsr_dw(n,x) subroutine psi_zalqsr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zalqsr_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -1321,10 +1315,9 @@ subroutine psi_zalqsr_dw(n,x)
else else
call psi_zalisr_dw(n,x) call psi_zalisr_dw(n,x)
endif endif
end subroutine psi_zalqsr_dw end subroutine psi_zalqsr_dw
subroutine psi_zaqsrx_up(n,x,idx) subroutine psi_zaqsrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1477,10 +1470,9 @@ subroutine psi_zaqsrx_up(n,x,idx)
endif endif
end subroutine psi_zaqsrx_up end subroutine psi_zaqsrx_up
subroutine psi_zaqsrx_dw(n,x,idx) subroutine psi_zaqsrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1631,10 +1623,9 @@ subroutine psi_zaqsrx_dw(n,x,idx)
call psi_zaisrx_dw(n,x,idx) call psi_zaisrx_dw(n,x,idx)
endif endif
end subroutine psi_zaqsrx_dw end subroutine psi_zaqsrx_dw
subroutine psi_zaqsr_up(n,x) subroutine psi_zaqsr_up(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zaqsr_up
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1771,10 +1762,9 @@ subroutine psi_zaqsr_up(n,x)
call psi_zaisr_up(n,x) call psi_zaisr_up(n,x)
endif endif
end subroutine psi_zaqsr_up end subroutine psi_zaqsr_up
subroutine psi_zaqsr_dw(n,x) subroutine psi_zaqsr_dw(n,x)
use psb_z_sort_mod, psb_protect_name => psi_zaqsr_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -1911,6 +1901,7 @@ subroutine psi_zaqsr_dw(n,x)
call psi_zaisr_dw(n,x) call psi_zaisr_dw(n,x)
endif endif
end subroutine psi_zaqsr_dw end subroutine psi_zaqsr_dw
end submodule psb_z_qsort_impl_mod

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