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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_chsort(x,ix,dir,flag) subroutine psb_chsort(x,ix,dir,flag,reord)
import import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_chsort end subroutine psb_chsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_cisort(x,ix,dir,flag) subroutine psb_cisort(x,ix,dir,flag,reord)
import import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cisort end subroutine psb_cisort
end interface psb_isort 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 interface psb_msort
subroutine psb_cmsort(x,ix,dir,flag) subroutine psb_cmsort(x,ix,dir,flag,reord)
import import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cmsort end subroutine psb_cmsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_cqsort(x,ix,dir,flag) subroutine psb_cqsort(x,ix,dir,flag,reord)
import import
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_cqsort end subroutine psb_cqsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_dhsort(x,ix,dir,flag) subroutine psb_dhsort(x,ix,dir,flag,reord)
import import
real(psb_dpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_dhsort end subroutine psb_dhsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_disort(x,ix,dir,flag) subroutine psb_disort(x,ix,dir,flag,reord)
import import
real(psb_dpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_disort end subroutine psb_disort
end interface psb_isort 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 interface psb_msort
subroutine psb_dmsort(x,ix,dir,flag) subroutine psb_dmsort(x,ix,dir,flag,reord)
import import
real(psb_dpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_dmsort end subroutine psb_dmsort
end interface psb_msort 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 end interface psb_ssrch
interface psb_qsort interface psb_qsort
subroutine psb_dqsort(x,ix,dir,flag) subroutine psb_dqsort(x,ix,dir,flag,reord)
import import
real(psb_dpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_dqsort end subroutine psb_dqsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_ehsort(x,ix,dir,flag) subroutine psb_ehsort(x,ix,dir,flag,reord)
import import
integer(psb_epk_), intent(inout) :: x(:) 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_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_ehsort end subroutine psb_ehsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_eisort(x,ix,dir,flag) subroutine psb_eisort(x,ix,dir,flag,reord)
import import
integer(psb_epk_), intent(inout) :: x(:) 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_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_eisort end subroutine psb_eisort
end interface psb_isort 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 interface psb_msort
subroutine psb_emsort(x,ix,dir,flag) subroutine psb_emsort(x,ix,dir,flag,reord)
import import
integer(psb_epk_), intent(inout) :: x(:) 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_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_emsort end subroutine psb_emsort
end interface psb_msort 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 end interface psb_ssrch
interface psb_qsort interface psb_qsort
subroutine psb_eqsort(x,ix,dir,flag) subroutine psb_eqsort(x,ix,dir,flag,reord)
import import
integer(psb_epk_), intent(inout) :: x(:) 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_epk_), optional, intent(inout) :: ix(:)
end subroutine psb_eqsort end subroutine psb_eqsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_i2hsort(x,ix,dir,flag) subroutine psb_i2hsort(x,ix,dir,flag,reord)
import import
integer(psb_i2pk_), intent(inout) :: x(:) 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(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2hsort end subroutine psb_i2hsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_i2isort(x,ix,dir,flag) subroutine psb_i2isort(x,ix,dir,flag,reord)
import import
integer(psb_i2pk_), intent(inout) :: x(:) 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(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2isort end subroutine psb_i2isort
end interface psb_isort 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 interface psb_msort
subroutine psb_i2msort(x,ix,dir,flag) subroutine psb_i2msort(x,ix,dir,flag,reord)
import import
integer(psb_i2pk_), intent(inout) :: x(:) 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(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2msort end subroutine psb_i2msort
end interface psb_msort 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 end interface psb_ssrch
interface psb_qsort interface psb_qsort
subroutine psb_i2qsort(x,ix,dir,flag) subroutine psb_i2qsort(x,ix,dir,flag,reord)
import import
integer(psb_i2pk_), intent(inout) :: x(:) 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(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_i2qsort end subroutine psb_i2qsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_mhsort(x,ix,dir,flag) subroutine psb_mhsort(x,ix,dir,flag,reord)
import import
integer(psb_mpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_mhsort end subroutine psb_mhsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_misort(x,ix,dir,flag) subroutine psb_misort(x,ix,dir,flag,reord)
import import
integer(psb_mpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_misort end subroutine psb_misort
end interface psb_isort 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 interface psb_msort
subroutine psb_mmsort(x,ix,dir,flag) subroutine psb_mmsort(x,ix,dir,flag,reord)
import import
integer(psb_mpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_mmsort end subroutine psb_mmsort
end interface psb_msort 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 end interface psb_ssrch
interface psb_qsort interface psb_qsort
subroutine psb_mqsort(x,ix,dir,flag) subroutine psb_mqsort(x,ix,dir,flag,reord)
import import
integer(psb_mpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
end subroutine psb_mqsort end subroutine psb_mqsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_shsort(x,ix,dir,flag) subroutine psb_shsort(x,ix,dir,flag,reord)
import import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_shsort end subroutine psb_shsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_sisort(x,ix,dir,flag) subroutine psb_sisort(x,ix,dir,flag,reord)
import import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_sisort end subroutine psb_sisort
end interface psb_isort 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 interface psb_msort
subroutine psb_smsort(x,ix,dir,flag) subroutine psb_smsort(x,ix,dir,flag,reord)
import import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_smsort end subroutine psb_smsort
end interface psb_msort 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 end interface psb_ssrch
interface psb_qsort interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag) subroutine psb_sqsort(x,ix,dir,flag,reord)
import import
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_sqsort end subroutine psb_sqsort
end interface psb_qsort 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 use psb_const_mod
interface psb_hsort interface psb_hsort
subroutine psb_zhsort(x,ix,dir,flag) subroutine psb_zhsort(x,ix,dir,flag,reord)
import import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zhsort end subroutine psb_zhsort
end interface psb_hsort 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 use psb_const_mod
interface psb_isort interface psb_isort
subroutine psb_zisort(x,ix,dir,flag) subroutine psb_zisort(x,ix,dir,flag,reord)
import import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zisort end subroutine psb_zisort
end interface psb_isort 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 interface psb_msort
subroutine psb_zmsort(x,ix,dir,flag) subroutine psb_zmsort(x,ix,dir,flag,reord)
import import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zmsort end subroutine psb_zmsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag) subroutine psb_zqsort(x,ix,dir,flag,reord)
import import
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
end subroutine psb_zqsort end subroutine psb_zqsort
end interface psb_qsort 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_chsort
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: dir_, l integer(psb_ipk_) :: n, i, l, dir_
complex(psb_spk_) :: key complex(psb_spk_) :: key
integer(psb_ipk_) :: index integer(psb_ipk_) :: index
complex(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_chsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_chsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 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_sort_mod, psb_protect_name => psb_cmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -96,6 +96,11 @@ subroutine psb_cmsort(x,ix,dir,flag)
name='psb_cmsort' name='psb_cmsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -163,11 +168,25 @@ subroutine psb_cmsort(x,ix,dir,flag)
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return

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

@ -41,22 +41,29 @@
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_cqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_ipk_) :: n
complex(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_cqsort' name='psb_cqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -91,25 +98,57 @@ subroutine psb_cqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_lsort_up_) case (psb_sort_reord_x_)
select case(dir_)
case (psb_lsort_up_)
call psi_clqsrx_up(n,x,ix) call psi_clqsrx_up(n,x,ix)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_clqsrx_dw(n,x,ix) call psi_clqsrx_dw(n,x,ix)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_calqsrx_up(n,x,ix) call psi_calqsrx_up(n,x,ix)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_calqsrx_dw(n,x,ix) call psi_calqsrx_dw(n,x,ix)
case (psb_asort_up_) case (psb_asort_up_)
call psi_caqsrx_up(n,x,ix) call psi_caqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_caqsrx_dw(n,x,ix) call psi_caqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_lsort_up_) case (psb_lsort_up_)
call psi_clqsr_up(n,x) 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_dhsort
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: dir_, l integer(psb_ipk_) :: n, i, l, dir_
real(psb_dpk_) :: key real(psb_dpk_) :: key
integer(psb_ipk_) :: index integer(psb_ipk_) :: index
real(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_dhsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_dhsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 return
end subroutine psb_dmsort_u 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_sort_mod, psb_protect_name => psb_dmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), 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_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -95,6 +95,11 @@ subroutine psb_dmsort(x,ix,dir,flag)
name='psb_dmsort' name='psb_dmsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -157,15 +162,28 @@ subroutine psb_dmsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return
9999 call psb_error_handler(err_act) 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 return
end function psb_dssrch 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_sort_mod, psb_protect_name => psb_dqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_ipk_) :: n
real(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_dqsort' name='psb_dqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -209,21 +216,49 @@ subroutine psb_dqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_sort_up_) case (psb_sort_reord_x_)
call psi_dqsrx_up(n,x,ix) select case(dir_)
case (psb_sort_down_) case (psb_sort_up_)
call psi_dqsrx_dw(n,x,ix) call psi_dqsrx_up(n,x,ix)
case (psb_asort_up_) case (psb_sort_down_)
call psi_dqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_daqsrx_up(n,x,ix) call psi_daqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_daqsrx_dw(n,x,ix) call psi_daqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_sort_up_) case (psb_sort_up_)
call psi_dqsr_up(n,x) 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_ehsort
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_epk_), intent(inout) :: x(:) 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_epk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_epk_) :: dir_, l integer(psb_epk_) :: n, i, l, dir_
integer(psb_epk_) :: key integer(psb_epk_) :: key
integer(psb_epk_) :: index integer(psb_epk_) :: index
integer(psb_epk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_ehsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_ehsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 return
end subroutine psb_emsort_u 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_sort_mod, psb_protect_name => psb_emsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
integer(psb_epk_), intent(inout) :: x(:) 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_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_epk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -150,6 +150,11 @@ subroutine psb_emsort(x,ix,dir,flag)
name='psb_emsort' name='psb_emsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -212,15 +217,28 @@ subroutine psb_emsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return
9999 call psb_error_handler(err_act) 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 return
end function psb_essrch 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_sort_mod, psb_protect_name => psb_eqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_epk_), intent(inout) :: x(:) 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_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_) :: n
integer(psb_epk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_eqsort' name='psb_eqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -209,21 +216,49 @@ subroutine psb_eqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_sort_up_) case (psb_sort_reord_x_)
call psi_eqsrx_up(n,x,ix) select case(dir_)
case (psb_sort_down_) case (psb_sort_up_)
call psi_eqsrx_dw(n,x,ix) call psi_eqsrx_up(n,x,ix)
case (psb_asort_up_) case (psb_sort_down_)
call psi_eqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_eaqsrx_up(n,x,ix) call psi_eaqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_eaqsrx_dw(n,x,ix) call psi_eaqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_sort_up_) case (psb_sort_up_)
call psi_eqsr_up(n,x) 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_mhsort
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_mpk_), intent(inout) :: x(:) 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_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: dir_, l integer(psb_ipk_) :: n, i, l, dir_
integer(psb_mpk_) :: key integer(psb_mpk_) :: key
integer(psb_ipk_) :: index integer(psb_ipk_) :: index
integer(psb_mpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_mhsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_mhsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 return
end subroutine psb_mmsort_u 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_sort_mod, psb_protect_name => psb_mmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
integer(psb_mpk_), intent(inout) :: x(:) 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_), 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_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -150,6 +150,11 @@ subroutine psb_mmsort(x,ix,dir,flag)
name='psb_mmsort' name='psb_mmsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -212,15 +217,28 @@ subroutine psb_mmsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return
9999 call psb_error_handler(err_act) 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 return
end function psb_mssrch 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_sort_mod, psb_protect_name => psb_mqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_mpk_), intent(inout) :: x(:) 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_), 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_ipk_) :: n
integer(psb_mpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_mqsort' name='psb_mqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -209,21 +216,49 @@ subroutine psb_mqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_sort_up_) case (psb_sort_reord_x_)
call psi_mqsrx_up(n,x,ix) select case(dir_)
case (psb_sort_down_) case (psb_sort_up_)
call psi_mqsrx_dw(n,x,ix) call psi_mqsrx_up(n,x,ix)
case (psb_asort_up_) case (psb_sort_down_)
call psi_mqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_maqsrx_up(n,x,ix) call psi_maqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_maqsrx_dw(n,x,ix) call psi_maqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_sort_up_) case (psb_sort_up_)
call psi_mqsr_up(n,x) 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_shsort
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: dir_, l integer(psb_ipk_) :: n, i, l, dir_
real(psb_spk_) :: key real(psb_spk_) :: key
integer(psb_ipk_) :: index integer(psb_ipk_) :: index
real(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_shsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_shsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 return
end subroutine psb_smsort_u 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_sort_mod, psb_protect_name => psb_smsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -95,6 +95,11 @@ subroutine psb_smsort(x,ix,dir,flag)
name='psb_smsort' name='psb_smsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -157,15 +162,28 @@ subroutine psb_smsort(x,ix,dir,flag)
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return
9999 call psb_error_handler(err_act) 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 return
end function psb_sssrch 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_sort_mod, psb_protect_name => psb_sqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_ipk_) :: n
real(psb_spk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_sqsort' name='psb_sqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -209,21 +216,49 @@ subroutine psb_sqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_sort_up_) case (psb_sort_reord_x_)
call psi_sqsrx_up(n,x,ix) select case(dir_)
case (psb_sort_down_) case (psb_sort_up_)
call psi_sqsrx_dw(n,x,ix) call psi_sqsrx_up(n,x,ix)
case (psb_asort_up_) case (psb_sort_down_)
call psi_sqsrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_saqsrx_up(n,x,ix) call psi_saqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_saqsrx_dw(n,x,ix) call psi_saqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_sort_up_) case (psb_sort_up_)
call psi_sqsr_up(n,x) 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 ! Data Structures and Algorithms
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_zhsort
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, n, i, err_act,info integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: dir_, l integer(psb_ipk_) :: n, i, l, dir_
complex(psb_dpk_) :: key complex(psb_dpk_) :: key
integer(psb_ipk_) :: index integer(psb_ipk_) :: index
complex(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -60,6 +61,13 @@ subroutine psb_zhsort(x,ix,dir,flag)
name='psb_hsort' name='psb_hsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -113,24 +121,57 @@ subroutine psb_zhsort(x,ix,dir,flag)
ix(i) = i ix(i) = i
end do end do
end if end if
l = 0 select case(reord_)
do i=1, n case (psb_sort_reord_x_)
key = x(i)
index = ix(i) l = 0
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info) do i=1, n
if (l /= i) then key = x(i)
write(psb_err_unit,*) 'Mismatch while heapifying ! ' index = ix(i)
end if call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
end do if (l /= i) then
do i=n, 2, -1 write(psb_err_unit,*) 'Mismatch while heapifying ! '
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info) end if
if (l /= i-1) then end do
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i do i=n, 2, -1
end if call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
x(i) = key if (l /= i-1) then
ix(i) = index write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end do end if
else if (.not.present(ix)) then 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 l = 0
do i=1, n do i=1, n
key = x(i) key = x(i)

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

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

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 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_sort_mod, psb_protect_name => psb_zmsort
use psb_error_mod use psb_error_mod
use psb_ip_reord_mod use psb_ip_reord_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i integer(psb_ipk_) :: iret, info, i
@ -96,6 +96,11 @@ subroutine psb_zmsort(x,ix,dir,flag)
name='psb_zmsort' name='psb_zmsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then if (present(dir)) then
dir_ = dir dir_ = dir
else else
@ -163,11 +168,25 @@ subroutine psb_zmsort(x,ix,dir,flag)
! only provide linked pointers. ! only provide linked pointers.
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then select case(reord_)
call psb_ip_reord(n,x,ix,iaux) case(psb_sort_reord_x_)
else if (present(ix)) then
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,ix,iaux)
end if 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 end if
return return

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

@ -41,22 +41,29 @@
! Addison-Wesley ! 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_sort_mod, psb_protect_name => psb_zqsort
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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_ipk_) :: n
complex(psb_dpk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
name='psb_zqsort' name='psb_zqsort'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then if (present(flag)) then
flag_ = flag flag_ = flag
else else
@ -91,25 +98,57 @@ subroutine psb_zqsort(x,ix,dir,flag)
end do end do
end if end if
select case(dir_) select case(reord_)
case (psb_lsort_up_) case (psb_sort_reord_x_)
select case(dir_)
case (psb_lsort_up_)
call psi_zlqsrx_up(n,x,ix) call psi_zlqsrx_up(n,x,ix)
case (psb_lsort_down_) case (psb_lsort_down_)
call psi_zlqsrx_dw(n,x,ix) call psi_zlqsrx_dw(n,x,ix)
case (psb_alsort_up_) case (psb_alsort_up_)
call psi_zalqsrx_up(n,x,ix) call psi_zalqsrx_up(n,x,ix)
case (psb_alsort_down_) case (psb_alsort_down_)
call psi_zalqsrx_dw(n,x,ix) call psi_zalqsrx_dw(n,x,ix)
case (psb_asort_up_) case (psb_asort_up_)
call psi_zaqsrx_up(n,x,ix) call psi_zaqsrx_up(n,x,ix)
case (psb_asort_down_) case (psb_asort_down_)
call psi_zaqsrx_dw(n,x,ix) call psi_zaqsrx_dw(n,x,ix)
case default case default
ierr(1) = 3; ierr(2) = dir_; ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
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) call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999 goto 9999
end select end select
else
select case(dir_) select case(dir_)
case (psb_lsort_up_) case (psb_lsort_up_)
call psi_zlqsr_up(n,x) 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"> <pre class="verbatim" id="verbatim-60">
call&#x00A0;psb_isort(x,ix,dir,flag) call&#x00A0;psb_isort(x,ix,dir,flag,reord)
call&#x00A0;psb_msort(x,ix,dir,flag) call&#x00A0;psb_msort(x,ix,dir,flag,reord)
call&#x00A0;psb_qsort(x,ix,dir,flag) call&#x00A0;psb_qsort(x,ix,dir,flag,reord)
call&#x00A0;psb_hsort(x,ix,dir,flag) call&#x00A0;psb_hsort(x,ix,dir,flag,reord)
</pre> </pre>
<!--l. 1798--><p class="nopar" > <!--l. 1798--><p class="nopar" >
<!--l. 1800--><p class="indent" > These serial routines sort a sequence <span <!--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 <!--l. 1810--><p class="noindent" >A vector of indices.<br
class="newline" />Type:<span class="newline" />Type:<span
class="pplb7t-">optional</span>.<br class="pplb7t-">optional</span>.<br
class="newline" />Specified as: an integer array of (at least) the same size as <span class="newline" />Specified as: an integer array of (at least) the same size as <span
class="zplmr7m-">X</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"> </dd><dt class="description">
<!--l. 1813--><p class="noindent" > <!--l. 1814--><p class="noindent" >
<span <span
class="pplb7t-">dir</span> </dt><dd class="pplb7t-">dir</span> </dt><dd
class="description"> 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="newline" />Type:<span
class="pplb7t-">optional</span>.<br class="pplb7t-">optional</span>.<br
class="newline" />Specified as: an integer value: class="newline" />Specified as: an integer value:
<dl class="description"><dt class="description"> <dl class="description"><dt class="description">
<!--l. 1816--><p class="noindent" > <!--l. 1817--><p class="noindent" >
<span <span
class="pplb7t-">Integer and real data:</span> </dt><dd class="pplb7t-">Integer and real data:</span> </dt><dd
class="description"> 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_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_sort_down_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_asort_up_</span></span></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"> </dd><dt class="description">
<!--l. 1819--><p class="noindent" > <!--l. 1820--><p class="noindent" >
<span <span
class="pplb7t-">Complex data:</span> </dt><dd class="pplb7t-">Complex data:</span> </dt><dd
class="description"> 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_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_lsort_down_</span></span></span>, <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_asort_up_</span></span></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_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> class="cmtt-10">psb_lsort_up_</span></span></span>.</dd></dl>
</dd><dt class="description"> </dd><dt class="description">
<!--l. 1823--><p class="noindent" > <!--l. 1824--><p class="noindent" >
<span <span
class="pplb7t-">flag</span> </dt><dd class="pplb7t-">flag</span> </dt><dd
class="description"> 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="zplmr7m-">IX</span>.<br
class="newline" />Type:<span class="newline" />Type:<span
class="pplb7t-">optional</span>.<br 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>; class="cmtt-10">psb_sort_keep_idx_</span></span></span>;
default <span class="obeylines-h"><span class="verb"><span default <span class="obeylines-h"><span class="verb"><span
class="cmtt-10">psb_sort_ovw_idx_</span></span></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> </dd></dl>
<!--l. 1830--><p class="indent" > <!--l. 1836--><p class="indent" >
<dl class="description"><dt class="description"> <dl class="description"><dt class="description">
<!--l. 1831--><p class="noindent" > <!--l. 1837--><p class="noindent" >
<span <span
class="pplb7t-">On Return</span> </dt><dd class="pplb7t-">On Return</span> </dt><dd
class="description"> class="description">
<!--l. 1831--><p class="noindent" > <!--l. 1837--><p class="noindent" >
</dd><dt class="description"> </dd><dt class="description">
<!--l. 1832--><p class="noindent" > <!--l. 1838--><p class="noindent" >
<span <span
class="pplb7t-">x</span> </dt><dd class="pplb7t-">x</span> </dt><dd
class="description"> 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="newline" />Type:<span
class="pplb7t-">required</span>.<br class="pplb7t-">required</span>.<br
class="newline" />Specified as: an integer, real or complex array of rank 1. class="newline" />Specified as: an integer, real or complex array of rank 1.
</dd><dt class="description"> </dd><dt class="description">
<!--l. 1835--><p class="noindent" > <!--l. 1842--><p class="noindent" >
<span <span
class="pplb7t-">ix</span> </dt><dd class="pplb7t-">ix</span> </dt><dd
class="description"> 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="newline" />Type: <span
class="pplb7t-">Optional </span><br class="pplb7t-">Optional </span><br
class="newline" />An integer array of rank 1, whose entries are moved to the same position class="newline" />An integer array of rank 1, whose <span
as the corresponding entries in <span class="zplmr7m-">i</span>-th entry gives the position of the
class="zplmr7m-">x</span>.</dd></dl> (sorted) value of <span
<!--l. 1841--><p class="noindent" ><span class="zplmr7m-">x </span>in the original sequence.</dd></dl>
<!--l. 1848--><p class="noindent" ><span
class="pplb7t-x-x-120">Notes</span> class="pplb7t-x-x-120">Notes</span>
<ol class="enumerate1" > <ol class="enumerate1" >
<li <li
class="enumerate" id="x12-105002x1"> 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; direction, on the natural or absolute values;
</li> </li>
<li <li
class="enumerate" id="x12-105004x2"> 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 sort on the real part with ties broken according to the imaginary part) or
on the absolute values; on the absolute values;
</li> </li>
<li <li
class="enumerate" id="x12-105006x3"> 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 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 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, 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>
<li <li
class="enumerate" id="x12-105008x4"> 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="zplmr7m-">flag </span><span
class="zplmr7t-">= </span><span class="zplmr7t-">= </span><span
class="zplmr7m-">psb</span>_<span class="zplmr7m-">psb</span>_<span
@ -4066,8 +4107,8 @@ class="zplmr7t-">) </span>occupied
in the original data sequence; in the original data sequence;
</li> </li>
<li <li
class="enumerate" id="x12-105010x5"> class="enumerate" id="x12-105012x6">
<!--l. 1859--><p class="noindent" >If <span <!--l. 1869--><p class="noindent" >If <span
class="zplmr7m-">flag </span><span class="zplmr7m-">flag </span><span
class="zplmr7t-">= </span><span class="zplmr7t-">= </span><span
class="zplmr7m-">psb</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; class="zplmr7t-">(:) </span>have already been initialized by the user;
</li> </li>
<li <li
class="enumerate" id="x12-105012x6"> class="enumerate" id="x12-105014x7">
<!--l. 1861--><p class="noindent" >Three sorting algorithms have a similar <span
<!--l. 1871--><p class="noindent" >Three sorting algorithms have a similar <span
class="zplmr7m-">O</span><span class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span class="zplmr7t-">(</span><span
class="zplmr7m-">n</span> log <span class="zplmr7m-">n</span> log <span
@ -4096,8 +4140,8 @@ class="zplmr7t-">)</span>; of the other three,
However note that: However note that:
<ol class="enumerate2" > <ol class="enumerate2" >
<li <li
class="enumerate" id="x12-105014x1"> class="enumerate" id="x12-105016x1">
<!--l. 1866--><p class="noindent" >The the best case running time for insertion sort is <span <!--l. 1876--><p class="noindent" >The the best case running time for insertion sort is <span
class="zplmr7t-">&#x03A9;(</span><span class="zplmr7t-">&#x03A9;(</span><span
class="zplmr7m-">n</span><span class="zplmr7m-">n</span><span
class="zplmr7t-">) </span>while the 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; sequences this is likely to be the fastest method;
</li> </li>
<li <li
class="enumerate" id="x12-105016x2"> class="enumerate" id="x12-105018x2">
<!--l. 1869--><p class="noindent" >The worst case running time <!--l. 1879--><p class="noindent" >The worst case running time
for quicksort is <span for quicksort is <span
class="zplmr7m-">O</span><span class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span class="zplmr7t-">(</span><span
@ -4122,21 +4166,18 @@ class="zplmr7t-">)</span>; the algorithm implemented here follows the
apply; apply;
</li> </li>
<li <li
class="enumerate" id="x12-105018x3"> class="enumerate" id="x12-105020x3">
<!--l. 1872--><p class="noindent" >The worst case running time for merge-sort and heap-sort is <!--l. 1882--><p class="noindent" >The worst case running time for merge-sort and heap-sort is
<span <span
class="zplmr7m-">O</span><span class="zplmr7m-">O</span><span
class="zplmr7t-">(</span><span class="zplmr7t-">(</span><span
class="zplmr7m-">n</span> log <span class="zplmr7m-">n</span> log <span
class="zplmr7m-">n</span><span class="zplmr7m-">n</span><span
class="zplmr7t-">) </span>as the average case; class="zplmr7t-">) </span>as the average case;
</li> </li>
<li <li
class="enumerate" id="x12-105020x4"> class="enumerate" id="x12-105022x4">
<!--l. 1874--><p class="noindent" >The merge-sort algorithm is implemented to take advantage of <!--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 subsequences that may be already in the desired ordering prior to
the subroutine call; this situation is relatively common when dealing the subroutine call; this situation is relatively common when dealing
with groups of indices of sparse matrix entries, thus merge-sort is 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} {\par\noindent\large\bfseries psb\_hsort --- Sorting by the Heapsort algorithm}
\begin{verbatim} \begin{verbatim}
call psb_isort(x,ix,dir,flag) call psb_isort(x,ix,dir,flag,reord)
call psb_msort(x,ix,dir,flag) call psb_msort(x,ix,dir,flag,reord)
call psb_qsort(x,ix,dir,flag) call psb_qsort(x,ix,dir,flag,reord)
call psb_hsort(x,ix,dir,flag) call psb_hsort(x,ix,dir,flag,reord)
\end{verbatim} \end{verbatim}
These serial routines sort a sequence $X$ into ascending or 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. Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\ \item[ix] A vector of indices.\\
Type:{\bf optional}.\\ 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.\\ \item[dir] The desired ordering.\\
Type:{\bf optional}.\\ Type:{\bf optional}.\\
Specified as: an integer value: \begin{description} Specified as: an integer value: \begin{description}
@ -1824,18 +1825,24 @@ default \verb|psb_lsort_up_|.
Type:{\bf optional}.\\ Type:{\bf optional}.\\
Specified as: an integer value \verb|psb_sort_ovw_idx_| or Specified as: an integer value \verb|psb_sort_ovw_idx_| or
\verb|psb_sort_keep_idx_|; default \verb|psb_sort_ovw_idx_|. \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} \end{description}
\begin{description} \begin{description}
\item[\bf On Return] \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}.\\ Type:{\bf required}.\\
Specified as: an integer, real or complex array of rank 1. Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\ \item[ix] A vector of indices.\\
Type: {\bf Optional} \\ Type: {\bf Optional} \\
An integer array of rank 1, whose entries are moved to the same An integer array of rank 1, whose $i$-th entry gives the position of
position as the corresponding entries in $x$. the (sorted) value of $x$ in the original sequence.
\end{description} \end{description}
{\goodbreak\par\noindent\large\bfseries Notes} {\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 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 ties are preserved in the same relative order as they had in the
original sequence, while this is not guaranteed for quicksort or 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)$ \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 where $n$ is the size of $x$ are initialized to $ix(i) \leftarrow
i$; thus, upon return from the subroutine, for each 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) 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 CFLAGS=-O3 -march=native
VTC=vectoacc.o 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) $(FLINK) -fopenacc -DOPENACC psb_d_oacc_pde3d.o -o psb_d_oacc_pde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_d_oacc_pde3d $(EXEDIR) /bin/mv psb_d_oacc_pde3d $(EXEDIR)
dpdegenmv: dpdegenmv: dpdegenmv.o
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) $(FCOPENACC) dpdegenmv.o -o dpdegenmv $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) -fopenacc -DOPENACC dpdegenmv.o -o dpdegenmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv dpdegenmv $(EXEDIR) /bin/mv dpdegenmv $(EXEDIR)
clean: 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