fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 04:12:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/Makefile
 base/modules/Makefile
 base/modules/psb_base_mod.f90
 base/modules/psb_linmap_mod.f90
 base/modules/psb_linmap_type_mod.f90
 base/modules/psb_mat_mod.f03
 base/modules/psb_psblas_mod.f90
 base/modules/psb_serial_mod.f90
 base/modules/psb_tools_mod.f90
 base/psblas/psb_cnrmi.f90
 base/psblas/psb_cspmm.f90
 base/psblas/psb_cspsm.f90
 base/psblas/psb_dnrmi.f90
 base/psblas/psb_dspsm.f90
 base/psblas/psb_snrmi.f90
 base/psblas/psb_sspmm.f90
 base/psblas/psb_sspsm.f90
 base/psblas/psb_znrmi.f90
 base/psblas/psb_zspmm.f90
 base/psblas/psb_zspsm.f90
 base/serial/Makefile
 base/serial/dp/Makefile
 base/serial/dp/gen_block.f
 base/serial/dp/partition.f
 base/serial/dp/scrjd.f
 base/serial/f77/Makefile
 base/serial/psb_cest.f90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cins.f90
 base/tools/psb_cspalloc.f90
 base/tools/psb_cspasb.f90
 base/tools/psb_cspfree.f90
 base/tools/psb_csphalo.F90
 base/tools/psb_cspins.f90
 base/tools/psb_csprn.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dins.f90
 base/tools/psb_dspalloc.f90
 base/tools/psb_dspasb.f90
 base/tools/psb_dspfree.f90
 base/tools/psb_dsphalo.F90
 base/tools/psb_dspins.f90
 base/tools/psb_dsprn.f90
 base/tools/psb_iins.f90
 base/tools/psb_linmap.f90
 base/tools/psb_scdbldext.F90
 base/tools/psb_sins.f90
 base/tools/psb_sspalloc.f90
 base/tools/psb_sspasb.f90
 base/tools/psb_sspfree.f90
 base/tools/psb_ssphalo.F90
 base/tools/psb_sspins.f90
 base/tools/psb_ssprn.f90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zins.f90
 base/tools/psb_zspalloc.f90
 base/tools/psb_zspasb.f90
 base/tools/psb_zspfree.f90
 base/tools/psb_zsphalo.F90
 base/tools/psb_zspins.f90
 base/tools/psb_zsprn.f90
 krylov/psb_cbicg.f90
 krylov/psb_ccg.f90
 krylov/psb_ccgs.f90
 krylov/psb_ccgstab.f90
 krylov/psb_ccgstabl.f90
 krylov/psb_crgmres.f90
 krylov/psb_dbicg.f90
 krylov/psb_dcg.F90
 krylov/psb_dcgs.f90
 krylov/psb_dcgstab.F90
 krylov/psb_dcgstabl.f90
 krylov/psb_drgmres.f90
 krylov/psb_krylov_mod.f90
 krylov/psb_sbicg.f90
 krylov/psb_scg.F90
 krylov/psb_scgs.f90
 krylov/psb_scgstab.F90
 krylov/psb_scgstabl.f90
 krylov/psb_srgmres.f90
 krylov/psb_zbicg.f90
 krylov/psb_zcg.F90
 krylov/psb_zcgs.f90
 krylov/psb_zcgstab.f90
 krylov/psb_zcgstabl.f90
 krylov/psb_zrgmres.f90
 prec/psb_cbjac_aply.f90
 prec/psb_cbjac_bld.f90
 prec/psb_cdiagsc_bld.f90
 prec/psb_cilu_fct.f90
 prec/psb_cprecbld.f90
 prec/psb_prec_mod.f90
 prec/psb_prec_type.f90
 prec/psb_zbjac_aply.f90
 prec/psb_zbjac_bld.f90
 prec/psb_zdiagsc_bld.f90
 prec/psb_zilu_fct.f90
 prec/psb_zprecbld.f90
 test/fileread/cf_sample.f90
 test/fileread/zf_sample.f90
 test/util/zhb2mm.f90
 test/util/zmm2hb.f90
 util/psb_hbio_mod.f90
 util/psb_mat_dist_mod.f90
 util/psb_metispart_mod.F90
 util/psb_mmio_mod.f90


complex version. 
Now the basic test appear to work. 
Next: move to MLD
This commit is contained in:
Salvatore Filippone
2009-09-25 17:03:30 +00:00
parent 35ea6ac5d6
commit 1e91812924
106 changed files with 1355 additions and 2371 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/Makefile
+1 -3
View File
@@ -7,11 +7,10 @@ LIBMOD=psb_base_mod$(.mod)
lib:
(cd modules; make lib LIBNAME=$(BASELIBNAME) F90=$(MPF90) F90COPT="$(F90COPT) $(MPI_OPT)")
(cd serial; make lib LIBNAME=$(BASELIBNAME))
# (cd newserial; make lib LIBNAME=$(BASELIBNAME) )
(cd comm; make lib LIBNAME=$(BASELIBNAME))
(cd internals; make lib LIBNAME=$(BASELIBNAME))
(cd tools; make lib LIBNAME=$(BASELIBNAME))
(cd psblas; make lib LIBNAME=$(BASELIBNAME))
(cd tools; make lib LIBNAME=$(BASELIBNAME))
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
/bin/cp -p $(LIBMOD) *$(.mod) $(LIBDIR)
@@ -22,7 +21,6 @@ clean:
(cd tools; make clean)
(cd serial; make clean)
(cd psblas; make clean)
# (cd newserial; make clean)
veryclean: clean
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod)
base/modules/Makefile
+5 -5
View File
@@ -1,7 +1,7 @@
include ../../Make.inc
BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o
UTIL_MODS = psb_string_mod.o psb_spmat_type.o \
UTIL_MODS = psb_string_mod.o \
psb_desc_type.o psb_sort_mod.o psb_penv_mod.o \
psb_serial_mod.o psb_tools_mod.o psb_blacs_mod.o \
psb_linmap_type_mod.o psb_comm_mod.o psb_psblas_mod.o \
@@ -52,12 +52,12 @@ psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o psb_serial_mod.o
psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o psb_hash_mod.o
psb_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o
psb_linmap_type_mod.o: psb_desc_type.o psb_spmat_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o
psb_linmap_type_mod.o: psb_desc_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o
psb_check_mod.o: psb_desc_type.o
psb_serial_mod.o: psb_spmat_type.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o
psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o
psb_sort_mod.o: psb_error_mod.o psb_realloc_mod.o psb_const_mod.o
psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o psb_gps_mod.o psb_linmap_mod.o psb_mat_mod.o
psb_psblas_mod.o: psb_mat_mod.o psb_spmat_type.o psb_desc_type.o
psb_tools_mod.o: psb_desc_type.o psi_mod.o psb_gps_mod.o psb_linmap_mod.o psb_mat_mod.o
psb_psblas_mod.o: psb_mat_mod.o psb_desc_type.o
psb_gps_mod.o: psb_realloc_mod.o
psb_hash_mod.o: psb_const_mod.o psb_realloc_mod.o
base/modules/psb_base_mod.f90
+1 -1
View File
@@ -36,10 +36,10 @@ module psb_base_mod
use psb_check_mod
use psb_descriptor_type
use psb_linmap_mod
use psb_mat_mod
use psb_serial_mod
use psb_comm_mod
use psb_psblas_mod
use psb_gps_mod
use psb_tools_mod
use psb_mat_mod
end module psb_base_mod
base/modules/psb_linmap_mod.f90
+11 -7
View File
@@ -37,7 +37,7 @@
!
module psb_linmap_mod
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_const_mod
use psb_descriptor_type
use psb_linmap_type_mod
@@ -183,7 +183,7 @@ module psb_linmap_mod
implicit none
type(psb_clinmap_type) :: psb_c_linmap
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
end function psb_c_linmap
@@ -192,7 +192,7 @@ module psb_linmap_mod
implicit none
type(psb_zlinmap_type) :: psb_z_linmap
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
end function psb_z_linmap
@@ -491,6 +491,7 @@ contains
end function psb_dlinmap_sizeof
function psb_clinmap_sizeof(map) result(val)
use psb_mat_mod
implicit none
type(psb_clinmap_type), intent(in) :: map
integer(psb_long_int_k_) :: val
@@ -510,6 +511,7 @@ contains
end function psb_clinmap_sizeof
function psb_zlinmap_sizeof(map) result(val)
use psb_mat_mod
implicit none
type(psb_zlinmap_type), intent(in) :: map
integer(psb_long_int_k_) :: val
@@ -556,7 +558,7 @@ contains
implicit none
type(psb_clinmap_type), intent(out) :: out_map
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr)
@@ -567,7 +569,7 @@ contains
implicit none
type(psb_zlinmap_type), intent(out) :: out_map
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr)
@@ -619,7 +621,8 @@ contains
end subroutine psb_dlinmap_transfer
subroutine psb_clinmap_transfer(mapin,mapout,info)
use psb_spmat_type
use psb_realloc_mod
use psb_mat_mod
use psb_descriptor_type
implicit none
type(psb_clinmap_type) :: mapin,mapout
@@ -640,7 +643,8 @@ contains
end subroutine psb_clinmap_transfer
subroutine psb_zlinmap_transfer(mapin,mapout,info)
use psb_spmat_type
use psb_realloc_mod
use psb_mat_mod
use psb_descriptor_type
implicit none
type(psb_zlinmap_type) :: mapin,mapout
base/modules/psb_linmap_type_mod.f90
+4 -5
View File
@@ -36,9 +36,8 @@
! to different spaces.
!
module psb_linmap_type_mod
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_mat_mod, only: psb_d_sparse_mat, psb_s_sparse_mat
use psb_const_mod
use psb_mat_mod, only: psb_d_sparse_mat, psb_s_sparse_mat, psb_z_sparse_mat, psb_c_sparse_mat
use psb_descriptor_type, only: psb_desc_type
@@ -72,14 +71,14 @@ module psb_linmap_type_mod
integer, allocatable :: itd_data(:), iaggr(:), naggr(:)
type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null()
type(psb_desc_type) :: desc_X, desc_Y
type(psb_cspmat_type) :: map_X2Y, map_Y2X
type(psb_c_sparse_mat) :: map_X2Y, map_Y2X
end type psb_clinmap_type
type psb_zlinmap_type
integer, allocatable :: itd_data(:), iaggr(:), naggr(:)
type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null()
type(psb_desc_type) :: desc_X, desc_Y
type(psb_zspmat_type) :: map_X2Y, map_Y2X
type(psb_z_sparse_mat) :: map_X2Y, map_Y2X
end type psb_zlinmap_type
end module psb_linmap_type_mod
base/modules/psb_mat_mod.f03
+1 -1
View File
@@ -1,4 +1,4 @@
module psb_mat_mod
module psb_mat_mod
use psb_s_mat_mod
use psb_d_mat_mod
use psb_c_mat_mod
base/modules/psb_psblas_mod.f90
+28 -18
View File
@@ -599,16 +599,18 @@ module psb_psblas_mod
function psb_cnrmi(a, desc_a,info)
use psb_serial_mod
use psb_descriptor_type
use psb_mat_mod
real(psb_spk_) :: psb_cnrmi
type(psb_cspmat_type), intent (in) :: a
type(psb_c_sparse_mat), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer, intent(out) :: info
end function psb_cnrmi
function psb_znrmi(a, desc_a,info)
use psb_serial_mod
use psb_descriptor_type
use psb_mat_mod
real(psb_dpk_) :: psb_znrmi
type(psb_zspmat_type), intent (in) :: a
type(psb_z_sparse_mat), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer, intent(out) :: info
end function psb_znrmi
@@ -681,7 +683,8 @@ module psb_psblas_mod
&trans, k, jx, jy,work,doswap)
use psb_serial_mod
use psb_descriptor_type
type(psb_cspmat_type), intent(in) :: a
use psb_mat_mod
type(psb_c_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(inout) :: x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_spk_), intent(in) :: alpha, beta
@@ -696,7 +699,8 @@ module psb_psblas_mod
& desc_a, info, trans, work,doswap)
use psb_serial_mod
use psb_descriptor_type
type(psb_cspmat_type), intent(in) :: a
use psb_mat_mod
type(psb_c_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(inout) :: x(:)
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), intent(in) :: alpha, beta
@@ -710,7 +714,8 @@ module psb_psblas_mod
&trans, k, jx, jy,work,doswap)
use psb_serial_mod
use psb_descriptor_type
type(psb_zspmat_type), intent(in) :: a
use psb_mat_mod
type(psb_z_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(inout) :: x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -725,7 +730,8 @@ module psb_psblas_mod
& desc_a, info, trans, work,doswap)
use psb_serial_mod
use psb_descriptor_type
type(psb_zspmat_type), intent(in) :: a
use psb_mat_mod
type(psb_z_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(inout) :: x(:)
complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -805,63 +811,67 @@ module psb_psblas_mod
integer, intent(out) :: info
end subroutine psb_dspsv
subroutine psb_cspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,&
& desc_a, info, trans, side, choice,&
& diag, n, jx, jy, work)
use psb_serial_mod
use psb_descriptor_type
type(psb_cspmat_type), intent(in) :: t
use psb_mat_mod
type(psb_c_sparse_mat), intent(in) :: t
complex(psb_spk_), intent(in) :: x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
complex(psb_spk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a
character, optional, intent(in) :: trans, unit
character, optional, intent(in) :: trans, side
integer, optional, intent(in) :: n, jx, jy
integer, optional, intent(in) :: choice
complex(psb_spk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info
end subroutine psb_cspsm
subroutine psb_cspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,&
& desc_a, info, trans, side, choice,&
& diag, work)
use psb_serial_mod
use psb_descriptor_type
type(psb_cspmat_type), intent(in) :: t
use psb_mat_mod
type(psb_c_sparse_mat), intent(in) :: t
complex(psb_spk_), intent(in) :: x(:)
complex(psb_spk_), intent(inout) :: y(:)
complex(psb_spk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a
character, optional, intent(in) :: trans, unit
character, optional, intent(in) :: trans, side
integer, optional, intent(in) :: choice
complex(psb_spk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info
end subroutine psb_cspsv
subroutine psb_zspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,&
& desc_a, info, trans, side, choice,&
& diag, n, jx, jy, work)
use psb_serial_mod
use psb_descriptor_type
type(psb_zspmat_type), intent(in) :: t
use psb_mat_mod
type(psb_z_sparse_mat), intent(in) :: t
complex(psb_dpk_), intent(in) :: x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
complex(psb_dpk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a
character, optional, intent(in) :: trans, unit
character, optional, intent(in) :: trans, side
integer, optional, intent(in) :: n, jx, jy
integer, optional, intent(in) :: choice
complex(psb_dpk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info
end subroutine psb_zspsm
subroutine psb_zspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,&
& desc_a, info, trans, side, choice,&
& diag, work)
use psb_serial_mod
use psb_descriptor_type
type(psb_zspmat_type), intent(in) :: t
use psb_mat_mod
type(psb_z_sparse_mat), intent(in) :: t
complex(psb_dpk_), intent(in) :: x(:)
complex(psb_dpk_), intent(inout) :: y(:)
complex(psb_dpk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a
character, optional, intent(in) :: trans, unit
character, optional, intent(in) :: trans, side
integer, optional, intent(in) :: choice
complex(psb_dpk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info
base/modules/psb_serial_mod.f90
+3 -975
View File
@@ -31,7 +31,8 @@
!!$
module psb_serial_mod
use psb_const_mod
use psb_spmat_type
use psb_error_mod
use psb_realloc_mod
use psb_string_mod
use psb_sort_mod
@@ -39,979 +40,6 @@ module psb_serial_mod
& psb_gth => psi_gth,&
& psb_sct => psi_sct
interface psb_csrws
!!$ subroutine psb_dcsrws(rw,a,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a
!!$ real(psb_dpk_), allocatable :: rw(:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_dcsrws
subroutine psb_zcsrws(rw,a,info,trans)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a
complex(psb_dpk_), allocatable :: rw(:)
integer :: info
character, optional :: trans
end subroutine psb_zcsrws
end interface
!!$ interface psb_cssm
!!$ subroutine psb_scssm(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: t
!!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ real(psb_spk_), optional, target :: d(:)
!!$ end subroutine psb_scssm
!!$ subroutine psb_scssv(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: t
!!$ real(psb_spk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ real(psb_spk_), optional, target :: d(:)
!!$ end subroutine psb_scssv
!!$ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: t
!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ real(psb_dpk_), optional, target :: d(:)
!!$ end subroutine psb_dcssm
!!$ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: t
!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ real(psb_dpk_), optional, target :: d(:)
!!$ end subroutine psb_dcssv
!!$ subroutine psb_ccssm(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_cspmat_type) :: t
!!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ complex(psb_spk_), optional, target :: d(:)
!!$ end subroutine psb_ccssm
!!$ subroutine psb_ccssv(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_cspmat_type) :: t
!!$ complex(psb_spk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ complex(psb_spk_), optional, target :: d(:)
!!$ end subroutine psb_ccssv
!!$ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_zspmat_type) :: t
!!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ complex(psb_dpk_), optional, target :: d(:)
!!$ end subroutine psb_zcssm
!!$ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_zspmat_type) :: t
!!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans, unitd
!!$ complex(psb_dpk_), optional, target :: d(:)
!!$ end subroutine psb_zcssv
!!$ end interface
!!$ interface psb_csmm
!!$ module procedure psb_scsmm, psb_scsmv, psb_dcsmm, psb_dcsmv,&
!!$ & psb_ccsmm, psb_ccsmv, psb_zcsmm, psb_zcsmv
!!$ subroutine psb_scsmv(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: a
!!$ real(psb_spk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_scsmv
!!$ subroutine psb_scsmm(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: a
!!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_scsmm
!!$ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a
!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_dcsmv
!!$ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a
!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_dcsmm
!!$ subroutine psb_ccsmv(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_cspmat_type) :: a
!!$ complex(psb_spk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_ccsmv
!!$ subroutine psb_ccsmm(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_cspmat_type) :: a
!!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_ccsmm
!!$ subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_zspmat_type) :: a
!!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_zcsmv
!!$ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_zspmat_type) :: a
!!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:)
!!$ integer :: info
!!$ character, optional :: trans
!!$ end subroutine psb_zcsmm
!!$ end interface
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character(len=*), intent(inout) :: afmt
end subroutine psb_cest
end interface
interface psb_spcnv
!!$ subroutine psb_sspcnv2(ain, a, info, afmt, upd, dupl)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent (in) :: ain
!!$ type(psb_sspmat_type), intent (out) :: a
!!$ integer, intent(out) :: info
!!$ integer,optional, intent(in) :: dupl, upd
!!$ character(len=*), optional, intent(in) :: afmt
!!$ end subroutine psb_sspcnv2
!!$ subroutine psb_sspcnv1(a, info, afmt, upd, dupl)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent (inout) :: a
!!$ integer, intent(out) :: info
!!$ integer,optional, intent(in) :: dupl, upd
!!$ character(len=*), optional, intent(in) :: afmt
!!$ end subroutine psb_sspcnv1
!!$ subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent (in) :: ain
!!$ type(psb_dspmat_type), intent (out) :: a
!!$ integer, intent(out) :: info
!!$ integer,optional, intent(in) :: dupl, upd
!!$ character(len=*), optional, intent(in) :: afmt
!!$ end subroutine psb_dspcnv2
!!$ subroutine psb_dspcnv1(a, info, afmt, upd, dupl)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent (inout) :: a
!!$ integer, intent(out) :: info
!!$ integer,optional, intent(in) :: dupl, upd
!!$ character(len=*), optional, intent(in) :: afmt
!!$ end subroutine psb_dspcnv1
subroutine psb_cspcnv2(ain, a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent (in) :: ain
type(psb_cspmat_type), intent (out) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
end subroutine psb_cspcnv2
subroutine psb_cspcnv1(a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent (inout) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
end subroutine psb_cspcnv1
subroutine psb_zspcnv2(ain, a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent (in) :: ain
type(psb_zspmat_type), intent (out) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
end subroutine psb_zspcnv2
subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent (inout) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
end subroutine psb_zspcnv1
end interface
interface psb_fixcoo
!!$ subroutine psb_sfixcoo(a,info,idir)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: idir
!!$ end subroutine psb_sfixcoo
!!$ subroutine psb_dfixcoo(a,info,idir)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: idir
!!$ end subroutine psb_dfixcoo
subroutine psb_cfixcoo(a,info,idir)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
end subroutine psb_cfixcoo
subroutine psb_zfixcoo(a,info,idir)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
end subroutine psb_zfixcoo
end interface
interface psb_ipcoo2csr
!!$ subroutine psb_sipcoo2csr(a,info,rwshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ logical, optional :: rwshr
!!$ end subroutine psb_sipcoo2csr
!!$ subroutine psb_dipcoo2csr(a,info,rwshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ logical, optional :: rwshr
!!$ end subroutine psb_dipcoo2csr
subroutine psb_cipcoo2csr(a,info,rwshr)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional :: rwshr
end subroutine psb_cipcoo2csr
subroutine psb_zipcoo2csr(a,info,rwshr)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional :: rwshr
end subroutine psb_zipcoo2csr
end interface
interface psb_ipcoo2csc
!!$ subroutine psb_sipcoo2csc(a,info,clshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ logical, optional :: clshr
!!$ end subroutine psb_sipcoo2csc
!!$ subroutine psb_dipcoo2csc(a,info,clshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ logical, optional :: clshr
!!$ end subroutine psb_dipcoo2csc
subroutine psb_cipcoo2csc(a,info,clshr)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional :: clshr
end subroutine psb_cipcoo2csc
subroutine psb_zipcoo2csc(a,info,clshr)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional :: clshr
end subroutine psb_zipcoo2csc
end interface
interface psb_ipcsr2coo
!!$ subroutine psb_sipcsr2coo(a,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ end subroutine psb_sipcsr2coo
!!$ subroutine psb_dipcsr2coo(a,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dipcsr2coo
subroutine psb_cipcsr2coo(a,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
end subroutine psb_cipcsr2coo
subroutine psb_zipcsr2coo(a,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
end subroutine psb_zipcsr2coo
end interface
interface psb_csprt
!!$ subroutine psb_scsprt(iout,a,iv,irs,ics,head,ivr,ivc)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: iout
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ integer, intent(in), optional :: iv(:)
!!$ integer, intent(in), optional :: irs,ics
!!$ character(len=*), optional :: head
!!$ integer, intent(in), optional :: ivr(:),ivc(:)
!!$ end subroutine psb_scsprt
!!$ subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: iout
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ integer, intent(in), optional :: iv(:)
!!$ integer, intent(in), optional :: irs,ics
!!$ character(len=*), optional :: head
!!$ integer, intent(in), optional :: ivr(:),ivc(:)
!!$ end subroutine psb_dcsprt
subroutine psb_ccsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: iout
type(psb_cspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: irs,ics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_ccsprt
subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: iout
type(psb_zspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: irs,ics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_zcsprt
end interface
interface psb_neigh
!!$ subroutine psb_sneigh(a,idx,neigh,n,info,lev)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ integer, intent(in) :: idx
!!$ integer, intent(out) :: n
!!$ integer, allocatable :: neigh(:)
!!$ integer, intent(out) :: info
!!$ integer, optional, intent(in) :: lev
!!$ end subroutine psb_sneigh
!!$ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ integer, intent(in) :: idx
!!$ integer, intent(out) :: n
!!$ integer, allocatable :: neigh(:)
!!$ integer, intent(out) :: info
!!$ integer, optional, intent(in) :: lev
!!$ end subroutine psb_dneigh
subroutine psb_cneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
end subroutine psb_cneigh
subroutine psb_zneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
end subroutine psb_zneigh
end interface
interface psb_coins
!!$ subroutine psb_scoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: nz, imin,imax,jmin,jmax
!!$ integer, intent(in) :: ia(:),ja(:)
!!$ real(psb_spk_), intent(in) :: val(:)
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: gtl(:)
!!$ logical, optional, intent(in) :: rebuild
!!$ end subroutine psb_scoins
!!$ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: nz, imin,imax,jmin,jmax
!!$ integer, intent(in) :: ia(:),ja(:)
!!$ real(psb_dpk_), intent(in) :: val(:)
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: gtl(:)
!!$ logical, optional, intent(in) :: rebuild
!!$ end subroutine psb_dcoins
subroutine psb_ccoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:)
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
logical, optional, intent(in) :: rebuild
end subroutine psb_ccoins
subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
logical, optional, intent(in) :: rebuild
end subroutine psb_zcoins
end interface
interface psb_symbmm
!!$ subroutine psb_ssymbmm(a,b,c,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: a,b,c
!!$ integer :: info
!!$ end subroutine psb_ssymbmm
!!$ subroutine psb_dsymbmm(a,b,c,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a,b,c
!!$ integer :: info
!!$ end subroutine psb_dsymbmm
subroutine psb_csymbmm(a,b,c,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type) :: a,b,c
integer :: info
end subroutine psb_csymbmm
subroutine psb_zsymbmm(a,b,c,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a,b,c
integer :: info
end subroutine psb_zsymbmm
end interface
interface psb_numbmm
!!$ subroutine psb_snumbmm(a,b,c)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type) :: a,b,c
!!$ end subroutine psb_snumbmm
!!$ subroutine psb_dnumbmm(a,b,c)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a,b,c
!!$ end subroutine psb_dnumbmm
subroutine psb_cnumbmm(a,b,c)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type) :: a,b,c
end subroutine psb_cnumbmm
subroutine psb_znumbmm(a,b,c)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a,b,c
end subroutine psb_znumbmm
end interface
interface psb_transp
!!$ subroutine psb_stransp(a,b,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ type(psb_sspmat_type), intent(out) :: b
!!$ integer, optional :: c
!!$ character(len=*), optional :: fmt
!!$ end subroutine psb_stransp
!!$ subroutine psb_dtransp(a,b,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ type(psb_dspmat_type), intent(out) :: b
!!$ integer, optional :: c
!!$ character(len=*), optional :: fmt
!!$ end subroutine psb_dtransp
subroutine psb_ctransp(a,b,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ctransp
subroutine psb_ztransp(a,b,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ztransp
!!$ subroutine psb_stransp1(a,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, optional :: c
!!$ character(len=*), optional :: fmt
!!$ end subroutine psb_stransp1
!!$ subroutine psb_dtransp1(a,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, optional :: c
!!$ character(len=*), optional :: fmt
!!$ end subroutine psb_dtransp1
subroutine psb_ctransp1(a,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ctransp1
subroutine psb_ztransp1(a,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ztransp1
end interface
interface psb_transc
subroutine psb_ctransc(a,b,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ctransc
subroutine psb_ztransc(a,b,c,fmt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, optional :: c
character(len=*), optional :: fmt
end subroutine psb_ztransc
end interface
interface psb_rwextd
!!$ subroutine psb_srwextd(nr,a,info,b,rowscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: nr
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ type(psb_sspmat_type), intent(in), optional :: b
!!$ logical, intent(in), optional :: rowscale
!!$ end subroutine psb_srwextd
!!$ subroutine psb_drwextd(nr,a,info,b,rowscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ integer, intent(in) :: nr
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ type(psb_dspmat_type), intent(in), optional :: b
!!$ logical, intent(in), optional :: rowscale
!!$ end subroutine psb_drwextd
subroutine psb_crwextd(nr,a,info,b,rowscale)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nr
type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info
type(psb_cspmat_type), intent(in), optional :: b
logical, intent(in), optional :: rowscale
end subroutine psb_crwextd
subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nr
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), optional :: b
logical, intent(in), optional :: rowscale
end subroutine psb_zrwextd
end interface
interface psb_csnmi
!!$ function psb_scsnmi(a,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ integer, intent(out) :: info
!!$ character, optional :: trans
!!$ real(psb_spk_) :: psb_scsnmi
!!$ end function psb_scsnmi
!!$ function psb_dcsnmi(a,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ integer, intent(out) :: info
!!$ character, optional :: trans
!!$ real(psb_dpk_) :: psb_dcsnmi
!!$ end function psb_dcsnmi
function psb_ccsnmi(a,info,trans)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
integer, intent(out) :: info
character, optional :: trans
real(psb_spk_) :: psb_ccsnmi
end function psb_ccsnmi
function psb_zcsnmi(a,info,trans)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
integer, intent(out) :: info
character, optional :: trans
real(psb_dpk_) :: psb_zcsnmi
end function psb_zcsnmi
end interface
interface psb_sp_clip
!!$ subroutine psb_sspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ implicit none
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ type(psb_sspmat_type), intent(out) :: b
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: imin,imax,jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ end subroutine psb_sspclip
!!$ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ implicit none
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ type(psb_dspmat_type), intent(out) :: b
!!$ integer, intent(out) :: info
!!$ integer, intent(in), optional :: imin,imax,jmin,jmax
!!$ logical, intent(in), optional :: rscale,cscale
!!$ end subroutine psb_dspclip
subroutine psb_cspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_cspclip
subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_zspclip
end interface
interface psb_sp_getdiag
!!$ subroutine psb_sspgtdiag(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ real(psb_spk_), intent(inout) :: d(:)
!!$ integer, intent(out) :: info
!!$ end subroutine psb_sspgtdiag
!!$ subroutine psb_dspgtdiag(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ real(psb_dpk_), intent(inout) :: d(:)
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspgtdiag
subroutine psb_cspgtdiag(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_cspgtdiag
subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspgtdiag
end interface
interface psb_sp_scal
!!$ subroutine psb_sspscals(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ real(psb_spk_), intent(in) :: d
!!$ integer, intent(out) :: info
!!$ end subroutine psb_sspscals
!!$ subroutine psb_sspscal(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(inout) :: a
!!$ real(psb_spk_), intent(in) :: d(:)
!!$ integer, intent(out) :: info
!!$ end subroutine psb_sspscal
!!$ subroutine psb_dspscals(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ real(psb_dpk_), intent(in) :: d
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspscals
!!$ subroutine psb_dspscal(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ real(psb_dpk_), intent(in) :: d(:)
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspscal
subroutine psb_cspscals(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer, intent(out) :: info
end subroutine psb_cspscals
subroutine psb_cspscal(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_cspscal
subroutine psb_zspscals(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer, intent(out) :: info
end subroutine psb_zspscals
subroutine psb_zspscal(a,d,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspscal
end interface
interface psb_sp_setbld
!!$ subroutine psb_dspsetbld1(a,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspsetbld1
!!$ subroutine psb_dspsetbld2(a,b,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ type(psb_dspmat_type), intent(out) :: b
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspsetbld2
subroutine psb_zspsetbld1(a,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
end subroutine psb_zspsetbld1
subroutine psb_zspsetbld2(a,b,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info
end subroutine psb_zspsetbld2
end interface
interface psb_sp_shift
!!$ subroutine psb_dspshift(alpha,a,beta,b,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ type(psb_dspmat_type), intent(out) :: b
!!$ real(psb_dpk_), intent(in) :: alpha, beta
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dspshift
subroutine psb_zspshift(alpha,a,beta,b,info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
complex(psb_dpk_), intent(in) :: alpha, beta
integer, intent(out) :: info
end subroutine psb_zspshift
end interface
interface psb_sp_getblk
!!$ subroutine psb_sspgtblk(irw,a,b,info,append,iren,lrw,srt)
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ integer, intent(in) :: irw
!!$ type(psb_sspmat_type), intent(inout) :: b
!!$ integer, intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer, intent(in), target, optional :: iren(:)
!!$ integer, intent(in), optional :: lrw
!!$ logical, intent(in), optional :: srt
!!$ end subroutine psb_sspgtblk
!!$ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ integer, intent(in) :: irw
!!$ type(psb_dspmat_type), intent(inout) :: b
!!$ integer, intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer, intent(in), target, optional :: iren(:)
!!$ integer, intent(in), optional :: lrw
!!$ logical, intent(in), optional :: srt
!!$ end subroutine psb_dspgtblk
subroutine psb_cspgtblk(irw,a,b,info,append,iren,lrw,srt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_cspmat_type), intent(inout) :: b
integer, intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
logical, intent(in), optional :: srt
end subroutine psb_cspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
integer, intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
logical, intent(in), optional :: srt
end subroutine psb_zspgtblk
end interface
interface psb_sp_getrow
!!$ subroutine psb_sspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
!!$ ! Output is always in COO format
!!$ use psb_spmat_type, only : psb_sspmat_type, &
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ implicit none
!!$
!!$ type(psb_sspmat_type), intent(in) :: a
!!$ integer, intent(in) :: irw
!!$ integer, intent(out) :: nz
!!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
!!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
!!$ integer,intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer, intent(in), optional :: iren(:)
!!$ integer, intent(in), optional :: lrw, nzin
!!$ end subroutine psb_sspgetrow
!!$ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
!!$ ! Output is always in COO format
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ implicit none
!!$
!!$ type(psb_dspmat_type), intent(in) :: a
!!$ integer, intent(in) :: irw
!!$ integer, intent(out) :: nz
!!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
!!$ real(psb_dpk_), allocatable, intent(inout) :: val(:)
!!$ integer,intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer, intent(in), optional :: iren(:)
!!$ integer, intent(in), optional :: lrw, nzin
!!$ end subroutine psb_dspgetrow
subroutine psb_cspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
! Output is always in COO format
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none
type(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: lrw, nzin
end subroutine psb_cspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
! Output is always in COO format
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: lrw, nzin
end subroutine psb_zspgetrow
end interface
interface psb_csrp
!!$ subroutine psb_dcsrp(trans,iperm,a, info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type), intent(inout) :: a
!!$ integer, intent(inout) :: iperm(:), info
!!$ character, intent(in) :: trans
!!$ end subroutine psb_dcsrp
subroutine psb_zcsrp(trans,iperm,a, info)
use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a
integer, intent(inout) :: iperm(:), info
character, intent(in) :: trans
end subroutine psb_zcsrp
end interface
use psb_mat_mod
end module psb_serial_mod
base/modules/psb_tools_mod.f90
+190 -58
View File
@@ -31,7 +31,7 @@
!!$
Module psb_tools_mod
use psb_const_mod
use psb_spmat_type
interface psb_cd_set_bld
subroutine psb_cd_set_bld(desc,info)
@@ -243,9 +243,9 @@ Module psb_tools_mod
Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_descriptor_type
use psb_spmat_type
Type(psb_cspmat_type),Intent(in) :: a
Type(psb_cspmat_type),Intent(inout) :: blk
use psb_mat_mod
Type(psb_c_sparse_mat),Intent(in) :: a
Type(psb_c_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in) :: desc_a
integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@@ -255,9 +255,9 @@ Module psb_tools_mod
Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_descriptor_type
use psb_spmat_type
Type(psb_zspmat_type),Intent(in) :: a
Type(psb_zspmat_type),Intent(inout) :: blk
use psb_mat_mod
Type(psb_z_sparse_mat),Intent(in) :: a
Type(psb_z_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in) :: desc_a
integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@@ -497,9 +497,9 @@ Module psb_tools_mod
end Subroutine psb_dcdbldext
Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype)
use psb_descriptor_type
Use psb_spmat_type
use psb_mat_mod
integer, intent(in) :: novr
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info
@@ -507,9 +507,9 @@ Module psb_tools_mod
end Subroutine psb_ccdbldext
Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype)
use psb_descriptor_type
Use psb_spmat_type
Use psb_mat_mod
integer, intent(in) :: novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info
@@ -548,7 +548,6 @@ Module psb_tools_mod
end subroutine psb_sspalloc
subroutine psb_dspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_d_sparse_mat), intent(out) :: a
@@ -557,17 +556,17 @@ Module psb_tools_mod
end subroutine psb_dspalloc
subroutine psb_cspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(out) :: a
type(psb_c_sparse_mat), intent(out) :: a
integer, intent(out) :: info
integer, optional, intent(in) :: nnz
end subroutine psb_cspalloc
subroutine psb_zspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(out) :: a
type(psb_z_sparse_mat), intent(out) :: a
integer, intent(out) :: info
integer, optional, intent(in) :: nnz
end subroutine psb_zspalloc
@@ -586,7 +585,6 @@ Module psb_tools_mod
end subroutine psb_sspasb
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_d_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a
@@ -597,8 +595,8 @@ Module psb_tools_mod
end subroutine psb_dspasb
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl)
use psb_descriptor_type
use psb_spmat_type
type(psb_cspmat_type), intent (inout) :: a
use psb_mat_mod
type(psb_c_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
@@ -606,8 +604,8 @@ Module psb_tools_mod
end subroutine psb_cspasb
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
use psb_descriptor_type
use psb_spmat_type
type(psb_zspmat_type), intent (inout) :: a
use psb_mat_mod
type(psb_z_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
@@ -629,7 +627,6 @@ Module psb_tools_mod
end subroutine psb_sspfree
subroutine psb_dspfree(a, desc_a,info)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_d_sparse_mat), intent(inout) :: a
@@ -637,16 +634,16 @@ Module psb_tools_mod
end subroutine psb_dspfree
subroutine psb_cspfree(a, desc_a,info)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) ::a
type(psb_c_sparse_mat), intent(inout) ::a
integer, intent(out) :: info
end subroutine psb_cspfree
subroutine psb_zspfree(a, desc_a,info)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) ::a
type(psb_z_sparse_mat), intent(inout) ::a
integer, intent(out) :: info
end subroutine psb_zspfree
end interface
@@ -675,7 +672,6 @@ Module psb_tools_mod
end subroutine psb_sspins_2desc
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_d_sparse_mat), intent(inout) :: a
@@ -696,9 +692,9 @@ Module psb_tools_mod
end subroutine psb_dspins_2desc
subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info
@@ -706,19 +702,19 @@ Module psb_tools_mod
end subroutine psb_cspins
subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info
end subroutine psb_cspins_2desc
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:)
integer, intent(out) :: info
@@ -726,10 +722,10 @@ Module psb_tools_mod
end subroutine psb_zspins
subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:)
integer, intent(out) :: info
@@ -756,17 +752,17 @@ Module psb_tools_mod
end subroutine psb_dsprn
subroutine psb_csprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
logical, intent(in), optional :: clear
end subroutine psb_csprn
subroutine psb_zsprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_spmat_type
use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
logical, intent(in), optional :: clear
end subroutine psb_zsprn
@@ -875,15 +871,15 @@ Module psb_tools_mod
interface psb_linmap_init
module procedure psb_dlinmap_init, psb_zlinmap_init
module procedure psb_slinmap_init, psb_clinmap_init, psb_dlinmap_init, psb_zlinmap_init
end interface
interface psb_linmap_ins
module procedure psb_dlinmap_ins, psb_zlinmap_ins
module procedure psb_slinmap_ins, psb_clinmap_ins, psb_dlinmap_ins, psb_zlinmap_ins
end interface
interface psb_linmap_asb
module procedure psb_dlinmap_asb, psb_zlinmap_asb
module procedure psb_slinmap_asb, psb_clinmap_asb, psb_dlinmap_asb, psb_zlinmap_asb
end interface
interface psb_is_owned
@@ -1158,6 +1154,73 @@ contains
end subroutine psb_cdasb
subroutine psb_slinmap_init(a_map,cd_xt,descin,descout)
use psb_descriptor_type
use psb_serial_mod
use psb_penv_mod
use psb_error_mod
use psb_mat_mod
implicit none
type(psb_s_sparse_mat), intent(out) :: a_map
type(psb_desc_type), intent(out) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
integer :: nrow_in, nrow_out, ncol_in, info, ictxt
ictxt = psb_cd_get_context(descin)
call psb_cdcpy(descin,cd_xt,info)
if (info ==0) call psb_cd_reinit(cd_xt,info)
if (info /= 0) then
write(0,*) 'Error on reinitialising the extension map'
call psb_error(ictxt)
call psb_abort(ictxt)
stop
end if
nrow_in = psb_cd_get_local_rows(cd_xt)
ncol_in = psb_cd_get_local_cols(cd_xt)
nrow_out = psb_cd_get_local_rows(descout)
call a_map%csall(nrow_out,ncol_in,info)
end subroutine psb_slinmap_init
subroutine psb_slinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout)
use psb_mat_mod
use psb_descriptor_type
implicit none
integer, intent(in) :: nz
integer, intent(in) :: ir(:),ic(:)
real(psb_spk_), intent(in) :: val(:)
type(psb_s_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
integer :: info
call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info)
end subroutine psb_slinmap_ins
subroutine psb_slinmap_asb(a_map,cd_xt,descin,descout,afmt)
use psb_mat_mod
use psb_descriptor_type
use psb_serial_mod
implicit none
type(psb_s_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
character(len=*), optional, intent(in) :: afmt
integer :: nrow_in, nrow_out, ncol_in, info, ictxt
ictxt = psb_cd_get_context(descin)
call psb_cdasb(cd_xt,info)
call a_map%set_ncols(psb_cd_get_local_cols(cd_xt))
call a_map%cscnv(info,type=afmt)
end subroutine psb_slinmap_asb
subroutine psb_dlinmap_init(a_map,cd_xt,descin,descout)
use psb_descriptor_type
use psb_serial_mod
@@ -1195,7 +1258,7 @@ contains
implicit none
integer, intent(in) :: nz
integer, intent(in) :: ir(:),ic(:)
real(kind(1.d0)), intent(in) :: val(:)
real(psb_dpk_), intent(in) :: val(:)
type(psb_d_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
@@ -1225,14 +1288,14 @@ contains
end subroutine psb_dlinmap_asb
subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout)
use psb_spmat_type
subroutine psb_clinmap_init(a_map,cd_xt,descin,descout)
use psb_mat_mod
use psb_descriptor_type
use psb_serial_mod
use psb_penv_mod
use psb_error_mod
implicit none
type(psb_zspmat_type), intent(out) :: a_map
type(psb_c_sparse_mat), intent(out) :: a_map
type(psb_desc_type), intent(out) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
@@ -1253,32 +1316,32 @@ contains
ncol_in = psb_cd_get_local_cols(cd_xt)
nrow_out = psb_cd_get_local_rows(descout)
call psb_sp_all(nrow_out,ncol_in,a_map,info)
call a_map%csall(nrow_out,ncol_in,info)
end subroutine psb_zlinmap_init
end subroutine psb_clinmap_init
subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout)
use psb_spmat_type
subroutine psb_clinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout)
use psb_mat_mod
use psb_descriptor_type
implicit none
integer, intent(in) :: nz
integer, intent(in) :: ir(:),ic(:)
complex(kind(1.d0)), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a_map
complex(psb_spk_), intent(in) :: val(:)
type(psb_c_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
integer :: info
call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info)
end subroutine psb_zlinmap_ins
end subroutine psb_clinmap_ins
subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt)
use psb_spmat_type
subroutine psb_clinmap_asb(a_map,cd_xt,descin,descout,afmt)
use psb_mat_mod
use psb_descriptor_type
use psb_serial_mod
implicit none
type(psb_zspmat_type), intent(inout) :: a_map
type(psb_c_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
character(len=*), optional, intent(in) :: afmt
@@ -1288,8 +1351,77 @@ contains
ictxt = psb_cd_get_context(descin)
call psb_cdasb(cd_xt,info)
a_map%k = psb_cd_get_local_cols(cd_xt)
call psb_spcnv(a_map,info,afmt=afmt)
call a_map%set_ncols(psb_cd_get_local_cols(cd_xt))
call a_map%cscnv(info,type=afmt)
end subroutine psb_clinmap_asb
subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout)
use psb_mat_mod
use psb_descriptor_type
use psb_serial_mod
use psb_penv_mod
use psb_error_mod
implicit none
type(psb_z_sparse_mat), intent(out) :: a_map
type(psb_desc_type), intent(out) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
integer :: nrow_in, nrow_out, ncol_in, info, ictxt
ictxt = psb_cd_get_context(descin)
call psb_cdcpy(descin,cd_xt,info)
if (info ==0) call psb_cd_reinit(cd_xt,info)
if (info /= 0) then
write(0,*) 'Error on reinitialising the extension map'
call psb_error(ictxt)
call psb_abort(ictxt)
stop
end if
nrow_in = psb_cd_get_local_rows(cd_xt)
ncol_in = psb_cd_get_local_cols(cd_xt)
nrow_out = psb_cd_get_local_rows(descout)
call a_map%csall(nrow_out,ncol_in,info)
end subroutine psb_zlinmap_init
subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout)
use psb_mat_mod
use psb_descriptor_type
implicit none
integer, intent(in) :: nz
integer, intent(in) :: ir(:),ic(:)
complex(psb_dpk_), intent(in) :: val(:)
type(psb_z_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
integer :: info
call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info)
end subroutine psb_zlinmap_ins
subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt)
use psb_mat_mod
use psb_descriptor_type
use psb_serial_mod
implicit none
type(psb_z_sparse_mat), intent(inout) :: a_map
type(psb_desc_type), intent(inout) :: cd_xt
type(psb_desc_type), intent(in) :: descin, descout
character(len=*), optional, intent(in) :: afmt
integer :: nrow_in, nrow_out, ncol_in, info, ictxt
ictxt = psb_cd_get_context(descin)
call psb_cdasb(cd_xt,info)
call a_map%set_ncols(psb_cd_get_local_cols(cd_xt))
call a_map%cscnv(info,type=afmt)
end subroutine psb_zlinmap_asb
base/psblas/psb_cnrmi.f90
+4 -4
View File
@@ -47,9 +47,10 @@ function psb_cnrmi(a,desc_a,info)
use psb_check_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: psb_cnrmi
@@ -94,8 +95,7 @@ function psb_cnrmi(a,desc_a,info)
end if
if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a,info)
nrmi = psb_csnmi(a)
if(info /= 0) then
info=4010
ch_err='psb_csnmi'
@@ -103,7 +103,7 @@ function psb_cnrmi(a,desc_a,info)
goto 9999
end if
else
nrmi = 0.d0
nrmi = 0.0
end if
! compute global max
base/psblas/psb_cspmm.f90
+10 -13
View File
@@ -65,7 +65,6 @@
subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
& trans, k, jx, jy, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
@@ -74,12 +73,13 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(inout), target :: x(:,:)
complex(psb_spk_), intent(inout), target :: y(:,:)
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_spk_), optional, target :: work(:)
@@ -250,7 +250,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) exit blk
! local Matrix-vector product
call a%csmm(alpha,x(:,jjx+i-1:jjx+i-1+ib-1),&
call psb_csmm(alpha,a,x(:,jjx+i-1:jjx+i-1+ib-1),&
& beta,y(:,jjy+i-1:jjy+i-1+ib-1),info,trans=trans_)
if(info /= 0) exit blk
@@ -265,9 +265,8 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,czero,x(:,1:ik),desc_a,iwork,info)
if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info)
if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
end if
if(info /= 0) then
info = 4011
call psb_errpush(info,name)
@@ -313,7 +312,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = czero
if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= 0) then
@@ -413,7 +412,7 @@ end subroutine psb_cspmm
!
! Arguments:
! alpha - complex The scalar alpha.
! a - type(psb_cspmat_type). The sparse matrix containing A.
! a - type(psb_c_sparse_mat). The sparse matrix containing A.
! x(:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:) - complex The input vector containing the entries of ( Y ).
@@ -426,8 +425,6 @@ end subroutine psb_cspmm
subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
& trans, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
use psb_const_mod
@@ -436,12 +433,13 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(inout), target :: x(:)
complex(psb_spk_), intent(inout), target :: y(:)
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_spk_), optional, target :: work(:)
@@ -582,8 +580,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
& czero,x,desc_a,iwork,info,data=psb_comm_halo_)
end if
! local Matrix-vector product
call a%csmm(alpha,x(iix:lldx),beta,y(iiy:lldy),info)
call psb_csmm(alpha,a,x,beta,y,info)
if(info /= 0) then
info = 4011
@@ -632,7 +629,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
yp(nrow+1:ncol) = czero
! local Matrix-vector product
if (info == 0) call a%csmm(alpha,x,beta,yp,info,trans=trans_)
if (info == 0) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
base/psblas/psb_cspsm.f90
+23 -27
View File
@@ -57,14 +57,14 @@
!
! Arguments:
! alpha - complex. The scalar alpha.
! a - type(psb_cspmat_type). The sparse matrix containing A.
! a - type(psb_c_sparse_mat). The sparse matrix containing A.
! x(:,:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:,:) - complex The input vector containing the entries of ( Y ).
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! trans - character(optional). Whether A or A'. If not present 'N' is assumed.
! unitd - character(optional). Specify some type of operation with
! side - character(optional). Specify some type of operation with
! the diagonal matrix D.
! choice - integer(optional). The kind of update to perform on overlap elements.
! d(:) - complex, optional Matrix for diagonal scaling.
@@ -74,10 +74,8 @@
! work(:) - complex, optional Working area.
!
subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, diag, k, jx, jy, work)
& trans, side, choice, diag, k, jx, jy, work)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
use psi_mod
@@ -85,17 +83,18 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(in), target :: x(:,:)
complex(psb_spk_), intent(inout), target :: y(:,:)
type (psb_cspmat_type), intent(in) :: a
type (psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_spk_), intent(in), optional, target :: diag(:)
complex(psb_spk_), optional, target :: work(:)
character, intent(in), optional :: trans, unitd
character, intent(in), optional :: trans, side
integer, intent(in), optional :: choice
integer, intent(in), optional :: k, jx, jy
@@ -105,7 +104,7 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd
character :: lside
integer, parameter :: nb=4
complex(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
character :: itrans
@@ -157,10 +156,10 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_
endif
if (present(unitd)) then
lunitd = psb_toupper(unitd)
if (present(side)) then
lside = psb_toupper(side)
else
lunitd = 'U'
lside = 'U'
endif
if (present(trans)) then
@@ -191,8 +190,6 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
! check for presence/size of a work area
iwork => null()
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
@@ -258,11 +255,11 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans)
call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans)
if(info /= 0) then
info = 4010
ch_err='zcssm'
ch_err='cssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@@ -349,23 +346,21 @@ end subroutine psb_cspsm
!
! Arguments:
! alpha - complex. The scalar alpha.
! a - type(psb_cspmat_type). The sparse matrix containing A.
! a - type(psb_c_sparse_mat). The sparse matrix containing A.
! x(:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:) - complex The input vector containing the entries of ( Y ).
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! trans - character(optional). Whether A or A'. If not present 'N' is assumed.
! unitd - character(optional). Specify some type of operation with
! side - character(optional). Specify some type of operation with
! the diagonal matrix D.
! choice - integer(optional). The kind of update to perform on overlap elements.
! d(:) - complex, optional Matrix for diagonal scaling.
! work(:) - complex, optional Working area.
!
subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, diag, work)
use psb_spmat_type
use psb_serial_mod
& trans, side, choice, diag, work)
use psb_descriptor_type
use psb_comm_mod
use psi_mod
@@ -373,17 +368,18 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_spk_), intent(in) :: alpha, beta
complex(psb_spk_), intent(in), target :: x(:)
complex(psb_spk_), intent(inout), target :: y(:)
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_spk_), intent(in), optional, target :: diag(:)
complex(psb_spk_), optional, target :: work(:)
character, intent(in), optional :: trans, unitd
character, intent(in), optional :: trans, side
integer, intent(in), optional :: choice
! locals
@@ -392,7 +388,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd
character :: lside
integer, parameter :: nb=4
complex(psb_spk_),pointer :: iwork(:), xp(:), yp(:), id(:)
character :: itrans
@@ -428,10 +424,10 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_
endif
if (present(unitd)) then
lunitd = psb_toupper(unitd)
if (present(side)) then
lside = psb_toupper(side)
else
lunitd = 'U'
lside = 'U'
endif
if (present(trans)) then
@@ -528,7 +524,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve
xp => x(iix:lldx)
yp => y(iiy:lldy)
call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans)
call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans)
if(info /= 0) then
info = 4010
base/psblas/psb_dnrmi.f90
+1 -1
View File
@@ -43,6 +43,7 @@
!
function psb_dnrmi(a,desc_a,info)
use psb_descriptor_type
use psb_serial_mod
use psb_check_mod
use psb_error_mod
use psb_penv_mod
@@ -101,7 +102,6 @@ function psb_dnrmi(a,desc_a,info)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
nrmi = 0.d0
end if
base/psblas/psb_dspsm.f90
+1 -1
View File
@@ -260,7 +260,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) then
info = 4010
ch_err='dcssm'
ch_err='cssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
base/psblas/psb_snrmi.f90
+2 -1
View File
@@ -43,6 +43,7 @@
!
function psb_snrmi(a,desc_a,info)
use psb_descriptor_type
use psb_serial_mod
use psb_check_mod
use psb_error_mod
use psb_penv_mod
@@ -103,7 +104,7 @@ function psb_snrmi(a,desc_a,info)
end if
else
nrmi = 0.d0
nrmi = 0.0
end if
! compute global max
call psb_amx(ictxt, nrmi)
base/psblas/psb_sspmm.f90
-1
View File
@@ -65,7 +65,6 @@
subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
& trans, k, jx, jy, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
base/psblas/psb_sspsm.f90
+1 -1
View File
@@ -260,7 +260,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) then
info = 4010
ch_err='dcssm'
ch_err='cssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
base/psblas/psb_znrmi.f90
+4 -5
View File
@@ -37,7 +37,7 @@
! normi := max(abs(sum(A(i,j))))
!
! Arguments:
! a - type(psb_dspmat_type). The sparse matrix containing A.
! a - type(psb_d_sparse_mat). The sparse matrix containing A.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
!
@@ -47,9 +47,10 @@ function psb_znrmi(a,desc_a,info)
use psb_check_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_) :: psb_znrmi
@@ -94,8 +95,7 @@ function psb_znrmi(a,desc_a,info)
end if
if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a,info)
nrmi = psb_csnmi(a)
if(info /= 0) then
info=4010
ch_err='psb_csnmi'
@@ -105,7 +105,6 @@ function psb_znrmi(a,desc_a,info)
else
nrmi = 0.d0
end if
! compute global max
call psb_amx(ictxt, nrmi)
base/psblas/psb_zspmm.f90
+11 -15
View File
@@ -49,7 +49,7 @@
!
! Arguments:
! alpha - complex The scalar alpha.
! a - type(psb_zspmat_type). The sparse matrix containing A.
! a - type(psb_z_sparse_mat). The sparse matrix containing A.
! x(:,:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:,:) - complex The input vector containing the entries of ( Y ).
@@ -65,8 +65,6 @@
subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
& trans, k, jx, jy, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
use psi_mod
@@ -74,12 +72,13 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(inout), target :: x(:,:)
complex(psb_dpk_), intent(inout), target :: y(:,:)
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_dpk_), optional, target :: work(:)
@@ -250,7 +249,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) exit blk
! local Matrix-vector product
call a%csmm(alpha,x(:,jjx+i-1:jjx+i-1+ib-1),&
call psb_csmm(alpha,a,x(:,jjx+i-1:jjx+i-1+ib-1),&
& beta,y(:,jjy+i-1:jjy+i-1+ib-1),info,trans=trans_)
if(info /= 0) exit blk
@@ -265,9 +264,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,zzero,x(:,1:ik),desc_a,iwork,info)
if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info)
if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info)
end if
if(info /= 0) then
info = 4011
call psb_errpush(info,name)
@@ -313,7 +311,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = zzero
if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= 0) then
@@ -413,7 +411,7 @@ end subroutine psb_zspmm
!
! Arguments:
! alpha - complex The scalar alpha.
! a - type(psb_zspmat_type). The sparse matrix containing A.
! a - type(psb_z_sparse_mat). The sparse matrix containing A.
! x(:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:) - complex The input vector containing the entries of ( Y ).
@@ -426,8 +424,6 @@ end subroutine psb_zspmm
subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
& trans, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
use psb_const_mod
@@ -436,12 +432,13 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(inout), target :: x(:)
complex(psb_dpk_), intent(inout), target :: y(:)
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_dpk_), optional, target :: work(:)
@@ -582,8 +579,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
& zzero,x,desc_a,iwork,info,data=psb_comm_halo_)
end if
! local Matrix-vector product
call a%csmm(alpha,x(iix:lldx),beta,y(iiy:lldy),info)
call psb_csmm(alpha,a,x,beta,y,info)
if(info /= 0) then
info = 4011
@@ -632,7 +628,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
yp(nrow+1:ncol) = zzero
! local Matrix-vector product
if (info == 0) call a%csmm(alpha,x,beta,yp,info,trans=trans_)
if (info == 0) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info
base/psblas/psb_zspsm.f90
+22 -26
View File
@@ -57,7 +57,7 @@
!
! Arguments:
! alpha - complex. The scalar alpha.
! a - type(psb_zspmat_type). The sparse matrix containing A.
! a - type(psb_z_sparse_mat). The sparse matrix containing A.
! x(:,:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:,:) - complex The input vector containing the entries of ( Y ).
@@ -74,10 +74,8 @@
! work(:) - complex, optional Working area.
!
subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, diag, k, jx, jy, work)
& trans, side, choice, diag, k, jx, jy, work)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type
use psb_comm_mod
use psi_mod
@@ -85,17 +83,18 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in), target :: x(:,:)
complex(psb_dpk_), intent(inout), target :: y(:,:)
type (psb_zspmat_type), intent(in) :: a
type (psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_dpk_), intent(in), optional, target :: diag(:)
complex(psb_dpk_), optional, target :: work(:)
character, intent(in), optional :: trans, unitd
character, intent(in), optional :: trans, side
integer, intent(in), optional :: choice
integer, intent(in), optional :: k, jx, jy
@@ -105,7 +104,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd
character :: lside
integer, parameter :: nb=4
complex(psb_dpk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
character :: itrans
@@ -157,10 +156,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_
endif
if (present(unitd)) then
lunitd = psb_toupper(unitd)
if (present(side)) then
lside = psb_toupper(side)
else
lunitd = 'U'
lside = 'U'
endif
if (present(trans)) then
@@ -191,8 +190,6 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
! check for presence/size of a work area
iwork => null()
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if (size(work) >= liwork) then
aliw =.false.
@@ -258,11 +255,11 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+ik-1)
call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans)
call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans)
if(info /= 0) then
info = 4010
ch_err='zcssm'
ch_err='cssm'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
@@ -349,23 +346,21 @@ end subroutine psb_zspsm
!
! Arguments:
! alpha - complex. The scalar alpha.
! a - type(psb_zspmat_type). The sparse matrix containing A.
! a - type(psb_z_sparse_mat). The sparse matrix containing A.
! x(:) - complex The input vector containing the entries of ( X ).
! beta - complex The scalar beta.
! y(:) - complex The input vector containing the entries of ( Y ).
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! trans - character(optional). Whether A or A'. If not present 'N' is assumed.
! unitd - character(optional). Specify some type of operation with
! side - character(optional). Specify some type of operation with
! the diagonal matrix D.
! choice - integer(optional). The kind of update to perform on overlap elements.
! d(:) - complex, optional Matrix for diagonal scaling.
! work(:) - complex, optional Working area.
!
subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, diag, work)
use psb_spmat_type
use psb_serial_mod
& trans, side, choice, diag, work)
use psb_descriptor_type
use psb_comm_mod
use psi_mod
@@ -373,17 +368,18 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
complex(psb_dpk_), intent(in) :: alpha, beta
complex(psb_dpk_), intent(in), target :: x(:)
complex(psb_dpk_), intent(inout), target :: y(:)
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(psb_dpk_), intent(in), optional, target :: diag(:)
complex(psb_dpk_), optional, target :: work(:)
character, intent(in), optional :: trans, unitd
character, intent(in), optional :: trans, side
integer, intent(in), optional :: choice
! locals
@@ -392,7 +388,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd
character :: lside
integer, parameter :: nb=4
complex(psb_dpk_),pointer :: iwork(:), xp(:), yp(:), id(:)
character :: itrans
@@ -428,10 +424,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_
endif
if (present(unitd)) then
lunitd = psb_toupper(unitd)
if (present(side)) then
lside = psb_toupper(side)
else
lunitd = 'U'
lside = 'U'
endif
if (present(trans)) then
@@ -528,7 +524,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve
xp => x(iix:lldx)
yp => y(iiy:lldy)
call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans)
call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans)
if(info /= 0) then
info = 4010
base/serial/Makefile
+18 -17
View File
@@ -1,22 +1,22 @@
include ../../Make.inc
FOBJS = psb_cest.o \
psb_regen_mod.o psb_lsame.o psb_zspgetrow.o\
psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\
psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zspcnv.o\
psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \
psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\
psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\
psb_zgelp.o\
psb_zspshift.o psb_zspsetbld.o\
psb_ccsprt.o psb_cspcnv.o psb_ccoins.o psb_ccsnmi.o\
psb_cfixcoo.o psb_cipcsr2coo.o psb_cipcoo2csr.o psb_cipcoo2csc.o \
psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\
psb_ccssm.o psb_ccssv.o psb_ccsmm.o psb_ccsmv.o psb_ctransp.o psb_ctransc.o\
psb_cspclip.o psb_crwextd.o psb_cspscal.o\
psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o
FOBJS = psb_lsame.o
# psb_regen_mod.o psb_lsame.o psb_zspgetrow.o\
# psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\
# psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zspcnv.o\
# psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \
# psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\
# psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\
# psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\
# psb_zgelp.o\
# psb_zspshift.o psb_zspsetbld.o\
# psb_ccsprt.o psb_cspcnv.o psb_ccoins.o psb_ccsnmi.o\
# psb_cfixcoo.o psb_cipcsr2coo.o psb_cipcoo2csr.o psb_cipcoo2csc.o \
# psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\
# psb_ccssm.o psb_ccssv.o psb_ccsmm.o psb_ccsmv.o psb_ctransp.o psb_ctransc.o\
# psb_cspclip.o psb_crwextd.o psb_cspscal.o\
# psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o
#FOBJS = psb_cest.o psb_dcoins.o psb_dcsmm.o psb_dcsmv.o \
# psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \
# psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \
@@ -49,10 +49,11 @@ LIBDIR=..
MODDIR=../modules
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG)$(MODDIR) $(FMFLAG).
lib: auxd cood csrd jadd f77d f03d dpd lib1
lib: auxd f77d f03d dpd lib1
$(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
#cood csrd jadd
lib1: $(FOBJS)
base/serial/dp/Makefile
+8 -6
View File
@@ -3,14 +3,16 @@ include ../../../Make.inc
# The object files
#
XOBJS = scrjd.o ccrjd.o zcrjd.o
XOBJS =
#scrjd.o ccrjd.o zcrjd.o
FOBJS = partition.o dgblock.o dvtfg.o \
check_dim.o \
Max_nnzero.o \
gen_block.o\
ccoco.o ccocr.o ccrco.o ccrcr.o cgindex.o cgind_tri.o\
zcoco.o zcocr.o zcrco.o zcrcr.o zgindex.o zgind_tri.o\
$(XOBJS)
gen_block.o
#\
# ccoco.o ccocr.o ccrco.o ccrcr.o cgindex.o cgind_tri.o\
# zcoco.o zcocr.o zcrco.o zcrcr.o zgindex.o zgind_tri.o\
# $(XOBJS)
#dcoco.o dcocr.o dcrco.o djdcox.o djdco.o dgind_tri.o \
#dcrcr.o
@@ -41,7 +43,7 @@ LIBFILE=$(LIBDIR)/$(LIBNAME)
#
lib: xobjs $(FOBJS)
lib: $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
base/serial/dp/gen_block.f
+1 -1
View File
@@ -31,7 +31,7 @@ C
C
SUBROUTINE GEN_BLOCK(M,NG,IA,AUX)
use psb_const_mod
use psb_spmat_type
use psb_serial_mod
IMPLICIT NONE
INTEGER M, NG
base/serial/dp/partition.f
+1 -1
View File
@@ -31,7 +31,7 @@ C
C
SUBROUTINE PARTITION(M, WORK, IA, N_BLOCK)
use psb_const_mod
use psb_spmat_type
use psb_serial_mod
IMPLICIT NONE
base/serial/dp/scrjd.f
+1 -1
View File
@@ -61,7 +61,7 @@ C ARN,IAN1
C IAN2,INFON, IP1, IP2
C
use psb_const_mod
use psb_spmat_type
use psb_serial_mod
use psb_string_mod
IMPLICIT NONE
base/serial/f77/Makefile
+7 -5
View File
@@ -4,11 +4,13 @@ include ../../../Make.inc
# The object files
#
FOBJS = daxpby.o saxpby.o \
sgelp.o\
caxpby.o clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\
cswsm.o ccssm.o cgelp.o\
zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\
zcsrws.o zgelp.o zlpupd.o
caxpby.o zaxpby.o
# clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\
# cswsm.o ccssm.o cgelp.o\
# zcsnmi.o zcsmm.o zcssm.o zswmm.o zswsm.o\
# zcsrws.o zgelp.o zlpupd.o
#dcsmm.o dcsnmi.o dcsrp.o dcssm.o \
# dgelp.o dlpupd.o dswmm.o \
base/serial/psb_cest.f90
+1 -1
View File
@@ -34,7 +34,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info)
use psb_error_mod
use psb_const_mod
use psb_string_mod
use psb_spmat_type
use psb_serial_mod
implicit none
base/tools/psb_ccdbldext.F90
+25 -45
View File
@@ -37,7 +37,7 @@
! specified on input.
!
! Arguments:
! a - type(psb_cspmat_type). The input sparse matrix.
! a - type(psb_c_sparse_mat). The input sparse matrix.
! desc_a - type(psb_desc_type). The input communication descriptor.
! novr - integer. The number of overlap levels.
! desc_ov - type(psb_desc_type). The auxiliary output communication
@@ -78,7 +78,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! .. Array Arguments ..
integer, intent(in) :: novr
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info
@@ -86,7 +86,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! .. Local Scalars ..
Integer :: i, j, np, me,m,nnzero,&
Integer :: i, j, np, me,m,&
& ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),&
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
@@ -95,7 +95,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer :: icomm, err_act
type(psb_cspmat_type) :: blk
integer, allocatable :: irow(:), icol(:)
Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
@@ -123,7 +123,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
extype_ = psb_ovt_xhal_
endif
m = psb_cd_get_local_rows(desc_a)
nnzero = Size(a%aspk)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-m
@@ -170,7 +169,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average
! nonzeros per row is the same as the global.
!
nztot = psb_sp_get_nnzeros(a)
nztot = a%get_nzeros()
if (nztot>0) then
lovr = ((nztot+m-1)/m)*nhalo*novr
lworks = ((nztot+m-1)/m)*nhalo
@@ -211,16 +210,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
call psb_sp_all(blk,max(lworks,lworkr),info)
if (info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blk%fida='COO'
Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),&
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
if (info /= 0) then
@@ -415,35 +404,20 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
! Prepare to exchange the halo rows with the other proc.
!
If (i_ovr <= (novr)) Then
n_elem = psb_sp_get_nnz_row(idx,a)
call a%csget(idx,idx,n_elem,irow,icol,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
call psb_ensure_size((idxs+tot_elem+n_elem),works,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
If((n_elem) > size(blk%ia2)) Then
isz = max((3*size(blk%ia2))/2,(n_elem))
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,'Realloc blk',isz
call psb_sp_reall(blk,isz,info)
if (info /= 0) then
info=4010
ch_err='psb_sp_reall'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
End If
call psb_sp_getblk(idx,a,blk,info)
if (info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_map_l2g(blk%ia2(1:n_elem),&
call psb_map_l2g(icol(1:n_elem),&
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
& desc_ov%idxmap,info)
tot_elem=tot_elem+n_elem
@@ -735,14 +709,20 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
end if
call psb_icdasb(desc_ov,info,ext_hv=.true.)
if (info /= 0) then
call psb_errpush(4010,name,a_err='icdasdb')
goto 9999
end if
call psb_cd_set_ovl_asb(desc_ov,info)
if (info == 0) call psb_sp_free(blk,info)
if (info /= 0) then
ch_err='sp_free'
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
goto 9999
if (info == 0) then
if (allocated(irow)) deallocate(irow,stat=info)
if ((info ==0).and.allocated(icol)) deallocate(icol,stat=info)
if (info /= 0) then
call psb_errpush(4013,name,a_err='deallocate',i_err=(/info,0,0,0,0/))
goto 9999
end if
end if
if (debug_level >= psb_debug_outer_) &
base/tools/psb_cins.f90
-2
View File
@@ -48,7 +48,6 @@
subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
@@ -234,7 +233,6 @@ end subroutine psb_cinsvi
subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
base/tools/psb_cspalloc.f90
+3 -4
View File
@@ -35,7 +35,7 @@
! Allocate sparse matrix structure for psblas routines.
!
! Arguments:
! a - type(psb_cspmat_type). The sparse matrix to be allocated.
! a - type(psb_c_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor to be updated.
! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix.
@@ -44,7 +44,6 @@
subroutine psb_cspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -53,7 +52,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
!....parameters...
type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(out) :: a
type(psb_c_sparse_mat), intent(out) :: a
integer, intent(out) :: info
integer, optional, intent(in) :: nnz
@@ -108,7 +107,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
!....allocate aspk, ia1, ia2.....
call psb_sp_all(loc_row,loc_col,a,length_ia1,info)
call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= 0) then
info=4010
ch_err='sp_all'
base/tools/psb_cspasb.f90
+16 -12
View File
@@ -35,7 +35,7 @@
! Assemble sparse matrix
!
! Arguments:
! a - type(psb_cspmat_type). The sparse matrix to be assembled
! a - type(psb_c_sparse_mat). The sparse matrix to be assembled
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
! afmt - character(optional) The desired output storage format.
@@ -48,10 +48,9 @@
! psb_dupl_err_ raise an error.
!
!
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl)
subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psi_mod
@@ -62,11 +61,12 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl)
!...Parameters....
type(psb_cspmat_type), intent (inout) :: a
type(psb_c_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
class(psb_c_base_sparse_mat), intent(in), optional :: mold
!....Locals....
integer :: int_err(5)
integer :: np,me,n_col, err_act
@@ -107,23 +107,27 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl)
!check on errors encountered in psdspins
spstate = a%infoa(psb_state_)
if (spstate == psb_spmat_bld_) then
if (a%is_bld()) then
!
! First case: we come from a fresh build.
!
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
a%m = n_row
a%k = n_col
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl)
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
IF (debug_level >= psb_debug_ext_)&
& write(debug_unit, *) me,' ',trim(name),': From SPCNV',&
& info,' ',A%FIDA
IF (debug_level >= psb_debug_ext_) then
ch_err=a%get_fmt()
write(debug_unit, *) me,' ',trim(name),': From SPCNV',&
& info,' ',ch_err
end IF
if (info /= psb_no_err_) then
info=4010
ch_err='psb_spcnv'
base/tools/psb_cspfree.f90
+3 -11
View File
@@ -35,14 +35,13 @@
! Frees a sparse matrix structure.
!
! Arguments:
! a - type(psb_cspmat_type). The sparse matrix to be freed.
! a - type(psb_c_sparse_mat). The sparse matrix to be freed.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
!
subroutine psb_cspfree(a, desc_a,info)
!...free sparse matrix structure...
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -50,7 +49,7 @@ subroutine psb_cspfree(a, desc_a,info)
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
!...locals....
integer :: ictxt, err_act
@@ -70,14 +69,7 @@ subroutine psb_cspfree(a, desc_a,info)
end if
!...deallocate a....
call psb_sp_free(a,info)
if(info /= 0) then
info=2045
call psb_errpush(info,name)
goto 9999
end if
call a%free()
call psb_erractionrestore(err_act)
return
base/tools/psb_csphalo.F90
+38 -52
View File
@@ -38,9 +38,9 @@
!
!
! Arguments:
! a - type(psb_cspmat_type) The local part of input matrix A
! a - type(psb_c_sparse_mat) The local part of input matrix A
! desc_a - type(psb_desc_type). The communication descriptor.
! blck - type(psb_cspmat_type) The local part of output matrix BLCK
! blck - type(psb_c_sparse_mat) The local part of output matrix BLCK
! info - integer. Return code
! rowcnv - logical Should row/col indices be converted
! colcnv - logical to/from global numbering when sent/received?
@@ -73,8 +73,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h'
#endif
Type(psb_cspmat_type),Intent(in) :: a
Type(psb_cspmat_type),Intent(inout) :: blk
Type(psb_c_sparse_mat),Intent(in) :: a
Type(psb_c_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a
integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@@ -89,8 +89,9 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_spk_), allocatable :: valsnd(:)
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
type(psb_c_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
@@ -143,7 +144,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Call psb_info(ictxt, me, np)
Allocate(sdid(np,3),rvid(np,3),brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1),stat=info)
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
if (info /= 0) then
info=4000
@@ -180,8 +181,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
idx = 0
idxs = 0
idxr = 0
blk%k = a%k
blk%m = 0
call acoo%allocate(0,a%get_ncols(),info)
! For all rows in the halo descriptor, extract and send/receive.
Do
proc=idxv(counter)
@@ -192,13 +192,11 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
tot_elem = 0
Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j)
n_elem = psb_sp_get_nnz_row(idx,a)
n_elem = a%get_nz_row(idx)
tot_elem = tot_elem+n_elem
Enddo
sdsz(proc+1) = tot_elem
blk%m = blk%m + n_el_recv
call acoo%set_nrows(acoo%get_nrows() + n_el_recv)
counter = counter+n_el_send+3
Enddo
@@ -228,9 +226,9 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Enddo
iszr=sum(rvsz)
call psb_sp_all(blk,max(iszr,1),info)
call acoo%reallocate(max(iszr,1))
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',size(blk%ia1),size(blk%ia2),&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
if (info /= 0) then
info=4010
@@ -259,9 +257,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j)
n_elem = psb_sp_get_nnz_row(idx,a)
call psb_sp_getrow(idx,a,ngtz,iasnd,jasnd,valsnd,info,&
n_elem = a%get_nz_row(idx)
call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,&
& append=.true.,nzin=tot_elem)
if (info /= 0) then
info=4010
@@ -271,9 +268,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
tot_elem=tot_elem+n_elem
Enddo
ipx = ipx + 1
counter = counter+n_el_send+3
Enddo
nz = tot_elem
@@ -289,11 +284,11 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,&
& blk%aspk,rvsz,brvindx,mpi_complex,icomm,info)
& acoo%val,rvsz,brvindx,mpi_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,mpi_integer,&
& blk%ia1,rvsz,brvindx,mpi_integer,icomm,info)
& acoo%ia,rvsz,brvindx,mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,mpi_integer,&
& blk%ia2,rvsz,brvindx,mpi_integer,icomm,info)
& acoo%ja,rvsz,brvindx,mpi_integer,icomm,info)
if (info /= 0) then
info=4010
ch_err='mpi_alltoallv'
@@ -304,8 +299,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
!
! Convert into local numbering
!
if (rowcnv_) call psb_glob_to_loc(blk%ia1(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(blk%ia2(1:iszr),desc_a,info,iact='I')
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= 0) then
info=4010
@@ -315,21 +310,21 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
l1 = 0
blk%m=0
call acoo%set_nrows(0)
!
irmin = huge(irmin)
icmin = huge(icmin)
irmax = 0
icmax = 0
Do i=1,iszr
r=(blk%ia1(i))
k=(blk%ia2(i))
r=(acoo%ia(i))
k=(acoo%ja(i))
! Just in case some of the conversions were out-of-range
If ((r>0).and.(k>0)) Then
l1=l1+1
blk%aspk(l1) = blk%aspk(i)
blk%ia1(l1) = r
blk%ia2(l1) = k
acoo%val(l1) = acoo%val(i)
acoo%ia(l1) = r
acoo%ja(l1) = k
irmin = min(irmin,r)
irmax = max(irmax,r)
icmin = min(icmin,k)
@@ -337,37 +332,28 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
End If
Enddo
if (rowscale_) then
blk%m = max(irmax-irmin+1,0)
blk%ia1(1:l1) = blk%ia1(1:l1) - irmin + 1
else
blk%m = irmax
call acoo%set_nrows(max(irmax-irmin+1,0))
acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1
else
call acoo%set_nrows(irmax)
end if
if (colscale_) then
blk%k = max(icmax-icmin+1,0)
blk%ia2(1:l1) = blk%ia2(1:l1) - icmin + 1
call acoo%set_ncols(max(icmax-icmin+1,0))
acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1
else
blk%k = icmax
call acoo%set_ncols(icmax)
end if
call acoo%set_nzeros(l1)
blk%fida = 'COO'
blk%infoa(psb_nnz_) = l1
call psb_ensure_size(1,blk%pl,info)
if (info == 0) call psb_ensure_size(1,blk%pr,info)
if (info /= 0) then
info=4010
ch_err='psb_ensure_size'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blk%pl = 0
blk%pr = 0
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1,blk%m
& ': End data exchange',counter,l1
call move_alloc(acoo,blk%a)
! Do we expect any duplicates to appear????
call psb_spcnv(blk,info,afmt=outfmt_,dupl=psb_dupl_add_)
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= 0) then
info=4010
ch_err='psb_spcnv'
base/tools/psb_cspins.f90
+13 -20
View File
@@ -42,7 +42,7 @@
! ia(:) - integer The row indices of the coefficients.
! ja(:) - integer The column indices of the coefficients.
! val(:) - complex The values of the coefficients to be inserted.
! a - type(psb_dspmat_type). The sparse destination matrix.
! a - type(psb_d_sparse_mat). The sparse destination matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under
@@ -52,7 +52,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_tools_mod, psb_protect_name => psb_cspins
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -61,20 +60,19 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
!....parameters...
type(psb_desc_type), intent(inout) :: desc_a
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info
logical, intent(in), optional :: rebuild
!locals.....
integer :: nrow, err_act,mglob,ncol, spstate
integer :: nrow, err_act, ncol, spstate
integer :: ictxt,np,me
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
logical :: rebuild_
integer, allocatable :: ila(:),jla(:)
character(len=20) :: name, ch_err
info = 0
@@ -83,7 +81,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
ictxt = psb_cd_get_context(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
call psb_info(ictxt, me, np)
@@ -122,7 +119,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_a)) then
if (psb_is_large_desc(desc_a)) then
@@ -141,8 +137,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info)
if (a%is_bld()) then
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -166,8 +162,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc)
if (a%is_bld()) then
call a%csput(nz,ia,ja,val,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -181,7 +177,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
end if
end if
else if (psb_is_asb_desc(desc_a)) then
if (psb_is_large_desc(desc_a)) then
@@ -200,8 +196,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,&
& info,rebuild=rebuild_)
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -212,8 +207,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
else
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,&
& info,gtl=desc_a%idxmap%glob_to_loc,rebuild=rebuild_)
call a%csput(nz,ia,ja,val,1,nrow,1,ncol,&
& info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -244,7 +239,6 @@ end subroutine psb_cspins
subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_tools_mod, psb_protect_name => psb_cspins_2desc
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -254,7 +248,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
!....parameters...
type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_cspmat_type), intent(inout) :: a
type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info
@@ -310,7 +304,6 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
end if
if (nz==0) return
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_ac)) then
allocate(ila(nz),jla(nz),stat=info)
@@ -334,7 +327,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
nrow = psb_cd_get_local_rows(desc_ar)
ncol = psb_cd_get_local_cols(desc_ac)
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info)
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
base/tools/psb_csprn.f90
+3 -9
View File
@@ -36,7 +36,7 @@
! is in the update state.
!
! Arguments:
! a - type(psb_cspmat_type). The sparse matrix to be reinitiated.
! a - type(psb_c_sparse_mat). The sparse matrix to be reinitiated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code.
! clear - logical, optional Whether the coefficients should be zeroed
@@ -45,7 +45,6 @@
Subroutine psb_csprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -54,7 +53,7 @@ Subroutine psb_csprn(a, desc_a,info,clear)
!....Parameters...
Type(psb_desc_type), intent(in) :: desc_a
Type(psb_cspmat_type), intent(inout) :: a
Type(psb_c_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
logical, intent(in), optional :: clear
@@ -87,13 +86,8 @@ Subroutine psb_csprn(a, desc_a,info,clear)
call psb_errpush(info,name)
goto 9999
endif
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
call psb_sp_reinit(a,info,clear=clear_)
call a%reinit(clear=clear)
if (info /= 0) goto 9999
if (debug_level >= psb_debug_outer_) &
base/tools/psb_dcdbldext.F90
+1 -2
View File
@@ -37,7 +37,7 @@
! specified on input.
!
! Arguments:
! a - type(psb_dspmat_type). The input sparse matrix.
! a - type(psb_d_sparse_mat). The input sparse matrix.
! desc_a - type(psb_desc_type). The input communication descriptor.
! novr - integer. The number of overlap levels.
! desc_ov - type(psb_desc_type). The auxiliary output communication
@@ -67,7 +67,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_mat_mod
use psi_mod
#ifdef MPI_MOD
use mpi
base/tools/psb_dins.f90
-2
View File
@@ -49,7 +49,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_const_mod
use psb_descriptor_type
use psb_spmat_type
use psb_error_mod
use psb_penv_mod
use psi_mod
@@ -234,7 +233,6 @@ end subroutine psb_dinsvi
subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
base/tools/psb_dspalloc.f90
+2 -2
View File
@@ -35,7 +35,7 @@
! Allocate sparse matrix structure for psblas routines.
!
! Arguments:
! a - type(psb_dspmat_type). The sparse matrix to be allocated.
! a - type(psb_d_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor to be updated.
! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix.
@@ -44,10 +44,10 @@
subroutine psb_dspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_dspasb.f90
+2 -2
View File
@@ -35,7 +35,7 @@
! Assemble sparse matrix
!
! Arguments:
! a - type(psb_dspmat_type). The sparse matrix to be allocated.
! a - type(psb_d_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
! afmt - character(optional) The desired output storage format.
@@ -50,12 +50,12 @@
!
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psi_mod
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
base/tools/psb_dspfree.f90
+2 -2
View File
@@ -35,16 +35,16 @@
! Frees a sparse matrix structure.
!
! Arguments:
! a - type(psb_dspmat_type). The sparse matrix to be freed.
! a - type(psb_d_sparse_mat). The sparse matrix to be freed.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
!
subroutine psb_dspfree(a, desc_a,info)
!...free sparse matrix structure...
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_dsphalo.F90
+1 -2
View File
@@ -60,8 +60,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_const_mod
use psb_string_mod
use psb_mat_mod
use psb_serial_mod
use psb_descriptor_type
use psb_realloc_mod
use psb_tools_mod, psb_protect_name => psb_dsphalo
base/tools/psb_dspins.f90
+3 -3
View File
@@ -42,7 +42,7 @@
! ia(:) - integer The row indices of the coefficients.
! ja(:) - integer The column indices of the coefficients.
! val(:) - real The values of the coefficients to be inserted.
! a - type(psb_dspmat_type). The sparse destination matrix.
! a - type(psb_d_sparse_mat). The sparse destination matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under
@@ -52,10 +52,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_tools_mod, psb_protect_name => psb_dspins
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
@@ -239,10 +239,10 @@ end subroutine psb_dspins
subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_tools_mod, psb_protect_name => psb_dspins_2desc
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_dsprn.f90
+1 -3
View File
@@ -36,7 +36,7 @@
! is in the update state.
!
! Arguments:
! a - type(psb_dspmat_type). The sparse matrix to be reinitiated.
! a - type(psb_d_sparse_mat). The sparse matrix to be reinitiated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code.
! clear - logical, optional Whether the coefficients should be zeroed
@@ -44,7 +44,6 @@
Subroutine psb_dsprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_mat_mod
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -57,7 +56,6 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
integer, intent(out) :: info
logical, intent(in), optional :: clear
!locals
Integer :: ictxt,np,me,err,err_act
integer :: debug_level, debug_unit
base/tools/psb_iins.f90
-2
View File
@@ -48,7 +48,6 @@
subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
@@ -233,7 +232,6 @@ end subroutine psb_iinsvi
subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
base/tools/psb_linmap.f90
+6 -6
View File
@@ -37,7 +37,7 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
implicit none
type(psb_clinmap_type) :: this
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
!
@@ -93,8 +93,8 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
info = 1
end select
if (info == 0) call psb_sp_clone(map_X2Y,this%map_X2Y,info)
if (info == 0) call psb_sp_clone(map_Y2X,this%map_Y2X,info)
if (info == 0) call psb_clone(map_X2Y,this%map_X2Y,info)
if (info == 0) call psb_clone(map_Y2X,this%map_Y2X,info)
if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info)
if (info == 0) then
call psb_set_map_kind(map_kind, this)
@@ -274,7 +274,7 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
implicit none
type(psb_zlinmap_type) :: this
type(psb_desc_type), target :: desc_X, desc_Y
type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X
type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:)
!
@@ -331,8 +331,8 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
info = 1
end select
if (info == 0) call psb_sp_clone(map_X2Y,this%map_X2Y,info)
if (info == 0) call psb_sp_clone(map_Y2X,this%map_Y2X,info)
if (info == 0) call psb_clone(map_X2Y,this%map_X2Y,info)
if (info == 0) call psb_clone(map_Y2X,this%map_Y2X,info)
if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info)
if (info == 0) then
call psb_set_map_kind(map_kind, this)
base/tools/psb_scdbldext.F90
-1
View File
@@ -67,7 +67,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
use psb_mat_mod
use psi_mod
#ifdef MPI_MOD
use mpi
base/tools/psb_sins.f90
-2
View File
@@ -49,7 +49,6 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_const_mod
use psb_descriptor_type
use psb_spmat_type
use psb_error_mod
use psb_penv_mod
use psi_mod
@@ -234,7 +233,6 @@ end subroutine psb_sinsvi
subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
base/tools/psb_sspalloc.f90
+2 -2
View File
@@ -35,7 +35,7 @@
! Allocate sparse matrix structure for psblas routines.
!
! Arguments:
! a - type(psb_sspmat_type). The sparse matrix to be allocated.
! a - type(psb_s_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor to be updated.
! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix.
@@ -44,10 +44,10 @@
subroutine psb_sspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_sspasb.f90
+2 -2
View File
@@ -35,7 +35,7 @@
! Assemble sparse matrix
!
! Arguments:
! a - type(psb_sspmat_type). The sparse matrix to be allocated.
! a - type(psb_s_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
! afmt - character(optional) The desired output storage format.
@@ -50,12 +50,12 @@
!
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psi_mod
use psb_error_mod
use psb_string_mod
use psb_penv_mod
use psb_mat_mod
implicit none
base/tools/psb_sspfree.f90
+1 -1
View File
@@ -42,9 +42,9 @@
subroutine psb_sspfree(a, desc_a,info)
!...free sparse matrix structure...
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_ssphalo.F90
+1 -2
View File
@@ -60,8 +60,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_const_mod
use psb_string_mod
use psb_mat_mod
use psb_serial_mod
use psb_descriptor_type
use psb_realloc_mod
use psb_tools_mod, psb_protect_name => psb_ssphalo
base/tools/psb_sspins.f90
+3 -3
View File
@@ -42,7 +42,7 @@
! ia(:) - integer The row indices of the coefficients.
! ja(:) - integer The column indices of the coefficients.
! val(:) - real The values of the coefficients to be inserted.
! a - type(psb_sspmat_type). The sparse destination matrix.
! a - type(psb_s_sparse_mat). The sparse destination matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under
@@ -52,10 +52,10 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_tools_mod, psb_protect_name => psb_sspins
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
@@ -239,10 +239,10 @@ end subroutine psb_sspins
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_tools_mod, psb_protect_name => psb_sspins_2desc
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
implicit none
!....parameters...
base/tools/psb_ssprn.f90
+1 -3
View File
@@ -36,7 +36,7 @@
! is in the update state.
!
! Arguments:
! a - type(psb_sspmat_type). The sparse matrix to be reinitiated.
! a - type(psb_s_sparse_mat). The sparse matrix to be reinitiated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code.
! clear - logical, optional Whether the coefficients should be zeroed
@@ -44,7 +44,6 @@
Subroutine psb_ssprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_mat_mod
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -57,7 +56,6 @@ Subroutine psb_ssprn(a, desc_a,info,clear)
integer, intent(out) :: info
logical, intent(in), optional :: clear
!locals
Integer :: ictxt,np,me,err,err_act
integer :: debug_level, debug_unit
base/tools/psb_zcdbldext.F90
+27 -47
View File
@@ -37,7 +37,7 @@
! specified on input.
!
! Arguments:
! a - type(psb_zspmat_type). The input sparse matrix.
! a - type(psb_z_sparse_mat). The input sparse matrix.
! desc_a - type(psb_desc_type). The input communication descriptor.
! novr - integer. The number of overlap levels.
! desc_ov - type(psb_desc_type). The auxiliary output communication
@@ -78,23 +78,23 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! .. Array Arguments ..
integer, intent(in) :: novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info
integer, intent(in),optional :: extype
! .. Local Scalars ..
Integer :: i, j, np, me,m,nnzero,&
Integer :: i, j, np, me,m,&
& ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),&
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo
Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
& n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer icomm, err_act
integer :: icomm, err_act
type(psb_zspmat_type) :: blk
integer, allocatable :: irow(:), icol(:)
Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:)
@@ -122,7 +122,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
extype_ = psb_ovt_xhal_
endif
m = psb_cd_get_local_rows(desc_a)
nnzero = Size(a%aspk)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-m
@@ -169,7 +168,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average
! nonzeros per row is the same as the global.
!
nztot = psb_sp_get_nnzeros(a)
nztot = a%get_nzeros()
if (nztot>0) then
lovr = ((nztot+m-1)/m)*nhalo*novr
lworks = ((nztot+m-1)/m)*nhalo
@@ -210,16 +209,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999
end if
call psb_sp_all(blk,max(lworks,lworkr),info)
if (info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blk%fida='COO'
Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),&
& tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
if (info /= 0) then
@@ -340,7 +329,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! add recv elements in halo_index into ovrlap_index
!
Do j=0,n_elem_recv-1
If ((counter+psb_elem_recv_+j)>Size(halo)) then
If((counter+psb_elem_recv_+j)>Size(halo)) then
info=-2
call psb_errpush(info,name)
goto 9999
@@ -414,35 +403,20 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
! Prepare to exchange the halo rows with the other proc.
!
If (i_ovr <= (novr)) Then
n_elem = psb_sp_get_nnz_row(idx,a)
call a%csget(idx,idx,n_elem,irow,icol,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
call psb_ensure_size((idxs+tot_elem+n_elem),works,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
If((n_elem) > size(blk%ia2)) Then
isz = max((3*size(blk%ia2))/2,(n_elem))
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,'Realloc blk',isz
call psb_sp_reall(blk,isz,info)
if (info /= 0) then
info=4010
ch_err='psb_sp_reall'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
End If
call psb_sp_getblk(idx,a,blk,info)
if (info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_map_l2g(blk%ia2(1:n_elem),&
call psb_map_l2g(icol(1:n_elem),&
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
& desc_ov%idxmap,info)
tot_elem=tot_elem+n_elem
@@ -734,14 +708,20 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
end if
call psb_icdasb(desc_ov,info,ext_hv=.true.)
if (info /= 0) then
call psb_errpush(4010,name,a_err='icdasdb')
goto 9999
end if
call psb_cd_set_ovl_asb(desc_ov,info)
if (info == 0) call psb_sp_free(blk,info)
if (info /= 0) then
ch_err='sp_free'
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
goto 9999
if (info == 0) then
if (allocated(irow)) deallocate(irow,stat=info)
if ((info ==0).and.allocated(icol)) deallocate(icol,stat=info)
if (info /= 0) then
call psb_errpush(4013,name,a_err='deallocate',i_err=(/info,0,0,0,0/))
goto 9999
end if
end if
if (debug_level >= psb_debug_outer_) &
base/tools/psb_zins.f90
-2
View File
@@ -48,7 +48,6 @@
subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
@@ -234,7 +233,6 @@ end subroutine psb_zinsvi
subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix .....
use psb_descriptor_type
use psb_spmat_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
base/tools/psb_zspalloc.f90
+3 -4
View File
@@ -35,7 +35,7 @@
! Allocate sparse matrix structure for psblas routines.
!
! Arguments:
! a - type(psb_zspmat_type). The sparse matrix to be allocated.
! a - type(psb_z_sparse_mat). The sparse matrix to be allocated.
! desc_a - type(psb_desc_type). The communication descriptor to be updated.
! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix.
@@ -44,7 +44,6 @@
subroutine psb_zspalloc(a, desc_a, info, nnz)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -53,7 +52,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
!....parameters...
type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(out) :: a
type(psb_z_sparse_mat), intent(out) :: a
integer, intent(out) :: info
integer, optional, intent(in) :: nnz
@@ -108,7 +107,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
!....allocate aspk, ia1, ia2.....
call psb_sp_all(loc_row,loc_col,a,length_ia1,info)
call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= 0) then
info=4010
ch_err='sp_all'
base/tools/psb_zspasb.f90
+16 -13
View File
@@ -35,7 +35,7 @@
! Assemble sparse matrix
!
! Arguments:
! a - type(psb_zspmat_type). The sparse matrix to be assembled
! a - type(psb_z_sparse_mat). The sparse matrix to be assembled
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
! afmt - character(optional) The desired output storage format.
@@ -48,10 +48,8 @@
! psb_dupl_err_ raise an error.
!
!
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psi_mod
@@ -62,11 +60,12 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
!...Parameters....
type(psb_zspmat_type), intent (inout) :: a
type(psb_z_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt
class(psb_z_base_sparse_mat), intent(in), optional :: mold
!....Locals....
integer :: int_err(5)
integer :: np,me,n_col, err_act
@@ -107,23 +106,27 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
!check on errors encountered in psdspins
spstate = a%infoa(psb_state_)
if (spstate == psb_spmat_bld_) then
if (a%is_bld()) then
!
! First case: we come from a fresh build.
!
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
a%m = n_row
a%k = n_col
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl)
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
IF (debug_level >= psb_debug_ext_)&
& write(debug_unit, *) me,' ',trim(name),': From SPCNV',&
& info,' ',A%FIDA
IF (debug_level >= psb_debug_ext_) then
ch_err=a%get_fmt()
write(debug_unit, *) me,' ',trim(name),': From SPCNV',&
& info,' ',ch_err
end IF
if (info /= psb_no_err_) then
info=4010
ch_err='psb_spcnv'
base/tools/psb_zspfree.f90
+3 -11
View File
@@ -35,14 +35,13 @@
! Frees a sparse matrix structure.
!
! Arguments:
! a - type(psb_zspmat_type). The sparse matrix to be freed.
! a - type(psb_z_sparse_mat). The sparse matrix to be freed.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code.
!
subroutine psb_zspfree(a, desc_a,info)
!...free sparse matrix structure...
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -50,7 +49,7 @@ subroutine psb_zspfree(a, desc_a,info)
!....parameters...
type(psb_desc_type), intent(in) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
!...locals....
integer :: ictxt, err_act
@@ -70,14 +69,7 @@ subroutine psb_zspfree(a, desc_a,info)
end if
!...deallocate a....
call psb_sp_free(a,info)
if(info /= 0) then
info=2045
call psb_errpush(info,name)
goto 9999
end if
call a%free()
call psb_erractionrestore(err_act)
return
base/tools/psb_zsphalo.F90
+38 -52
View File
@@ -38,9 +38,9 @@
!
!
! Arguments:
! a - type(psb_zspmat_type) The local part of input matrix A
! a - type(psb_z_sparse_mat) The local part of input matrix A
! desc_a - type(psb_desc_type). The communication descriptor.
! blck - type(psb_zspmat_type) The local part of output matrix BLCK
! blck - type(psb_z_sparse_mat) The local part of output matrix BLCK
! info - integer. Return code
! rowcnv - logical Should row/col indices be converted
! colcnv - logical to/from global numbering when sent/received?
@@ -73,8 +73,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h'
#endif
Type(psb_zspmat_type),Intent(in) :: a
Type(psb_zspmat_type),Intent(inout) :: blk
Type(psb_z_sparse_mat),Intent(in) :: a
Type(psb_z_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a
integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@@ -89,8 +89,9 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_dpk_), allocatable :: valsnd(:)
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
type(psb_z_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
@@ -143,7 +144,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Call psb_info(ictxt, me, np)
Allocate(sdid(np,3),rvid(np,3),brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1),stat=info)
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
if (info /= 0) then
info=4000
@@ -180,8 +181,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
idx = 0
idxs = 0
idxr = 0
blk%k = a%k
blk%m = 0
call acoo%allocate(0,a%get_ncols(),info)
! For all rows in the halo descriptor, extract and send/receive.
Do
proc=idxv(counter)
@@ -192,13 +192,11 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
tot_elem = 0
Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j)
n_elem = psb_sp_get_nnz_row(idx,a)
n_elem = a%get_nz_row(idx)
tot_elem = tot_elem+n_elem
Enddo
sdsz(proc+1) = tot_elem
blk%m = blk%m + n_el_recv
call acoo%set_nrows(acoo%get_nrows() + n_el_recv)
counter = counter+n_el_send+3
Enddo
@@ -228,9 +226,9 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Enddo
iszr=sum(rvsz)
call psb_sp_all(blk,max(iszr,1),info)
call acoo%reallocate(max(iszr,1))
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',size(blk%ia1),size(blk%ia2),&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
if (info /= 0) then
info=4010
@@ -259,9 +257,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j)
n_elem = psb_sp_get_nnz_row(idx,a)
call psb_sp_getrow(idx,a,ngtz,iasnd,jasnd,valsnd,info,&
n_elem = a%get_nz_row(idx)
call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,&
& append=.true.,nzin=tot_elem)
if (info /= 0) then
info=4010
@@ -271,9 +268,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
tot_elem=tot_elem+n_elem
Enddo
ipx = ipx + 1
counter = counter+n_el_send+3
Enddo
nz = tot_elem
@@ -289,11 +284,11 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,&
& blk%aspk,rvsz,brvindx,mpi_double_complex,icomm,info)
& acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,mpi_integer,&
& blk%ia1,rvsz,brvindx,mpi_integer,icomm,info)
& acoo%ia,rvsz,brvindx,mpi_integer,icomm,info)
call mpi_alltoallv(jasnd,sdsz,bsdindx,mpi_integer,&
& blk%ia2,rvsz,brvindx,mpi_integer,icomm,info)
& acoo%ja,rvsz,brvindx,mpi_integer,icomm,info)
if (info /= 0) then
info=4010
ch_err='mpi_alltoallv'
@@ -304,8 +299,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
!
! Convert into local numbering
!
if (rowcnv_) call psb_glob_to_loc(blk%ia1(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(blk%ia2(1:iszr),desc_a,info,iact='I')
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I')
if (info /= 0) then
info=4010
@@ -315,21 +310,21 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if
l1 = 0
blk%m=0
call acoo%set_nrows(0)
!
irmin = huge(irmin)
icmin = huge(icmin)
irmax = 0
icmax = 0
Do i=1,iszr
r=(blk%ia1(i))
k=(blk%ia2(i))
r=(acoo%ia(i))
k=(acoo%ja(i))
! Just in case some of the conversions were out-of-range
If ((r>0).and.(k>0)) Then
l1=l1+1
blk%aspk(l1) = blk%aspk(i)
blk%ia1(l1) = r
blk%ia2(l1) = k
acoo%val(l1) = acoo%val(i)
acoo%ia(l1) = r
acoo%ja(l1) = k
irmin = min(irmin,r)
irmax = max(irmax,r)
icmin = min(icmin,k)
@@ -337,37 +332,28 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
End If
Enddo
if (rowscale_) then
blk%m = max(irmax-irmin+1,0)
blk%ia1(1:l1) = blk%ia1(1:l1) - irmin + 1
else
blk%m = irmax
call acoo%set_nrows(max(irmax-irmin+1,0))
acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1
else
call acoo%set_nrows(irmax)
end if
if (colscale_) then
blk%k = max(icmax-icmin+1,0)
blk%ia2(1:l1) = blk%ia2(1:l1) - icmin + 1
call acoo%set_ncols(max(icmax-icmin+1,0))
acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1
else
blk%k = icmax
call acoo%set_ncols(icmax)
end if
call acoo%set_nzeros(l1)
blk%fida = 'COO'
blk%infoa(psb_nnz_) = l1
call psb_ensure_size(1,blk%pl,info)
if (info == 0) call psb_ensure_size(1,blk%pr,info)
if (info /= 0) then
info=4010
ch_err='psb_ensure_size'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blk%pl = 0
blk%pr = 0
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1,blk%m
& ': End data exchange',counter,l1
call move_alloc(acoo,blk%a)
! Do we expect any duplicates to appear????
call psb_spcnv(blk,info,afmt=outfmt_,dupl=psb_dupl_add_)
call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_)
if (info /= 0) then
info=4010
ch_err='psb_spcnv'
base/tools/psb_zspins.f90
+12 -19
View File
@@ -42,7 +42,7 @@
! ia(:) - integer The row indices of the coefficients.
! ja(:) - integer The column indices of the coefficients.
! val(:) - complex The values of the coefficients to be inserted.
! a - type(psb_dspmat_type). The sparse destination matrix.
! a - type(psb_d_sparse_mat). The sparse destination matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under
@@ -52,7 +52,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_tools_mod, psb_protect_name => psb_zspins
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -61,20 +60,19 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
!....parameters...
type(psb_desc_type), intent(inout) :: desc_a
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:)
integer, intent(out) :: info
logical, intent(in), optional :: rebuild
!locals.....
integer :: nrow, err_act,mglob,ncol, spstate
integer :: nrow, err_act, ncol, spstate
integer :: ictxt,np,me
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
logical :: rebuild_
integer, allocatable :: ila(:),jla(:)
character(len=20) :: name, ch_err
info = 0
@@ -83,7 +81,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
ictxt = psb_cd_get_context(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
call psb_info(ictxt, me, np)
@@ -122,7 +119,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_a)) then
if (psb_is_large_desc(desc_a)) then
@@ -141,8 +137,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info)
if (a%is_bld()) then
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -166,8 +162,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc)
if (a%is_bld()) then
call a%csput(nz,ia,ja,val,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -200,8 +196,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,&
& info,rebuild=rebuild_)
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -212,8 +207,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
else
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,&
& info,gtl=desc_a%idxmap%glob_to_loc,rebuild=rebuild_)
call a%csput(nz,ia,ja,val,1,nrow,1,ncol,&
& info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then
info=4010
ch_err='psb_coins'
@@ -244,7 +239,6 @@ end subroutine psb_zspins
subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_tools_mod, psb_protect_name => psb_zspins_2desc
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -254,7 +248,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
!....parameters...
type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_zspmat_type), intent(inout) :: a
type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:)
integer, intent(out) :: info
@@ -310,7 +304,6 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
end if
if (nz==0) return
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_ac)) then
allocate(ila(nz),jla(nz),stat=info)
@@ -334,7 +327,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
nrow = psb_cd_get_local_rows(desc_ar)
ncol = psb_cd_get_local_cols(desc_ac)
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info)
call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
if (info /= 0) then
info=4010
ch_err='psb_coins'
base/tools/psb_zsprn.f90
+3 -9
View File
@@ -36,7 +36,7 @@
! is in the update state.
!
! Arguments:
! a - type(psb_zspmat_type). The sparse matrix to be reinitiated.
! a - type(psb_z_sparse_mat). The sparse matrix to be reinitiated.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code.
! clear - logical, optional Whether the coefficients should be zeroed
@@ -45,7 +45,6 @@
Subroutine psb_zsprn(a, desc_a,info,clear)
use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
@@ -54,7 +53,7 @@ Subroutine psb_zsprn(a, desc_a,info,clear)
!....Parameters...
Type(psb_desc_type), intent(in) :: desc_a
Type(psb_zspmat_type), intent(inout) :: a
Type(psb_z_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
logical, intent(in), optional :: clear
@@ -87,13 +86,8 @@ Subroutine psb_zsprn(a, desc_a,info,clear)
call psb_errpush(info,name)
goto 9999
endif
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
call psb_sp_reinit(a,info,clear=clear_)
call a%reinit(clear=clear)
if (info /= 0) goto 9999
if (debug_level >= psb_debug_outer_) &
krylov/psb_cbicg.f90
+4 -4
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -100,8 +100,8 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ parameters
type(psb_cspmat_type), intent(in) :: a
type(psb_cprec_type), intent(in) :: prec
type(psb_c_sparse_mat), intent(in) :: a
class(psb_cprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), intent(in) :: b(:)
complex(psb_spk_), intent(inout) :: x(:)
krylov/psb_ccg.f90
+4 -4
View File
@@ -63,8 +63,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -102,8 +102,8 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ Parameters
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_cprec_type), Intent(in) :: prec
Type(psb_c_sparse_mat), Intent(in) :: a
class(psb_cprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
krylov/psb_ccgs.f90
+4 -4
View File
@@ -61,8 +61,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -99,9 +99,9 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ parameters
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_cprec_type), Intent(in) :: prec
class(psb_cprec_type), Intent(in) :: prec
Complex(psb_spk_), Intent(in) :: b(:)
Complex(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
krylov/psb_ccgstab.f90
+4 -4
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -99,8 +99,8 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_krylov_mod, psb_protect_name => psb_ccgstab
Implicit None
!!$ parameters
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_cprec_type), Intent(in) :: prec
Type(psb_c_sparse_mat), Intent(in) :: a
class(psb_cprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Complex(psb_spk_), Intent(in) :: b(:)
Complex(psb_spk_), Intent(inout) :: x(:)
krylov/psb_ccgstabl.f90
+4 -4
View File
@@ -69,8 +69,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -110,8 +110,8 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
implicit none
!!$ parameters
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_cprec_type), Intent(in) :: prec
Type(psb_c_sparse_mat), Intent(in) :: a
class(psb_cprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
krylov/psb_crgmres.f90
+4 -4
View File
@@ -73,8 +73,8 @@
!
! Arguments:
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -112,8 +112,8 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
implicit none
!!$ Parameters
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_cprec_type), Intent(in) :: prec
Type(psb_c_sparse_mat), Intent(in) :: a
class(psb_cprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
krylov/psb_dbicg.f90
+3 -3
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -101,7 +101,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
type(psb_d_sparse_mat), intent(in) :: a
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
krylov/psb_dcg.F90
+3 -3
View File
@@ -63,8 +63,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -104,7 +104,7 @@ subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond)
Type(psb_dprec_type), Intent(in) :: prec
class(psb_dprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_dcgs.f90
+3 -3
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -103,7 +103,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_dprec_type), Intent(in) :: prec
class(psb_dprec_type), Intent(in) :: prec
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
krylov/psb_dcgstab.F90
+3 -3
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -102,7 +102,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
type(psb_d_sparse_mat), intent(in) :: a
Type(psb_dprec_type), Intent(in) :: prec
class(psb_dprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_dcgstabl.f90
+3 -3
View File
@@ -69,8 +69,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -111,7 +111,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
type(psb_d_sparse_mat), intent(in) :: a
Type(psb_dprec_type), Intent(in) :: prec
class(psb_dprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_drgmres.f90
+3 -3
View File
@@ -73,8 +73,8 @@
!
! Arguments:
!
! a - type(psb_dspmat_type) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -114,7 +114,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
type(psb_d_sparse_mat), intent(in) :: a
Type(psb_dprec_type), Intent(in) :: prec
class(psb_dprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_krylov_mod.f90
+62 -62
View File
@@ -52,7 +52,7 @@ Module psb_krylov_mod
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -67,7 +67,7 @@ Module psb_krylov_mod
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -75,14 +75,14 @@ Module psb_krylov_mod
end subroutine psb_dcg
subroutine psb_ccg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), intent(in) :: b(:)
complex(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -90,14 +90,14 @@ Module psb_krylov_mod
end subroutine psb_ccg
subroutine psb_zcg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), intent(in) :: b(:)
complex(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -115,7 +115,7 @@ Module psb_krylov_mod
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -130,7 +130,7 @@ Module psb_krylov_mod
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -138,14 +138,14 @@ Module psb_krylov_mod
end subroutine psb_dbicg
subroutine psb_cbicg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), intent(in) :: b(:)
complex(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -153,14 +153,14 @@ Module psb_krylov_mod
end subroutine psb_cbicg
subroutine psb_zbicg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), intent(in) :: b(:)
complex(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -178,7 +178,7 @@ Module psb_krylov_mod
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -193,7 +193,7 @@ Module psb_krylov_mod
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -201,14 +201,14 @@ Module psb_krylov_mod
end subroutine psb_dcgstab
subroutine psb_ccgstab(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), intent(in) :: b(:)
complex(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -216,14 +216,14 @@ Module psb_krylov_mod
end subroutine psb_ccgstab
subroutine psb_zcgstab(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), intent(in) :: b(:)
complex(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -238,7 +238,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_sprec_type
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -253,7 +253,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_dprec_type
type(psb_d_sparse_mat), intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -264,11 +264,11 @@ Module psb_krylov_mod
end subroutine psb_dcgstabl
Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -279,11 +279,11 @@ Module psb_krylov_mod
end subroutine psb_ccgstabl
Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -301,7 +301,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_sprec_type
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -316,7 +316,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_dprec_type
type(psb_d_sparse_mat), intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -327,11 +327,11 @@ Module psb_krylov_mod
end subroutine psb_drgmres
Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -342,11 +342,11 @@ Module psb_krylov_mod
end subroutine psb_crgmres
Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -364,7 +364,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_sprec_type
type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
@@ -379,7 +379,7 @@ Module psb_krylov_mod
use psb_prec_mod, only : psb_dprec_type
type(psb_d_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
real(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
@@ -390,14 +390,14 @@ Module psb_krylov_mod
end subroutine psb_dcgs
subroutine psb_ccgs(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_cprec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), intent(in) :: b(:)
complex(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(in) :: eps
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -405,14 +405,14 @@ Module psb_krylov_mod
end subroutine psb_ccgs
subroutine psb_zcgs(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_mod, only : psb_zprec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), intent(in) :: b(:)
complex(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(in) :: eps
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
integer, intent(out) :: info
integer, optional, intent(in) :: itmax, itrace,istop
integer, optional, intent(out) :: iter
@@ -463,7 +463,7 @@ contains
! RGMRES
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -500,7 +500,7 @@ contains
character(len=*) :: method
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -580,7 +580,7 @@ contains
! RGMRES
!
! a - type(psb_d_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_dprec_type) Input: preconditioner
! prec - class(psb_dprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -618,7 +618,7 @@ contains
character(len=*) :: method
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_dprec_type), intent(in) :: prec
class(psb_dprec_type), intent(in) :: prec
Real(psb_dpk_), Intent(in) :: b(:)
Real(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -698,8 +698,8 @@ contains
! BICGSTABL
! RGMRES
!
! a - type(psb_cspmat_type) Input: sparse matrix containing A.
! prec - type(psb_cprec_type) Input: preconditioner
! a - type(psb_c_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_cprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -732,9 +732,9 @@ contains
use psb_base_mod
use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type
character(len=*) :: method
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_c_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_cprec_type), intent(in) :: prec
class(psb_cprec_type), intent(in) :: prec
complex(psb_spk_), Intent(in) :: b(:)
complex(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
@@ -814,8 +814,8 @@ contains
! BICGSTABL
! RGMRES
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -848,9 +848,9 @@ contains
use psb_base_mod
use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type
character(len=*) :: method
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_zprec_type), intent(in) :: prec
class(psb_zprec_type), intent(in) :: prec
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
@@ -1130,7 +1130,7 @@ contains
implicit none
character(len=*), intent(in) :: methdname
integer, intent(in) :: stopc, trace, itmax
type(psb_cspmat_type), intent(in) :: a
type(psb_c_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(in) :: eps
type(psb_desc_type), intent(in) :: desc_a
@@ -1198,7 +1198,7 @@ contains
implicit none
character(len=*), intent(in) :: methdname
integer, intent(in) :: stopc, trace, itmax
type(psb_zspmat_type), intent(in) :: a
type(psb_z_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: b(:)
real(psb_dpk_), intent(in) :: eps
type(psb_desc_type), intent(in) :: desc_a
krylov/psb_sbicg.f90
+2 -2
View File
@@ -63,7 +63,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -102,7 +102,7 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
!!$ parameters
type(psb_s_sparse_mat), intent(in) :: a
type(psb_sprec_type), intent(in) :: prec
class(psb_sprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:)
krylov/psb_scg.F90
+2 -2
View File
@@ -64,7 +64,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -103,7 +103,7 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond)
!!$ Parameters
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec
class(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
krylov/psb_scgs.f90
+2 -2
View File
@@ -63,7 +63,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -103,7 +103,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
!!$ parameters
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_sprec_type), Intent(in) :: prec
class(psb_sprec_type), Intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
Real(psb_spk_), Intent(in) :: eps
krylov/psb_scgstab.F90
+2 -2
View File
@@ -63,7 +63,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -101,7 +101,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
Implicit None
!!$ parameters
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec
class(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
krylov/psb_scgstabl.f90
+2 -2
View File
@@ -70,7 +70,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -111,7 +111,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
!!$ parameters
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec
class(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
krylov/psb_srgmres.f90
+2 -2
View File
@@ -74,7 +74,7 @@
! Arguments:
!
! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner
! prec - class(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the
! right hand side B
! x - real,dimension(:) Input/Output: vector containing the
@@ -114,7 +114,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
!!$ Parameters
Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec
class(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:)
Real(psb_spk_), Intent(inout) :: x(:)
krylov/psb_zbicg.f90
+4 -4
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -100,8 +100,8 @@ subroutine psb_zbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ parameters
type(psb_zspmat_type), intent(in) :: a
type(psb_zprec_type), intent(in) :: prec
type(psb_z_sparse_mat), intent(in) :: a
class(psb_zprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), intent(in) :: b(:)
complex(psb_dpk_), intent(inout) :: x(:)
krylov/psb_zcg.F90
+4 -4
View File
@@ -63,8 +63,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -102,8 +102,8 @@ subroutine psb_zcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ Parameters
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zprec_type), Intent(in) :: prec
Type(psb_z_sparse_mat), Intent(in) :: a
class(psb_zprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_zcgs.f90
+4 -4
View File
@@ -61,8 +61,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -99,9 +99,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none
!!$ parameters
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_z_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_zprec_type), Intent(in) :: prec
class(psb_zprec_type), Intent(in) :: prec
Complex(psb_dpk_), Intent(in) :: b(:)
Complex(psb_dpk_), Intent(inout) :: x(:)
Real(psb_dpk_), Intent(in) :: eps
krylov/psb_zcgstab.f90
+4 -4
View File
@@ -62,8 +62,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -99,8 +99,8 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_krylov_mod, psb_protect_name => psb_zcgstab
Implicit None
!!$ parameters
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zprec_type), Intent(in) :: prec
Type(psb_z_sparse_mat), Intent(in) :: a
class(psb_zprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
Complex(psb_dpk_), Intent(in) :: b(:)
Complex(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_zcgstabl.f90
+4 -4
View File
@@ -69,8 +69,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b(:) - complex Input: vector containing the
! right hand side B
! x(:) - complex Input/Output: vector containing the
@@ -110,8 +110,8 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
implicit none
!!$ parameters
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zprec_type), Intent(in) :: prec
Type(psb_z_sparse_mat), Intent(in) :: a
class(psb_zprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
krylov/psb_zrgmres.f90
+4 -4
View File
@@ -73,8 +73,8 @@
!
! Arguments:
!
! a - type(psb_zspmat_type) Input: sparse matrix containing A.
! prec - type(psb_zprec_type) Input: preconditioner
! a - type(psb_z_sparse_mat) Input: sparse matrix containing A.
! prec - class(psb_zprec_type) Input: preconditioner
! b - complex,dimension(:) Input: vector containing the
! right hand side B
! x - complex,dimension(:) Input/Output: vector containing the
@@ -112,8 +112,8 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
implicit none
!!$ Parameters
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zprec_type), Intent(in) :: prec
Type(psb_z_sparse_mat), Intent(in) :: a
class(psb_zprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a
complex(psb_dpk_), Intent(in) :: b(:)
complex(psb_dpk_), Intent(inout) :: x(:)
prec/psb_cbjac_aply.f90
+6 -6
View File
@@ -108,26 +108,26 @@ subroutine psb_cbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case('N')
call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux)
& trans=trans_,side='L',diag=prec%d,choice=psb_none_,work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_, work=aux)
& trans=trans_,side='U',choice=psb_none_, work=aux)
if(info /=0) goto 9999
case('T')
call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux)
& trans=trans_,side='L',diag=prec%d,choice=psb_none_, work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux)
& trans=trans_,side='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999
case('C')
call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux)
& trans=trans_,side='L',diag=conjg(prec%d),choice=psb_none_, work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux)
& trans=trans_,side='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999
end select
prec/psb_cbjac_bld.f90
+20 -30
View File
@@ -37,7 +37,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
! .. Scalar Arguments ..
integer, intent(out) :: info
! .. array Arguments ..
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_cprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
@@ -46,7 +46,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
integer :: i, m
integer :: int_err(5)
character :: trans, unitd
type(psb_cspmat_type) :: atmp
type(psb_c_csr_sparse_mat), allocatable :: lf, uf
real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8
integer nztota, err_act, n_row, nrow_a,n_col, nhalo
integer :: ictxt,np,me
@@ -61,7 +61,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
m = a%m
m = a%get_nrows()
if (m < 0) then
info = 10
int_err(1) = 1
@@ -71,7 +71,6 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
endif
trans = 'N'
unitd = 'U'
call psb_nullify_sp(atmp)
call psb_cdcpy(desc_a,p%desc_data,info)
if(info /= 0) then
@@ -89,12 +88,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
if (allocated(p%av)) then
if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
call p%av(i)%free()
enddo
deallocate(p%av,stat=info)
endif
@@ -108,17 +102,16 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
endif
nrow_a = psb_cd_get_local_rows(desc_a)
nztota = psb_sp_get_nnzeros(a)
nztota = a%get_nzeros()
n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(psb_l_pr_)%m = n_row
p%av(psb_l_pr_)%k = n_row
p%av(psb_u_pr_)%m = n_row
p%av(psb_u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info)
allocate(lf,uf,stat=info)
if (info == 0) call lf%allocate(n_row,n_row,nztota)
if (info == 0) call uf%allocate(n_row,n_row,nztota)
if(info/=0) then
info=4010
ch_err='psb_sp_all'
@@ -140,26 +133,23 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
endif
t3 = psb_wtime()
! This is where we have mo renumbering, thus no need
! for ATMP
! This is where we have no renumbering, thus no need
call psb_ilu_fct(a,lf,uf,p%d,info)
call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info)
if(info/=0) then
if(info==0) then
call p%av(psb_l_pr_)%mv_from(lf)
call p%av(psb_u_pr_)%mv_from(uf)
call p%av(psb_l_pr_)%set_asb()
call p%av(psb_u_pr_)%set_asb()
call p%av(psb_l_pr_)%trim()
call p%av(psb_u_pr_)%trim()
else
info=4010
ch_err='psb_ilu_fct'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_u_pr_),info)
endif
if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_l_pr_),info)
endif
case(psb_f_none_)
info=4010
ch_err='Inconsistent prec psb_f_none_'
prec/psb_cdiagsc_bld.f90
+2 -15
View File
@@ -35,7 +35,7 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info)
use psb_prec_mod, psb_protect_name => psb_cdiagsc_bld
Implicit None
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_cprec_type),intent(inout) :: p
character, intent(in) :: upd
@@ -76,7 +76,7 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info)
!
! Retrieve the diagonal entries of the matrix A
!
call psb_sp_getdiag(a,p%d,info)
call a%get_diag(p%d,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_getdiag'
@@ -105,19 +105,6 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info)
endif
end do
if (a%pl(1) /= 0) then
!
! Apply the same row permutation as in the sparse matrix A
!
call psb_gelp('n',a%pl,p%d,info)
if(info /= 0) then
info=4010
ch_err='psb_gelp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
endif
call psb_erractionrestore(err_act)
return
prec/psb_cilu_fct.f90
+88 -154
View File
@@ -41,15 +41,15 @@ subroutine psb_cilu_fct(a,l,u,d,info,blck)
! .. Scalar Arguments ..
integer, intent(out) :: info
! .. Array Arguments ..
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
type(psb_cspmat_type),intent(in), optional, target :: blck
type(psb_c_sparse_mat),intent(in) :: a
type(psb_c_csr_sparse_mat),intent(inout) :: l,u
type(psb_c_sparse_mat),intent(in), optional, target :: blck
complex(psb_spk_), intent(inout) :: d(:)
! .. Local Scalars ..
integer :: l1, l2,m,err_act
type(psb_cspmat_type), pointer :: blck_
type(psb_c_sparse_mat), pointer :: blck_
character(len=20) :: name, ch_err
name='psb_ccsrlu'
name='psb_ilu_fct'
info = 0
call psb_erractionsave(err_act)
! .. Executable Statements ..
@@ -64,41 +64,34 @@ subroutine psb_cilu_fct(a,l,u,d,info,blck)
goto 9999
end if
call psb_nullify_sp(blck_) ! Why do we need this? Who knows....
call psb_sp_all(0,0,blck_,1,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call blck_%csall(0,0,info,1)
blck_%m=0
endif
call psb_cilu_fctint(m,a%m,a,blck_%m,blck_,&
& d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info)
call psb_cilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,&
& d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info)
if(info /= 0) then
info=4010
ch_err='psb_cilu_fctint'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
l%infoa(1) = l1
l%fida = 'CSR'
l%descra = 'TLU'
u%infoa(1) = l2
u%fida = 'CSR'
u%descra = 'TUU'
l%m = m
l%k = m
u%m = m
u%k = m
call l%set_triangle()
call l%set_lower()
call l%set_unit()
call u%set_triangle()
call u%set_upper()
call u%set_unit()
call l%set_nrows(m)
call l%set_ncols(m)
call u%set_nrows(m)
call u%set_ncols(m)
if (present(blck)) then
blck_ => null()
else
call psb_sp_free(blck_,info)
call blck_%free()
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
@@ -124,15 +117,15 @@ contains
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
implicit none
type(psb_cspmat_type) :: a,b
type(psb_c_sparse_mat) :: a,b
integer :: m,ma,mb,l1,l2,info
integer, dimension(:) :: lia1,lia2,uia1,uia2
complex(psb_spk_), dimension(:) :: laspk,uaspk,d
integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act
integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz
complex(psb_spk_) :: dia,temp
integer, parameter :: nrb=16
type(psb_cspmat_type) :: trw
integer, parameter :: nrb=60
type(psb_c_coo_sparse_mat) :: trw
integer :: int_err(5)
character(len=20) :: name, ch_err
@@ -140,11 +133,7 @@ contains
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
call psb_nullify_sp(trw)
trw%m=0
trw%k=0
call psb_sp_all(trw,1,info)
call trw%allocate(0,0,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
@@ -159,64 +148,40 @@ contains
m = ma+mb
do i = 1, ma
d(i) = zzero
d(i) = czero
!
! Here we take a fast shortcut if possible, otherwise
! use spgtblk, slower but able (in principle) to handle
! anything.
!
if (a%fida=='CSR') then
do j = a%ia2(i), a%ia2(i+1) - 1
k = a%ia1(j)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = a%aspk(j)
lia1(l1) = k
else if (k == i) then
d(i) = a%aspk(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = a%aspk(j)
uia1(l2) = k
end if
enddo
else
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1)
if(info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
ktrw=1
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call a%a%csget(i,i+irb-1,trw,info)
if(info /= 0) then
info=4010
ch_err='a%csget'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
do
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%aspk(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%aspk(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
nz = trw%get_nzeros()
ktrw=1
end if
do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
!!$
lia2(i+1) = l1 + 1
@@ -291,7 +256,7 @@ contains
call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
goto 9999
else
dia = zone/dia
dia = cone/dia
end if
d(i) = dia
! write(6,*)'diag(',i,')=',d(i)
@@ -302,63 +267,38 @@ contains
enddo
do i = ma+1, m
d(i) = zzero
d(i) = czero
if (b%fida=='CSR') then
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
k = b%ia1(j)
! if (me == 2) write(0,*)'ecco k=',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = b%aspk(j)
lia1(l1) = k
! if(me == 2) write(0,*)'scrivo l'
else if (k == i) then
d(i) = b%aspk(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = b%aspk(j)
! write(0,*)'KKKKK',k
uia1(l2) = k
end if
enddo
else
if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then
irb = min(m-i+1,nrb)
call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1)
if(info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
ktrw=1
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call b%a%csget(i-ma,i-ma+irb-1,trw,info)
nz = trw%get_nzeros()
if(info /= 0) then
info=4010
ch_err='a%csget'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
do
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%aspk(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%aspk(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
endif
ktrw=1
end if
do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
lia2(i+1) = l1 + 1
@@ -431,7 +371,7 @@ contains
call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
goto 9999
else
dia = zone/dia
dia = cone/dia
end if
d(i) = dia
! Scale row i of upper triangle
@@ -440,13 +380,7 @@ contains
enddo
enddo
call psb_sp_free(trw,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call trw%free()
call psb_erractionrestore(err_act)
return
prec/psb_cprecbld.f90
+1 -1
View File
@@ -35,7 +35,7 @@ subroutine psb_cprecbld(a,desc_a,p,info,upd)
use psb_prec_mod, psb_protect_name => psb_cprecbld
Implicit None
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_cprec_type),intent(inout) :: p
integer, intent(out) :: info
prec/psb_prec_mod.f90
+34 -32
View File
@@ -55,20 +55,20 @@ module psb_prec_mod
character, intent(in),optional :: upd
end subroutine psb_dprecbld
subroutine psb_cprecbld(a,desc_a,prec,info,upd)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_cprec_type), intent(inout) :: prec
integer, intent(out) :: info
character, intent(in),optional :: upd
end subroutine psb_cprecbld
subroutine psb_zprecbld(a,desc_a,prec,info,upd)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_zprec_type), intent(inout) :: prec
integer, intent(out) :: info
@@ -147,7 +147,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_dprecsetd
subroutine psb_cprecseti(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
implicit none
type(psb_cprec_type), intent(inout) :: prec
@@ -155,7 +155,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_cprecseti
subroutine psb_cprecsets(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
implicit none
type(psb_cprec_type), intent(inout) :: prec
@@ -164,7 +164,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_cprecsets
subroutine psb_zprecseti(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
implicit none
type(psb_zprec_type), intent(inout) :: prec
@@ -172,7 +172,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_zprecseti
subroutine psb_zprecsetd(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
implicit none
type(psb_zprec_type), intent(inout) :: prec
@@ -225,7 +225,7 @@ module psb_prec_mod
character(len=1), optional :: trans
end subroutine psb_dprc_aply1
subroutine psb_cprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
@@ -236,7 +236,7 @@ module psb_prec_mod
complex(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_cprc_aply
subroutine psb_cprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
@@ -245,7 +245,7 @@ module psb_prec_mod
character(len=1), optional :: trans
end subroutine psb_cprc_aply1
subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
@@ -256,7 +256,7 @@ module psb_prec_mod
complex(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_zprc_aply
subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
@@ -293,7 +293,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_dbjac_aply
subroutine psb_cbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
@@ -305,7 +305,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_cbjac_aply
subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
@@ -338,19 +338,21 @@ module psb_prec_mod
real(psb_dpk_), intent(inout) :: d(:)
end subroutine psb_dilu_fct
subroutine psb_cilu_fct(a,l,u,d,info,blck)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, &
& psb_c_csr_sparse_mat, psb_spk_
integer, intent(out) :: info
type(psb_cspmat_type),intent(in) :: a
type(psb_cspmat_type),intent(inout) :: l,u
type(psb_cspmat_type),intent(in), optional, target :: blck
type(psb_c_sparse_mat),intent(in) :: a
type(psb_c_csr_sparse_mat),intent(inout) :: l,u
type(psb_c_sparse_mat),intent(in), optional, target :: blck
complex(psb_spk_), intent(inout) :: d(:)
end subroutine psb_cilu_fct
subroutine psb_zilu_fct(a,l,u,d,info,blck)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, &
& psb_z_csr_sparse_mat, psb_dpk_
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck
type(psb_z_sparse_mat),intent(in) :: a
type(psb_z_csr_sparse_mat),intent(inout) :: l,u
type(psb_z_sparse_mat),intent(in), optional, target :: blck
complex(psb_dpk_), intent(inout) :: d(:)
end subroutine psb_zilu_fct
end interface
@@ -375,19 +377,19 @@ module psb_prec_mod
character, intent(in) :: upd
end subroutine psb_dbjac_bld
subroutine psb_cbjac_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
integer, intent(out) :: info
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_cprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
end subroutine psb_cbjac_bld
subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_zprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
@@ -415,19 +417,19 @@ module psb_prec_mod
character, intent(in) :: upd
end subroutine psb_ddiagsc_bld
subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
integer, intent(out) :: info
type(psb_cspmat_type), intent(in), target :: a
type(psb_c_sparse_mat), intent(in), target :: a
type(psb_cprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
end subroutine psb_cdiagsc_bld
subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_zprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
@@ -460,7 +462,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_dgprec_aply
subroutine psb_cgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_
use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_
use psb_prec_type, only : psb_cprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_cprec_type), intent(in) :: prec
@@ -472,7 +474,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_cgprec_aply
subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_
use psb_prec_type, only : psb_zprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
prec/psb_prec_type.f90
+8 -21
View File
@@ -37,11 +37,10 @@
module psb_prec_type
! Reduces size of .mod file.
use psb_base_mod, only : psb_cspmat_type,&
& psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,&
& psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus
use psb_mat_mod, only : psb_s_sparse_mat, psb_d_sparse_mat
use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_desc_type, psb_sizeof, psb_free, psb_cdfree,&
& psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,&
& psb_s_sparse_mat, psb_d_sparse_mat, psb_c_sparse_mat, psb_z_sparse_mat
integer, parameter :: psb_min_prec_=0, psb_noprec_=0, psb_diag_=1, &
& psb_bjac_=2, psb_max_prec_=2
@@ -86,7 +85,7 @@ module psb_prec_type
end type psb_dprec_type
type psb_cprec_type
type(psb_cspmat_type), allocatable :: av(:)
type(psb_c_sparse_mat), allocatable :: av(:)
complex(psb_spk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data
integer, allocatable :: iprcparm(:)
@@ -97,7 +96,7 @@ module psb_prec_type
type psb_zprec_type
type(psb_zspmat_type), allocatable :: av(:)
type(psb_z_sparse_mat), allocatable :: av(:)
complex(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data
integer, allocatable :: iprcparm(:)
@@ -460,12 +459,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
call p%av(i)%free()
enddo
deallocate(p%av,stat=info)
@@ -523,12 +517,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
call p%av(i)%free()
enddo
deallocate(p%av,stat=info)
@@ -591,7 +580,6 @@ contains
function psb_dprec_sizeof(prec) result(val)
use psb_mat_mod
type(psb_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@@ -611,7 +599,6 @@ contains
end function psb_dprec_sizeof
function psb_sprec_sizeof(prec) result(val)
use psb_mat_mod
type(psb_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
prec/psb_zbjac_aply.f90
+6 -6
View File
@@ -108,26 +108,26 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case('N')
call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux)
& trans=trans_,side='L',diag=prec%d,choice=psb_none_,work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_, work=aux)
& trans=trans_,side='U',choice=psb_none_, work=aux)
if(info /=0) goto 9999
case('T')
call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux)
& trans=trans_,side='L',diag=prec%d,choice=psb_none_, work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux)
& trans=trans_,side='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999
case('C')
call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,&
& trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux)
& trans=trans_,side='L',diag=conjg(prec%d),choice=psb_none_, work=aux)
if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,&
& trans=trans_,unit='U',choice=psb_none_,work=aux)
& trans=trans_,side='U',choice=psb_none_,work=aux)
if(info /=0) goto 9999
end select
prec/psb_zbjac_bld.f90
+20 -30
View File
@@ -37,7 +37,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
! .. Scalar Arguments ..
integer, intent(out) :: info
! .. array Arguments ..
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_zprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd
@@ -46,7 +46,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
integer :: i, m
integer :: int_err(5)
character :: trans, unitd
type(psb_zspmat_type) :: atmp
type(psb_z_csr_sparse_mat), allocatable :: lf, uf
real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8
integer nztota, err_act, n_row, nrow_a,n_col, nhalo
integer :: ictxt,np,me
@@ -61,7 +61,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
m = a%m
m = a%get_nrows()
if (m < 0) then
info = 10
int_err(1) = 1
@@ -71,7 +71,6 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif
trans = 'N'
unitd = 'U'
call psb_nullify_sp(atmp)
call psb_cdcpy(desc_a,p%desc_data,info)
if(info /= 0) then
@@ -89,12 +88,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
if (allocated(p%av)) then
if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
call p%av(i)%free()
enddo
deallocate(p%av,stat=info)
endif
@@ -108,17 +102,16 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif
nrow_a = psb_cd_get_local_rows(desc_a)
nztota = psb_sp_get_nnzeros(a)
nztota = a%get_nzeros()
n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_)
p%av(psb_l_pr_)%m = n_row
p%av(psb_l_pr_)%k = n_row
p%av(psb_u_pr_)%m = n_row
p%av(psb_u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info)
if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info)
allocate(lf,uf,stat=info)
if (info == 0) call lf%allocate(n_row,n_row,nztota)
if (info == 0) call uf%allocate(n_row,n_row,nztota)
if(info/=0) then
info=4010
ch_err='psb_sp_all'
@@ -140,26 +133,23 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif
t3 = psb_wtime()
! This is where we have mo renumbering, thus no need
! for ATMP
! This is where we have no renumbering, thus no need
call psb_ilu_fct(a,lf,uf,p%d,info)
call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info)
if(info/=0) then
if(info==0) then
call p%av(psb_l_pr_)%mv_from(lf)
call p%av(psb_u_pr_)%mv_from(uf)
call p%av(psb_l_pr_)%set_asb()
call p%av(psb_u_pr_)%set_asb()
call p%av(psb_l_pr_)%trim()
call p%av(psb_u_pr_)%trim()
else
info=4010
ch_err='psb_ilu_fct'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_u_pr_),info)
endif
if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trim(p%av(psb_l_pr_),info)
endif
case(psb_f_none_)
info=4010
ch_err='Inconsistent prec psb_f_none_'
prec/psb_zdiagsc_bld.f90
+2 -15
View File
@@ -35,7 +35,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
use psb_prec_mod, psb_protect_name => psb_zdiagsc_bld
Implicit None
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zprec_type),intent(inout) :: p
character, intent(in) :: upd
@@ -76,7 +76,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
!
! Retrieve the diagonal entries of the matrix A
!
call psb_sp_getdiag(a,p%d,info)
call a%get_diag(p%d,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_getdiag'
@@ -105,19 +105,6 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
endif
end do
if (a%pl(1) /= 0) then
!
! Apply the same row permutation as in the sparse matrix A
!
call psb_gelp('n',a%pl,p%d,info)
if(info /= 0) then
info=4010
ch_err='psb_zgelp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
endif
call psb_erractionrestore(err_act)
return
prec/psb_zilu_fct.f90
+84 -150
View File
@@ -41,15 +41,15 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck)
! .. Scalar Arguments ..
integer, intent(out) :: info
! .. Array Arguments ..
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck
type(psb_z_sparse_mat),intent(in) :: a
type(psb_z_csr_sparse_mat),intent(inout) :: l,u
type(psb_z_sparse_mat),intent(in), optional, target :: blck
complex(psb_dpk_), intent(inout) :: d(:)
! .. Local Scalars ..
integer :: l1, l2,m,err_act
type(psb_zspmat_type), pointer :: blck_
type(psb_z_sparse_mat), pointer :: blck_
character(len=20) :: name, ch_err
name='psb_zcsrlu'
name='psb_ilu_fct'
info = 0
call psb_erractionsave(err_act)
! .. Executable Statements ..
@@ -64,41 +64,34 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck)
goto 9999
end if
call psb_nullify_sp(blck_) ! Why do we need this? Who knows....
call psb_sp_all(0,0,blck_,1,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call blck_%csall(0,0,info,1)
blck_%m=0
endif
call psb_zilu_fctint(m,a%m,a,blck_%m,blck_,&
& d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info)
call psb_zilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,&
& d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info)
if(info /= 0) then
info=4010
ch_err='psb_zilu_fctint'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
l%infoa(1) = l1
l%fida = 'CSR'
l%descra = 'TLU'
u%infoa(1) = l2
u%fida = 'CSR'
u%descra = 'TUU'
l%m = m
l%k = m
u%m = m
u%k = m
call l%set_triangle()
call l%set_lower()
call l%set_unit()
call u%set_triangle()
call u%set_upper()
call u%set_unit()
call l%set_nrows(m)
call l%set_ncols(m)
call u%set_nrows(m)
call u%set_ncols(m)
if (present(blck)) then
blck_ => null()
else
call psb_sp_free(blck_,info)
call blck_%free()
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
@@ -124,15 +117,15 @@ contains
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
implicit none
type(psb_zspmat_type) :: a,b
type(psb_z_sparse_mat) :: a,b
integer :: m,ma,mb,l1,l2,info
integer, dimension(:) :: lia1,lia2,uia1,uia2
complex(psb_dpk_), dimension(:) :: laspk,uaspk,d
integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act
integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz
complex(psb_dpk_) :: dia,temp
integer, parameter :: nrb=16
type(psb_zspmat_type) :: trw
integer, parameter :: nrb=60
type(psb_z_coo_sparse_mat) :: trw
integer :: int_err(5)
character(len=20) :: name, ch_err
@@ -140,11 +133,7 @@ contains
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
call psb_nullify_sp(trw)
trw%m=0
trw%k=0
call psb_sp_all(trw,1,info)
call trw%allocate(0,0,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
@@ -162,61 +151,37 @@ contains
d(i) = zzero
!
! Here we take a fast shortcut if possible, otherwise
! use spgtblk, slower but able (in principle) to handle
! anything.
!
if (a%fida=='CSR') then
do j = a%ia2(i), a%ia2(i+1) - 1
k = a%ia1(j)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = a%aspk(j)
lia1(l1) = k
else if (k == i) then
d(i) = a%aspk(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = a%aspk(j)
uia1(l2) = k
end if
enddo
else
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1)
if(info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
ktrw=1
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call a%a%csget(i,i+irb-1,trw,info)
if(info /= 0) then
info=4010
ch_err='a%csget'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
do
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%aspk(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%aspk(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
nz = trw%get_nzeros()
ktrw=1
end if
do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
!!$
lia2(i+1) = l1 + 1
@@ -304,61 +269,36 @@ contains
do i = ma+1, m
d(i) = zzero
if (b%fida=='CSR') then
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
k = b%ia1(j)
! if (me == 2) write(0,*)'ecco k=',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = b%aspk(j)
lia1(l1) = k
! if(me == 2) write(0,*)'scrivo l'
else if (k == i) then
d(i) = b%aspk(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = b%aspk(j)
! write(0,*)'KKKKK',k
uia1(l2) = k
end if
enddo
else
if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then
irb = min(m-i+1,nrb)
call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1)
if(info /= 0) then
info=4010
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
ktrw=1
if ((mod(i,nrb) == 1).or.(nrb==1)) then
irb = min(ma-i+1,nrb)
call b%a%csget(i-ma,i-ma+irb-1,trw,info)
nz = trw%get_nzeros()
if(info /= 0) then
info=4010
ch_err='a%csget'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
do
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%aspk(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%aspk(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
endif
ktrw=1
end if
do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
lia2(i+1) = l1 + 1
@@ -440,13 +380,7 @@ contains
enddo
enddo
call psb_sp_free(trw,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call trw%free()
call psb_erractionrestore(err_act)
return
prec/psb_zprecbld.f90
+1 -1
View File
@@ -35,7 +35,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
use psb_prec_mod, psb_protect_name => psb_zprecbld
Implicit None
type(psb_zspmat_type), intent(in), target :: a
type(psb_z_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_zprec_type),intent(inout) :: p
integer, intent(out) :: info
test/fileread/cf_sample.f90
+4 -3
View File
@@ -41,7 +41,7 @@ program cf_sample
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_cspmat_type) :: a, aux_a
type(psb_c_sparse_mat) :: a, aux_a
! preconditioner data
type(psb_cprec_type) :: prec
@@ -129,7 +129,7 @@ program cf_sample
call psb_abort(ictxt)
end if
m_problem = aux_a%m
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
! At this point aux_b may still be unallocated
@@ -179,7 +179,8 @@ program cf_sample
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
call build_mtpart(aux_a,np)
endif
call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
test/fileread/zf_sample.f90
+4 -5
View File
@@ -41,7 +41,7 @@ program zf_sample
character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_zspmat_type) :: a, aux_a
type(psb_z_sparse_mat) :: a, aux_a
! preconditioner data
type(psb_zprec_type) :: prec
@@ -129,7 +129,7 @@ program zf_sample
call psb_abort(ictxt)
end if
m_problem = aux_a%m
m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem)
! At this point aux_b may still be unallocated
@@ -179,7 +179,8 @@ program zf_sample
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
call build_mtpart(aux_a,np)
endif
call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
@@ -230,14 +231,12 @@ program zf_sample
write(*,'(" ")')
end if
call psb_set_debug_level(0)
iparm = 0
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
call psb_barrier(ictxt)
call psb_set_debug_level(0)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info)

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