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

9
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)
end subroutine psi_d_amsort_dw
end interface
module
interface psb_qsort
module subroutine psb_dqsort(x,ix,dir,flag)
@ -134,6 +134,7 @@ module psb_d_sort_mod
end interface psb_hsort
interface
module subroutine psi_d_insert_heap(key,last,heap,dir,info)
implicit none
@ -188,9 +189,9 @@ module psb_d_sort_mod
interface
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
real(psb_dpk_), intent(inout) :: heap(:)
real(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(in) :: dir
integer(psb_ipk_), intent(inout) :: last
integer(psb_ipk_), intent(inout) :: idxs(:)
@ -273,7 +274,7 @@ module psb_d_sort_mod
module subroutine psi_daqsr_dw(n,x)
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daqsr_dw
end subroutine psi_daqsr_dw
end interface
contains

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
interface psb_iblsrch
function psb_iblsrch(key,n,v) result(ipos)
import :: psb_ipk_
module function psb_iblsrch(key,n,v) result(ipos)
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
end function psb_iblsrch
end interface psb_iblsrch
interface psb_ibsrch
function psb_ibsrch(key,n,v) result(ipos)
import :: psb_ipk_
module function psb_ibsrch(key,n,v) result(ipos)
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
end function psb_ibsrch
end interface psb_ibsrch
interface psb_issrch
function psb_issrch(key,n,v) result(ipos)
import :: psb_ipk_
module function psb_issrch(key,n,v) result(ipos)
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
@ -69,16 +66,15 @@ module psb_i_sort_mod
end interface psb_issrch
interface psb_isaperm
logical function psb_isaperm(n,eip)
import :: psb_ipk_
module function psb_isaperm(n,eip) result(res)
logical :: res
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(in) :: eip(n)
end function psb_isaperm
end interface psb_isaperm
interface psb_msort_unique
subroutine psb_imsort_u(x,nout,dir)
import :: psb_ipk_, psb_spk_, psb_dpk_
module subroutine psb_imsort_u(x,nout,dir)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
@ -112,8 +108,7 @@ module psb_i_sort_mod
interface psb_msort
subroutine psb_imsort(x,ix,dir,flag)
import
module subroutine psb_imsort(x,ix,dir,flag)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -121,15 +116,13 @@ module psb_i_sort_mod
end interface psb_msort
interface
subroutine psi_i_msort_up(n,k,l,iret)
import
module subroutine psi_i_msort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_msort_up
subroutine psi_i_msort_dw(n,k,l,iret)
import
module subroutine psi_i_msort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
@ -137,26 +130,23 @@ module psb_i_sort_mod
end subroutine psi_i_msort_dw
end interface
interface
subroutine psi_i_amsort_up(n,k,l,iret)
import
module subroutine psi_i_amsort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_up
subroutine psi_i_amsort_dw(n,k,l,iret)
import
module subroutine psi_i_amsort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_dw
end interface
module
interface psb_qsort
subroutine psb_iqsort(x,ix,dir,flag)
import
module subroutine psb_iqsort(x,ix,dir,flag)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -164,8 +154,7 @@ module psb_i_sort_mod
end interface psb_qsort
interface psb_isort
subroutine psb_iisort(x,ix,dir,flag)
import
module subroutine psb_iisort(x,ix,dir,flag)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -174,8 +163,7 @@ module psb_i_sort_mod
interface psb_hsort
subroutine psb_ihsort(x,ix,dir,flag)
import
module subroutine psb_ihsort(x,ix,dir,flag)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -183,36 +171,9 @@ module psb_i_sort_mod
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
subroutine psi_i_insert_heap(key,last,heap,dir,info)
import
module subroutine psi_i_insert_heap(key,last,heap,dir,info)
implicit none
!
@ -231,8 +192,7 @@ module psb_i_sort_mod
end interface
interface
subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_i_idx_insert_heap(key,index,last,heap,idxs,dir,info)
implicit none
!
@ -254,8 +214,7 @@ module psb_i_sort_mod
interface
subroutine psi_i_heap_get_first(key,last,heap,dir,info)
import
module subroutine psi_i_heap_get_first(key,last,heap,dir,info)
implicit none
integer(psb_ipk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last
@ -266,8 +225,7 @@ module psb_i_sort_mod
end interface
interface
subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_i_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
integer(psb_ipk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index
integer(psb_ipk_), intent(inout) :: heap(:)
@ -279,94 +237,78 @@ module psb_i_sort_mod
end interface
interface
subroutine psi_iisrx_up(n,x,ix)
import
module subroutine psi_iisrx_up(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisrx_up
subroutine psi_iisrx_dw(n,x,ix)
import
module subroutine psi_iisrx_dw(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisrx_dw
subroutine psi_iisr_up(n,x)
import
module subroutine psi_iisr_up(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisr_up
subroutine psi_iisr_dw(n,x)
import
module subroutine psi_iisr_dw(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iisr_dw
subroutine psi_iaisrx_up(n,x,ix)
import
module subroutine psi_iaisrx_up(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisrx_up
subroutine psi_iaisrx_dw(n,x,ix)
import
module subroutine psi_iaisrx_dw(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisrx_dw
subroutine psi_iaisr_up(n,x)
import
module subroutine psi_iaisr_up(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisr_up
subroutine psi_iaisr_dw(n,x)
import
module subroutine psi_iaisr_dw(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaisr_dw
end interface
interface
subroutine psi_iqsrx_up(n,x,ix)
import
module subroutine psi_iqsrx_up(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsrx_up
subroutine psi_iqsrx_dw(n,x,ix)
import
module subroutine psi_iqsrx_dw(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsrx_dw
subroutine psi_iqsr_up(n,x)
import
module subroutine psi_iqsr_up(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsr_up
subroutine psi_iqsr_dw(n,x)
import
module subroutine psi_iqsr_dw(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iqsr_dw
subroutine psi_iaqsrx_up(n,x,ix)
import
module subroutine psi_iaqsrx_up(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsrx_up
subroutine psi_iaqsrx_dw(n,x,ix)
import
module subroutine psi_iaqsrx_dw(n,x,ix)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsrx_dw
subroutine psi_iaqsr_up(n,x)
import
module subroutine psi_iaqsr_up(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_iaqsr_up
subroutine psi_iaqsr_dw(n,x)
import
module subroutine psi_iaqsr_dw(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
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
subroutine psb_smsort(x,ix,dir,flag)
import
module subroutine psb_smsort(x,ix,dir,flag)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -80,15 +79,13 @@ module psb_s_sort_mod
end interface psb_msort
interface
subroutine psi_s_msort_up(n,k,l,iret)
import
module subroutine psi_s_msort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_msort_up
subroutine psi_s_msort_dw(n,k,l,iret)
import
module subroutine psi_s_msort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
@ -96,26 +93,23 @@ module psb_s_sort_mod
end subroutine psi_s_msort_dw
end interface
interface
subroutine psi_s_amsort_up(n,k,l,iret)
import
module subroutine psi_s_amsort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_up
subroutine psi_s_amsort_dw(n,k,l,iret)
import
module subroutine psi_s_amsort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_dw
end interface
module
interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag)
import
module subroutine psb_sqsort(x,ix,dir,flag)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -123,8 +117,7 @@ module psb_s_sort_mod
end interface psb_qsort
interface psb_isort
subroutine psb_sisort(x,ix,dir,flag)
import
module subroutine psb_sisort(x,ix,dir,flag)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -133,8 +126,7 @@ module psb_s_sort_mod
interface psb_hsort
subroutine psb_shsort(x,ix,dir,flag)
import
module subroutine psb_shsort(x,ix,dir,flag)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -142,36 +134,9 @@ module psb_s_sort_mod
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
subroutine psi_s_insert_heap(key,last,heap,dir,info)
import
module subroutine psi_s_insert_heap(key,last,heap,dir,info)
implicit none
!
@ -190,8 +155,7 @@ module psb_s_sort_mod
end interface
interface
subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_s_idx_insert_heap(key,index,last,heap,idxs,dir,info)
implicit none
!
@ -213,8 +177,7 @@ module psb_s_sort_mod
interface
subroutine psi_s_heap_get_first(key,last,heap,dir,info)
import
module subroutine psi_s_heap_get_first(key,last,heap,dir,info)
implicit none
real(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last
@ -225,8 +188,7 @@ module psb_s_sort_mod
end interface
interface
subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_s_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
real(psb_spk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index
real(psb_spk_), intent(inout) :: heap(:)
@ -238,94 +200,78 @@ module psb_s_sort_mod
end interface
interface
subroutine psi_sisrx_up(n,x,ix)
import
module subroutine psi_sisrx_up(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisrx_up
subroutine psi_sisrx_dw(n,x,ix)
import
module subroutine psi_sisrx_dw(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisrx_dw
subroutine psi_sisr_up(n,x)
import
module subroutine psi_sisr_up(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisr_up
subroutine psi_sisr_dw(n,x)
import
module subroutine psi_sisr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sisr_dw
subroutine psi_saisrx_up(n,x,ix)
import
module subroutine psi_saisrx_up(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisrx_up
subroutine psi_saisrx_dw(n,x,ix)
import
module subroutine psi_saisrx_dw(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisrx_dw
subroutine psi_saisr_up(n,x)
import
module subroutine psi_saisr_up(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisr_up
subroutine psi_saisr_dw(n,x)
import
module subroutine psi_saisr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saisr_dw
end interface
interface
subroutine psi_sqsrx_up(n,x,ix)
import
module subroutine psi_sqsrx_up(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsrx_up
subroutine psi_sqsrx_dw(n,x,ix)
import
module subroutine psi_sqsrx_dw(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsrx_dw
subroutine psi_sqsr_up(n,x)
import
module subroutine psi_sqsr_up(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsr_up
subroutine psi_sqsr_dw(n,x)
import
module subroutine psi_sqsr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_sqsr_dw
subroutine psi_saqsrx_up(n,x,ix)
import
module subroutine psi_saqsrx_up(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsrx_up
subroutine psi_saqsrx_dw(n,x,ix)
import
module subroutine psi_saqsrx_dw(n,x,ix)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsrx_dw
subroutine psi_saqsr_up(n,x)
import
module subroutine psi_saqsr_up(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_saqsr_up
subroutine psi_saqsr_dw(n,x)
import
module subroutine psi_saqsr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
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
subroutine psb_zmsort(x,ix,dir,flag)
import
module subroutine psb_zmsort(x,ix,dir,flag)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -80,29 +79,25 @@ module psb_z_sort_mod
end interface psb_msort
interface
subroutine psi_z_lmsort_up(n,k,l,iret)
import
module subroutine psi_z_lmsort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_up
subroutine psi_z_lmsort_dw(n,k,l,iret)
import
module subroutine psi_z_lmsort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_dw
subroutine psi_z_almsort_up(n,k,l,iret)
import
module subroutine psi_z_almsort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_almsort_up
subroutine psi_z_almsort_dw(n,k,l,iret)
import
module subroutine psi_z_almsort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
@ -110,26 +105,23 @@ module psb_z_sort_mod
end subroutine psi_z_almsort_dw
end interface
interface
subroutine psi_z_amsort_up(n,k,l,iret)
import
module subroutine psi_z_amsort_up(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_up
subroutine psi_z_amsort_dw(n,k,l,iret)
import
module subroutine psi_z_amsort_dw(n,k,l,iret)
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_dw
end interface
module
interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag)
import
module subroutine psb_zqsort(x,ix,dir,flag)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -137,8 +129,7 @@ module psb_z_sort_mod
end interface psb_qsort
interface psb_isort
subroutine psb_zisort(x,ix,dir,flag)
import
module subroutine psb_zisort(x,ix,dir,flag)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -147,8 +138,7 @@ module psb_z_sort_mod
interface psb_hsort
subroutine psb_zhsort(x,ix,dir,flag)
import
module subroutine psb_zhsort(x,ix,dir,flag)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
@ -156,36 +146,9 @@ module psb_z_sort_mod
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
subroutine psi_z_insert_heap(key,last,heap,dir,info)
import
module subroutine psi_z_insert_heap(key,last,heap,dir,info)
implicit none
!
@ -204,8 +167,7 @@ module psb_z_sort_mod
end interface
interface
subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
implicit none
!
@ -227,8 +189,7 @@ module psb_z_sort_mod
interface
subroutine psi_z_heap_get_first(key,last,heap,dir,info)
import
module subroutine psi_z_heap_get_first(key,last,heap,dir,info)
implicit none
complex(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last
@ -239,8 +200,7 @@ module psb_z_sort_mod
end interface
interface
subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
module subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
complex(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index
complex(psb_dpk_), intent(inout) :: heap(:)
@ -252,138 +212,114 @@ module psb_z_sort_mod
end interface
interface
subroutine psi_zlisrx_up(n,x,ix)
import
module subroutine psi_zlisrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisrx_up
subroutine psi_zlisrx_dw(n,x,ix)
import
module subroutine psi_zlisrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisrx_dw
subroutine psi_zlisr_up(n,x)
import
module subroutine psi_zlisr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisr_up
subroutine psi_zlisr_dw(n,x)
import
module subroutine psi_zlisr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlisr_dw
subroutine psi_zalisrx_up(n,x,ix)
import
module subroutine psi_zalisrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisrx_up
subroutine psi_zalisrx_dw(n,x,ix)
import
module subroutine psi_zalisrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisrx_dw
subroutine psi_zalisr_up(n,x)
import
module subroutine psi_zalisr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisr_up
subroutine psi_zalisr_dw(n,x)
import
module subroutine psi_zalisr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalisr_dw
subroutine psi_zaisrx_up(n,x,ix)
import
module subroutine psi_zaisrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisrx_up
subroutine psi_zaisrx_dw(n,x,ix)
import
module subroutine psi_zaisrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisrx_dw
subroutine psi_zaisr_up(n,x)
import
module subroutine psi_zaisr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisr_up
subroutine psi_zaisr_dw(n,x)
import
module subroutine psi_zaisr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaisr_dw
end interface
interface
subroutine psi_zlqsrx_up(n,x,ix)
import
module subroutine psi_zlqsrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsrx_up
subroutine psi_zlqsrx_dw(n,x,ix)
import
module subroutine psi_zlqsrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsrx_dw
subroutine psi_zlqsr_up(n,x)
import
module subroutine psi_zlqsr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsr_up
subroutine psi_zlqsr_dw(n,x)
import
module subroutine psi_zlqsr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zlqsr_dw
subroutine psi_zalqsrx_up(n,x,ix)
import
module subroutine psi_zalqsrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsrx_up
subroutine psi_zalqsrx_dw(n,x,ix)
import
module subroutine psi_zalqsrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsrx_dw
subroutine psi_zalqsr_up(n,x)
import
module subroutine psi_zalqsr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsr_up
subroutine psi_zalqsr_dw(n,x)
import
module subroutine psi_zalqsr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zalqsr_dw
subroutine psi_zaqsrx_up(n,x,ix)
import
module subroutine psi_zaqsrx_up(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsrx_up
subroutine psi_zaqsrx_dw(n,x,ix)
import
module subroutine psi_zaqsrx_dw(n,x,ix)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsrx_dw
subroutine psi_zaqsr_up(n,x)
import
module subroutine psi_zaqsr_up(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsr_up
subroutine psi_zaqsr_dw(n,x)
import
module subroutine psi_zaqsr_dw(n,x)
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_zaqsr_dw

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

File diff suppressed because it is too large Load Diff

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

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

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

File diff suppressed because it is too large Load Diff

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

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

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

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

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

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

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

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

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

File diff suppressed because it is too large Load Diff

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

@ -29,312 +29,307 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! The insertion sort routines
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_iisort(x,ix,dir,flag)
use psb_i_sort_mod, psb_protect_name => psb_iisort
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
!
! The insertion sort routines
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
submodule (psb_i_sort_mod) psb_i_isort_impl_mod
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
contains
subroutine psb_iisort(x,ix,dir,flag)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
name='psb_iisort'
call psb_erractionsave(err_act)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
name='psb_iisort'
call psb_erractionsave(err_act)
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_iisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_iisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_iaisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_iaisrx_dw(n,x,ix)
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 3; ierr(2) = dir_;
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_iisr_up(n,x)
case (psb_sort_down_)
call psi_iisr_dw(n,x)
case (psb_asort_up_)
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_iisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_iisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_iaisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_iaisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_iisr_up(n,x)
case (psb_sort_down_)
call psi_iisr_dw(n,x)
case (psb_asort_up_)
call psi_iaisr_up(n,x)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_iaisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
end if
return
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_iisort
return
end subroutine psb_iisort
subroutine psi_iisrx_up(n,x,idx)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iisrx_up
subroutine psi_iisrx_dw(n,x,idx)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iisrx_dw
subroutine psi_iisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iisrx_up
subroutine psi_iisr_up(n,x)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
subroutine psi_iisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iisr_up
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iisrx_dw
subroutine psi_iisr_dw(n,x)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iisr_dw
subroutine psi_iisr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iisr_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iisr_up
subroutine psi_iaisrx_up(n,x,idx)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
subroutine psi_iisr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iisr_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iisr_dw
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iaisrx_up
subroutine psi_iaisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
subroutine psi_iaisrx_dw(n,x,idx)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iaisrx_up
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iaisrx_dw
subroutine psi_iaisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
subroutine psi_iaisr_up(n,x)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_iaisrx_dw
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iaisr_up
subroutine psi_iaisr_up(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaisr_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iaisr_up
subroutine psi_iaisr_dw(n,x)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
subroutine psi_iaisr_dw(n,x)
use psb_i_sort_mod, psb_protect_name => psi_iaisr_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_ipk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_iaisr_dw
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_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
! Addison-Wesley
!
submodule (psb_i_sort_mod) psb_i_msort_impl_mod
contains
logical function psb_isaperm(n,eip)
use psb_i_sort_mod, psb_protect_name => psb_isaperm
implicit none
integer(psb_ipk_), intent(in) :: n
@ -96,7 +98,6 @@
end function psb_isaperm
function psb_iblsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_iblsrch
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
@ -138,7 +139,6 @@
end function psb_iblsrch
function psb_ibsrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_ibsrch
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
@ -164,7 +164,6 @@
end function psb_ibsrch
function psb_issrch(key,n,v) result(ipos)
use psb_i_sort_mod, psb_protect_name => psb_issrch
implicit none
integer(psb_ipk_) :: ipos, key, n
integer(psb_ipk_) :: v(:)
@ -184,7 +183,6 @@
subroutine psb_imsort_u(x,nout,dir)
use psb_i_sort_mod, psb_protect_name => psb_imsort_u
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
@ -233,7 +231,6 @@
subroutine psb_imsort(x,ix,dir,flag)
use psb_i_sort_mod, psb_protect_name => psb_imsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
@ -754,3 +751,4 @@
end submodule psb_i_msort_impl_mod

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

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

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

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

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

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

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

File diff suppressed because it is too large Load Diff

4
test/kernel/Makefile
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save