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

Modify sorting with REORD. Document same.

Browse Source
pull/31/head
sfilippone 8 months ago
parent ed97717037
commit 246bd70b3a
57 changed files with 3176 additions and 2274 deletions
Show Stats Download Patch File Download Diff File

4
base/modules/auxil/psb_c_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_c_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_chsort(x,ix,dir,flag)
subroutine psb_chsort(x,ix,dir,flag,reord)
import
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_chsort
end interface psb_hsort

4
base/modules/auxil/psb_c_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_c_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_cisort(x,ix,dir,flag)
subroutine psb_cisort(x,ix,dir,flag,reord)
import
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cisort
end interface psb_isort

4
base/modules/auxil/psb_c_msort_mod.f90
Unescape Escape View File

@ -55,10 +55,10 @@ module psb_c_msort_mod
interface psb_msort
subroutine psb_cmsort(x,ix,dir,flag)
subroutine psb_cmsort(x,ix,dir,flag,reord)
import
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cmsort
end interface psb_msort

4
base/modules/auxil/psb_c_qsort_mod.f90
Unescape Escape View File

@ -45,10 +45,10 @@ module psb_c_qsort_mod
interface psb_qsort
subroutine psb_cqsort(x,ix,dir,flag)
subroutine psb_cqsort(x,ix,dir,flag,reord)
import
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cqsort
end interface psb_qsort

4
base/modules/auxil/psb_d_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_d_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_dhsort(x,ix,dir,flag)
subroutine psb_dhsort(x,ix,dir,flag,reord)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_dhsort
end interface psb_hsort

4
base/modules/auxil/psb_d_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_d_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_disort(x,ix,dir,flag)
subroutine psb_disort(x,ix,dir,flag,reord)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_disort
end interface psb_isort

4
base/modules/auxil/psb_d_msort_mod.f90
Unescape Escape View File

@ -55,10 +55,10 @@ module psb_d_msort_mod
interface psb_msort
subroutine psb_dmsort(x,ix,dir,flag)
subroutine psb_dmsort(x,ix,dir,flag,reord)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_dmsort
end interface psb_msort

4
base/modules/auxil/psb_d_qsort_mod.f90
Unescape Escape View File

@ -64,10 +64,10 @@ module psb_d_qsort_mod
end interface psb_ssrch
interface psb_qsort
subroutine psb_dqsort(x,ix,dir,flag)
subroutine psb_dqsort(x,ix,dir,flag,reord)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_dqsort
end interface psb_qsort

4
base/modules/auxil/psb_e_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_e_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_ehsort(x,ix,dir,flag)
subroutine psb_ehsort(x,ix,dir,flag,reord)
import
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_ehsort
end interface psb_hsort

4
base/modules/auxil/psb_e_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_e_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_eisort(x,ix,dir,flag)
subroutine psb_eisort(x,ix,dir,flag,reord)
import
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_eisort
end interface psb_isort

4
base/modules/auxil/psb_e_msort_mod.f90
Unescape Escape View File

@ -62,10 +62,10 @@ module psb_e_msort_mod
interface psb_msort
subroutine psb_emsort(x,ix,dir,flag)
subroutine psb_emsort(x,ix,dir,flag,reord)
import
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_emsort
end interface psb_msort

4
base/modules/auxil/psb_e_qsort_mod.f90
Unescape Escape View File

@ -64,10 +64,10 @@ module psb_e_qsort_mod
end interface psb_ssrch
interface psb_qsort
subroutine psb_eqsort(x,ix,dir,flag)
subroutine psb_eqsort(x,ix,dir,flag,reord)
import
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_eqsort
end interface psb_qsort

4
base/modules/auxil/psb_i2_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_i2_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_i2hsort(x,ix,dir,flag)
subroutine psb_i2hsort(x,ix,dir,flag,reord)
import
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2hsort
end interface psb_hsort

4
base/modules/auxil/psb_i2_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_i2_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_i2isort(x,ix,dir,flag)
subroutine psb_i2isort(x,ix,dir,flag,reord)
import
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2isort
end interface psb_isort

4
base/modules/auxil/psb_i2_msort_mod.f90
Unescape Escape View File

@ -62,10 +62,10 @@ module psb_i2_msort_mod
interface psb_msort
subroutine psb_i2msort(x,ix,dir,flag)
subroutine psb_i2msort(x,ix,dir,flag,reord)
import
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2msort
end interface psb_msort

4
base/modules/auxil/psb_i2_qsort_mod.f90
Unescape Escape View File

@ -64,10 +64,10 @@ module psb_i2_qsort_mod
end interface psb_ssrch
interface psb_qsort
subroutine psb_i2qsort(x,ix,dir,flag)
subroutine psb_i2qsort(x,ix,dir,flag,reord)
import
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2qsort
end interface psb_qsort

4
base/modules/auxil/psb_m_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_m_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_mhsort(x,ix,dir,flag)
subroutine psb_mhsort(x,ix,dir,flag,reord)
import
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_mhsort
end interface psb_hsort

4
base/modules/auxil/psb_m_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_m_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_misort(x,ix,dir,flag)
subroutine psb_misort(x,ix,dir,flag,reord)
import
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_misort
end interface psb_isort

4
base/modules/auxil/psb_m_msort_mod.f90
Unescape Escape View File

@ -62,10 +62,10 @@ module psb_m_msort_mod
interface psb_msort
subroutine psb_mmsort(x,ix,dir,flag)
subroutine psb_mmsort(x,ix,dir,flag,reord)
import
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_mmsort
end interface psb_msort

4
base/modules/auxil/psb_m_qsort_mod.f90
Unescape Escape View File

@ -64,10 +64,10 @@ module psb_m_qsort_mod
end interface psb_ssrch
interface psb_qsort
subroutine psb_mqsort(x,ix,dir,flag)
subroutine psb_mqsort(x,ix,dir,flag,reord)
import
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_mqsort
end interface psb_qsort

4
base/modules/auxil/psb_s_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_s_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_shsort(x,ix,dir,flag)
subroutine psb_shsort(x,ix,dir,flag,reord)
import
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_shsort
end interface psb_hsort

4
base/modules/auxil/psb_s_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_s_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_sisort(x,ix,dir,flag)
subroutine psb_sisort(x,ix,dir,flag,reord)
import
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_sisort
end interface psb_isort

4
base/modules/auxil/psb_s_msort_mod.f90
Unescape Escape View File

@ -55,10 +55,10 @@ module psb_s_msort_mod
interface psb_msort
subroutine psb_smsort(x,ix,dir,flag)
subroutine psb_smsort(x,ix,dir,flag,reord)
import
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_smsort
end interface psb_msort

4
base/modules/auxil/psb_s_qsort_mod.f90
Unescape Escape View File

@ -64,10 +64,10 @@ module psb_s_qsort_mod
end interface psb_ssrch
interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag)
subroutine psb_sqsort(x,ix,dir,flag,reord)
import
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_sqsort
end interface psb_qsort

4
base/modules/auxil/psb_z_hsort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_z_hsort_mod
use psb_const_mod
interface psb_hsort
subroutine psb_zhsort(x,ix,dir,flag)
subroutine psb_zhsort(x,ix,dir,flag,reord)
import
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zhsort
end interface psb_hsort

4
base/modules/auxil/psb_z_isort_mod.f90
Unescape Escape View File

@ -44,10 +44,10 @@ module psb_z_isort_mod
use psb_const_mod
interface psb_isort
subroutine psb_zisort(x,ix,dir,flag)
subroutine psb_zisort(x,ix,dir,flag,reord)
import
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zisort
end interface psb_isort

4
base/modules/auxil/psb_z_msort_mod.f90
Unescape Escape View File

@ -55,10 +55,10 @@ module psb_z_msort_mod
interface psb_msort
subroutine psb_zmsort(x,ix,dir,flag)
subroutine psb_zmsort(x,ix,dir,flag,reord)
import
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zmsort
end interface psb_msort

4
base/modules/auxil/psb_z_qsort_mod.f90
Unescape Escape View File

@ -45,10 +45,10 @@ module psb_z_qsort_mod
interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag)
subroutine psb_zqsort(x,ix,dir,flag,reord)
import
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zqsort
end interface psb_qsort

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

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_chsort(x,ix,dir,flag)
subroutine psb_chsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_chsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_ipk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
complex(psb_spk_) :: key
integer(psb_ipk_) :: index
complex(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_chsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_chsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

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

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_cisort(x,ix,dir,flag)
subroutine psb_cisort(x,ix,dir,flag,reord)
use psb_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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
complex(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_cisort(x,ix,dir,flag)
name='psb_cisort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,39 +97,73 @@ subroutine psb_cisort(x,ix,dir,flag)
ix(i) = i
end do
end if
select case(dir_)
case (psb_lsort_up_)
select case(reord_)
case (psb_sort_reord_x_)
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_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_lsort_up_)
call psi_clisrx_up(n,tx,ix)
case (psb_lsort_down_)
call psi_clisrx_dw(n,tx,ix)
case (psb_alsort_up_)
call psi_calisrx_up(n,tx,ix)
case (psb_alsort_down_)
call psi_calisrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_caisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_caisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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)
call psi_clisr_up(n,x)
case (psb_lsort_down_)
call psi_clisr_dw(n,x)
call psi_clisr_dw(n,x)
case (psb_alsort_up_)
call psi_calisr_up(n,x)
call psi_calisr_up(n,x)
case (psb_alsort_down_)
call psi_calisr_dw(n,x)
call psi_calisr_dw(n,x)
case (psb_asort_up_)
call psi_caisr_up(n,x)
call psi_caisr_up(n,x)
case (psb_asort_down_)
call psi_caisr_dw(n,x)
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)

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

@ -77,16 +77,16 @@ subroutine psb_cmsort_u(x,nout,dir)
end subroutine psb_cmsort_u
subroutine psb_cmsort(x,ix,dir,flag)
subroutine psb_cmsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_cmsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -96,6 +96,11 @@ subroutine psb_cmsort(x,ix,dir,flag)
name='psb_cmsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -163,11 +168,25 @@ subroutine psb_cmsort(x,ix,dir,flag)
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return

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

@ -41,22 +41,29 @@
! Addison-Wesley
!
subroutine psb_cqsort(x,ix,dir,flag)
subroutine psb_cqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_cqsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_ipk_) :: n
complex(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_cqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -91,25 +98,57 @@ subroutine psb_cqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_lsort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_lsort_up_)
call psi_clqsrx_up(n,x,ix)
case (psb_lsort_down_)
case (psb_lsort_down_)
call psi_clqsrx_dw(n,x,ix)
case (psb_alsort_up_)
case (psb_alsort_up_)
call psi_calqsrx_up(n,x,ix)
case (psb_alsort_down_)
case (psb_alsort_down_)
call psi_calqsrx_dw(n,x,ix)
case (psb_asort_up_)
case (psb_asort_up_)
call psi_caqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_caqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_lsort_up_)
call psi_clqsrx_up(n,tx,ix)
case (psb_lsort_down_)
call psi_clqsrx_dw(n,tx,ix)
case (psb_alsort_up_)
call psi_calqsrx_up(n,tx,ix)
case (psb_alsort_down_)
call psi_calqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_caqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_caqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_clqsr_up(n,x)

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

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_dhsort(x,ix,dir,flag)
subroutine psb_dhsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_dhsort
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_ipk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
real(psb_dpk_) :: key
integer(psb_ipk_) :: index
real(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_dhsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_dhsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

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

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_disort(x,ix,dir,flag)
subroutine psb_disort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_disort
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
real(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_disort(x,ix,dir,flag)
name='psb_disort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,31 +97,61 @@ subroutine psb_disort(x,ix,dir,flag)
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_disrx_up(n,x,ix)
case (psb_sort_down_)
call psi_disrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_disrx_up(n,x,ix)
case (psb_sort_down_)
call psi_disrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_daisrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_daisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_disrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_disrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_daisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_daisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_disr_up(n,x)
case (psb_sort_down_)
call psi_disr_dw(n,x)
case (psb_asort_up_)
call psi_daisr_up(n,x)
call psi_daisr_up(n,x)
case (psb_asort_down_)
call psi_daisr_dw(n,x)
call psi_daisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)

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

@ -76,16 +76,16 @@ subroutine psb_dmsort_u(x,nout,dir)
return
end subroutine psb_dmsort_u
subroutine psb_dmsort(x,ix,dir,flag)
subroutine psb_dmsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_dmsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -95,6 +95,11 @@ subroutine psb_dmsort(x,ix,dir,flag)
name='psb_dmsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -157,15 +162,28 @@ subroutine psb_dmsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
if (iret == 0 ) then
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)

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

@ -159,22 +159,29 @@ function psb_dssrch(key,n,v) result(ipos)
return
end function psb_dssrch
subroutine psb_dqsort(x,ix,dir,flag)
subroutine psb_dqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_dqsort
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_ipk_) :: n
real(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_dqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -209,21 +216,49 @@ subroutine psb_dqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_dqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_dqsrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_dqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_dqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_daqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_daqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_dqsrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_dqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_daqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_daqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_dqsr_up(n,x)

85
base/serial/sort/psb_e_hsort_impl.f90
Unescape Escape View File

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_ehsort(x,ix,dir,flag)
subroutine psb_ehsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_ehsort
use psb_error_mod
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_epk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_epk_) :: n, i, l, dir_
integer(psb_epk_) :: key
integer(psb_epk_) :: index
integer(psb_epk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_ehsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_ehsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

69
base/serial/sort/psb_e_isort_impl.f90
Unescape Escape View File

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_eisort(x,ix,dir,flag)
subroutine psb_eisort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_eisort
use psb_error_mod
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_epk_) :: n, i
integer(psb_epk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_eisort(x,ix,dir,flag)
name='psb_eisort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,31 +97,61 @@ subroutine psb_eisort(x,ix,dir,flag)
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_eisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_eisrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_eisrx_up(n,x,ix)
case (psb_sort_down_)
call psi_eisrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_eaisrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_eaisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_eisrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_eisrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_eaisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_eaisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_eisr_up(n,x)
case (psb_sort_down_)
call psi_eisr_dw(n,x)
case (psb_asort_up_)
call psi_eaisr_up(n,x)
call psi_eaisr_up(n,x)
case (psb_asort_down_)
call psi_eaisr_dw(n,x)
call psi_eaisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)

38
base/serial/sort/psb_e_msort_impl.f90
Unescape Escape View File

@ -131,16 +131,16 @@ subroutine psb_emsort_u(x,nout,dir)
return
end subroutine psb_emsort_u
subroutine psb_emsort(x,ix,dir,flag)
subroutine psb_emsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_emsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_epk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -150,6 +150,11 @@ subroutine psb_emsort(x,ix,dir,flag)
name='psb_emsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -212,15 +217,28 @@ subroutine psb_emsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
if (iret == 0 ) then
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)

61
base/serial/sort/psb_e_qsort_impl.f90
Unescape Escape View File

@ -159,22 +159,29 @@ function psb_essrch(key,n,v) result(ipos)
return
end function psb_essrch
subroutine psb_eqsort(x,ix,dir,flag)
subroutine psb_eqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_eqsort
use psb_error_mod
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_epk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_epk_) :: n
integer(psb_epk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_eqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -209,21 +216,49 @@ subroutine psb_eqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_eqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_eqsrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_eqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_eqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_eaqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_eaqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_eqsrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_eqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_eaqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_eaqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_eqsr_up(n,x)

85
base/serial/sort/psb_m_hsort_impl.f90
Unescape Escape View File

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_mhsort(x,ix,dir,flag)
subroutine psb_mhsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_mhsort
use psb_error_mod
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_ipk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
integer(psb_mpk_) :: key
integer(psb_ipk_) :: index
integer(psb_mpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_mhsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_mhsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

69
base/serial/sort/psb_m_isort_impl.f90
Unescape Escape View File

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_misort(x,ix,dir,flag)
subroutine psb_misort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_misort
use psb_error_mod
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
integer(psb_mpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_misort(x,ix,dir,flag)
name='psb_misort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,31 +97,61 @@ subroutine psb_misort(x,ix,dir,flag)
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_misrx_up(n,x,ix)
case (psb_sort_down_)
call psi_misrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_misrx_up(n,x,ix)
case (psb_sort_down_)
call psi_misrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_maisrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_maisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_misrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_misrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_maisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_maisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_misr_up(n,x)
case (psb_sort_down_)
call psi_misr_dw(n,x)
case (psb_asort_up_)
call psi_maisr_up(n,x)
call psi_maisr_up(n,x)
case (psb_asort_down_)
call psi_maisr_dw(n,x)
call psi_maisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)

38
base/serial/sort/psb_m_msort_impl.f90
Unescape Escape View File

@ -131,16 +131,16 @@ subroutine psb_mmsort_u(x,nout,dir)
return
end subroutine psb_mmsort_u
subroutine psb_mmsort(x,ix,dir,flag)
subroutine psb_mmsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_mmsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -150,6 +150,11 @@ subroutine psb_mmsort(x,ix,dir,flag)
name='psb_mmsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -212,15 +217,28 @@ subroutine psb_mmsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
if (iret == 0 ) then
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)

61
base/serial/sort/psb_m_qsort_impl.f90
Unescape Escape View File

@ -159,22 +159,29 @@ function psb_mssrch(key,n,v) result(ipos)
return
end function psb_mssrch
subroutine psb_mqsort(x,ix,dir,flag)
subroutine psb_mqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_mqsort
use psb_error_mod
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_ipk_) :: n
integer(psb_mpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_mqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -209,21 +216,49 @@ subroutine psb_mqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_mqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_mqsrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_mqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_mqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_maqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_maqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_mqsrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_mqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_maqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_maqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_mqsr_up(n,x)

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

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_shsort(x,ix,dir,flag)
subroutine psb_shsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_shsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_ipk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
real(psb_spk_) :: key
integer(psb_ipk_) :: index
real(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_shsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_shsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

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

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_sisort(x,ix,dir,flag)
subroutine psb_sisort(x,ix,dir,flag,reord)
use psb_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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
real(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_sisort(x,ix,dir,flag)
name='psb_sisort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,31 +97,61 @@ subroutine psb_sisort(x,ix,dir,flag)
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_)
select case(reord_)
case (psb_sort_reord_x_)
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_)
case (psb_asort_down_)
call psi_saisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_sisrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_sisrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_saisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_saisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_sisr_up(n,x)
case (psb_sort_down_)
call psi_sisr_dw(n,x)
case (psb_asort_up_)
call psi_saisr_up(n,x)
call psi_saisr_up(n,x)
case (psb_asort_down_)
call psi_saisr_dw(n,x)
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)

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

@ -76,16 +76,16 @@ subroutine psb_smsort_u(x,nout,dir)
return
end subroutine psb_smsort_u
subroutine psb_smsort(x,ix,dir,flag)
subroutine psb_smsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_smsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -95,6 +95,11 @@ subroutine psb_smsort(x,ix,dir,flag)
name='psb_smsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -157,15 +162,28 @@ subroutine psb_smsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
if (iret == 0 ) then
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)

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

@ -159,22 +159,29 @@ function psb_sssrch(key,n,v) result(ipos)
return
end function psb_sssrch
subroutine psb_sqsort(x,ix,dir,flag)
subroutine psb_sqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_sqsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_ipk_) :: n
real(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_sqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -209,21 +216,49 @@ subroutine psb_sqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_sqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_sqsrx_dw(n,x,ix)
case (psb_asort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_sqsrx_up(n,x,ix)
case (psb_sort_down_)
call psi_sqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_saqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_saqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_sqsrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_sqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_saqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_saqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_sqsr_up(n,x)

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

@ -41,18 +41,19 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_zhsort(x,ix,dir,flag)
subroutine psb_zhsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_zhsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info
integer(psb_ipk_) :: dir_, l
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
complex(psb_dpk_) :: key
integer(psb_ipk_) :: index
complex(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_zhsort(x,ix,dir,flag)
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -113,24 +121,57 @@ subroutine psb_zhsort(x,ix,dir,flag)
ix(i) = i
end do
end if
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)

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

@ -40,16 +40,17 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_zisort(x,ix,dir,flag)
subroutine psb_zisort(x,ix,dir,flag,reord)
use psb_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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
complex(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -57,6 +58,12 @@ subroutine psb_zisort(x,ix,dir,flag)
name='psb_zisort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -90,39 +97,73 @@ subroutine psb_zisort(x,ix,dir,flag)
ix(i) = i
end do
end if
select case(dir_)
case (psb_lsort_up_)
select case(reord_)
case (psb_sort_reord_x_)
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_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_lsort_up_)
call psi_zlisrx_up(n,tx,ix)
case (psb_lsort_down_)
call psi_zlisrx_dw(n,tx,ix)
case (psb_alsort_up_)
call psi_zalisrx_up(n,tx,ix)
case (psb_alsort_down_)
call psi_zalisrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_zaisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_zaisrx_dw(n,tx,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
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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)
call psi_zlisr_up(n,x)
case (psb_lsort_down_)
call psi_zlisr_dw(n,x)
call psi_zlisr_dw(n,x)
case (psb_alsort_up_)
call psi_zalisr_up(n,x)
call psi_zalisr_up(n,x)
case (psb_alsort_down_)
call psi_zalisr_dw(n,x)
call psi_zalisr_dw(n,x)
case (psb_asort_up_)
call psi_zaisr_up(n,x)
call psi_zaisr_up(n,x)
case (psb_asort_down_)
call psi_zaisr_dw(n,x)
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)

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

@ -77,16 +77,16 @@ subroutine psb_zmsort_u(x,nout,dir)
end subroutine psb_zmsort_u
subroutine psb_zmsort(x,ix,dir,flag)
subroutine psb_zmsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_zmsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
@ -96,6 +96,11 @@ subroutine psb_zmsort(x,ix,dir,flag)
name='psb_zmsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
@ -163,11 +168,25 @@ subroutine psb_zmsort(x,ix,dir,flag)
! only provide linked pointers.
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return

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

@ -41,22 +41,29 @@
! Addison-Wesley
!
subroutine psb_zqsort(x,ix,dir,flag)
subroutine psb_zqsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_zqsort
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(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, i
integer(psb_ipk_) :: dir_, flag_, err_act, i, reord_
integer(psb_ipk_) :: n
complex(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_zqsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
@ -91,25 +98,57 @@ subroutine psb_zqsort(x,ix,dir,flag)
end do
end if
select case(dir_)
case (psb_lsort_up_)
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_lsort_up_)
call psi_zlqsrx_up(n,x,ix)
case (psb_lsort_down_)
case (psb_lsort_down_)
call psi_zlqsrx_dw(n,x,ix)
case (psb_alsort_up_)
case (psb_alsort_up_)
call psi_zalqsrx_up(n,x,ix)
case (psb_alsort_down_)
case (psb_alsort_down_)
call psi_zalqsrx_dw(n,x,ix)
case (psb_asort_up_)
case (psb_asort_up_)
call psi_zaqsrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_zaqsrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
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(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_lsort_up_)
call psi_zlqsrx_up(n,tx,ix)
case (psb_lsort_down_)
call psi_zlqsrx_dw(n,tx,ix)
case (psb_alsort_up_)
call psi_zalqsrx_up(n,tx,ix)
case (psb_alsort_down_)
call psi_zalqsrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_zaqsrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_zaqsrx_dw(n,tx,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
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
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_zlqsr_up(n,x)

135
docs/html/userhtmlse6.html
Unescape Escape View File

@ -3886,10 +3886,10 @@ class="pplb7t-x-x-120">_hsort &#8212; Sorting by the Heapsort algorithm</span>
<pre class="verbatim" id="verbatim-60">
call&#x00A0;psb_isort(x,ix,dir,flag)
call&#x00A0;psb_msort(x,ix,dir,flag)
call&#x00A0;psb_qsort(x,ix,dir,flag)
call&#x00A0;psb_hsort(x,ix,dir,flag)
call&#x00A0;psb_isort(x,ix,dir,flag,reord)
call&#x00A0;psb_msort(x,ix,dir,flag,reord)
call&#x00A0;psb_qsort(x,ix,dir,flag,reord)
call&#x00A0;psb_hsort(x,ix,dir,flag,reord)
</pre>
<!--l. 1798--><p class="nopar" >
<!--l. 1800--><p class="indent" > These serial routines sort a sequence <span
@ -3925,23 +3925,30 @@ class="description">
<!--l. 1810--><p class="noindent" >A vector of indices.<br
class="newline" />Type:<span
class="pplb7t-">optional</span>.<br
class="newline" />Specified as: an integer array of (at least) the same size as <span
class="zplmr7m-">X</span>.
class="newline" />Specified as: an integer array of (at least) the same size as <span
class="zplmr7m-">X</span>. This
argument is required when <span
class="zplmr7m-">reord </span><span
class="zplmr7t-">= </span><span
class="zplmr7m-">psb</span>_<span
class="zplmr7m-">sort</span>_<span
class="zplmr7m-">noreord</span>_<span
class="zplmr7m-">x</span>_.
</dd><dt class="description">
<!--l. 1813--><p class="noindent" >
<!--l. 1814--><p class="noindent" >
<span
class="pplb7t-">dir</span> </dt><dd
class="description">
<!--l. 1813--><p class="noindent" >The desired ordering.<br
<!--l. 1814--><p class="noindent" >The desired ordering.<br
class="newline" />Type:<span
class="pplb7t-">optional</span>.<br
class="newline" />Specified as: an integer value:
<dl class="description"><dt class="description">
<!--l. 1816--><p class="noindent" >
<!--l. 1817--><p class="noindent" >
<span
class="pplb7t-">Integer and real data:</span> </dt><dd
class="description">
<!--l. 1816--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
<!--l. 1817--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_up_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_down_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_asort_up_</span></span></span>,
@ -3952,11 +3959,11 @@ class="cmtt-10">psb_sort_up_</span></span></span>.
</dd><dt class="description">
<!--l. 1819--><p class="noindent" >
<!--l. 1820--><p class="noindent" >
<span
class="pplb7t-">Complex data:</span> </dt><dd
class="description">
<!--l. 1819--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
<!--l. 1820--><p class="noindent" ><span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_lsort_up_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_lsort_down_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_asort_up_</span></span></span>,
@ -3964,11 +3971,11 @@ class="cmtt-10">psb_asort_up_</span></span></span>,
class="cmtt-10">psb_asort_down_</span></span></span>; default <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_lsort_up_</span></span></span>.</dd></dl>
</dd><dt class="description">
<!--l. 1823--><p class="noindent" >
<!--l. 1824--><p class="noindent" >
<span
class="pplb7t-">flag</span> </dt><dd
class="description">
<!--l. 1823--><p class="noindent" >Whether to keep the original values in <span
<!--l. 1824--><p class="noindent" >Whether to keep the original values in <span
class="zplmr7m-">IX</span>.<br
class="newline" />Type:<span
class="pplb7t-">optional</span>.<br
@ -3977,54 +3984,73 @@ class="cmtt-10">psb_sort_ovw_idx_</span></span></span> or <span class="obeylines
class="cmtt-10">psb_sort_keep_idx_</span></span></span>;
default <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_ovw_idx_</span></span></span>.
</dd><dt class="description">
<!--l. 1828--><p class="noindent" >
<span
class="pplb7t-">reord</span> </dt><dd
class="description">
<!--l. 1828--><p class="noindent" >Whether to reorder the input vector <span
class="zplmr7m-">x </span>or just return <span
class="zplmr7m-">IX </span>for further
usage.<br
class="newline" />Type:<span
class="pplb7t-">optional</span>.<br
class="newline" />Specified as: an integer value <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_reord_x_</span></span></span> or <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_noreord_x_</span></span></span>;
default <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_reord_x_</span></span></span>.
</dd></dl>
<!--l. 1830--><p class="indent" >
<!--l. 1836--><p class="indent" >
<dl class="description"><dt class="description">
<!--l. 1831--><p class="noindent" >
<!--l. 1837--><p class="noindent" >
<span
class="pplb7t-">On Return</span> </dt><dd
class="description">
<!--l. 1831--><p class="noindent" >
<!--l. 1837--><p class="noindent" >
</dd><dt class="description">
<!--l. 1832--><p class="noindent" >
<!--l. 1838--><p class="noindent" >
<span
class="pplb7t-">x</span> </dt><dd
class="description">
<!--l. 1832--><p class="noindent" >The sequence of values, in the chosen ordering.<br
<!--l. 1838--><p class="noindent" >The sequence of values; if <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">reord=psb_sort_reord_x_</span></span></span> it will be in the
chosen ordering.<br
class="newline" />Type:<span
class="pplb7t-">required</span>.<br
class="newline" />Specified as: an integer, real or complex array of rank 1.
</dd><dt class="description">
<!--l. 1835--><p class="noindent" >
<!--l. 1842--><p class="noindent" >
<span
class="pplb7t-">ix</span> </dt><dd
class="description">
<!--l. 1835--><p class="noindent" >A vector of indices.<br
<!--l. 1842--><p class="noindent" >A vector of indices.<br
class="newline" />Type: <span
class="pplb7t-">Optional </span><br
class="newline" />An integer array of rank 1, whose entries are moved to the same position
as the corresponding entries in <span
class="zplmr7m-">x</span>.</dd></dl>
<!--l. 1841--><p class="noindent" ><span
class="newline" />An integer array of rank 1, whose <span
class="zplmr7m-">i</span>-th entry gives the position of the
(sorted) value of <span
class="zplmr7m-">x </span>in the original sequence.</dd></dl>
<!--l. 1848--><p class="noindent" ><span
class="pplb7t-x-x-120">Notes</span>
<ol class="enumerate1" >
<li
class="enumerate" id="x12-105002x1">
<!--l. 1843--><p class="noindent" >For integer or real data the sorting can be performed in the up/down
<!--l. 1850--><p class="noindent" >For integer or real data the sorting can be performed in the up/down
direction, on the natural or absolute values;
</li>
<li
class="enumerate" id="x12-105004x2">
<!--l. 1845--><p class="noindent" >For complex data the sorting can be done in a lexicographic order (i.e.:
<!--l. 1852--><p class="noindent" >For complex data the sorting can be done in a lexicographic order (i.e.:
sort on the real part with ties broken according to the imaginary part) or
on the absolute values;
</li>
<li
class="enumerate" id="x12-105006x3">
<!--l. 1848--><p class="noindent" >The routines return the items in the chosen ordering; the output
<!--l. 1855--><p class="noindent" >The routines return the items in the chosen ordering; the output
difference is the handling of ties (i.e. items with an equal value) in the
original input. With the insertion-sort or merge-sort algorithms ties are
preserved in the same relative order as they had in the original sequence,
@ -4032,7 +4058,22 @@ class="pplb7t-x-x-120">Notes</span>
</li>
<li
class="enumerate" id="x12-105008x4">
<!--l. 1854--><p class="noindent" >If <span
<!--l. 1861--><p class="noindent" >If <span
class="zplmr7m-">reord </span><span
class="zplmr7t-">= </span><span
class="zplmr7m-">psb</span>_<span
class="zplmr7m-">sort</span>_<span
class="zplmr7m-">noreord</span>_<span
class="zplmr7m-">x</span>_, then the input sequence <span
class="zplmr7m-">x </span>is not reordered;
the output is given in <span
class="zplmr7m-">ix</span>. Calling without <span
class="zplmr7m-">ix </span>in this case is flagged as an
error;
</li>
<li
class="enumerate" id="x12-105010x5">
<!--l. 1864--><p class="noindent" >If <span
class="zplmr7m-">flag </span><span
class="zplmr7t-">= </span><span
class="zplmr7m-">psb</span>_<span
@ -4066,8 +4107,8 @@ class="zplmr7t-">) </span>occupied
in the original data sequence;
</li>
<li
class="enumerate" id="x12-105010x5">
<!--l. 1859--><p class="noindent" >If <span
class="enumerate" id="x12-105012x6">
<!--l. 1869--><p class="noindent" >If <span
class="zplmr7m-">flag </span><span
class="zplmr7t-">= </span><span
class="zplmr7m-">psb</span>_<span
@ -4079,8 +4120,11 @@ class="zplmr7m-">ix</span><span
class="zplmr7t-">(:) </span>have already been initialized by the user;
</li>
<li
class="enumerate" id="x12-105012x6">
<!--l. 1861--><p class="noindent" >Three sorting algorithms have a similar <span
class="enumerate" id="x12-105014x7">
<!--l. 1871--><p class="noindent" >Three sorting algorithms have a similar <span
class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span
class="zplmr7m-">n</span> log <span
@ -4096,8 +4140,8 @@ class="zplmr7t-">)</span>; of the other three,
However note that:
<ol class="enumerate2" >
<li
class="enumerate" id="x12-105014x1">
<!--l. 1866--><p class="noindent" >The the best case running time for insertion sort is <span
class="enumerate" id="x12-105016x1">
<!--l. 1876--><p class="noindent" >The the best case running time for insertion sort is <span
class="zplmr7t-">&#x03A9;(</span><span
class="zplmr7m-">n</span><span
class="zplmr7t-">) </span>while the
@ -4110,8 +4154,8 @@ class="zplmr7t-">)</span>; however for very short input
sequences this is likely to be the fastest method;
</li>
<li
class="enumerate" id="x12-105016x2">
<!--l. 1869--><p class="noindent" >The worst case running time
class="enumerate" id="x12-105018x2">
<!--l. 1879--><p class="noindent" >The worst case running time
for quicksort is <span
class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span
@ -4122,21 +4166,18 @@ class="zplmr7t-">)</span>; the algorithm implemented here follows the
apply;
</li>
<li
class="enumerate" id="x12-105018x3">
<!--l. 1872--><p class="noindent" >The worst case running time for merge-sort and heap-sort is
class="enumerate" id="x12-105020x3">
<!--l. 1882--><p class="noindent" >The worst case running time for merge-sort and heap-sort is
<span
class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span
class="zplmr7m-">n</span> log <span
class="zplmr7m-">n</span><span
class="zplmr7t-">) </span>as the average case;
</li>
<li
class="enumerate" id="x12-105020x4">
<!--l. 1874--><p class="noindent" >The merge-sort algorithm is implemented to take advantage of
class="enumerate" id="x12-105022x4">
<!--l. 1884--><p class="noindent" >The merge-sort algorithm is implemented to take advantage of
subsequences that may be already in the desired ordering prior to
the subroutine call; this situation is relatively common when dealing
with groups of indices of sparse matrix entries, thus merge-sort is

3605
docs/psblas-3.9.pdf
View File

File diff suppressed because it is too large Load Diff

28
docs/src/toolsrout.tex
Unescape Escape View File

@ -1791,10 +1791,10 @@ Returned as: an \verb|integer(psb_long_int_k_)| number.
{\par\noindent\large\bfseries psb\_hsort --- Sorting by the Heapsort algorithm}
\begin{verbatim}
call psb_isort(x,ix,dir,flag)
call psb_msort(x,ix,dir,flag)
call psb_qsort(x,ix,dir,flag)
call psb_hsort(x,ix,dir,flag)
call psb_isort(x,ix,dir,flag,reord)
call psb_msort(x,ix,dir,flag,reord)
call psb_qsort(x,ix,dir,flag,reord)
call psb_hsort(x,ix,dir,flag,reord)
\end{verbatim}
These serial routines sort a sequence $X$ into ascending or
@ -1809,7 +1809,8 @@ Type:{\bf required}.\\
Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\
Type:{\bf optional}.\\
Specified as: an integer array of (at least) the same size as $X$.
Specified as: an integer array of (at least) the same size as
$X$. This argument is required when $reord=psb\_sort\_noreord\_x\_$.
\item[dir] The desired ordering.\\
Type:{\bf optional}.\\
Specified as: an integer value: \begin{description}
@ -1824,18 +1825,24 @@ default \verb|psb_lsort_up_|.
Type:{\bf optional}.\\
Specified as: an integer value \verb|psb_sort_ovw_idx_| or
\verb|psb_sort_keep_idx_|; default \verb|psb_sort_ovw_idx_|.
\item[reord] Whether to reorder the input vector $x$ or just return
$IX$ for further usage.\\
Type:{\bf optional}.\\
Specified as: an integer value \verb|psb_sort_reord_x_| or
\verb|psb_sort_noreord_x_|; default \verb|psb_sort_reord_x_|.
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The sequence of values, in the chosen ordering.\\
\item[x] The sequence of values; if \verb|reord=psb_sort_reord_x_| it
will be in the chosen ordering.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\
Type: {\bf Optional} \\
An integer array of rank 1, whose entries are moved to the same
position as the corresponding entries in $x$.
An integer array of rank 1, whose $i$-th entry gives the position of
the (sorted) value of $x$ in the original sequence.
\end{description}
{\goodbreak\par\noindent\large\bfseries Notes}
@ -1850,7 +1857,10 @@ position as the corresponding entries in $x$.
equal value) in the original input. With the insertion-sort or merge-sort algorithms
ties are preserved in the same relative order as they had in the
original sequence, while this is not guaranteed for quicksort or
heapsort;
heapsort;
\item If $reord=psb\_sort\_noreord\_x\_$, then the input sequence $x$
is not reordered; the output is given in $ix$. Calling without $ix$
in this case is flagged as an error;
\item If $flag = psb\_sort\_ovw\_idx\_$ then the entries in $ix(1:n)$
where $n$ is the size of $x$ are initialized to $ix(i) \leftarrow
i$; thus, upon return from the subroutine, for each

7
test/openacc/Makefile
Unescape Escape View File

@ -14,7 +14,7 @@ LDLIBS=$(PSBGPULDLIBS)
FINCLUDES=$(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(FMFLAG). $(FMFLAG)$(PSBMODDIR) $(FMFLAG)$(PSBINCDIR) $(LIBRSB_DEFINES)
FFLAGS=-O3 -march=native -fopenacc -foffload=nvptx-none="-march=sm_75"
FFLAGS=-O3 -march=native $(FCOPENACC) -DOPENACC
CFLAGS=-O3 -march=native
VTC=vectoacc.o
@ -47,9 +47,8 @@ psb_d_oacc_pde3d:
$(FLINK) -fopenacc -DOPENACC psb_d_oacc_pde3d.o -o psb_d_oacc_pde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_d_oacc_pde3d $(EXEDIR)
dpdegenmv:
mpifort -fallow-argument-mismatch -frecursive -g -O3 -frecursive -I../../modules/ -I. -DOPENACC -DHAVE_LAPACK -DHAVE_FLUSH_STMT -DLPK8 -DIPK4 -DMPI_MOD -c dpdegenmv.F90 -o dpdegenmv.o
$(FLINK) -fopenacc -DOPENACC dpdegenmv.o -o dpdegenmv $(PSBLAS_LIB) $(LDLIBS)
dpdegenmv: dpdegenmv.o
$(FLINK) $(FCOPENACC) dpdegenmv.o -o dpdegenmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv dpdegenmv $(EXEDIR)
clean:

19
test/openacc/runs/ppde.inp
Unescape Escape View File

@ -1,19 +0,0 @@
17 Number of entries below this
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR RICHARDSON
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO
HLL Storage format for matrix A: CSR COO
140 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
3 Partition: 1 BLOCK 3 3D
2 Stopping criterion 1 2
0200 MAXIT
10 ITRACE
002 IRST restart for RGMRES and BiCGSTABL
INVK Block Solver ILU,ILUT,INVK,INVT,AINV
NONE If ILU : MILU or NONE othewise ignored
NONE Scaling if ILUT: NONE, MAXVAL otherwise ignored
0 Level of fill for forward factorization
1 Level of fill for inverse factorization (only INVK,INVT)
1E-1 Threshold for forward factorization
1E-1 Threshold for inverse factorization (Only INVK, INVT)
LLK What orthogonalization algorithm? (Only AINV)
Write Preview
Loading…
Cancel
Save