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

Merge branch 'development' into cmake

Browse Source
cmake
Luca Pepè Sciarria 6 months ago
parent f0e6592275 3c791b5370
commit 4c27ffb760
154 changed files with 5176 additions and 3510 deletions
Show Stats Download Patch File Download Diff File

8
base/CMakeLists.txt
Unescape Escape View File

@ -272,7 +272,7 @@ set(PSB_base_source_files
tools/psb_zsprn.f90
tools/psb_get_overlap.f90
serial/psb_crwextd.f90
serial/psb_zspspmm.f90
serial/psb_zspspmm.F90
serial/psb_drwextd.f90
serial/psb_dnumbmm.f90
serial/psb_damax_s.f90
@ -343,14 +343,14 @@ set(PSB_base_source_files
serial/psb_dsymbmm.f90
serial/psb_samax_s.f90
serial/psb_lsame.f90
serial/psb_dspspmm.f90
serial/psb_dspspmm.F90
serial/psb_ssymbmm.f90
serial/psb_cgeprt.f90
serial/psb_sgeprt.f90
# serial/psi_i2_serial_impl.F90
serial/psi_e_serial_impl.F90
serial/psb_zsymbmm.f90
serial/psb_cspspmm.f90
serial/psb_cspspmm.F90
serial/psb_aspxpby.f90
serial/psi_s_serial_impl.F90
serial/psb_zamax_s.f90
@ -359,7 +359,7 @@ set(PSB_base_source_files
serial/psb_casum_s.f90
serial/psi_d_serial_impl.F90
serial/psi_c_serial_impl.F90
serial/psb_sspspmm.f90
serial/psb_sspspmm.F90
serial/psb_cnumbmm.f90
psblas/psb_damax.f90
psblas/psb_dspmm.f90

4
base/comm/internals/psi_cswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_cswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_cswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_ctranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_ctranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_dswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_dswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_dswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_dtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_dtranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_eswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_eswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_eswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_etranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_etranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_epk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_i2swapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_i2swapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_i2swaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_i2tranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_i2tranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_i2pk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_mswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_mswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_mswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_mtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_mtranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
integer(psb_mpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_sswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_sswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_sswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_stranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_stranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_zswapdata_a.F90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
logical, parameter :: usersend=.false.
complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -680,7 +680,7 @@ subroutine psi_zswapidxv(ctxt,icomm,flag,beta,y,idx, &
logical, parameter :: usersend=.false.
complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

4
base/comm/internals/psi_zswaptran_a.F90
Unescape Escape View File

@ -197,7 +197,7 @@ subroutine psi_ztranidxm(ctxt,icomm,flag,n,beta,y,idx,&
logical, parameter :: usersend=.false.
complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name
@ -691,7 +691,7 @@ subroutine psi_ztranidxv(ctxt,icomm,flag,beta,y,idx,&
logical, parameter :: usersend=.false.
complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
#if !defined(FLANG)
#if !defined(PSB_CMP_FLANG)
volatile :: sndbuf, rcvbuf
#endif
character(len=20) :: name

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

218
base/modules/penv/psi_penv_mod.F90
Unescape Escape View File

@ -49,7 +49,9 @@ module mpi
integer(psb_mpk_), parameter :: mpi_integer4 = 10
integer(psb_mpk_), parameter :: mpi_comm_null = -1
integer(psb_mpk_), parameter :: mpi_comm_world = 1
integer(psb_mpk_), parameter :: mpi_address_kind = psb_epk_
!real(psb_dpk_), external :: mpi_wtime
interface
@ -179,44 +181,53 @@ end module mpi
module psi_penv_mod
use psb_const_mod
use iso_c_binding
integer(psb_mpk_), parameter:: psb_int_tag = 543987
integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1
integer(psb_mpk_), parameter:: psb_double_tag = psb_real_tag + 1
integer(psb_mpk_), parameter:: psb_complex_tag = psb_double_tag + 1
integer(psb_mpk_), parameter:: psb_dcomplex_tag = psb_complex_tag + 1
integer(psb_mpk_), parameter:: psb_logical_tag = psb_dcomplex_tag + 1
integer(psb_mpk_), parameter:: psb_char_tag = psb_logical_tag + 1
integer(psb_mpk_), parameter:: psb_int8_tag = psb_char_tag + 1
integer(psb_mpk_), parameter:: psb_int2_tag = psb_int8_tag + 1
integer(psb_mpk_), parameter:: psb_int4_tag = psb_int2_tag + 1
integer(psb_mpk_), parameter:: psb_long_tag = psb_int4_tag + 1
integer(psb_mpk_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_double_swap_tag = psb_double_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_complex_swap_tag = psb_complex_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_dcomplex_swap_tag = psb_dcomplex_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_logical_swap_tag = psb_logical_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_long_swap_tag = psb_long_tag + psb_int_tag
#ifdef PSB_MPI_MOD
use mpi
#endif
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), parameter :: psb_apk_ = mpi_address_kind
integer(psb_mpk_), parameter :: psb_tag_space = 200
integer(psb_mpk_), parameter :: psb_tag_base = 512
integer(psb_mpk_), parameter :: psb_int_tag = psb_tag_base + 1
integer(psb_mpk_), parameter :: psb_real_tag = psb_int_tag + 1
integer(psb_mpk_), parameter :: psb_double_tag = psb_real_tag + 1
integer(psb_mpk_), parameter :: psb_complex_tag = psb_double_tag + 1
integer(psb_mpk_), parameter :: psb_dcomplex_tag = psb_complex_tag + 1
integer(psb_mpk_), parameter :: psb_logical_tag = psb_dcomplex_tag + 1
integer(psb_mpk_), parameter :: psb_char_tag = psb_logical_tag + 1
integer(psb_mpk_), parameter :: psb_int8_tag = psb_char_tag + 1
integer(psb_mpk_), parameter :: psb_int2_tag = psb_int8_tag + 1
integer(psb_mpk_), parameter :: psb_int4_tag = psb_int2_tag + 1
integer(psb_mpk_), parameter :: psb_long_tag = psb_int4_tag + 1
integer(psb_mpk_), parameter :: psb_max_simple_tag = psb_long_tag + 2
integer(psb_mpk_), parameter :: psb_int_swap_tag = psb_max_simple_tag + 1
integer(psb_mpk_), parameter :: psb_real_swap_tag = psb_int_swap_tag + 1
integer(psb_mpk_), parameter :: psb_double_swap_tag = psb_real_swap_tag + 1
integer(psb_mpk_), parameter :: psb_complex_swap_tag = psb_double_swap_tag + 1
integer(psb_mpk_), parameter :: psb_dcomplex_swap_tag = psb_complex_swap_tag + 1
integer(psb_mpk_), parameter :: psb_logical_swap_tag = psb_dcomplex_swap_tag + 1
integer(psb_mpk_), parameter :: psb_char_swap_tag = psb_logical_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int8_swap_tag = psb_char_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int2_swap_tag = psb_int8_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int4_swap_tag = psb_int2_swap_tag + 1
integer(psb_mpk_), parameter :: psb_long_swap_tag = psb_int4_swap_tag + 1
integer(psb_mpk_), private, parameter:: psb_int_type = 987543
integer(psb_mpk_), private, parameter:: psb_real_type = psb_int_type + 1
integer(psb_mpk_), private, parameter:: psb_double_type = psb_real_type + 1
integer(psb_mpk_), private, parameter:: psb_complex_type = psb_double_type + 1
integer(psb_mpk_), private, parameter:: psb_dcomplex_type = psb_complex_type + 1
integer(psb_mpk_), private, parameter:: psb_logical_type = psb_dcomplex_type + 1
integer(psb_mpk_), private, parameter:: psb_char_type = psb_logical_type + 1
integer(psb_mpk_), private, parameter:: psb_int8_type = psb_char_type + 1
integer(psb_mpk_), private, parameter:: psb_int2_type = psb_int8_type + 1
integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1
integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1
integer(psb_mpk_), private, parameter :: psb_int_type = 200
integer(psb_mpk_), private, parameter :: psb_real_type = psb_int_type + 1
integer(psb_mpk_), private, parameter :: psb_double_type = psb_real_type + 1
integer(psb_mpk_), private, parameter :: psb_complex_type = psb_double_type + 1
integer(psb_mpk_), private, parameter :: psb_dcomplex_type = psb_complex_type + 1
integer(psb_mpk_), private, parameter :: psb_logical_type = psb_dcomplex_type + 1
integer(psb_mpk_), private, parameter :: psb_char_type = psb_logical_type + 1
integer(psb_mpk_), private, parameter :: psb_int8_type = psb_char_type + 1
integer(psb_mpk_), private, parameter :: psb_int2_type = psb_int8_type + 1
integer(psb_mpk_), private, parameter :: psb_int4_type = psb_int2_type + 1
integer(psb_mpk_), private, parameter :: psb_long_type = psb_int4_type + 1
type psb_buffer_node
integer(psb_mpk_) :: request
@ -304,7 +315,7 @@ module psi_penv_mod
#endif
private :: psi_get_sizes, psi_register_mpi_extras
private :: psi_get_sizes, psi_register_mpi_const
private :: psi_i2amx_op, psi_i2amn_op
private :: psi_iamx_op, psi_iamn_op
private :: psi_mamx_op, psi_mamn_op
@ -341,13 +352,7 @@ contains
end subroutine psb_init_queue
subroutine psb_wait_buffer(node, info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: status(mpi_status_size),minfo
@ -357,13 +362,7 @@ contains
end subroutine psb_wait_buffer
subroutine psb_test_buffer(node, flag, info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node
logical, intent(out) :: flag
integer(psb_ipk_), intent(out) :: info
@ -476,13 +475,7 @@ contains
!
! !!!!!!!!!!!!!!!!!
subroutine psi_msnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
integer(psb_mpk_), allocatable, intent(inout) :: buffer(:)
@ -515,13 +508,7 @@ contains
subroutine psi_esnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
integer(psb_epk_), allocatable, intent(inout) :: buffer(:)
@ -552,13 +539,7 @@ contains
end subroutine psi_esnd
subroutine psi_i2snd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:)
@ -589,13 +570,7 @@ contains
end subroutine psi_i2snd
subroutine psi_ssnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
real(psb_spk_), allocatable, intent(inout) :: buffer(:)
@ -626,13 +601,7 @@ contains
end subroutine psi_ssnd
subroutine psi_dsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
real(psb_dpk_), allocatable, intent(inout) :: buffer(:)
@ -663,13 +632,7 @@ contains
end subroutine psi_dsnd
subroutine psi_csnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
complex(psb_spk_), allocatable, intent(inout) :: buffer(:)
@ -700,13 +663,7 @@ contains
end subroutine psi_csnd
subroutine psi_zsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
complex(psb_dpk_), allocatable, intent(inout) :: buffer(:)
@ -738,13 +695,7 @@ contains
subroutine psi_logsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
logical, allocatable, intent(inout) :: buffer(:)
@ -776,13 +727,7 @@ contains
subroutine psi_hsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest
character(len=1), allocatable, intent(inout) :: buffer(:)
@ -850,16 +795,11 @@ contains
end subroutine psi_get_sizes
subroutine psi_register_mpi_extras(info)
#ifdef PSB_MPI_MOD
use mpi
#endif
subroutine psi_register_mpi_const(comm,info)
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_) :: info
integer(psb_mpk_) :: comm,info
integer(psb_mpk_) :: ierror
logical :: flag
info = 0
#if 0
if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info)
@ -896,8 +836,7 @@ contains
psb_mpi_c_dpk_ = mpi_double_complex
#endif
#if defined(PSB_SERIAL_MPI)
#else
#if ! defined(PSB_SERIAL_MPI)
if (info == 0) call mpi_op_create(psi_i2amx_op,.true.,mpi_i2amx_op,info)
if (info == 0) call mpi_op_create(psi_i2amn_op,.true.,mpi_i2amn_op,info)
if (info == 0) call mpi_op_create(psi_mamx_op,.true.,mpi_mamx_op,info)
@ -915,8 +854,7 @@ contains
if (info == 0) call mpi_op_create(psi_snrm2_op,.true.,mpi_snrm2_op,info)
if (info == 0) call mpi_op_create(psi_dnrm2_op,.true.,mpi_dnrm2_op,info)
#endif
end subroutine psi_register_mpi_extras
end subroutine psi_register_mpi_const
#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8)
subroutine psb_info_epk(ctxt,iam,np)
@ -941,13 +879,7 @@ contains
use psb_mat_mod
use psb_vect_mod
! !$ use psb_rsb_mod
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(out) :: ctxt
type(psb_ctxt_type), intent(in), optional :: basectxt
integer(psb_mpk_), intent(in), optional :: np, ids(:), extcomm
@ -965,7 +897,7 @@ contains
ctxt%ctxt = nctxt ! allocate on assignment
nctxt = nctxt + 1
call psi_register_mpi_extras(info)
call psi_register_mpi_const(nctxt,info)
call psi_get_sizes()
#else
@ -1054,7 +986,7 @@ contains
if (info == 0) then
ctxt%ctxt = icomm ! allocate on assignment
end if
call psi_register_mpi_extras(info)
call psi_register_mpi_const(icomm,info)
call psi_get_sizes()
!if (ctxt == mpi_comm_null) return
if (.not.allocated(ctxt%ctxt)) return
@ -1080,13 +1012,7 @@ contains
use psb_mat_mod
use psb_vect_mod
! !$ use psb_rsb_mod
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(inout) :: ctxt
logical, intent(in), optional :: close
logical :: close_
@ -1154,13 +1080,7 @@ contains
subroutine psb_barrier_mpik(ctxt)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_) :: info
@ -1175,13 +1095,7 @@ contains
function psb_wtime()
use psb_const_mod
! use mpi_constants
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_dpk_) :: psb_wtime
psb_wtime = mpi_wtime()
@ -1210,13 +1124,7 @@ contains
subroutine psb_info_mpik(ctxt,iam,np)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(out) :: iam, np
@ -1269,13 +1177,7 @@ contains
function psb_m_get_mpi_comm(ctxt) result(comm)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: comm
comm = mpi_comm_null
@ -1291,13 +1193,7 @@ contains
end function psb_m_get_mpi_rank
subroutine psb_get_mpicomm(ctxt,comm)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: comm
comm = mpi_comm_null

5
base/modules/psb_config.h.in
Unescape Escape View File

@ -4,6 +4,11 @@
#define PSB_ERR_ERROR -1
#define PSB_ERR_SUCCESS 0
#define PSB_VERSION_MAJOR @PSBLASMAJOR@
#define PSB_VERSION_MINOR @PSBLASMINOR@
#define PSB_VERSION_PATCHLEVEL @PSBLASPATCH@
#define PSB_VERSION_STRING @PSBLASSTRING@
@CSERIALMPI@
@PSB_IPKDEF@

17
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -35,7 +35,7 @@ module psb_const_mod
use iso_fortran_env
! This is a 2-byte integer, just in case
integer, parameter :: psb_i2pk_ = int16
! This is always a 4-byte integer, for MPI-related stuff
! This is always a 4-byte integer.
integer, parameter :: psb_mpk_ = int32
! This is always an 8-byte integer.
integer, parameter :: psb_epk_ = int64
@ -51,7 +51,7 @@ module psb_const_mod
! This is a 2-byte integer, just in case
integer, parameter :: i2ndig=4
integer, parameter :: psb_i2pk_ = selected_int_kind(i2ndig)
! This is always a 4-byte integer, for MPI-related stuff
! This is always a 4-byte integer.
integer, parameter :: indig=8
integer, parameter :: psb_mpk_ = selected_int_kind(indig)
! This is always an 8-byte integer.
@ -185,11 +185,12 @@ module psb_const_mod
! The up/down constant are defined in pairs having
! opposite values. We make use of this fact in the heapsort routine.
!
integer(psb_ipk_), parameter :: psb_sort_up_ = 1, psb_sort_down_ = -1
integer(psb_ipk_), parameter :: psb_lsort_up_ = 2, psb_lsort_down_ = -2
integer(psb_ipk_), parameter :: psb_asort_up_ = 3, psb_asort_down_ = -3
integer(psb_ipk_), parameter :: psb_alsort_up_ = 4, psb_alsort_down_ = -4
integer(psb_ipk_), parameter :: psb_sort_ovw_idx_ = 0, psb_sort_keep_idx_ = 1
integer(psb_ipk_), parameter :: psb_sort_up_ = 1, psb_sort_down_ = -1
integer(psb_ipk_), parameter :: psb_lsort_up_ = 2, psb_lsort_down_ = -2
integer(psb_ipk_), parameter :: psb_asort_up_ = 3, psb_asort_down_ = -3
integer(psb_ipk_), parameter :: psb_alsort_up_ = 4, psb_alsort_down_ = -4
integer(psb_ipk_), parameter :: psb_sort_ovw_idx_ = 0, psb_sort_keep_idx_ = 1
integer(psb_ipk_), parameter :: psb_sort_reord_x_ = 0, psb_sort_noreord_x_ = 1
integer(psb_ipk_), parameter :: psb_heap_resize = 200
integer(psb_ipk_), parameter :: psb_find_any_ = 0
integer(psb_ipk_), parameter :: psb_find_first_ge_ = 1
@ -282,7 +283,7 @@ module psb_const_mod
integer(psb_ipk_), parameter, public :: psb_err_parm_differs_among_procs_=550
integer(psb_ipk_), parameter, public :: psb_err_entry_out_of_bounds_=551
integer(psb_ipk_), parameter, public :: psb_err_inconsistent_index_lists_=552
integer(psb_ipk_), parameter, public :: psb_err_partfunc_toomuchprocs_=570
integer(psb_ipk_), parameter, public :: psb_err_partfunc_toomanyprocs_=570
integer(psb_ipk_), parameter, public :: psb_err_partfunc_toofewprocs_=575
integer(psb_ipk_), parameter, public :: psb_err_partfunc_wrong_pid_=580
integer(psb_ipk_), parameter, public :: psb_err_no_optional_arg_=581

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -750,7 +750,7 @@ contains
achmsg(1) = tmpmsg
write(achmsg(2),'("Index lists are inconsistent: some indices are orphans")')
case(psb_err_partfunc_toomuchprocs_)
case(psb_err_partfunc_toomanyprocs_)
allocate(achmsg(4))
achmsg(1) = tmpmsg
write(achmsg(2),&

17
base/modules/serial/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -912,6 +912,23 @@ module psb_c_csc_mat_mod
end subroutine psb_lc_csc_scals
end interface
interface
subroutine psb_ccscspspmm(a,b,c,info)
import
implicit none
class(psb_c_csc_sparse_mat), intent(in) :: a,b
type(psb_c_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccscspspmm
subroutine psb_lccscspspmm(a,b,c,info)
import
implicit none
class(psb_lc_csc_sparse_mat), intent(in) :: a,b
type(psb_lc_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lccscspspmm
end interface
contains
! == ===================================

17
base/modules/serial/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -1162,6 +1162,23 @@ module psb_c_csr_mat_mod
end subroutine psb_lc_csr_aclsum
end interface
! Interfaces for SPSPMM
interface
subroutine psb_ccsrspspmm(a,b,c,info)
import
implicit none
class(psb_c_csr_sparse_mat), intent(in) :: a,b
type(psb_c_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccsrspspmm
subroutine psb_lccsrspspmm(a,b,c,info)
import
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a,b
type(psb_lc_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lccsrspspmm
end interface
contains

7
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -78,6 +78,8 @@
!
module psb_c_mat_mod
use psb_c_vect_mod
use psb_i_vect_mod
use psb_c_base_mat_mod
use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat, psb_lc_csr_sparse_mat,&
& psb_c_ecsr_sparse_mat
@ -661,9 +663,8 @@ module psb_c_mat_mod
interface
subroutine psb_c_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
use psb_c_vect_mod, only : psb_c_vect_type
use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_ipk_, psb_lpk_, psb_cspmat_type
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, &
& psb_c_vect_type, psb_i_vect_type
class(psb_cspmat_type), intent(inout) :: a
type(psb_c_vect_type), intent(inout) :: val
type(psb_i_vect_type), intent(inout) :: ia, ja

46
base/modules/serial/psb_c_serial_mod.f90
Unescape Escape View File

@ -60,24 +60,8 @@ module psb_c_serial_mod
type(psb_cspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cspspmm
subroutine psb_ccsrspspmm(a,b,c,info)
use psb_c_mat_mod, only : psb_c_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_c_csr_sparse_mat), intent(in) :: a,b
type(psb_c_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccsrspspmm
subroutine psb_ccscspspmm(a,b,c,info)
use psb_c_mat_mod, only : psb_c_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_c_csc_sparse_mat), intent(in) :: a,b
type(psb_c_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ccscspspmm
end interface
end interface psb_spspmm
interface psb_symbmm
subroutine psb_csymbmm(a,b,c,info)
use psb_c_mat_mod, only : psb_cspmat_type
@ -114,6 +98,16 @@ module psb_c_serial_mod
end subroutine psb_cbase_numbmm
end interface psb_numbmm
interface psb_aplusat
subroutine psb_caplusat(ain,aout,info)
use psb_c_mat_mod, only : psb_cspmat_type
import :: psb_ipk_
implicit none
type(psb_cspmat_type) :: ain, aout
integer(psb_ipk_) :: info
end subroutine psb_caplusat
end interface
interface psb_rwextd
subroutine psb_crwextd(nr,a,info,b,rowscale)
use psb_c_mat_mod, only : psb_cspmat_type
@ -232,22 +226,6 @@ module psb_c_serial_mod
type(psb_lcspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lcspspmm
subroutine psb_lccsrspspmm(a,b,c,info)
use psb_c_mat_mod, only : psb_lc_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a,b
type(psb_lc_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lccsrspspmm
subroutine psb_lccscspspmm(a,b,c,info)
use psb_c_mat_mod, only : psb_lc_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lc_csc_sparse_mat), intent(in) :: a,b
type(psb_lc_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lccscspspmm
end interface psb_spspmm
interface psb_symbmm

17
base/modules/serial/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -912,6 +912,23 @@ module psb_d_csc_mat_mod
end subroutine psb_ld_csc_scals
end interface
interface
subroutine psb_dcscspspmm(a,b,c,info)
import
implicit none
class(psb_d_csc_sparse_mat), intent(in) :: a,b
type(psb_d_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcscspspmm
subroutine psb_ldcscspspmm(a,b,c,info)
import
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a,b
type(psb_ld_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcscspspmm
end interface
contains
! == ===================================

17
base/modules/serial/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -1162,6 +1162,23 @@ module psb_d_csr_mat_mod
end subroutine psb_ld_csr_aclsum
end interface
! Interfaces for SPSPMM
interface
subroutine psb_dcsrspspmm(a,b,c,info)
import
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a,b
type(psb_d_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcsrspspmm
subroutine psb_ldcsrspspmm(a,b,c,info)
import
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcsrspspmm
end interface
contains

7
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -78,6 +78,8 @@
!
module psb_d_mat_mod
use psb_d_vect_mod
use psb_i_vect_mod
use psb_d_base_mat_mod
use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat,&
& psb_d_ecsr_sparse_mat
@ -661,9 +663,8 @@ module psb_d_mat_mod
interface
subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
use psb_d_vect_mod, only : psb_d_vect_type
use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_ipk_, psb_lpk_, psb_dspmat_type
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, &
& psb_d_vect_type, psb_i_vect_type
class(psb_dspmat_type), intent(inout) :: a
type(psb_d_vect_type), intent(inout) :: val
type(psb_i_vect_type), intent(inout) :: ia, ja

46
base/modules/serial/psb_d_serial_mod.f90
Unescape Escape View File

@ -60,24 +60,8 @@ module psb_d_serial_mod
type(psb_dspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dspspmm
subroutine psb_dcsrspspmm(a,b,c,info)
use psb_d_mat_mod, only : psb_d_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a,b
type(psb_d_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcsrspspmm
subroutine psb_dcscspspmm(a,b,c,info)
use psb_d_mat_mod, only : psb_d_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_d_csc_sparse_mat), intent(in) :: a,b
type(psb_d_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_dcscspspmm
end interface
end interface psb_spspmm
interface psb_symbmm
subroutine psb_dsymbmm(a,b,c,info)
use psb_d_mat_mod, only : psb_dspmat_type
@ -114,6 +98,16 @@ module psb_d_serial_mod
end subroutine psb_dbase_numbmm
end interface psb_numbmm
interface psb_aplusat
subroutine psb_daplusat(ain,aout,info)
use psb_d_mat_mod, only : psb_dspmat_type
import :: psb_ipk_
implicit none
type(psb_dspmat_type) :: ain, aout
integer(psb_ipk_) :: info
end subroutine psb_daplusat
end interface
interface psb_rwextd
subroutine psb_drwextd(nr,a,info,b,rowscale)
use psb_d_mat_mod, only : psb_dspmat_type
@ -232,22 +226,6 @@ module psb_d_serial_mod
type(psb_ldspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldspspmm
subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_d_mat_mod, only : psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcsrspspmm
subroutine psb_ldcscspspmm(a,b,c,info)
use psb_d_mat_mod, only : psb_ld_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a,b
type(psb_ld_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcscspspmm
end interface psb_spspmm
interface psb_symbmm

17
base/modules/serial/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -912,6 +912,23 @@ module psb_s_csc_mat_mod
end subroutine psb_ls_csc_scals
end interface
interface
subroutine psb_scscspspmm(a,b,c,info)
import
implicit none
class(psb_s_csc_sparse_mat), intent(in) :: a,b
type(psb_s_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scscspspmm
subroutine psb_lscscspspmm(a,b,c,info)
import
implicit none
class(psb_ls_csc_sparse_mat), intent(in) :: a,b
type(psb_ls_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lscscspspmm
end interface
contains
! == ===================================

17
base/modules/serial/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -1162,6 +1162,23 @@ module psb_s_csr_mat_mod
end subroutine psb_ls_csr_aclsum
end interface
! Interfaces for SPSPMM
interface
subroutine psb_scsrspspmm(a,b,c,info)
import
implicit none
class(psb_s_csr_sparse_mat), intent(in) :: a,b
type(psb_s_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scsrspspmm
subroutine psb_lscsrspspmm(a,b,c,info)
import
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a,b
type(psb_ls_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lscsrspspmm
end interface
contains

7
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -78,6 +78,8 @@
!
module psb_s_mat_mod
use psb_s_vect_mod
use psb_i_vect_mod
use psb_s_base_mat_mod
use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat,&
& psb_s_ecsr_sparse_mat
@ -661,9 +663,8 @@ module psb_s_mat_mod
interface
subroutine psb_s_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
use psb_s_vect_mod, only : psb_s_vect_type
use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_ipk_, psb_lpk_, psb_sspmat_type
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, &
& psb_s_vect_type, psb_i_vect_type
class(psb_sspmat_type), intent(inout) :: a
type(psb_s_vect_type), intent(inout) :: val
type(psb_i_vect_type), intent(inout) :: ia, ja

46
base/modules/serial/psb_s_serial_mod.f90
Unescape Escape View File

@ -60,24 +60,8 @@ module psb_s_serial_mod
type(psb_sspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_sspspmm
subroutine psb_scsrspspmm(a,b,c,info)
use psb_s_mat_mod, only : psb_s_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_s_csr_sparse_mat), intent(in) :: a,b
type(psb_s_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scsrspspmm
subroutine psb_scscspspmm(a,b,c,info)
use psb_s_mat_mod, only : psb_s_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_s_csc_sparse_mat), intent(in) :: a,b
type(psb_s_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_scscspspmm
end interface
end interface psb_spspmm
interface psb_symbmm
subroutine psb_ssymbmm(a,b,c,info)
use psb_s_mat_mod, only : psb_sspmat_type
@ -114,6 +98,16 @@ module psb_s_serial_mod
end subroutine psb_sbase_numbmm
end interface psb_numbmm
interface psb_aplusat
subroutine psb_saplusat(ain,aout,info)
use psb_s_mat_mod, only : psb_sspmat_type
import :: psb_ipk_
implicit none
type(psb_sspmat_type) :: ain, aout
integer(psb_ipk_) :: info
end subroutine psb_saplusat
end interface
interface psb_rwextd
subroutine psb_srwextd(nr,a,info,b,rowscale)
use psb_s_mat_mod, only : psb_sspmat_type
@ -232,22 +226,6 @@ module psb_s_serial_mod
type(psb_lsspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lsspspmm
subroutine psb_lscsrspspmm(a,b,c,info)
use psb_s_mat_mod, only : psb_ls_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a,b
type(psb_ls_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lscsrspspmm
subroutine psb_lscscspspmm(a,b,c,info)
use psb_s_mat_mod, only : psb_ls_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ls_csc_sparse_mat), intent(in) :: a,b
type(psb_ls_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lscscspspmm
end interface psb_spspmm
interface psb_symbmm

17
base/modules/serial/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -912,6 +912,23 @@ module psb_z_csc_mat_mod
end subroutine psb_lz_csc_scals
end interface
interface
subroutine psb_zcscspspmm(a,b,c,info)
import
implicit none
class(psb_z_csc_sparse_mat), intent(in) :: a,b
type(psb_z_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcscspspmm
subroutine psb_lzcscspspmm(a,b,c,info)
import
implicit none
class(psb_lz_csc_sparse_mat), intent(in) :: a,b
type(psb_lz_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzcscspspmm
end interface
contains
! == ===================================

17
base/modules/serial/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -1162,6 +1162,23 @@ module psb_z_csr_mat_mod
end subroutine psb_lz_csr_aclsum
end interface
! Interfaces for SPSPMM
interface
subroutine psb_zcsrspspmm(a,b,c,info)
import
implicit none
class(psb_z_csr_sparse_mat), intent(in) :: a,b
type(psb_z_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcsrspspmm
subroutine psb_lzcsrspspmm(a,b,c,info)
import
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a,b
type(psb_lz_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzcsrspspmm
end interface
contains

7
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -78,6 +78,8 @@
!
module psb_z_mat_mod
use psb_z_vect_mod
use psb_i_vect_mod
use psb_z_base_mat_mod
use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat, psb_lz_csr_sparse_mat,&
& psb_z_ecsr_sparse_mat
@ -661,9 +663,8 @@ module psb_z_mat_mod
interface
subroutine psb_z_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
use psb_z_vect_mod, only : psb_z_vect_type
use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_ipk_, psb_lpk_, psb_zspmat_type
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, &
& psb_z_vect_type, psb_i_vect_type
class(psb_zspmat_type), intent(inout) :: a
type(psb_z_vect_type), intent(inout) :: val
type(psb_i_vect_type), intent(inout) :: ia, ja

46
base/modules/serial/psb_z_serial_mod.f90
Unescape Escape View File

@ -60,24 +60,8 @@ module psb_z_serial_mod
type(psb_zspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zspspmm
subroutine psb_zcsrspspmm(a,b,c,info)
use psb_z_mat_mod, only : psb_z_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_z_csr_sparse_mat), intent(in) :: a,b
type(psb_z_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcsrspspmm
subroutine psb_zcscspspmm(a,b,c,info)
use psb_z_mat_mod, only : psb_z_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_z_csc_sparse_mat), intent(in) :: a,b
type(psb_z_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_zcscspspmm
end interface
end interface psb_spspmm
interface psb_symbmm
subroutine psb_zsymbmm(a,b,c,info)
use psb_z_mat_mod, only : psb_zspmat_type
@ -114,6 +98,16 @@ module psb_z_serial_mod
end subroutine psb_zbase_numbmm
end interface psb_numbmm
interface psb_aplusat
subroutine psb_zaplusat(ain,aout,info)
use psb_z_mat_mod, only : psb_zspmat_type
import :: psb_ipk_
implicit none
type(psb_zspmat_type) :: ain, aout
integer(psb_ipk_) :: info
end subroutine psb_zaplusat
end interface
interface psb_rwextd
subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_z_mat_mod, only : psb_zspmat_type
@ -232,22 +226,6 @@ module psb_z_serial_mod
type(psb_lzspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzspspmm
subroutine psb_lzcsrspspmm(a,b,c,info)
use psb_z_mat_mod, only : psb_lz_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a,b
type(psb_lz_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzcsrspspmm
subroutine psb_lzcscspspmm(a,b,c,info)
use psb_z_mat_mod, only : psb_lz_csc_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lz_csc_sparse_mat), intent(in) :: a,b
type(psb_lz_csc_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzcscspspmm
end interface psb_spspmm
interface psb_symbmm

1
base/serial/Makefile
Unescape Escape View File

@ -11,6 +11,7 @@ FOBJS = psb_lsame.o psi_m_serial_impl.o psi_e_serial_impl.o \
smmp.o lsmmp.o \
psb_sgeprt.o psb_dgeprt.o psb_cgeprt.o psb_zgeprt.o\
psb_spdot_srtd.o psb_aspxpby.o psb_spge_dot.o\
psb_saplusat.o psb_daplusat.o psb_caplusat.o psb_zaplusat.o \
psb_samax_s.o psb_damax_s.o psb_camax_s.o psb_zamax_s.o \
psb_sasum_s.o psb_dasum_s.o psb_casum_s.o psb_zasum_s.o

8
base/serial/impl/psb_c_csc_impl.F90
Unescape Escape View File

@ -2824,8 +2824,8 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_c_csc_print
subroutine psb_ccscspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_ccscspspmm
use psb_c_csc_mat_mod, psb_protect_name => psb_ccscspspmm
use psb_serial_mod
implicit none
@ -4664,8 +4664,8 @@ subroutine psb_lc_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_lc_csc_print
subroutine psb_lccscspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_lccscspspmm
use psb_c_csc_mat_mod, psb_protect_name => psb_lccscspspmm
use psb_serial_mod
implicit none

28
base/serial/impl/psb_c_csr_impl.F90
Unescape Escape View File

@ -3657,8 +3657,8 @@ end subroutine psb_c_cp_csr_from_fmt
#if defined(PSB_OPENMP)
subroutine psb_ccsrspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_ccsrspspmm
use psb_c_csr_mat_mod, psb_protect_name => psb_ccsrspspmm
use psb_serial_mod
implicit none
@ -4204,8 +4204,8 @@ end subroutine psb_ccsrspspmm
#else
subroutine psb_ccsrspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_ccsrspspmm
use psb_c_csr_mat_mod, psb_protect_name => psb_ccsrspspmm
use psb_serial_mod
implicit none
@ -4238,7 +4238,7 @@ subroutine psb_ccsrspspmm(a,b,c,info)
! Estimate number of nonzeros on output.
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = max(nint(0.5*(nza+nzb)),ma,mb,na,nb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -4276,9 +4276,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0
@ -6580,8 +6580,8 @@ end subroutine psb_lc_cp_csr_from_fmt
!!$end subroutine psb_lc_csr_clean_zeros
subroutine psb_lccsrspspmm(a,b,c,info)
use psb_c_mat_mod
use psb_serial_mod, psb_protect_name => psb_lccsrspspmm
use psb_c_csr_mat_mod, psb_protect_name => psb_lccsrspspmm
use psb_serial_mod
implicit none
@ -6613,7 +6613,7 @@ subroutine psb_lccsrspspmm(a,b,c,info)
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = 2*(nza+nzb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -6651,9 +6651,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0

8
base/serial/impl/psb_d_csc_impl.F90
Unescape Escape View File

@ -2824,8 +2824,8 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_d_csc_print
subroutine psb_dcscspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_dcscspspmm
use psb_d_csc_mat_mod, psb_protect_name => psb_dcscspspmm
use psb_serial_mod
implicit none
@ -4664,8 +4664,8 @@ subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_ld_csc_print
subroutine psb_ldcscspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_ldcscspspmm
use psb_d_csc_mat_mod, psb_protect_name => psb_ldcscspspmm
use psb_serial_mod
implicit none

28
base/serial/impl/psb_d_csr_impl.F90
Unescape Escape View File

@ -3657,8 +3657,8 @@ end subroutine psb_d_cp_csr_from_fmt
#if defined(PSB_OPENMP)
subroutine psb_dcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
use psb_d_csr_mat_mod, psb_protect_name => psb_dcsrspspmm
use psb_serial_mod
implicit none
@ -4204,8 +4204,8 @@ end subroutine psb_dcsrspspmm
#else
subroutine psb_dcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
use psb_d_csr_mat_mod, psb_protect_name => psb_dcsrspspmm
use psb_serial_mod
implicit none
@ -4238,7 +4238,7 @@ subroutine psb_dcsrspspmm(a,b,c,info)
! Estimate number of nonzeros on output.
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = max(nint(0.5*(nza+nzb)),ma,mb,na,nb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -4276,9 +4276,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0
@ -6580,8 +6580,8 @@ end subroutine psb_ld_cp_csr_from_fmt
!!$end subroutine psb_ld_csr_clean_zeros
subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_ldcsrspspmm
use psb_d_csr_mat_mod, psb_protect_name => psb_ldcsrspspmm
use psb_serial_mod
implicit none
@ -6613,7 +6613,7 @@ subroutine psb_ldcsrspspmm(a,b,c,info)
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = 2*(nza+nzb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -6651,9 +6651,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0

8
base/serial/impl/psb_s_csc_impl.F90
Unescape Escape View File

@ -2824,8 +2824,8 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_s_csc_print
subroutine psb_scscspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_scscspspmm
use psb_s_csc_mat_mod, psb_protect_name => psb_scscspspmm
use psb_serial_mod
implicit none
@ -4664,8 +4664,8 @@ subroutine psb_ls_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_ls_csc_print
subroutine psb_lscscspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_lscscspspmm
use psb_s_csc_mat_mod, psb_protect_name => psb_lscscspspmm
use psb_serial_mod
implicit none

28
base/serial/impl/psb_s_csr_impl.F90
Unescape Escape View File

@ -3657,8 +3657,8 @@ end subroutine psb_s_cp_csr_from_fmt
#if defined(PSB_OPENMP)
subroutine psb_scsrspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_scsrspspmm
use psb_s_csr_mat_mod, psb_protect_name => psb_scsrspspmm
use psb_serial_mod
implicit none
@ -4204,8 +4204,8 @@ end subroutine psb_scsrspspmm
#else
subroutine psb_scsrspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_scsrspspmm
use psb_s_csr_mat_mod, psb_protect_name => psb_scsrspspmm
use psb_serial_mod
implicit none
@ -4238,7 +4238,7 @@ subroutine psb_scsrspspmm(a,b,c,info)
! Estimate number of nonzeros on output.
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = max(nint(0.5*(nza+nzb)),ma,mb,na,nb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -4276,9 +4276,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0
@ -6580,8 +6580,8 @@ end subroutine psb_ls_cp_csr_from_fmt
!!$end subroutine psb_ls_csr_clean_zeros
subroutine psb_lscsrspspmm(a,b,c,info)
use psb_s_mat_mod
use psb_serial_mod, psb_protect_name => psb_lscsrspspmm
use psb_s_csr_mat_mod, psb_protect_name => psb_lscsrspspmm
use psb_serial_mod
implicit none
@ -6613,7 +6613,7 @@ subroutine psb_lscsrspspmm(a,b,c,info)
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = 2*(nza+nzb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -6651,9 +6651,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0

8
base/serial/impl/psb_z_csc_impl.F90
Unescape Escape View File

@ -2824,8 +2824,8 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_z_csc_print
subroutine psb_zcscspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_zcscspspmm
use psb_z_csc_mat_mod, psb_protect_name => psb_zcscspspmm
use psb_serial_mod
implicit none
@ -4664,8 +4664,8 @@ subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc)
end subroutine psb_lz_csc_print
subroutine psb_lzcscspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_lzcscspspmm
use psb_z_csc_mat_mod, psb_protect_name => psb_lzcscspspmm
use psb_serial_mod
implicit none

28
base/serial/impl/psb_z_csr_impl.F90
Unescape Escape View File

@ -3657,8 +3657,8 @@ end subroutine psb_z_cp_csr_from_fmt
#if defined(PSB_OPENMP)
subroutine psb_zcsrspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_zcsrspspmm
use psb_z_csr_mat_mod, psb_protect_name => psb_zcsrspspmm
use psb_serial_mod
implicit none
@ -4204,8 +4204,8 @@ end subroutine psb_zcsrspspmm
#else
subroutine psb_zcsrspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_zcsrspspmm
use psb_z_csr_mat_mod, psb_protect_name => psb_zcsrspspmm
use psb_serial_mod
implicit none
@ -4238,7 +4238,7 @@ subroutine psb_zcsrspspmm(a,b,c,info)
! Estimate number of nonzeros on output.
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = max(nint(0.5*(nza+nzb)),ma,mb,na,nb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -4276,9 +4276,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0
@ -6580,8 +6580,8 @@ end subroutine psb_lz_cp_csr_from_fmt
!!$end subroutine psb_lz_csr_clean_zeros
subroutine psb_lzcsrspspmm(a,b,c,info)
use psb_z_mat_mod
use psb_serial_mod, psb_protect_name => psb_lzcsrspspmm
use psb_z_csr_mat_mod, psb_protect_name => psb_lzcsrspspmm
use psb_serial_mod
implicit none
@ -6613,7 +6613,7 @@ subroutine psb_lzcsrspspmm(a,b,c,info)
nza = a%get_nzeros()
nzb = b%get_nzeros()
nzc = 2*(nza+nzb)
nzc = max(nint(0.25*(nza+nzb)),ma,nb)
call c%allocate(ma,nb,nzc)
call csr_spspmm(a,b,c,info)
@ -6651,9 +6651,9 @@ contains
nze = min(size(c%val),size(c%ja))
isz = max(ma,na,mb,nb)
call psb_realloc(isz,row,info)
if (info == 0) call psb_realloc(isz,idxs,info)
if (info == 0) call psb_realloc(isz,irow,info)
call psb_realloc(nb,row,info)
if (info == 0) call psb_realloc(max(na,nb),idxs,info)
if (info == 0) call psb_realloc(nb,irow,info)
if (info /= 0) return
row = dzero
irow = 0

50
base/serial/psb_caplusat.f90
Unescape Escape View File

@ -0,0 +1,50 @@
subroutine psb_caplusat(ain,aout,info)
use psb_c_mat_mod
implicit none
type(psb_cspmat_type), intent(inout) :: ain
type(psb_cspmat_type), intent(out) :: aout
integer(psb_ipk_) :: info
type(psb_c_coo_sparse_mat) :: acoo1, acoo2
integer(psb_ipk_) :: nr, nc, nz1, nz2
integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err
name='psb_caplusat'
info = psb_success_
call psb_erractionsave(err_act)
nr = ain%get_nrows()
nc = ain%get_ncols()
if (nr /= nc) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
call ain%cp_to(acoo1)
call acoo1%cp_to_coo(acoo2,info)
nz1 = acoo1%get_nzeros()
nz2 = acoo2%get_nzeros()
call acoo1%reallocate(nz1+nz2)
acoo1%ia(nz1+1:nz1+nz2) = acoo2%ja(1:nz2)
acoo1%ja(nz1+1:nz1+nz2) = acoo2%ia(1:nz2)
acoo1%val(nz1+1:nz1+nz2) = acoo2%val(1:nz2)
call acoo1%set_nrows(nr)
call acoo1%set_ncols(nr)
call acoo1%set_nzeros(nz1+nz2)
call aout%cp_from(acoo1)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_caplusat

9
base/serial/psb_cspspmm.f90 → base/serial/psb_cspspmm.F90
Unescape Escape View File

@ -37,9 +37,9 @@
!
subroutine psb_cspspmm(a,b,c,info)
use psb_mat_mod
use psb_c_csr_mat_mod
use psb_c_csc_mat_mod
use psb_c_serial_mod, psb_protect_name => psb_cspspmm
implicit none
type(psb_cspmat_type), intent(in) :: a,b
type(psb_cspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
@ -48,6 +48,8 @@ subroutine psb_cspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
@ -118,6 +120,8 @@ end subroutine psb_cspspmm
subroutine psb_lcspspmm(a,b,c,info)
use psb_mat_mod
use psb_c_csr_mat_mod
use psb_c_csc_mat_mod
use psb_c_serial_mod, psb_protect_name => psb_lcspspmm
implicit none
@ -129,6 +133,7 @@ subroutine psb_lcspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_

1
base/serial/psb_csymbmm.f90
Unescape Escape View File

@ -85,6 +85,7 @@ end subroutine psb_csymbmm
subroutine psb_cbase_symbmm(a,b,c,info)
use psb_mat_mod
use psb_sort_mod
use psb_serial_mod, only : symbmm
implicit none
class(psb_c_base_sparse_mat), intent(in) :: a,b

50
base/serial/psb_daplusat.f90
Unescape Escape View File

@ -0,0 +1,50 @@
subroutine psb_daplusat(ain,aout,info)
use psb_d_mat_mod
implicit none
type(psb_dspmat_type), intent(inout) :: ain
type(psb_dspmat_type), intent(out) :: aout
integer(psb_ipk_) :: info
type(psb_d_coo_sparse_mat) :: acoo1, acoo2
integer(psb_ipk_) :: nr, nc, nz1, nz2
integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err
name='psb_daplusat'
info = psb_success_
call psb_erractionsave(err_act)
nr = ain%get_nrows()
nc = ain%get_ncols()
if (nr /= nc) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
call ain%cp_to(acoo1)
call acoo1%cp_to_coo(acoo2,info)
nz1 = acoo1%get_nzeros()
nz2 = acoo2%get_nzeros()
call acoo1%reallocate(nz1+nz2)
acoo1%ia(nz1+1:nz1+nz2) = acoo2%ja(1:nz2)
acoo1%ja(nz1+1:nz1+nz2) = acoo2%ia(1:nz2)
acoo1%val(nz1+1:nz1+nz2) = acoo2%val(1:nz2)
call acoo1%set_nrows(nr)
call acoo1%set_ncols(nr)
call acoo1%set_nzeros(nz1+nz2)
call aout%cp_from(acoo1)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_daplusat

9
base/serial/psb_dspspmm.f90 → base/serial/psb_dspspmm.F90
Unescape Escape View File

@ -37,9 +37,9 @@
!
subroutine psb_dspspmm(a,b,c,info)
use psb_mat_mod
use psb_d_csr_mat_mod
use psb_d_csc_mat_mod
use psb_d_serial_mod, psb_protect_name => psb_dspspmm
implicit none
type(psb_dspmat_type), intent(in) :: a,b
type(psb_dspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
@ -48,6 +48,8 @@ subroutine psb_dspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
@ -118,6 +120,8 @@ end subroutine psb_dspspmm
subroutine psb_ldspspmm(a,b,c,info)
use psb_mat_mod
use psb_d_csr_mat_mod
use psb_d_csc_mat_mod
use psb_d_serial_mod, psb_protect_name => psb_ldspspmm
implicit none
@ -129,6 +133,7 @@ subroutine psb_ldspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_

1
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -85,6 +85,7 @@ end subroutine psb_dsymbmm
subroutine psb_dbase_symbmm(a,b,c,info)
use psb_mat_mod
use psb_sort_mod
use psb_serial_mod, only : symbmm
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a,b

50
base/serial/psb_saplusat.f90
Unescape Escape View File

@ -0,0 +1,50 @@
subroutine psb_saplusat(ain,aout,info)
use psb_s_mat_mod
implicit none
type(psb_sspmat_type), intent(inout) :: ain
type(psb_sspmat_type), intent(out) :: aout
integer(psb_ipk_) :: info
type(psb_s_coo_sparse_mat) :: acoo1, acoo2
integer(psb_ipk_) :: nr, nc, nz1, nz2
integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err
name='psb_saplusat'
info = psb_success_
call psb_erractionsave(err_act)
nr = ain%get_nrows()
nc = ain%get_ncols()
if (nr /= nc) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
call ain%cp_to(acoo1)
call acoo1%cp_to_coo(acoo2,info)
nz1 = acoo1%get_nzeros()
nz2 = acoo2%get_nzeros()
call acoo1%reallocate(nz1+nz2)
acoo1%ia(nz1+1:nz1+nz2) = acoo2%ja(1:nz2)
acoo1%ja(nz1+1:nz1+nz2) = acoo2%ia(1:nz2)
acoo1%val(nz1+1:nz1+nz2) = acoo2%val(1:nz2)
call acoo1%set_nrows(nr)
call acoo1%set_ncols(nr)
call acoo1%set_nzeros(nz1+nz2)
call aout%cp_from(acoo1)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_saplusat

9
base/serial/psb_sspspmm.f90 → base/serial/psb_sspspmm.F90
Unescape Escape View File

@ -37,9 +37,9 @@
!
subroutine psb_sspspmm(a,b,c,info)
use psb_mat_mod
use psb_s_csr_mat_mod
use psb_s_csc_mat_mod
use psb_s_serial_mod, psb_protect_name => psb_sspspmm
implicit none
type(psb_sspmat_type), intent(in) :: a,b
type(psb_sspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
@ -48,6 +48,8 @@ subroutine psb_sspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
@ -118,6 +120,8 @@ end subroutine psb_sspspmm
subroutine psb_lsspspmm(a,b,c,info)
use psb_mat_mod
use psb_s_csr_mat_mod
use psb_s_csc_mat_mod
use psb_s_serial_mod, psb_protect_name => psb_lsspspmm
implicit none
@ -129,6 +133,7 @@ subroutine psb_lsspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_

1
base/serial/psb_ssymbmm.f90
Unescape Escape View File

@ -85,6 +85,7 @@ end subroutine psb_ssymbmm
subroutine psb_sbase_symbmm(a,b,c,info)
use psb_mat_mod
use psb_sort_mod
use psb_serial_mod, only : symbmm
implicit none
class(psb_s_base_sparse_mat), intent(in) :: a,b

50
base/serial/psb_zaplusat.f90
Unescape Escape View File

@ -0,0 +1,50 @@
subroutine psb_zaplusat(ain,aout,info)
use psb_z_mat_mod
implicit none
type(psb_zspmat_type), intent(inout) :: ain
type(psb_zspmat_type), intent(out) :: aout
integer(psb_ipk_) :: info
type(psb_z_coo_sparse_mat) :: acoo1, acoo2
integer(psb_ipk_) :: nr, nc, nz1, nz2
integer(psb_ipk_) :: err_act
character(len=20) :: name, ch_err
name='psb_zaplusat'
info = psb_success_
call psb_erractionsave(err_act)
nr = ain%get_nrows()
nc = ain%get_ncols()
if (nr /= nc) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
call ain%cp_to(acoo1)
call acoo1%cp_to_coo(acoo2,info)
nz1 = acoo1%get_nzeros()
nz2 = acoo2%get_nzeros()
call acoo1%reallocate(nz1+nz2)
acoo1%ia(nz1+1:nz1+nz2) = acoo2%ja(1:nz2)
acoo1%ja(nz1+1:nz1+nz2) = acoo2%ia(1:nz2)
acoo1%val(nz1+1:nz1+nz2) = acoo2%val(1:nz2)
call acoo1%set_nrows(nr)
call acoo1%set_ncols(nr)
call acoo1%set_nzeros(nz1+nz2)
call aout%cp_from(acoo1)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_zaplusat

9
base/serial/psb_zspspmm.f90 → base/serial/psb_zspspmm.F90
Unescape Escape View File

@ -37,9 +37,9 @@
!
subroutine psb_zspspmm(a,b,c,info)
use psb_mat_mod
use psb_z_csr_mat_mod
use psb_z_csc_mat_mod
use psb_z_serial_mod, psb_protect_name => psb_zspspmm
implicit none
type(psb_zspmat_type), intent(in) :: a,b
type(psb_zspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
@ -48,6 +48,8 @@ subroutine psb_zspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
@ -118,6 +120,8 @@ end subroutine psb_zspspmm
subroutine psb_lzspspmm(a,b,c,info)
use psb_mat_mod
use psb_z_csr_mat_mod
use psb_z_csc_mat_mod
use psb_z_serial_mod, psb_protect_name => psb_lzspspmm
implicit none
@ -129,6 +133,7 @@ subroutine psb_lzspspmm(a,b,c,info)
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_

1
base/serial/psb_zsymbmm.f90
Unescape Escape View File

@ -85,6 +85,7 @@ end subroutine psb_zsymbmm
subroutine psb_zbase_symbmm(a,b,c,info)
use psb_mat_mod
use psb_sort_mod
use psb_serial_mod, only : symbmm
implicit none
class(psb_z_base_sparse_mat), intent(in) :: a,b

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save