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

psblas3:

Browse Source 
base/modules/Makefile
 base/modules/psb_base_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_linmap_mod.f90
 base/modules/psb_linmap_type_mod.f90
 base/modules/psb_psblas_mod.f90
 base/modules/psb_s_base_mat_mod.f03
 base/modules/psb_serial_mod.f90
 base/modules/psb_spmat_type.f03
 base/modules/psb_tools_mod.f90
 base/modules/psi_serial_mod.f90
 base/psblas/psb_dnrmi.f90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_dspsm.f90
 base/psblas/psb_snrmi.f90
 base/psblas/psb_sspmm.f90
 base/psblas/psb_sspsm.f90
 base/serial/Makefile
 base/serial/coo/Makefile
 base/serial/csr/Makefile
 base/serial/dp/Makefile
 base/serial/f03/psb_d_csr_impl.f03
 base/serial/f03/psb_s_csr_impl.f03
 base/serial/f77/Makefile
 base/serial/jad/Makefile
 base/serial/psb_getrow_mod.f90
 base/serial/psb_regen_mod.f90
 base/serial/psb_update_mod.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dspalloc.f90
 base/tools/psb_dspasb.f90
 base/tools/psb_dspfree.f90
 base/tools/psb_dspins.f90
 base/tools/psb_linmap.f90
 base/tools/psb_scdbldext.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
 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
 prec/psb_dbjac_aply.f90
 prec/psb_dbjac_bld.f90
 prec/psb_ddiagsc_bld.f90
 prec/psb_dilu_fct.f90
 prec/psb_dprecbld.f90
 prec/psb_prec_mod.f90
 prec/psb_prec_type.f90
 prec/psb_sbjac_aply.f90
 prec/psb_sbjac_bld.f90
 prec/psb_sdiagsc_bld.f90
 prec/psb_silu_fct.f90
 prec/psb_sprecbld.f90
 test/pargen/Makefile
 test/pargen/ppde.f90
 test/pargen/runs/ppde.inp
 test/pargen/spde.f90
 util/psb_hbio_mod.f90
 util/psb_mat_dist_mod.f90
 util/psb_metispart_mod.F90
 util/psb_mmio_mod.f90

Single precision version. At least, up to working pargen examples..
psblas3-type-indexed
Salvatore Filippone 16 years ago
parent 052a1751ef
commit 7cc636302a
68 changed files with 3934 additions and 3724 deletions
Show Stats Download Patch File Download Diff File

4
base/modules/Makefile
Unescape Escape View File

@ -27,7 +27,7 @@ lib: $(BASIC_MODS) blacsmod $(UTIL_MODS) $(OBJS) $(LIBMOD)
/bin/cp -p *$(.mod) $(LIBDIR) /bin/cp -p *$(.mod) $(LIBDIR)
psb_base_mat_mod.o: psb_string_mod.o psb_sort_mod.o psb_ip_reord_mod.o psb_error_mod.o psb_base_mat_mod.o: psb_string_mod.o psb_sort_mod.o psb_ip_reord_mod.o psb_error_mod.o psi_serial_mod.o
psb_s_base_mat_mod.o psb_d_base_mat_mod.o: psb_base_mat_mod.o psb_s_base_mat_mod.o psb_d_base_mat_mod.o: psb_base_mat_mod.o
psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o
psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o
@ -41,7 +41,7 @@ psb_blacs_mod.o: psb_const_mod.o
psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o 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 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_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_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_spmat_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_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_spmat_type.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o

1
base/modules/psb_base_mat_mod.f03
Unescape Escape View File

@ -1,6 +1,7 @@
module psb_base_mat_mod module psb_base_mat_mod
use psb_const_mod use psb_const_mod
use psi_serial_mod
type :: psb_base_sparse_mat type :: psb_base_sparse_mat
integer, private :: m, n integer, private :: m, n

4
base/modules/psb_d_base_mat_mod.f03
Unescape Escape View File

@ -995,7 +995,7 @@ contains
end do end do
end if end if
if (info == 0)& if (info == 0)&
& call daxpby(nar,nc,alpha,tmp,size(tmp,1),beta,y,size(y,1),info) & call psb_geaxpby(nar,nc,alpha,tmp,beta,y,info)
if (info == 0) then if (info == 0) then
deallocate(tmp,stat=info) deallocate(tmp,stat=info)
@ -1120,7 +1120,7 @@ contains
if (info == 0) tmp(1:nar) = d(1:nar)*tmp(1:nar) if (info == 0) tmp(1:nar) = d(1:nar)*tmp(1:nar)
if (info == 0)& if (info == 0)&
& call daxpby(nar,nc,alpha,tmp,size(tmp,1),beta,y,size(y,1),info) & call psb_geaxpby(nar,alpha,tmp,beta,y,info)
if (info == 0) then if (info == 0) then
deallocate(tmp,stat=info) deallocate(tmp,stat=info)

13
base/modules/psb_linmap_mod.f90
Unescape Escape View File

@ -37,8 +37,7 @@
! !
module psb_linmap_mod module psb_linmap_mod
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_descriptor_type use psb_descriptor_type
use psb_linmap_type_mod use psb_linmap_type_mod
@ -166,7 +165,7 @@ module psb_linmap_mod
implicit none implicit none
type(psb_slinmap_type) :: psb_s_linmap type(psb_slinmap_type) :: psb_s_linmap
type(psb_desc_type), target :: desc_X, desc_Y type(psb_desc_type), target :: desc_X, desc_Y
type(psb_sspmat_type), intent(in) :: map_X2Y, map_Y2X type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:) integer, intent(in), optional :: iaggr(:), naggr(:)
end function psb_s_linmap end function psb_s_linmap
@ -452,6 +451,7 @@ contains
function psb_slinmap_sizeof(map) result(val) function psb_slinmap_sizeof(map) result(val)
use psb_mat_mod
implicit none implicit none
type(psb_slinmap_type), intent(in) :: map type(psb_slinmap_type), intent(in) :: map
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
@ -471,7 +471,7 @@ contains
end function psb_slinmap_sizeof end function psb_slinmap_sizeof
function psb_dlinmap_sizeof(map) result(val) function psb_dlinmap_sizeof(map) result(val)
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
type(psb_dlinmap_type), intent(in) :: map type(psb_dlinmap_type), intent(in) :: map
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
@ -534,7 +534,7 @@ contains
implicit none implicit none
type(psb_slinmap_type), intent(out) :: out_map type(psb_slinmap_type), intent(out) :: out_map
type(psb_desc_type), target :: desc_X, desc_Y type(psb_desc_type), target :: desc_X, desc_Y
type(psb_sspmat_type), intent(in) :: map_X2Y, map_Y2X type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:) integer, intent(in), optional :: iaggr(:), naggr(:)
out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr)
@ -575,8 +575,9 @@ contains
subroutine psb_slinmap_transfer(mapin,mapout,info) subroutine psb_slinmap_transfer(mapin,mapout,info)
use psb_spmat_type use psb_realloc_mod
use psb_descriptor_type use psb_descriptor_type
use psb_mat_mod
implicit none implicit none
type(psb_slinmap_type) :: mapin,mapout type(psb_slinmap_type) :: mapin,mapout
integer, intent(out) :: info integer, intent(out) :: info

15
base/modules/psb_linmap_type_mod.f90
Unescape Escape View File

@ -36,10 +36,9 @@
! to different spaces. ! to different spaces.
! !
module psb_linmap_type_mod module psb_linmap_type_mod
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_d_mat_mod, only: psb_d_sparse_mat use psb_mat_mod, only: psb_d_sparse_mat, psb_s_sparse_mat
use psb_descriptor_type, only: psb_desc_type use psb_descriptor_type, only: psb_desc_type
@ -56,16 +55,16 @@ module psb_linmap_type_mod
type psb_slinmap_type type psb_slinmap_type
integer, allocatable :: itd_data(:), iaggr(:), naggr(:) integer, allocatable :: itd_data(:), iaggr(:), naggr(:)
type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null() type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null()
type(psb_desc_type) :: desc_X, desc_Y type(psb_desc_type) :: desc_X, desc_Y
type(psb_sspmat_type) :: map_X2Y, map_Y2X type(psb_s_sparse_mat) :: map_X2Y, map_Y2X
end type psb_slinmap_type end type psb_slinmap_type
type psb_dlinmap_type type psb_dlinmap_type
integer, allocatable :: itd_data(:), iaggr(:), naggr(:) integer, allocatable :: itd_data(:), iaggr(:), naggr(:)
type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null() type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null()
type(psb_desc_type) :: desc_X, desc_Y type(psb_desc_type) :: desc_X, desc_Y
type(psb_d_sparse_mat) :: map_X2Y, map_Y2X type(psb_d_sparse_mat) :: map_X2Y, map_Y2X
end type psb_dlinmap_type end type psb_dlinmap_type

49
base/modules/psb_psblas_mod.f90
Unescape Escape View File

@ -581,18 +581,19 @@ module psb_psblas_mod
function psb_snrmi(a, desc_a,info) function psb_snrmi(a, desc_a,info)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
real(psb_spk_) :: psb_snrmi use psb_mat_mod
type(psb_sspmat_type), intent (in) :: a real(psb_spk_) :: psb_snrmi
type(psb_desc_type), intent (in) :: desc_a type(psb_s_sparse_mat), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
end function psb_snrmi end function psb_snrmi
function psb_dnrmi(a, desc_a,info) function psb_dnrmi(a, desc_a,info)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
real(psb_dpk_) :: psb_dnrmi real(psb_dpk_) :: psb_dnrmi
type(psb_d_sparse_mat), intent (in) :: a type(psb_d_sparse_mat), intent (in) :: a
type(psb_desc_type), intent (in) :: desc_a type(psb_desc_type), intent (in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
end function psb_dnrmi end function psb_dnrmi
function psb_cnrmi(a, desc_a,info) function psb_cnrmi(a, desc_a,info)
@ -618,7 +619,8 @@ module psb_psblas_mod
&trans, k, jx, jy,work,doswap) &trans, k, jx, jy,work,doswap)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
type(psb_sspmat_type), intent(in) :: a use psb_mat_mod
type(psb_s_sparse_mat), intent(in) :: a
real(psb_spk_), intent(inout) :: x(:,:) real(psb_spk_), intent(inout) :: x(:,:)
real(psb_spk_), intent(inout) :: y(:,:) real(psb_spk_), intent(inout) :: y(:,:)
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@ -633,7 +635,8 @@ module psb_psblas_mod
& desc_a, info, trans, work,doswap) & desc_a, info, trans, work,doswap)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
type(psb_sspmat_type), intent(in) :: a use psb_mat_mod
type(psb_s_sparse_mat), intent(in) :: a
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@ -647,7 +650,7 @@ module psb_psblas_mod
&trans, k, jx, jy,work,doswap) &trans, k, jx, jy,work,doswap)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent(in) :: a type(psb_d_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(inout) :: x(:,:) real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:) real(psb_dpk_), intent(inout) :: y(:,:)
@ -663,7 +666,7 @@ module psb_psblas_mod
& desc_a, info, trans, work,doswap) & desc_a, info, trans, work,doswap)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent(in) :: a type(psb_d_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
@ -736,65 +739,67 @@ module psb_psblas_mod
interface psb_spsm interface psb_spsm
subroutine psb_sspsm(alpha, t, x, beta, y,& subroutine psb_sspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,& & desc_a, info, trans, side, choice,&
& diag, n, jx, jy, work) & diag, n, jx, jy, work)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
type(psb_sspmat_type), intent(in) :: t use psb_mat_mod
type(psb_s_sparse_mat), intent(in) :: t
real(psb_spk_), intent(in) :: x(:,:) real(psb_spk_), intent(in) :: x(:,:)
real(psb_spk_), intent(inout) :: y(:,:) real(psb_spk_), intent(inout) :: y(:,:)
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a 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) :: n, jx, jy
integer, optional, intent(in) :: choice integer, optional, intent(in) :: choice
real(psb_spk_), optional, intent(in),target :: work(:), diag(:) real(psb_spk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspsm end subroutine psb_sspsm
subroutine psb_sspsv(alpha, t, x, beta, y,& subroutine psb_sspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,& & desc_a, info, trans, side, choice,&
& diag, work) & diag, work)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
type(psb_sspmat_type), intent(in) :: t use psb_mat_mod
type(psb_s_sparse_mat), intent(in) :: t
real(psb_spk_), intent(in) :: x(:) real(psb_spk_), intent(in) :: x(:)
real(psb_spk_), intent(inout) :: y(:) real(psb_spk_), intent(inout) :: y(:)
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a 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 integer, optional, intent(in) :: choice
real(psb_spk_), optional, intent(in),target :: work(:), diag(:) real(psb_spk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspsv end subroutine psb_sspsv
subroutine psb_dspsm(alpha, t, x, beta, y,& subroutine psb_dspsm(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,& & desc_a, info, trans, side, choice,&
& diag, n, jx, jy, work) & diag, n, jx, jy, work)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent(in) :: t type(psb_d_sparse_mat), intent(in) :: t
real(psb_dpk_), intent(in) :: x(:,:) real(psb_dpk_), intent(in) :: x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:) real(psb_dpk_), intent(inout) :: y(:,:)
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a 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) :: n, jx, jy
integer, optional, intent(in) :: choice integer, optional, intent(in) :: choice
real(psb_dpk_), optional, intent(in),target :: work(:), diag(:) real(psb_dpk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_dspsm end subroutine psb_dspsm
subroutine psb_dspsv(alpha, t, x, beta, y,& subroutine psb_dspsv(alpha, t, x, beta, y,&
& desc_a, info, trans, unit, choice,& & desc_a, info, trans, side, choice,&
& diag, work) & diag, work)
use psb_serial_mod use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent(in) :: t type(psb_d_sparse_mat), intent(in) :: t
real(psb_dpk_), intent(in) :: x(:) real(psb_dpk_), intent(in) :: x(:)
real(psb_dpk_), intent(inout) :: y(:) real(psb_dpk_), intent(inout) :: y(:)
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
type(psb_desc_type), intent(in) :: desc_a 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 integer, optional, intent(in) :: choice
real(psb_dpk_), optional, intent(in),target :: work(:), diag(:) real(psb_dpk_), optional, intent(in),target :: work(:), diag(:)
integer, intent(out) :: info integer, intent(out) :: info

4
base/modules/psb_s_base_mat_mod.f03
Unescape Escape View File

@ -995,7 +995,7 @@ contains
end do end do
end if end if
if (info == 0)& if (info == 0)&
& call daxpby(nar,nc,alpha,tmp,size(tmp,1),beta,y,size(y,1),info) & call psb_geaxpby(nar,nc,alpha,tmp,beta,y,info)
if (info == 0) then if (info == 0) then
deallocate(tmp,stat=info) deallocate(tmp,stat=info)
@ -1120,7 +1120,7 @@ contains
if (info == 0) tmp(1:nar) = d(1:nar)*tmp(1:nar) if (info == 0) tmp(1:nar) = d(1:nar)*tmp(1:nar)
if (info == 0)& if (info == 0)&
& call daxpby(nar,nc,alpha,tmp,size(tmp,1),beta,y,size(y,1),info) & call psb_geaxpby(nar,alpha,tmp,beta,y,info)
if (info == 0) then if (info == 0) then
deallocate(tmp,stat=info) deallocate(tmp,stat=info)

569
base/modules/psb_serial_mod.f90
Unescape Escape View File

@ -49,8 +49,7 @@ module psb_serial_mod
!!$ character, optional :: trans !!$ character, optional :: trans
!!$ end subroutine psb_dcsrws !!$ end subroutine psb_dcsrws
subroutine psb_zcsrws(rw,a,info,trans) subroutine psb_zcsrws(rw,a,info,trans)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(psb_dpk_), allocatable :: rw(:) complex(psb_dpk_), allocatable :: rw(:)
integer :: info integer :: info
@ -211,23 +210,23 @@ module psb_serial_mod
end interface end interface
interface psb_spcnv interface psb_spcnv
subroutine psb_sspcnv2(ain, a, info, afmt, upd, dupl) !!$ subroutine psb_sspcnv2(ain, a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent (in) :: ain !!$ type(psb_sspmat_type), intent (in) :: ain
type(psb_sspmat_type), intent (out) :: a !!$ type(psb_sspmat_type), intent (out) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd !!$ integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt !!$ character(len=*), optional, intent(in) :: afmt
end subroutine psb_sspcnv2 !!$ end subroutine psb_sspcnv2
subroutine psb_sspcnv1(a, info, afmt, upd, dupl) !!$ subroutine psb_sspcnv1(a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent (inout) :: a !!$ type(psb_sspmat_type), intent (inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd !!$ integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt !!$ character(len=*), optional, intent(in) :: afmt
end subroutine psb_sspcnv1 !!$ end subroutine psb_sspcnv1
!!$ subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl) !!$ subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -246,8 +245,7 @@ module psb_serial_mod
!!$ character(len=*), optional, intent(in) :: afmt !!$ character(len=*), optional, intent(in) :: afmt
!!$ end subroutine psb_dspcnv1 !!$ end subroutine psb_dspcnv1
subroutine psb_cspcnv2(ain, a, info, afmt, upd, dupl) subroutine psb_cspcnv2(ain, a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent (in) :: ain type(psb_cspmat_type), intent (in) :: ain
type(psb_cspmat_type), intent (out) :: a type(psb_cspmat_type), intent (out) :: a
integer, intent(out) :: info integer, intent(out) :: info
@ -255,16 +253,14 @@ module psb_serial_mod
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
end subroutine psb_cspcnv2 end subroutine psb_cspcnv2
subroutine psb_cspcnv1(a, info, afmt, upd, dupl) subroutine psb_cspcnv1(a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent (inout) :: a type(psb_cspmat_type), intent (inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
end subroutine psb_cspcnv1 end subroutine psb_cspcnv1
subroutine psb_zspcnv2(ain, a, info, afmt, upd, dupl) subroutine psb_zspcnv2(ain, a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent (in) :: ain type(psb_zspmat_type), intent (in) :: ain
type(psb_zspmat_type), intent (out) :: a type(psb_zspmat_type), intent (out) :: a
integer, intent(out) :: info integer, intent(out) :: info
@ -272,8 +268,7 @@ module psb_serial_mod
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
end subroutine psb_zspcnv2 end subroutine psb_zspcnv2
subroutine psb_zspcnv1(a, info, afmt, upd, dupl) subroutine psb_zspcnv1(a, info, afmt, upd, dupl)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent (inout) :: a type(psb_zspmat_type), intent (inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd integer,optional, intent(in) :: dupl, upd
@ -284,13 +279,13 @@ module psb_serial_mod
interface psb_fixcoo interface psb_fixcoo
subroutine psb_sfixcoo(a,info,idir) !!$ subroutine psb_sfixcoo(a,info,idir)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer, intent(in), optional :: idir !!$ integer, intent(in), optional :: idir
end subroutine psb_sfixcoo !!$ end subroutine psb_sfixcoo
!!$ subroutine psb_dfixcoo(a,info,idir) !!$ subroutine psb_dfixcoo(a,info,idir)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -299,15 +294,13 @@ module psb_serial_mod
!!$ integer, intent(in), optional :: idir !!$ integer, intent(in), optional :: idir
!!$ end subroutine psb_dfixcoo !!$ end subroutine psb_dfixcoo
subroutine psb_cfixcoo(a,info,idir) subroutine psb_cfixcoo(a,info,idir)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: idir integer, intent(in), optional :: idir
end subroutine psb_cfixcoo end subroutine psb_cfixcoo
subroutine psb_zfixcoo(a,info,idir) subroutine psb_zfixcoo(a,info,idir)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: idir integer, intent(in), optional :: idir
@ -315,13 +308,13 @@ module psb_serial_mod
end interface end interface
interface psb_ipcoo2csr interface psb_ipcoo2csr
subroutine psb_sipcoo2csr(a,info,rwshr) !!$ subroutine psb_sipcoo2csr(a,info,rwshr)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
logical, optional :: rwshr !!$ logical, optional :: rwshr
end subroutine psb_sipcoo2csr !!$ end subroutine psb_sipcoo2csr
!!$ subroutine psb_dipcoo2csr(a,info,rwshr) !!$ subroutine psb_dipcoo2csr(a,info,rwshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -330,15 +323,13 @@ module psb_serial_mod
!!$ logical, optional :: rwshr !!$ logical, optional :: rwshr
!!$ end subroutine psb_dipcoo2csr !!$ end subroutine psb_dipcoo2csr
subroutine psb_cipcoo2csr(a,info,rwshr) subroutine psb_cipcoo2csr(a,info,rwshr)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: rwshr logical, optional :: rwshr
end subroutine psb_cipcoo2csr end subroutine psb_cipcoo2csr
subroutine psb_zipcoo2csr(a,info,rwshr) subroutine psb_zipcoo2csr(a,info,rwshr)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: rwshr logical, optional :: rwshr
@ -346,13 +337,13 @@ module psb_serial_mod
end interface end interface
interface psb_ipcoo2csc interface psb_ipcoo2csc
subroutine psb_sipcoo2csc(a,info,clshr) !!$ subroutine psb_sipcoo2csc(a,info,clshr)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
logical, optional :: clshr !!$ logical, optional :: clshr
end subroutine psb_sipcoo2csc !!$ end subroutine psb_sipcoo2csc
!!$ subroutine psb_dipcoo2csc(a,info,clshr) !!$ subroutine psb_dipcoo2csc(a,info,clshr)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -361,15 +352,13 @@ module psb_serial_mod
!!$ logical, optional :: clshr !!$ logical, optional :: clshr
!!$ end subroutine psb_dipcoo2csc !!$ end subroutine psb_dipcoo2csc
subroutine psb_cipcoo2csc(a,info,clshr) subroutine psb_cipcoo2csc(a,info,clshr)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: clshr logical, optional :: clshr
end subroutine psb_cipcoo2csc end subroutine psb_cipcoo2csc
subroutine psb_zipcoo2csc(a,info,clshr) subroutine psb_zipcoo2csc(a,info,clshr)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: clshr logical, optional :: clshr
@ -377,12 +366,12 @@ module psb_serial_mod
end interface end interface
interface psb_ipcsr2coo interface psb_ipcsr2coo
subroutine psb_sipcsr2coo(a,info) !!$ subroutine psb_sipcsr2coo(a,info)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
end subroutine psb_sipcsr2coo !!$ end subroutine psb_sipcsr2coo
!!$ subroutine psb_dipcsr2coo(a,info) !!$ subroutine psb_dipcsr2coo(a,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -390,30 +379,28 @@ module psb_serial_mod
!!$ integer, intent(out) :: info !!$ integer, intent(out) :: info
!!$ end subroutine psb_dipcsr2coo !!$ end subroutine psb_dipcsr2coo
subroutine psb_cipcsr2coo(a,info) subroutine psb_cipcsr2coo(a,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_cipcsr2coo end subroutine psb_cipcsr2coo
subroutine psb_zipcsr2coo(a,info) subroutine psb_zipcsr2coo(a,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zipcsr2coo end subroutine psb_zipcsr2coo
end interface end interface
interface psb_csprt interface psb_csprt
subroutine psb_scsprt(iout,a,iv,irs,ics,head,ivr,ivc) !!$ subroutine psb_scsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: iout !!$ integer, intent(in) :: iout
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:) !!$ integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: irs,ics !!$ integer, intent(in), optional :: irs,ics
character(len=*), optional :: head !!$ character(len=*), optional :: head
integer, intent(in), optional :: ivr(:),ivc(:) !!$ integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_scsprt !!$ end subroutine psb_scsprt
!!$ subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) !!$ subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -425,8 +412,7 @@ module psb_serial_mod
!!$ integer, intent(in), optional :: ivr(:),ivc(:) !!$ integer, intent(in), optional :: ivr(:),ivc(:)
!!$ end subroutine psb_dcsprt !!$ end subroutine psb_dcsprt
subroutine psb_ccsprt(iout,a,iv,irs,ics,head,ivr,ivc) subroutine psb_ccsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: iout integer, intent(in) :: iout
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:) integer, intent(in), optional :: iv(:)
@ -435,8 +421,7 @@ module psb_serial_mod
integer, intent(in), optional :: ivr(:),ivc(:) integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_ccsprt end subroutine psb_ccsprt
subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: iout integer, intent(in) :: iout
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:) integer, intent(in), optional :: iv(:)
@ -447,16 +432,16 @@ module psb_serial_mod
end interface end interface
interface psb_neigh interface psb_neigh
subroutine psb_sneigh(a,idx,neigh,n,info,lev) !!$ subroutine psb_sneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: idx !!$ integer, intent(in) :: idx
integer, intent(out) :: n !!$ integer, intent(out) :: n
integer, allocatable :: neigh(:) !!$ integer, allocatable :: neigh(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer, optional, intent(in) :: lev !!$ integer, optional, intent(in) :: lev
end subroutine psb_sneigh !!$ end subroutine psb_sneigh
!!$ subroutine psb_dneigh(a,idx,neigh,n,info,lev) !!$ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -468,8 +453,7 @@ module psb_serial_mod
!!$ integer, optional, intent(in) :: lev !!$ integer, optional, intent(in) :: lev
!!$ end subroutine psb_dneigh !!$ end subroutine psb_dneigh
subroutine psb_cneigh(a,idx,neigh,n,info,lev) subroutine psb_cneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: idx integer, intent(in) :: idx
integer, intent(out) :: n integer, intent(out) :: n
@ -478,8 +462,7 @@ module psb_serial_mod
integer, optional, intent(in) :: lev integer, optional, intent(in) :: lev
end subroutine psb_cneigh end subroutine psb_cneigh
subroutine psb_zneigh(a,idx,neigh,n,info,lev) subroutine psb_zneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: idx integer, intent(in) :: idx
integer, intent(out) :: n integer, intent(out) :: n
@ -490,17 +473,17 @@ module psb_serial_mod
end interface end interface
interface psb_coins interface psb_coins
subroutine psb_scoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) !!$ subroutine psb_scoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nz, imin,imax,jmin,jmax !!$ integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:) !!$ integer, intent(in) :: ia(:),ja(:)
real(psb_spk_), intent(in) :: val(:) !!$ real(psb_spk_), intent(in) :: val(:)
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer, intent(in), optional :: gtl(:) !!$ integer, intent(in), optional :: gtl(:)
logical, optional, intent(in) :: rebuild !!$ logical, optional, intent(in) :: rebuild
end subroutine psb_scoins !!$ end subroutine psb_scoins
!!$ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) !!$ 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,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -513,8 +496,7 @@ module psb_serial_mod
!!$ logical, optional, intent(in) :: rebuild !!$ logical, optional, intent(in) :: rebuild
!!$ end subroutine psb_dcoins !!$ end subroutine psb_dcoins
subroutine psb_ccoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) subroutine psb_ccoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:) integer, intent(in) :: ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
@ -524,8 +506,7 @@ module psb_serial_mod
logical, optional, intent(in) :: rebuild logical, optional, intent(in) :: rebuild
end subroutine psb_ccoins end subroutine psb_ccoins
subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:) integer, intent(in) :: ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
@ -538,12 +519,12 @@ module psb_serial_mod
interface psb_symbmm interface psb_symbmm
subroutine psb_ssymbmm(a,b,c,info) !!$ subroutine psb_ssymbmm(a,b,c,info)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type) :: a,b,c !!$ type(psb_sspmat_type) :: a,b,c
integer :: info !!$ integer :: info
end subroutine psb_ssymbmm !!$ end subroutine psb_ssymbmm
!!$ subroutine psb_dsymbmm(a,b,c,info) !!$ subroutine psb_dsymbmm(a,b,c,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -551,51 +532,47 @@ module psb_serial_mod
!!$ integer :: info !!$ integer :: info
!!$ end subroutine psb_dsymbmm !!$ end subroutine psb_dsymbmm
subroutine psb_csymbmm(a,b,c,info) subroutine psb_csymbmm(a,b,c,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type) :: a,b,c type(psb_cspmat_type) :: a,b,c
integer :: info integer :: info
end subroutine psb_csymbmm end subroutine psb_csymbmm
subroutine psb_zsymbmm(a,b,c,info) subroutine psb_zsymbmm(a,b,c,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a,b,c type(psb_zspmat_type) :: a,b,c
integer :: info integer :: info
end subroutine psb_zsymbmm end subroutine psb_zsymbmm
end interface end interface
interface psb_numbmm interface psb_numbmm
subroutine psb_snumbmm(a,b,c) !!$ subroutine psb_snumbmm(a,b,c)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type) :: a,b,c !!$ type(psb_sspmat_type) :: a,b,c
end subroutine psb_snumbmm !!$ end subroutine psb_snumbmm
!!$ subroutine psb_dnumbmm(a,b,c) !!$ subroutine psb_dnumbmm(a,b,c)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
!!$ type(psb_dspmat_type) :: a,b,c !!$ type(psb_dspmat_type) :: a,b,c
!!$ end subroutine psb_dnumbmm !!$ end subroutine psb_dnumbmm
subroutine psb_cnumbmm(a,b,c) subroutine psb_cnumbmm(a,b,c)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type) :: a,b,c type(psb_cspmat_type) :: a,b,c
end subroutine psb_cnumbmm end subroutine psb_cnumbmm
subroutine psb_znumbmm(a,b,c) subroutine psb_znumbmm(a,b,c)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type) :: a,b,c type(psb_zspmat_type) :: a,b,c
end subroutine psb_znumbmm end subroutine psb_znumbmm
end interface end interface
interface psb_transp interface psb_transp
subroutine psb_stransp(a,b,c,fmt) !!$ subroutine psb_stransp(a,b,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
type(psb_sspmat_type), intent(out) :: b !!$ type(psb_sspmat_type), intent(out) :: b
integer, optional :: c !!$ integer, optional :: c
character(len=*), optional :: fmt !!$ character(len=*), optional :: fmt
end subroutine psb_stransp !!$ end subroutine psb_stransp
!!$ subroutine psb_dtransp(a,b,c,fmt) !!$ subroutine psb_dtransp(a,b,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -605,28 +582,26 @@ module psb_serial_mod
!!$ character(len=*), optional :: fmt !!$ character(len=*), optional :: fmt
!!$ end subroutine psb_dtransp !!$ end subroutine psb_dtransp
subroutine psb_ctransp(a,b,c,fmt) subroutine psb_ctransp(a,b,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b type(psb_cspmat_type), intent(out) :: b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ctransp end subroutine psb_ctransp
subroutine psb_ztransp(a,b,c,fmt) subroutine psb_ztransp(a,b,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b type(psb_zspmat_type), intent(out) :: b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ztransp end subroutine psb_ztransp
subroutine psb_stransp1(a,c,fmt) !!$ subroutine psb_stransp1(a,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, optional :: c !!$ integer, optional :: c
character(len=*), optional :: fmt !!$ character(len=*), optional :: fmt
end subroutine psb_stransp1 !!$ end subroutine psb_stransp1
!!$ subroutine psb_dtransp1(a,c,fmt) !!$ subroutine psb_dtransp1(a,c,fmt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -635,15 +610,13 @@ module psb_serial_mod
!!$ character(len=*), optional :: fmt !!$ character(len=*), optional :: fmt
!!$ end subroutine psb_dtransp1 !!$ end subroutine psb_dtransp1
subroutine psb_ctransp1(a,c,fmt) subroutine psb_ctransp1(a,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ctransp1 end subroutine psb_ctransp1
subroutine psb_ztransp1(a,c,fmt) subroutine psb_ztransp1(a,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
@ -652,16 +625,14 @@ module psb_serial_mod
interface psb_transc interface psb_transc
subroutine psb_ctransc(a,b,c,fmt) subroutine psb_ctransc(a,b,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b type(psb_cspmat_type), intent(out) :: b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ctransc end subroutine psb_ctransc
subroutine psb_ztransc(a,b,c,fmt) subroutine psb_ztransc(a,b,c,fmt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b type(psb_zspmat_type), intent(out) :: b
integer, optional :: c integer, optional :: c
@ -670,15 +641,15 @@ module psb_serial_mod
end interface end interface
interface psb_rwextd interface psb_rwextd
subroutine psb_srwextd(nr,a,info,b,rowscale) !!$ subroutine psb_srwextd(nr,a,info,b,rowscale)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nr !!$ integer, intent(in) :: nr
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
type(psb_sspmat_type), intent(in), optional :: b !!$ type(psb_sspmat_type), intent(in), optional :: b
logical, intent(in), optional :: rowscale !!$ logical, intent(in), optional :: rowscale
end subroutine psb_srwextd !!$ end subroutine psb_srwextd
!!$ subroutine psb_drwextd(nr,a,info,b,rowscale) !!$ subroutine psb_drwextd(nr,a,info,b,rowscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -689,8 +660,7 @@ module psb_serial_mod
!!$ logical, intent(in), optional :: rowscale !!$ logical, intent(in), optional :: rowscale
!!$ end subroutine psb_drwextd !!$ end subroutine psb_drwextd
subroutine psb_crwextd(nr,a,info,b,rowscale) subroutine psb_crwextd(nr,a,info,b,rowscale)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nr integer, intent(in) :: nr
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
@ -698,8 +668,7 @@ module psb_serial_mod
logical, intent(in), optional :: rowscale logical, intent(in), optional :: rowscale
end subroutine psb_crwextd end subroutine psb_crwextd
subroutine psb_zrwextd(nr,a,info,b,rowscale) subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
integer, intent(in) :: nr integer, intent(in) :: nr
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
@ -709,14 +678,14 @@ module psb_serial_mod
end interface end interface
interface psb_csnmi interface psb_csnmi
function psb_scsnmi(a,info,trans) !!$ function psb_scsnmi(a,info,trans)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer, intent(out) :: info !!$ integer, intent(out) :: info
character, optional :: trans !!$ character, optional :: trans
real(psb_spk_) :: psb_scsnmi !!$ real(psb_spk_) :: psb_scsnmi
end function psb_scsnmi !!$ end function psb_scsnmi
!!$ function psb_dcsnmi(a,info,trans) !!$ function psb_dcsnmi(a,info,trans)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -726,16 +695,14 @@ module psb_serial_mod
!!$ real(psb_dpk_) :: psb_dcsnmi !!$ real(psb_dpk_) :: psb_dcsnmi
!!$ end function psb_dcsnmi !!$ end function psb_dcsnmi
function psb_ccsnmi(a,info,trans) function psb_ccsnmi(a,info,trans)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
character, optional :: trans character, optional :: trans
real(psb_spk_) :: psb_ccsnmi real(psb_spk_) :: psb_ccsnmi
end function psb_ccsnmi end function psb_ccsnmi
function psb_zcsnmi(a,info,trans) function psb_zcsnmi(a,info,trans)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
character, optional :: trans character, optional :: trans
@ -744,16 +711,16 @@ module psb_serial_mod
end interface end interface
interface psb_sp_clip interface psb_sp_clip
subroutine psb_sspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) !!$ subroutine psb_sspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none !!$ implicit none
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
type(psb_sspmat_type), intent(out) :: b !!$ type(psb_sspmat_type), intent(out) :: b
integer, intent(out) :: info !!$ integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax !!$ integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
end subroutine psb_sspclip !!$ end subroutine psb_sspclip
!!$ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) !!$ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -765,8 +732,7 @@ module psb_serial_mod
!!$ logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
!!$ end subroutine psb_dspclip !!$ end subroutine psb_dspclip
subroutine psb_cspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) subroutine psb_cspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_cspmat_type), intent(out) :: b type(psb_cspmat_type), intent(out) :: b
@ -775,8 +741,7 @@ module psb_serial_mod
logical, intent(in), optional :: rscale,cscale logical, intent(in), optional :: rscale,cscale
end subroutine psb_cspclip end subroutine psb_cspclip
subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b type(psb_zspmat_type), intent(out) :: b
@ -787,13 +752,13 @@ module psb_serial_mod
end interface end interface
interface psb_sp_getdiag interface psb_sp_getdiag
subroutine psb_sspgtdiag(a,d,info) !!$ subroutine psb_sspgtdiag(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
real(psb_spk_), intent(inout) :: d(:) !!$ real(psb_spk_), intent(inout) :: d(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
end subroutine psb_sspgtdiag !!$ end subroutine psb_sspgtdiag
!!$ subroutine psb_dspgtdiag(a,d,info) !!$ subroutine psb_dspgtdiag(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -802,15 +767,13 @@ module psb_serial_mod
!!$ integer, intent(out) :: info !!$ integer, intent(out) :: info
!!$ end subroutine psb_dspgtdiag !!$ end subroutine psb_dspgtdiag
subroutine psb_cspgtdiag(a,d,info) subroutine psb_cspgtdiag(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
complex(psb_spk_), intent(inout) :: d(:) complex(psb_spk_), intent(inout) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_cspgtdiag end subroutine psb_cspgtdiag
subroutine psb_zspgtdiag(a,d,info) subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
complex(psb_dpk_), intent(inout) :: d(:) complex(psb_dpk_), intent(inout) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -818,20 +781,20 @@ module psb_serial_mod
end interface end interface
interface psb_sp_scal interface psb_sp_scal
subroutine psb_sspscals(a,d,info) !!$ subroutine psb_sspscals(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d !!$ real(psb_spk_), intent(in) :: d
integer, intent(out) :: info !!$ integer, intent(out) :: info
end subroutine psb_sspscals !!$ end subroutine psb_sspscals
subroutine psb_sspscal(a,d,info) !!$ subroutine psb_sspscal(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:) !!$ real(psb_spk_), intent(in) :: d(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
end subroutine psb_sspscal !!$ end subroutine psb_sspscal
!!$ subroutine psb_dspscals(a,d,info) !!$ subroutine psb_dspscals(a,d,info)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -847,29 +810,25 @@ module psb_serial_mod
!!$ integer, intent(out) :: info !!$ integer, intent(out) :: info
!!$ end subroutine psb_dspscal !!$ end subroutine psb_dspscal
subroutine psb_cspscals(a,d,info) subroutine psb_cspscals(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d complex(psb_spk_), intent(in) :: d
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_cspscals end subroutine psb_cspscals
subroutine psb_cspscal(a,d,info) subroutine psb_cspscal(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(inout) :: a type(psb_cspmat_type), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:) complex(psb_spk_), intent(in) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_cspscal end subroutine psb_cspscal
subroutine psb_zspscals(a,d,info) subroutine psb_zspscals(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d complex(psb_dpk_), intent(in) :: d
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zspscals end subroutine psb_zspscals
subroutine psb_zspscal(a,d,info) subroutine psb_zspscal(a,d,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:) complex(psb_dpk_), intent(in) :: d(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -892,14 +851,12 @@ module psb_serial_mod
!!$ integer, intent(out) :: info !!$ integer, intent(out) :: info
!!$ end subroutine psb_dspsetbld2 !!$ end subroutine psb_dspsetbld2
subroutine psb_zspsetbld1(a,info) subroutine psb_zspsetbld1(a,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zspsetbld1 end subroutine psb_zspsetbld1
subroutine psb_zspsetbld2(a,b,info) subroutine psb_zspsetbld2(a,b,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b type(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
@ -916,8 +873,7 @@ module psb_serial_mod
!!$ integer, intent(out) :: info !!$ integer, intent(out) :: info
!!$ end subroutine psb_dspshift !!$ end subroutine psb_dspshift
subroutine psb_zspshift(alpha,a,beta,b,info) subroutine psb_zspshift(alpha,a,beta,b,info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b type(psb_zspmat_type), intent(out) :: b
complex(psb_dpk_), intent(in) :: alpha, beta complex(psb_dpk_), intent(in) :: alpha, beta
@ -926,18 +882,18 @@ module psb_serial_mod
end interface end interface
interface psb_sp_getblk interface psb_sp_getblk
subroutine psb_sspgtblk(irw,a,b,info,append,iren,lrw,srt) !!$ subroutine psb_sspgtblk(irw,a,b,info,append,iren,lrw,srt)
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: irw !!$ integer, intent(in) :: irw
type(psb_sspmat_type), intent(inout) :: b !!$ type(psb_sspmat_type), intent(inout) :: b
integer, intent(out) :: info !!$ integer, intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:) !!$ integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw !!$ integer, intent(in), optional :: lrw
logical, intent(in), optional :: srt !!$ logical, intent(in), optional :: srt
end subroutine psb_sspgtblk !!$ end subroutine psb_sspgtblk
!!$ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) !!$ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt)
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
@ -951,8 +907,7 @@ module psb_serial_mod
!!$ logical, intent(in), optional :: srt !!$ logical, intent(in), optional :: srt
!!$ end subroutine psb_dspgtblk !!$ end subroutine psb_dspgtblk
subroutine psb_cspgtblk(irw,a,b,info,append,iren,lrw,srt) subroutine psb_cspgtblk(irw,a,b,info,append,iren,lrw,srt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
integer, intent(in) :: irw integer, intent(in) :: irw
type(psb_cspmat_type), intent(inout) :: b type(psb_cspmat_type), intent(inout) :: b
@ -963,8 +918,7 @@ module psb_serial_mod
logical, intent(in), optional :: srt logical, intent(in), optional :: srt
end subroutine psb_cspgtblk end subroutine psb_cspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt) subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b type(psb_zspmat_type), intent(inout) :: b
@ -977,22 +931,22 @@ module psb_serial_mod
end interface end interface
interface psb_sp_getrow interface psb_sp_getrow
subroutine psb_sspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) !!$ subroutine psb_sspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
! Output is always in COO format !!$ ! Output is always in COO format
use psb_spmat_type, only : psb_sspmat_type, & !!$ use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ !!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none !!$ implicit none
!!$
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer, intent(in) :: irw !!$ integer, intent(in) :: irw
integer, intent(out) :: nz !!$ integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:) !!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:) !!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info !!$ integer,intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:) !!$ integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: lrw, nzin !!$ integer, intent(in), optional :: lrw, nzin
end subroutine psb_sspgetrow !!$ end subroutine psb_sspgetrow
!!$ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) !!$ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
!!$ ! Output is always in COO format !!$ ! Output is always in COO format
!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& !!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,&
@ -1011,8 +965,7 @@ module psb_serial_mod
!!$ end subroutine psb_dspgetrow !!$ end subroutine psb_dspgetrow
subroutine psb_cspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) subroutine psb_cspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
! Output is always in COO format ! Output is always in COO format
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none implicit none
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
@ -1027,8 +980,7 @@ module psb_serial_mod
end subroutine psb_cspgetrow end subroutine psb_cspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin)
! Output is always in COO format ! Output is always in COO format
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
implicit none implicit none
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
@ -1054,81 +1006,12 @@ module psb_serial_mod
!!$ character, intent(in) :: trans !!$ character, intent(in) :: trans
!!$ end subroutine psb_dcsrp !!$ end subroutine psb_dcsrp
subroutine psb_zcsrp(trans,iperm,a, info) subroutine psb_zcsrp(trans,iperm,a, info)
use psb_spmat_type, only : psb_sspmat_type, & use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(inout) :: iperm(:), info integer, intent(inout) :: iperm(:), info
character, intent(in) :: trans character, intent(in) :: trans
end subroutine psb_zcsrp end subroutine psb_zcsrp
end interface end interface
interface psb_gelp
! 2-D version
subroutine psb_sgelp(trans,iperm,x,info)
use psb_const_mod
real(psb_spk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelp
! 1-D version
subroutine psb_sgelpv(trans,iperm,x,info)
use psb_const_mod
real(psb_spk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelpv
subroutine psb_dgelp(trans,iperm,x,info)
use psb_const_mod
real(psb_dpk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_dgelp
! 1-D version
subroutine psb_dgelpv(trans,iperm,x,info)
use psb_const_mod
real(psb_dpk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_dgelpv
! 2-D version
subroutine psb_cgelp(trans,iperm,x,info)
use psb_const_mod
complex(psb_spk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_cgelp
! 1-D version
subroutine psb_cgelpv(trans,iperm,x,info)
use psb_const_mod
complex(psb_spk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_cgelpv
! 2-D version
subroutine psb_zgelp(trans,iperm,x,info)
use psb_const_mod
complex(psb_dpk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_zgelp
! 1-D version
subroutine psb_zgelpv(trans,iperm,x,info)
use psb_const_mod
complex(psb_dpk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_zgelpv
end interface
end module psb_serial_mod end module psb_serial_mod

2282
base/modules/psb_spmat_type.f03
View File

File diff suppressed because it is too large Load Diff

103
base/modules/psb_tools_mod.f90
Unescape Escape View File

@ -219,9 +219,9 @@ Module psb_tools_mod
Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
Type(psb_sspmat_type),Intent(in) :: a Type(psb_s_sparse_mat),Intent(in) :: a
Type(psb_sspmat_type),Intent(inout) :: blk Type(psb_s_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in),target :: desc_a Type(psb_desc_type),Intent(in),target :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@ -477,9 +477,9 @@ Module psb_tools_mod
interface psb_cdbldext interface psb_cdbldext
Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype) Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype)
use psb_descriptor_type use psb_descriptor_type
Use psb_spmat_type Use psb_mat_mod
integer, intent(in) :: novr integer, intent(in) :: novr
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info integer, intent(out) :: info
@ -540,20 +540,20 @@ Module psb_tools_mod
interface psb_spall interface psb_spall
subroutine psb_sspalloc(a, desc_a, info, nnz) subroutine psb_sspalloc(a, desc_a, info, nnz)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(out) :: a type(psb_s_sparse_mat), intent(out) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: nnz integer, optional, intent(in) :: nnz
end subroutine psb_sspalloc end subroutine psb_sspalloc
subroutine psb_dspalloc(a, desc_a, info, nnz) subroutine psb_dspalloc(a, desc_a, info, nnz)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
use psb_d_mat_mod use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_d_sparse_mat), intent(out) :: a type(psb_d_sparse_mat), intent(out) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: nnz integer, optional, intent(in) :: nnz
end subroutine psb_dspalloc end subroutine psb_dspalloc
subroutine psb_cspalloc(a, desc_a, info, nnz) subroutine psb_cspalloc(a, desc_a, info, nnz)
use psb_descriptor_type use psb_descriptor_type
@ -574,19 +574,20 @@ Module psb_tools_mod
end interface end interface
interface psb_spasb interface psb_spasb
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl) subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
type(psb_sspmat_type), intent (inout) :: a type(psb_s_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_s_base_sparse_mat), intent(in), optional :: mold
end subroutine psb_sspasb end subroutine psb_sspasb
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold) subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent (inout) :: a type(psb_d_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
@ -621,18 +622,18 @@ Module psb_tools_mod
interface psb_spfree interface psb_spfree
subroutine psb_sspfree(a, desc_a,info) subroutine psb_sspfree(a, desc_a,info)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) ::a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspfree end subroutine psb_sspfree
subroutine psb_dspfree(a, desc_a,info) subroutine psb_dspfree(a, desc_a,info)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
use psb_d_mat_mod use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_sparse_mat), intent(inout) ::a type(psb_d_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_dspfree end subroutine psb_dspfree
subroutine psb_cspfree(a, desc_a,info) subroutine psb_cspfree(a, desc_a,info)
use psb_descriptor_type use psb_descriptor_type
@ -654,28 +655,28 @@ Module psb_tools_mod
interface psb_spins interface psb_spins
subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:) integer, intent(in) :: nz,ia(:),ja(:)
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild
end subroutine psb_sspins end subroutine psb_sspins
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_descriptor_type 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(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:) integer, intent(in) :: nz,ia(:),ja(:)
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sspins_2desc end subroutine psb_sspins_2desc
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
use psb_d_mat_mod use psb_mat_mod
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_d_sparse_mat), intent(inout) :: a type(psb_d_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:) integer, intent(in) :: nz,ia(:),ja(:)
@ -685,7 +686,7 @@ Module psb_tools_mod
end subroutine psb_dspins end subroutine psb_dspins
subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_descriptor_type use psb_descriptor_type
use psb_d_mat_mod use psb_mat_mod
type(psb_d_sparse_mat), intent(inout) :: a type(psb_d_sparse_mat), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
@ -739,19 +740,19 @@ Module psb_tools_mod
interface psb_sprn interface psb_sprn
subroutine psb_ssprn(a, desc_a,info,clear) subroutine psb_ssprn(a, desc_a,info,clear)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
end subroutine psb_ssprn end subroutine psb_ssprn
subroutine psb_dsprn(a, desc_a,info,clear) subroutine psb_dsprn(a, desc_a,info,clear)
use psb_descriptor_type use psb_descriptor_type
use psb_mat_mod use psb_mat_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_sparse_mat), intent(inout) :: a type(psb_d_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
end subroutine psb_dsprn end subroutine psb_dsprn
subroutine psb_csprn(a, desc_a,info,clear) subroutine psb_csprn(a, desc_a,info,clear)
use psb_descriptor_type use psb_descriptor_type

497
base/modules/psi_serial_mod.f90
Unescape Escape View File

@ -30,8 +30,8 @@
!!$ !!$
!!$ !!$
module psi_serial_mod module psi_serial_mod
interface psi_gth interface psi_gth
module procedure & module procedure &
& psi_igthv, psi_sgthv, psi_cgthv, psi_dgthv, psi_zgthv,& & psi_igthv, psi_sgthv, psi_cgthv, psi_dgthv, psi_zgthv,&
@ -47,6 +47,80 @@ module psi_serial_mod
& psi_zsctmv, psi_zsctv & psi_zsctmv, psi_zsctv
end interface end interface
interface psb_geaxpby
module procedure psi_saxpbyv, psi_saxpby, &
& psi_daxpbyv, psi_daxpby, &
& psi_caxpbyv, psi_caxpby, &
& psi_zaxpbyv, psi_zaxpby
end interface
interface psb_gelp
! 2-D version
subroutine psb_sgelp(trans,iperm,x,info)
use psb_const_mod
real(psb_spk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelp
! 1-D version
subroutine psb_sgelpv(trans,iperm,x,info)
use psb_const_mod
real(psb_spk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelpv
subroutine psb_dgelp(trans,iperm,x,info)
use psb_const_mod
real(psb_dpk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_dgelp
! 1-D version
subroutine psb_dgelpv(trans,iperm,x,info)
use psb_const_mod
real(psb_dpk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_dgelpv
! 2-D version
subroutine psb_cgelp(trans,iperm,x,info)
use psb_const_mod
complex(psb_spk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_cgelp
! 1-D version
subroutine psb_cgelpv(trans,iperm,x,info)
use psb_const_mod
complex(psb_spk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_cgelpv
! 2-D version
subroutine psb_zgelp(trans,iperm,x,info)
use psb_const_mod
complex(psb_dpk_), intent(inout) :: x(:,:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_zgelp
! 1-D version
subroutine psb_zgelpv(trans,iperm,x,info)
use psb_const_mod
complex(psb_dpk_), intent(inout) :: x(:)
integer, intent(in) :: iperm(:)
integer, intent(out) :: info
character, intent(in) :: trans
end subroutine psb_zgelpv
end interface
contains contains
@ -87,7 +161,7 @@ contains
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == izero) then if (alpha == izero) then
! do nothing ! do nothing
else if (alpha == ione) then else if (alpha == ione) then
@ -143,7 +217,7 @@ contains
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == szero) then if (alpha == szero) then
! do nothing ! do nothing
else if (alpha == sone) then else if (alpha == sone) then
@ -199,7 +273,7 @@ contains
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == dzero) then if (alpha == dzero) then
! do nothing ! do nothing
else if (alpha == done) then else if (alpha == done) then
@ -255,7 +329,7 @@ contains
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == czero) then if (alpha == czero) then
! do nothing ! do nothing
else if (alpha == cone) then else if (alpha == cone) then
@ -311,7 +385,7 @@ contains
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == zzero) then if (alpha == zzero) then
! do nothing ! do nothing
else if (alpha == zone) then else if (alpha == zone) then
@ -854,6 +928,413 @@ contains
end do end do
end if end if
end subroutine psi_zsctv end subroutine psi_zsctv
subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
real(psb_spk_), intent (inout) :: y(:)
real(psb_spk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (size(x) < m) then
info = 36
call psb_errpush(info,name,i_err=(/3,m,0,0,0/))
goto 9999
end if
if (size(y) < m) then
info = 36
call psb_errpush(info,name,i_err=(/5,m,0,0,0/))
goto 9999
end if
if (m>0) call saxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_saxpbyv
subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m, n
real(psb_spk_), intent (in) :: x(:,:)
real(psb_spk_), intent (inout) :: y(:,:)
real(psb_spk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (n < 0) then
info = 10
call psb_errpush(info,name,i_err=(/2,n,0,0,0/))
goto 9999
end if
if (size(x,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/4,m,0,0,0/))
goto 9999
end if
if (size(y,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/6,m,0,0,0/))
goto 9999
end if
if ((m>0).and.(n>0)) call saxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_saxpby
subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
real(psb_dpk_), intent (inout) :: y(:)
real(psb_dpk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (size(x) < m) then
info = 36
call psb_errpush(info,name,i_err=(/3,m,0,0,0/))
goto 9999
end if
if (size(y) < m) then
info = 36
call psb_errpush(info,name,i_err=(/5,m,0,0,0/))
goto 9999
end if
if (m>0) call daxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_daxpbyv
subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m, n
real(psb_dpk_), intent (in) :: x(:,:)
real(psb_dpk_), intent (inout) :: y(:,:)
real(psb_dpk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (n < 0) then
info = 10
call psb_errpush(info,name,i_err=(/2,n,0,0,0/))
goto 9999
end if
if (size(x,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/4,m,0,0,0/))
goto 9999
end if
if (size(y,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/6,m,0,0,0/))
goto 9999
end if
if ((m>0).and.(n>0)) call daxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_daxpby
subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
complex(psb_spk_), intent (inout) :: y(:)
complex(psb_spk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (size(x) < m) then
info = 36
call psb_errpush(info,name,i_err=(/3,m,0,0,0/))
goto 9999
end if
if (size(y) < m) then
info = 36
call psb_errpush(info,name,i_err=(/5,m,0,0,0/))
goto 9999
end if
if (m>0) call caxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_caxpbyv
subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m, n
complex(psb_spk_), intent (in) :: x(:,:)
complex(psb_spk_), intent (inout) :: y(:,:)
complex(psb_spk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (n < 0) then
info = 10
call psb_errpush(info,name,i_err=(/2,n,0,0,0/))
goto 9999
end if
if (size(x,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/4,m,0,0,0/))
goto 9999
end if
if (size(y,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/6,m,0,0,0/))
goto 9999
end if
if ((m>0).and.(n>0)) call caxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_caxpby
subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
complex(psb_dpk_), intent (inout) :: y(:)
complex(psb_dpk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (size(x) < m) then
info = 36
call psb_errpush(info,name,i_err=(/3,m,0,0,0/))
goto 9999
end if
if (size(y) < m) then
info = 36
call psb_errpush(info,name,i_err=(/5,m,0,0,0/))
goto 9999
end if
if (m>0) call zaxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_zaxpbyv
subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
use psb_error_mod
implicit none
integer, intent(in) :: m, n
complex(psb_dpk_), intent (in) :: x(:,:)
complex(psb_dpk_), intent (inout) :: y(:,:)
complex(psb_dpk_), intent (in) :: alpha, beta
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name, ch_err
name='psb_geaxpby'
if(psb_get_errstatus() /= 0) return
info=0
call psb_erractionsave(err_act)
if (m < 0) then
info = 10
call psb_errpush(info,name,i_err=(/1,m,0,0,0/))
goto 9999
end if
if (n < 0) then
info = 10
call psb_errpush(info,name,i_err=(/2,n,0,0,0/))
goto 9999
end if
if (size(x,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/4,m,0,0,0/))
goto 9999
end if
if (size(y,1) < m) then
info = 36
call psb_errpush(info,name,i_err=(/6,m,0,0,0/))
goto 9999
end if
if ((m>0).and.(n>0)) call zaxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_zaxpby
end module psi_serial_mod end module psi_serial_mod

2
base/psblas/psb_dnrmi.f90
Unescape Escape View File

@ -46,7 +46,7 @@ function psb_dnrmi(a,desc_a,info)
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
type(psb_d_sparse_mat), intent(in) :: a type(psb_d_sparse_mat), intent(in) :: a

4
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -72,7 +72,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@ -432,7 +432,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta

5
base/psblas/psb_dspsm.f90
Unescape Escape View File

@ -84,7 +84,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@ -369,7 +369,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@ -526,7 +526,6 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
xp => x(iix:lldx) xp => x(iix:lldx)
yp => y(iiy:lldy) yp => y(iiy:lldy)
call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans) call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans)
!!$ call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=id,trans=itrans)
if(info /= 0) then if(info /= 0) then
info = 4010 info = 4010

7
base/psblas/psb_snrmi.f90
Unescape Escape View File

@ -43,13 +43,13 @@
! !
function psb_snrmi(a,desc_a,info) function psb_snrmi(a,desc_a,info)
use psb_descriptor_type use psb_descriptor_type
use psb_serial_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_) :: psb_snrmi real(psb_spk_) :: psb_snrmi
@ -94,8 +94,7 @@ function psb_snrmi(a,desc_a,info)
end if end if
if ((m /= 0).and.(n /= 0)) then if ((m /= 0).and.(n /= 0)) then
nrmi = psb_csnmi(a,info) nrmi = psb_csnmi(a)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_csnmi' ch_err='psb_csnmi'

19
base/psblas/psb_sspmm.f90
Unescape Escape View File

@ -74,12 +74,13 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(inout), target :: x(:,:) real(psb_spk_), intent(inout), target :: x(:,:)
real(psb_spk_), intent(inout), target :: y(:,:) real(psb_spk_), intent(inout), target :: y(:,:)
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), optional, target :: work(:) real(psb_spk_), optional, target :: work(:)
@ -250,7 +251,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
if(info /= 0) exit blk if(info /= 0) exit blk
! local Matrix-vector product ! 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_) & beta,y(:,jjy+i-1:jjy+i-1+ib-1),info,trans=trans_)
if(info /= 0) exit blk if(info /= 0) exit blk
@ -265,7 +266,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
if (doswap_)& if (doswap_)&
& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& ib1,szero,x(:,1:ik),desc_a,iwork,info) & ib1,szero,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 end if
if(info /= 0) then if(info /= 0) then
info = 4011 info = 4011
@ -312,7 +313,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info) if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
y(nrow+1:ncol,1:ik) = szero y(nrow+1:ncol,1:ik) = szero
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_) & if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info & write(debug_unit,*) me,' ',trim(name),' csmm ', info
if (info /= 0) then if (info /= 0) then
@ -425,8 +426,6 @@ end subroutine psb_sspmm
subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
& trans, work, doswap) & trans, work, doswap)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_comm_mod use psb_comm_mod
use psb_const_mod use psb_const_mod
@ -435,12 +434,13 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(inout), target :: x(:) real(psb_spk_), intent(inout), target :: x(:)
real(psb_spk_), intent(inout), target :: y(:) real(psb_spk_), intent(inout), target :: y(:)
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), optional, target :: work(:) real(psb_spk_), optional, target :: work(:)
@ -581,8 +581,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
& szero,x,desc_a,iwork,info,data=psb_comm_halo_) & szero,x,desc_a,iwork,info,data=psb_comm_halo_)
end if end if
! local Matrix-vector product call psb_csmm(alpha,a,x,beta,y,info)
call a%csmm(alpha,x(iix:lldx),beta,y(iiy:lldy),info)
if(info /= 0) then if(info /= 0) then
info = 4011 info = 4011
@ -631,7 +630,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
yp(nrow+1:ncol) = szero yp(nrow+1:ncol) = szero
! local Matrix-vector product ! 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_) & if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' csmm ', info & write(debug_unit,*) me,' ',trim(name),' csmm ', info

42
base/psblas/psb_sspsm.f90
Unescape Escape View File

@ -75,10 +75,8 @@
! !
! !
subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& subroutine psb_sspsm(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_descriptor_type
use psb_comm_mod use psb_comm_mod
use psi_mod use psi_mod
@ -86,17 +84,18 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(in), target :: x(:,:) real(psb_spk_), intent(in), target :: x(:,:)
real(psb_spk_), intent(inout), target :: y(:,:) real(psb_spk_), intent(inout), target :: y(:,:)
type (psb_sspmat_type), intent(in) :: a type (psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), intent(in), optional, target :: diag(:) real(psb_spk_), intent(in), optional, target :: diag(:)
real(psb_spk_), optional, target :: work(:) real(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 :: choice
integer, intent(in), optional :: k, jx, jy integer, intent(in), optional :: k, jx, jy
@ -106,7 +105,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, ijx, ijy, i, lld,& & ix, iy, ik, ijx, ijy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd character :: lside
integer, parameter :: nb=4 integer, parameter :: nb=4
real(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:) real(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
character :: itrans character :: itrans
@ -158,10 +157,10 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_ choice_ = psb_avg_
endif endif
if (present(unitd)) then if (present(side)) then
lunitd = psb_toupper(unitd) lside = psb_toupper(side)
else else
lunitd = 'U' lside = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
@ -192,8 +191,6 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
! check for presence/size of a work area ! check for presence/size of a work area
iwork => null() iwork => null()
liwork= 2*ncol 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 (present(work)) then
if (size(work) >= liwork) then if (size(work) >= liwork) then
aliw =.false. aliw =.false.
@ -259,7 +256,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve ! Perform local triangular system solve
xp => x(iix:lldx,jjx:jjx+ik-1) xp => x(iix:lldx,jjx:jjx+ik-1)
yp => y(iiy:lldy,jjy:jjy+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 if(info /= 0) then
info = 4010 info = 4010
@ -357,16 +354,14 @@ end subroutine psb_sspsm
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
! trans - character(optional). Whether A or A'. If not present 'N' is assumed. ! 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. ! the diagonal matrix D.
! choice - integer(optional). The kind of update to perform on overlap elements. ! choice - integer(optional). The kind of update to perform on overlap elements.
! d(:) - real , optional Matrix for diagonal scaling. ! d(:) - real , optional Matrix for diagonal scaling.
! work(:) - real , optional Working area. ! work(:) - real , optional Working area.
! !
subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
& trans, unitd, choice, diag, work) & trans, side, choice, diag, work)
use psb_spmat_type
use psb_serial_mod
use psb_descriptor_type use psb_descriptor_type
use psb_comm_mod use psb_comm_mod
use psi_mod use psi_mod
@ -374,17 +369,18 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
real(psb_spk_), intent(in), target :: x(:) real(psb_spk_), intent(in), target :: x(:)
real(psb_spk_), intent(inout), target :: y(:) real(psb_spk_), intent(inout), target :: y(:)
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
real(psb_spk_), intent(in), optional, target :: diag(:) real(psb_spk_), intent(in), optional, target :: diag(:)
real(psb_spk_), optional, target :: work(:) real(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 :: choice
! locals ! locals
@ -393,7 +389,7 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
& ix, iy, ik, jx, jy, i, lld,& & ix, iy, ik, jx, jy, i, lld,&
& m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm
character :: lunitd character :: lside
integer, parameter :: nb=4 integer, parameter :: nb=4
real(psb_spk_),pointer :: iwork(:), xp(:), yp(:), id(:) real(psb_spk_),pointer :: iwork(:), xp(:), yp(:), id(:)
character :: itrans character :: itrans
@ -429,10 +425,10 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
choice_ = psb_avg_ choice_ = psb_avg_
endif endif
if (present(unitd)) then if (present(side)) then
lunitd = psb_toupper(unitd) lside = psb_toupper(side)
else else
lunitd = 'U' lside = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
@ -529,7 +525,7 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
! Perform local triangular system solve ! Perform local triangular system solve
xp => x(iix:lldx) xp => x(iix:lldx)
yp => y(iiy:lldy) 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 if(info /= 0) then
info = 4010 info = 4010

6
base/serial/Makefile
Unescape Escape View File

@ -11,12 +11,6 @@ FOBJS = psb_cest.o \
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\ psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\
psb_zgelp.o\ psb_zgelp.o\
psb_zspshift.o psb_zspsetbld.o\ psb_zspshift.o psb_zspsetbld.o\
psb_scsprt.o psb_sspcnv.o psb_scoins.o psb_scsmm.o psb_scsmv.o \
psb_scssm.o psb_scssv.o psb_sneigh.o psb_sspgtblk.o psb_sspgetrow.o \
psb_sfixcoo.o psb_sipcsr2coo.o psb_sipcoo2csr.o psb_sipcoo2csc.o \
psb_sgelp.o psb_sspgtdiag.o psb_scsnmi.o psb_stransp.o \
psb_sspclip.o psb_srwextd.o psb_sspscal.o\
psb_snumbmm.o psb_ssymbmm.o\
psb_ccsprt.o psb_cspcnv.o psb_ccoins.o psb_ccsnmi.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_cfixcoo.o psb_cipcsr2coo.o psb_cipcoo2csr.o psb_cipcoo2csc.o \
psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\ psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\

5
base/serial/coo/Makefile
Unescape Escape View File

@ -3,11 +3,12 @@ include ../../../Make.inc
# #
# The object files # The object files
# #
FOBJS = scoonrmi.o scoomm.o scoomv.o scoosm.o scoosv.o scoorws.o\ FOBJS = ccoonrmi.o ccoomm.o ccoomv.o ccoosm.o ccoosv.o ccoorws.o\
ccoonrmi.o ccoomm.o ccoomv.o ccoosm.o ccoosv.o ccoorws.o\
zcoomm.o zcoomv.o zcoonrmi.o zcoorws.o zcoosm.o zcoosv.o zcoomm.o zcoomv.o zcoonrmi.o zcoorws.o zcoosm.o zcoosv.o
# dcoonrmi.o dcoomm.o dcoomv.o dcoosm.o dcoosv.o dcoorws.o\ # dcoonrmi.o dcoomm.o dcoomv.o dcoosm.o dcoosv.o dcoorws.o\
#scoonrmi.o scoomm.o scoomv.o scoosm.o scoosv.o scoorws.o\
OBJS=$(FOBJS) OBJS=$(FOBJS)

6
base/serial/csr/Makefile
Unescape Escape View File

@ -4,13 +4,13 @@ include ../../../Make.inc
# The object files # The object files
# #
FOBJS = scsrmm.o scsrmv.o scsrmv2.o scsrmv3.o scsrmv4.o scsrsm.o scsrsv.o\ FOBJS = ccrnrmi.o ccsrmm.o ccsrrws.o ccsrsm.o csrmv.o csrsv.o ccsrck.o\
scrnrmi.o \
ccrnrmi.o ccsrmm.o ccsrrws.o ccsrsm.o csrmv.o csrsv.o ccsrck.o\
zcrnrmi.o zcsrmm.o zcsrrws.o zcsrsm.o zsrmv.o zsrsv.o zcsrck.o zcrnrmi.o zcsrmm.o zcsrrws.o zcsrsm.o zsrmv.o zsrsv.o zcsrck.o
#dcsrck.o dcsrmm.o dcsrsm.o dcsrmv.o dcsrsv.o dcrnrmi.o \ #dcsrck.o dcsrmm.o dcsrsm.o dcsrmv.o dcsrsv.o dcrnrmi.o \
# dcsrmv4.o dcsrmv2.o dcsrmv3.o dcsrrws.o\ # dcsrmv4.o dcsrmv2.o dcsrmv3.o dcsrrws.o\
# scsrmm.o scsrmv.o scsrmv2.o scsrmv3.o scsrmv4.o scsrsm.o scsrsv.o\
# scrnrmi.o \
OBJS=$(FOBJS) OBJS=$(FOBJS)

2
base/serial/dp/Makefile
Unescape Escape View File

@ -8,7 +8,6 @@ FOBJS = partition.o dgblock.o dvtfg.o \
check_dim.o \ check_dim.o \
Max_nnzero.o \ Max_nnzero.o \
gen_block.o\ gen_block.o\
scrco.o scrcr.o scocr.o scoco.o sgindex.o sgind_tri.o\
ccoco.o ccocr.o ccrco.o ccrcr.o cgindex.o cgind_tri.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\ zcoco.o zcocr.o zcrco.o zcrcr.o zgindex.o zgind_tri.o\
$(XOBJS) $(XOBJS)
@ -17,6 +16,7 @@ FOBJS = partition.o dgblock.o dvtfg.o \
#dcrcr.o #dcrcr.o
#dgindex.o djadrp.o djadrp1.o dcsrrp.o dcsrp1.o #dgindex.o djadrp.o djadrp1.o dcsrrp.o dcsrp1.o
#dcrjd.o #dcrjd.o
# scrco.o scrcr.o scocr.o scoco.o sgindex.o sgind_tri.o\
# #
# dgind_tri.o # dgind_tri.o

2
base/serial/f03/psb_d_csr_impl.f03
Unescape Escape View File

@ -807,7 +807,7 @@ subroutine d_csr_cssm_impl(alpha,a,x,beta,y,info,trans)
real(psb_dpk_), allocatable :: tmp(:,:) real(psb_dpk_), allocatable :: tmp(:,:)
logical :: tra logical :: tra
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_base_csmm' character(len=20) :: name='d_base_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 info = 0

14
base/serial/f03/psb_s_csr_impl.f03
Unescape Escape View File

@ -622,12 +622,24 @@ subroutine s_csr_cssv_impl(alpha,a,x,beta,y,info,trans)
tra = ((trans_=='T').or.(trans_=='t')) tra = ((trans_=='T').or.(trans_=='t'))
m = a%get_nrows() m = a%get_nrows()
if (.not. (a%is_triangle())) then if (.not. (a%is_triangle())) then
info = 1121 info = 1121
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
if (size(x)<m) then
info = 36
call psb_errpush(info,name,i_err=(/3,m,0,0,0/))
goto 9999
end if
if (size(y)<m) then
info = 36
call psb_errpush(info,name,i_err=(/5,m,0,0,0/))
goto 9999
end if
if (alpha == szero) then if (alpha == szero) then
if (beta == szero) then if (beta == szero) then
@ -807,7 +819,7 @@ subroutine s_csr_cssm_impl(alpha,a,x,beta,y,info,trans)
real(psb_spk_), allocatable :: tmp(:,:) real(psb_spk_), allocatable :: tmp(:,:)
logical :: tra logical :: tra
Integer :: err_act Integer :: err_act
character(len=20) :: name='s_base_csmm' character(len=20) :: name='s_base_cssm'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 info = 0

6
base/serial/f77/Makefile
Unescape Escape View File

@ -3,8 +3,8 @@ include ../../../Make.inc
# #
# The object files # The object files
# #
FOBJS = daxpby.o saxpby.o slpupd.o scsmm.o sswmm.o scsnmi.o scsrws.o\ FOBJS = daxpby.o saxpby.o \
sswsm.o scssm.o sgelp.o\ sgelp.o\
caxpby.o clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\ caxpby.o clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\
cswsm.o ccssm.o cgelp.o\ cswsm.o ccssm.o cgelp.o\
zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\ zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\
@ -13,6 +13,8 @@ FOBJS = daxpby.o saxpby.o slpupd.o scsmm.o sswmm.o scsnmi.o scsrws.o\
#dcsmm.o dcsnmi.o dcsrp.o dcssm.o \ #dcsmm.o dcsnmi.o dcsrp.o dcssm.o \
# dgelp.o dlpupd.o dswmm.o \ # dgelp.o dlpupd.o dswmm.o \
# dswsm.o smmp.o dcsrws.o \ # dswsm.o smmp.o dcsrws.o \
#slpupd.o scsmm.o sswmm.o scsnmi.o scsrws.o\
#sswsm.o scssm.o
OBJS=$(FOBJS) OBJS=$(FOBJS)

5
base/serial/jad/Makefile
Unescape Escape View File

@ -3,8 +3,9 @@ include ../../../Make.inc
# The object files # The object files
# #
FOBJS = sjadmm.o sjadmv.o sjadsm.o sjadsv.o sjdnrmi.o sjadnr.o\ FOBJS =
sjadmv2.o sjadmv3.o sjadmv4.o sjadrws.o sjdrws.o # sjadmm.o sjadmv.o sjadsm.o sjadsv.o sjdnrmi.o sjadnr.o\
# sjadmv2.o sjadmv3.o sjadmv4.o sjadrws.o sjdrws.o
#djadmm.o djadmv.o djadsm.o djadsv.o djdnrmi.o djadnr.o\ #djadmm.o djadmv.o djadsm.o djadsv.o djdnrmi.o djadnr.o\
# djadmv2.o djadmv3.o djadmv4.o djadrws.o djdrws.o \ # djadmv2.o djadmv3.o djadmv4.o djadrws.o djdrws.o \

850
base/serial/psb_getrow_mod.f90
Unescape Escape View File

@ -32,440 +32,440 @@
module psb_getrow_mod module psb_getrow_mod
interface csr_getrow interface csr_getrow
module procedure csr_sspgtrow, csr_cspgtrow, csr_zspgtrow module procedure csr_cspgtrow, csr_zspgtrow
end interface end interface
interface coo_getrow interface coo_getrow
module procedure coo_sspgtrow, coo_cspgtrow, coo_zspgtrow module procedure coo_cspgtrow, coo_zspgtrow
end interface end interface
interface jad_getrow interface jad_getrow
module procedure jad_sspgtrow, jad_cspgtrow, jad_zspgtrow module procedure jad_cspgtrow, jad_zspgtrow
end interface end interface
contains contains
subroutine csr_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren) !!$ subroutine csr_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren)
!!$
use psb_sort_mod !!$ use psb_sort_mod
use psb_spmat_type !!$ use psb_spmat_type
use psb_const_mod !!$ use psb_const_mod
implicit none !!$ implicit none
!!$
type(psb_sspmat_type), intent(in) :: a !!$ type(psb_sspmat_type), intent(in) :: a
integer :: irw !!$ integer :: irw
integer, intent(out) :: nz !!$ integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:) !!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:) !!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
integer :: nzin !!$ integer :: nzin
logical, intent(in) :: append !!$ logical, intent(in) :: append
integer :: lrw,info !!$ integer :: lrw,info
integer, optional :: iren(:) !!$ integer, optional :: iren(:)
!!$
integer :: idx,i,j, k, nr, row_idx, nzin_ !!$ integer :: idx,i,j, k, nr, row_idx, nzin_
integer, allocatable :: indices(:) !!$ integer, allocatable :: indices(:)
!!$
if (append) then !!$ if (append) then
nzin_ = nzin !!$ nzin_ = nzin
else !!$ else
nzin_ = 0 !!$ nzin_ = 0
endif !!$ endif
!!$
if (a%pl(1) /= 0) then !!$ if (a%pl(1) /= 0) then
!!$
nr = lrw - irw + 1 !!$ nr = lrw - irw + 1
allocate(indices(nr)) !!$ allocate(indices(nr))
nz = 0 !!$ nz = 0
do i=1,nr !!$ do i=1,nr
indices(i)=a%pl(irw+i-1) !!$ indices(i)=a%pl(irw+i-1)
nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i)) !!$ nz=nz+a%ia2(indices(i)+1)-a%ia2(indices(i))
end do !!$ end do
!!$
call psb_ensure_size(nzin_+nz,ia,info) !!$ call psb_ensure_size(nzin_+nz,ia,info)
if (info==0) call psb_ensure_size(nzin_+nz,ja,info) !!$ if (info==0) call psb_ensure_size(nzin_+nz,ja,info)
if (info==0) call psb_ensure_size(nzin_+nz,val,info) !!$ if (info==0) call psb_ensure_size(nzin_+nz,val,info)
if (info /= 0) return !!$ if (info /= 0) return
!!$
k=0 !!$ k=0
if(present(iren)) then !!$ if(present(iren)) then
do i=1,nr !!$ do i=1,nr
row_idx=indices(i) !!$ row_idx=indices(i)
do j=a%ia2(row_idx),a%ia2(row_idx+1)-1 !!$ do j=a%ia2(row_idx),a%ia2(row_idx+1)-1
k = k + 1 !!$ k = k + 1
val(nzin_+k) = a%aspk(j) !!$ val(nzin_+k) = a%aspk(j)
ia(nzin_+k) = iren(row_idx) !!$ ia(nzin_+k) = iren(row_idx)
ja(nzin_+k) = iren(a%ia1(j)) !!$ ja(nzin_+k) = iren(a%ia1(j))
end do !!$ end do
end do !!$ end do
else !!$ else
do i=1,nr !!$ do i=1,nr
row_idx=indices(i) !!$ row_idx=indices(i)
do j=a%ia2(row_idx),a%ia2(row_idx+1)-1 !!$ do j=a%ia2(row_idx),a%ia2(row_idx+1)-1
k = k + 1 !!$ k = k + 1
val(nzin_+k) = a%aspk(j) !!$ val(nzin_+k) = a%aspk(j)
ia(nzin_+k) = row_idx !!$ ia(nzin_+k) = row_idx
ja(nzin_+k) = a%ia1(j) !!$ ja(nzin_+k) = a%ia1(j)
end do !!$ end do
end do !!$ end do
end if !!$ end if
!!$
else !!$ else
!!$
idx = irw !!$ idx = irw
!!$
if (idx<0) then !!$ if (idx<0) then
write(0,*) ' spgtrow Error : idx no good ',idx !!$ write(0,*) ' spgtrow Error : idx no good ',idx
info = 2 !!$ info = 2
return !!$ return
end if !!$ end if
nr = lrw - irw + 1 !!$ nr = lrw - irw + 1
nz = a%ia2(idx+nr) - a%ia2(idx) !!$ nz = a%ia2(idx+nr) - a%ia2(idx)
!!$
call psb_ensure_size(nzin_+nz,ia,info) !!$ call psb_ensure_size(nzin_+nz,ia,info)
if (info==0) call psb_ensure_size(nzin_+nz,ja,info) !!$ if (info==0) call psb_ensure_size(nzin_+nz,ja,info)
if (info==0) call psb_ensure_size(nzin_+nz,val,info) !!$ if (info==0) call psb_ensure_size(nzin_+nz,val,info)
if (info /= 0) return !!$ if (info /= 0) return
!!$
!!$
if (present(iren)) then !!$ if (present(iren)) then
k=0 !!$ k=0
do i=irw,lrw !!$ do i=irw,lrw
do j=a%ia2(i),a%ia2(i+1)-1 !!$ do j=a%ia2(i),a%ia2(i+1)-1
k = k + 1 !!$ k = k + 1
val(nzin_+k) = a%aspk(j) !!$ val(nzin_+k) = a%aspk(j)
ia(nzin_+k) = iren(i) !!$ ia(nzin_+k) = iren(i)
ja(nzin_+k) = iren(a%ia1(j)) !!$ ja(nzin_+k) = iren(a%ia1(j))
end do !!$ end do
enddo !!$ enddo
else !!$ else
k=0 !!$ k=0
!!$
do i=irw,lrw !!$ do i=irw,lrw
do j=a%ia2(i),a%ia2(i+1)-1 !!$ do j=a%ia2(i),a%ia2(i+1)-1
k = k + 1 !!$ k = k + 1
ia(nzin_+k) = i !!$ ia(nzin_+k) = i
ja(nzin_+k) = a%ia1(j) !!$ ja(nzin_+k) = a%ia1(j)
val(nzin_+k) = a%aspk(j) !!$ val(nzin_+k) = a%aspk(j)
end do !!$ end do
enddo !!$ enddo
end if !!$ end if
!!$ if (nz /= k) then !!$! !$ if (nz /= k) then
!!$ write(0,*) 'csr getrow Size mismatch ',nz,k !!$! !$ write(0,*) 'csr getrow Size mismatch ',nz,k
!!$! !$ endif
!!$ if (a%pr(1) /= 0) then
!!$ write(0,*) 'Feeling lazy today, Right Permutation will have to wait'
!!$ endif !!$ endif
if (a%pr(1) /= 0) then !!$
write(0,*) 'Feeling lazy today, Right Permutation will have to wait' !!$ endif
endif !!$
!!$ end subroutine csr_sspgtrow
endif !!$
!!$ subroutine coo_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren)
end subroutine csr_sspgtrow !!$
!!$ use psb_sort_mod
subroutine coo_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren) !!$ use psb_spmat_type
!!$ use psb_const_mod
use psb_sort_mod !!$ use psb_error_mod
use psb_spmat_type !!$ implicit none
use psb_const_mod !!$
use psb_error_mod !!$ type(psb_sspmat_type), intent(in) :: a
implicit none !!$ integer :: irw
!!$ integer, intent(out) :: nz
type(psb_sspmat_type), intent(in) :: a !!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
integer :: irw !!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
integer, intent(out) :: nz !!$ integer :: nzin
integer, allocatable, intent(inout) :: ia(:), ja(:) !!$ logical, intent(in) :: append
real(psb_spk_), allocatable, intent(inout) :: val(:) !!$ integer :: lrw,info
integer :: nzin !!$ integer, optional :: iren(:)
logical, intent(in) :: append !!$ integer :: nzin_, nza, idx,ip,jp,i,k, nzt
integer :: lrw,info !!$ integer :: debug_level, debug_unit
integer, optional :: iren(:) !!$ character(len=20) :: name='coo_sspgtrow'
integer :: nzin_, nza, idx,ip,jp,i,k, nzt !!$
integer :: debug_level, debug_unit !!$ debug_unit = psb_get_debug_unit()
character(len=20) :: name='coo_sspgtrow' !!$ debug_level = psb_get_debug_level()
!!$
debug_unit = psb_get_debug_unit() !!$ nza = a%infoa(psb_nnz_)
debug_level = psb_get_debug_level() !!$ if (a%pl(1) /= 0) then
!!$ write(debug_unit,*) 'Fatal error in SPGTROW: do not feed a permuted mat so far!'
nza = a%infoa(psb_nnz_) !!$ idx = -1
if (a%pl(1) /= 0) then !!$ else
write(debug_unit,*) 'Fatal error in SPGTROW: do not feed a permuted mat so far!' !!$ idx = irw
idx = -1 !!$ endif
else !!$ if (idx<0) then
idx = irw !!$ write(debug_unit,*) ' spgtrow Error : idx no good ',idx
endif !!$ info = 2
if (idx<0) then !!$ return
write(debug_unit,*) ' spgtrow Error : idx no good ',idx !!$ end if
info = 2 !!$
return !!$ if (append) then
end if !!$ nzin_ = nzin
!!$ else
if (append) then !!$ nzin_ = 0
nzin_ = nzin !!$ endif
else !!$
nzin_ = 0 !!$ if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then
endif !!$ ! In this case we can do a binary search.
!!$ if (debug_level >= psb_debug_serial_)&
if (a%infoa(psb_srtd_) == psb_isrtdcoo_) then !!$ & write(debug_unit,*) trim(name), ': srtdcoo '
! In this case we can do a binary search. !!$ do
if (debug_level >= psb_debug_serial_)& !!$ ip = psb_ibsrch(irw,nza,a%ia1)
& write(debug_unit,*) trim(name), ': srtdcoo ' !!$ if (ip /= -1) exit
do !!$ irw = irw + 1
ip = psb_ibsrch(irw,nza,a%ia1) !!$ if (irw > lrw) then
if (ip /= -1) exit !!$ write(debug_unit,*) trim(name),&
irw = irw + 1 !!$ & 'Warning : did not find any rows. Is this an error? ',&
if (irw > lrw) then !!$ & irw,lrw,idx
write(debug_unit,*) trim(name),& !!$ exit
& 'Warning : did not find any rows. Is this an error? ',& !!$ end if
& irw,lrw,idx !!$ end do
exit !!$
end if !!$ if (ip /= -1) then
end do !!$ ! expand [ip,jp] to contain all row entries.
!!$ do
if (ip /= -1) then !!$ if (ip < 2) exit
! expand [ip,jp] to contain all row entries. !!$ if (a%ia1(ip-1) == irw) then
do !!$ ip = ip -1
if (ip < 2) exit !!$ else
if (a%ia1(ip-1) == irw) then !!$ exit
ip = ip -1 !!$ end if
else !!$ end do
exit !!$
end if !!$ end if
end do !!$
!!$ do
end if !!$ jp = psb_ibsrch(lrw,nza,a%ia1)
!!$ if (jp /= -1) exit
do !!$ lrw = lrw - 1
jp = psb_ibsrch(lrw,nza,a%ia1) !!$ if (irw > lrw) then
if (jp /= -1) exit !!$ write(debug_unit,*) trim(name),&
lrw = lrw - 1 !!$ & 'Warning : did not find any rows. Is this an error?'
if (irw > lrw) then !!$ exit
write(debug_unit,*) trim(name),& !!$ end if
& 'Warning : did not find any rows. Is this an error?' !!$ end do
exit !!$
end if !!$ if (jp /= -1) then
end do !!$ ! expand [ip,jp] to contain all row entries.
!!$ do
if (jp /= -1) then !!$ if (jp == nza) exit
! expand [ip,jp] to contain all row entries. !!$ if (a%ia1(jp+1) == lrw) then
do !!$ jp = jp + 1
if (jp == nza) exit !!$ else
if (a%ia1(jp+1) == lrw) then !!$ exit
jp = jp + 1 !!$ end if
else !!$ end do
exit !!$ end if
end if !!$ if (debug_level >= psb_debug_serial_) &
end do !!$ & write(debug_unit,*) trim(name),': ip jp',ip,jp,nza
end if !!$ if ((ip /= -1) .and.(jp /= -1)) then
if (debug_level >= psb_debug_serial_) & !!$ ! Now do the copy.
& write(debug_unit,*) trim(name),': ip jp',ip,jp,nza !!$ nz = jp - ip +1
if ((ip /= -1) .and.(jp /= -1)) then !!$
! Now do the copy. !!$ call psb_ensure_size(nzin_+nz,ia,info)
nz = jp - ip +1 !!$ if (info==0) call psb_ensure_size(nzin_+nz,ja,info)
!!$ if (info==0) call psb_ensure_size(nzin_+nz,val,info)
call psb_ensure_size(nzin_+nz,ia,info) !!$ if (info /= 0) return
if (info==0) call psb_ensure_size(nzin_+nz,ja,info) !!$
if (info==0) call psb_ensure_size(nzin_+nz,val,info) !!$ if (present(iren)) then
if (info /= 0) return !!$ do i=ip,jp
!!$ nzin_ = nzin_ + 1
if (present(iren)) then !!$ val(nzin_) = a%aspk(i)
do i=ip,jp !!$ ia(nzin_) = iren(a%ia1(i))
nzin_ = nzin_ + 1 !!$ ja(nzin_) = iren(a%ia2(i))
val(nzin_) = a%aspk(i) !!$ enddo
ia(nzin_) = iren(a%ia1(i)) !!$ else
ja(nzin_) = iren(a%ia2(i)) !!$ do i=ip,jp
enddo !!$ nzin_ = nzin_ + 1
else !!$ val(nzin_) = a%aspk(i)
do i=ip,jp !!$ ia(nzin_) = a%ia1(i)
nzin_ = nzin_ + 1 !!$ ja(nzin_) = a%ia2(i)
val(nzin_) = a%aspk(i) !!$ enddo
ia(nzin_) = a%ia1(i) !!$ end if
ja(nzin_) = a%ia2(i) !!$ else
enddo !!$ nz = 0
end if !!$ end if
else !!$
nz = 0 !!$ else
end if !!$ if (debug_level >= psb_debug_serial_) &
!!$ & write(debug_unit,*) trim(name),': unsorted '
else !!$
if (debug_level >= psb_debug_serial_) & !!$ nzt = (nza*(lrw-irw+1))/max(a%m,1)
& write(debug_unit,*) trim(name),': unsorted ' !!$ call psb_ensure_size(nzin_+nzt,ia,info)
!!$ if (info==0) call psb_ensure_size(nzin_+nzt,ja,info)
nzt = (nza*(lrw-irw+1))/max(a%m,1) !!$ if (info==0) call psb_ensure_size(nzin_+nzt,val,info)
call psb_ensure_size(nzin_+nzt,ia,info) !!$ if (info /= 0) return
if (info==0) call psb_ensure_size(nzin_+nzt,ja,info) !!$
if (info==0) call psb_ensure_size(nzin_+nzt,val,info) !!$ if (present(iren)) then
if (info /= 0) return !!$ k = 0
!!$ do i=1, a%infoa(psb_nnz_)
if (present(iren)) then !!$ if ((a%ia1(i)>=irw).and.(a%ia1(i)<=lrw)) then
k = 0 !!$ k = k + 1
do i=1, a%infoa(psb_nnz_) !!$ if (k > nzt) then
if ((a%ia1(i)>=irw).and.(a%ia1(i)<=lrw)) then !!$ nzt = k
k = k + 1 !!$ call psb_ensure_size(nzin_+nzt,ia,info)
if (k > nzt) then !!$ if (info==0) call psb_ensure_size(nzin_+nzt,ja,info)
nzt = k !!$ if (info==0) call psb_ensure_size(nzin_+nzt,val,info)
call psb_ensure_size(nzin_+nzt,ia,info) !!$ if (info /= 0) return
if (info==0) call psb_ensure_size(nzin_+nzt,ja,info) !!$ end if
if (info==0) call psb_ensure_size(nzin_+nzt,val,info) !!$ val(nzin_+k) = a%aspk(i)
if (info /= 0) return !!$ ia(nzin_+k) = iren(a%ia1(i))
end if !!$ ja(nzin_+k) = iren(a%ia2(i))
val(nzin_+k) = a%aspk(i) !!$ endif
ia(nzin_+k) = iren(a%ia1(i)) !!$ enddo
ja(nzin_+k) = iren(a%ia2(i)) !!$ else
endif !!$ k = 0
enddo !!$ do i=1,a%infoa(psb_nnz_)
else !!$ if ((a%ia1(i)>=irw).and.(a%ia1(i)<=lrw)) then
k = 0 !!$ k = k + 1
do i=1,a%infoa(psb_nnz_) !!$ if (k > nzt) then
if ((a%ia1(i)>=irw).and.(a%ia1(i)<=lrw)) then !!$ nzt = k
k = k + 1 !!$ call psb_ensure_size(nzin_+nzt,ia,info)
if (k > nzt) then !!$ if (info==0) call psb_ensure_size(nzin_+nzt,ja,info)
nzt = k !!$ if (info==0) call psb_ensure_size(nzin_+nzt,val,info)
call psb_ensure_size(nzin_+nzt,ia,info) !!$ if (info /= 0) return
if (info==0) call psb_ensure_size(nzin_+nzt,ja,info) !!$
if (info==0) call psb_ensure_size(nzin_+nzt,val,info) !!$ end if
if (info /= 0) return !!$ val(nzin_+k) = a%aspk(i)
!!$ ia(nzin_+k) = (a%ia1(i))
end if !!$ ja(nzin_+k) = (a%ia2(i))
val(nzin_+k) = a%aspk(i) !!$ endif
ia(nzin_+k) = (a%ia1(i)) !!$ enddo
ja(nzin_+k) = (a%ia2(i)) !!$ nzin_=nzin_+k
endif !!$ end if
enddo !!$ nz = k
nzin_=nzin_+k !!$ end if
end if !!$
nz = k !!$ end subroutine coo_sspgtrow
end if !!$
!!$
end subroutine coo_sspgtrow !!$ subroutine jad_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren)
!!$
!!$ use psb_sort_mod
subroutine jad_sspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren) !!$ use psb_spmat_type
!!$ use psb_const_mod
use psb_sort_mod !!$
use psb_spmat_type !!$ implicit none
use psb_const_mod !!$
!!$ type(psb_sspmat_type), intent(in), target :: a
implicit none !!$ integer :: irw
!!$ integer, intent(out) :: nz
type(psb_sspmat_type), intent(in), target :: a !!$ integer, allocatable, intent(inout) :: ia(:), ja(:)
integer :: irw !!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
integer, intent(out) :: nz !!$ integer :: nzin
integer, allocatable, intent(inout) :: ia(:), ja(:) !!$ logical, intent(in) :: append
real(psb_spk_), allocatable, intent(inout) :: val(:) !!$ integer, optional :: iren(:)
integer :: nzin !!$ integer :: lrw,info
logical, intent(in) :: append !!$
integer, optional :: iren(:) !!$ integer, pointer :: ia1(:), ia2(:), ia3(:),&
integer :: lrw,info !!$ & ja_(:), ka_(:), indices(:), blks(:)
!!$ integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ng, nzin_,&
integer, pointer :: ia1(:), ia2(:), ia3(:),& !!$ & i,j,k,nr
& ja_(:), ka_(:), indices(:), blks(:) !!$
integer :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ng, nzin_,& !!$
& i,j,k,nr !!$ png = a%ia2(1) ! points to the number of blocks
!!$ pia = a%ia2(2) ! points to the beginning of ia(3,png)
!!$ pja = a%ia2(3) ! points to the beginning of ja(:)
png = a%ia2(1) ! points to the number of blocks !!$
pia = a%ia2(2) ! points to the beginning of ia(3,png) !!$ ng = a%ia2(png) ! the number of blocks
pja = a%ia2(3) ! points to the beginning of ja(:) !!$ ja_ => a%ia2(pja:) ! the array containing the pointers to ka and aspk
!!$ ka_ => a%ia1(:) ! the array containing the column indices
ng = a%ia2(png) ! the number of blocks !!$ ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block
ja_ => a%ia2(pja:) ! the array containing the pointers to ka and aspk !!$ ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column
ka_ => a%ia1(:) ! the array containing the column indices !!$ ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column
ia1 => a%ia2(pia:pja-1:3) ! the array containing the first row index of each block !!$
ia2 => a%ia2(pia+1:pja-1:3) ! the array containing a pointer to the pos. in ja to the first jad column !!$ if (append) then
ia3 => a%ia2(pia+2:pja-1:3) ! the array containing a pointer to the pos. in ja to the first csr column !!$ nzin_ = nzin
!!$ else
if (append) then !!$ nzin_ = 0
nzin_ = nzin !!$ endif
else !!$
nzin_ = 0 !!$ if (a%pl(1) /= 0) then
endif !!$
!!$ nr = lrw - irw + 1
if (a%pl(1) /= 0) then !!$ allocate(indices(nr),blks(nr))
!!$ nz = 0
nr = lrw - irw + 1 !!$
allocate(indices(nr),blks(nr)) !!$ do i=1,nr
nz = 0 !!$ indices(i)=a%pl(irw+i-1)
!!$ j=0
do i=1,nr !!$ blkfnd: do
indices(i)=a%pl(irw+i-1) !!$ j=j+1
j=0 !!$ if(ia1(j) == indices(i)) then
blkfnd: do !!$ blks(i)=j
j=j+1 !!$ nz=nz+ia3(j)-ia2(j)
if(ia1(j) == indices(i)) then !!$ ipx = ia1(j) ! the first row index of the block
blks(i)=j !!$ rb = indices(i)-ipx ! the row offset within the block
nz=nz+ia3(j)-ia2(j) !!$ row = ia3(j)+rb
ipx = ia1(j) ! the first row index of the block !!$ nz = nz+ja_(row+1)-ja_(row)
rb = indices(i)-ipx ! the row offset within the block !!$ exit blkfnd
row = ia3(j)+rb !!$ else if(ia1(j) > indices(i)) then
nz = nz+ja_(row+1)-ja_(row) !!$ blks(i)=j-1
exit blkfnd !!$ nz=nz+ia3(j-1)-ia2(j-1)
else if(ia1(j) > indices(i)) then !!$ ipx = ia1(j-1) ! the first row index of the block
blks(i)=j-1 !!$ rb = indices(i)-ipx ! the row offset within the block
nz=nz+ia3(j-1)-ia2(j-1) !!$ row = ia3(j-1)+rb
ipx = ia1(j-1) ! the first row index of the block !!$ nz = nz+ja_(row+1)-ja_(row)
rb = indices(i)-ipx ! the row offset within the block !!$ exit blkfnd
row = ia3(j-1)+rb !!$ end if
nz = nz+ja_(row+1)-ja_(row) !!$ end do blkfnd
exit blkfnd !!$ end do
end if !!$
end do blkfnd !!$
end do !!$ call psb_ensure_size(nzin_+nz,ia,info)
!!$ if (info==0) call psb_ensure_size(nzin_+nz,ja,info)
!!$ if (info==0) call psb_ensure_size(nzin_+nz,val,info)
call psb_ensure_size(nzin_+nz,ia,info) !!$ if (info /= 0) return
if (info==0) call psb_ensure_size(nzin_+nz,ja,info) !!$
if (info==0) call psb_ensure_size(nzin_+nz,val,info) !!$ k=0
if (info /= 0) return !!$ ! cycle over rows
!!$ do i=1,nr
k=0 !!$
! cycle over rows !!$ ! find which block the row belongs to
do i=1,nr !!$ blk = blks(i)
!!$
! find which block the row belongs to !!$ ! extract first part of the row from the jad block
blk = blks(i) !!$ ipx = ia1(blk) ! the first row index of the block
!!$ k_pt= ia2(blk) ! the pointer to the beginning of a column in ja
! extract first part of the row from the jad block !!$ rb = indices(i)-ipx ! the row offset within the block
ipx = ia1(blk) ! the first row index of the block !!$ npg = ja_(k_pt+1)-ja_(k_pt) ! the number of rows in the block
k_pt= ia2(blk) ! the pointer to the beginning of a column in ja !!$
rb = indices(i)-ipx ! the row offset within the block !!$ if(present(iren))then
npg = ja_(k_pt+1)-ja_(k_pt) ! the number of rows in the block !!$ do col = ia2(blk), ia3(blk)-1
!!$ k=k+1
if(present(iren))then !!$ val(nzin_+k) = a%aspk(ja_(col)+rb)
do col = ia2(blk), ia3(blk)-1 !!$ ia(nzin_+k) = iren(irw+i-1)
k=k+1 !!$ ja(nzin_+k) = iren(ka_(ja_(col)+rb))
val(nzin_+k) = a%aspk(ja_(col)+rb) !!$ end do
ia(nzin_+k) = iren(irw+i-1) !!$ else
ja(nzin_+k) = iren(ka_(ja_(col)+rb)) !!$ do col = ia2(blk), ia3(blk)-1
end do !!$ k=k+1
else !!$ val(nzin_+k) = a%aspk(ja_(col)+rb)
do col = ia2(blk), ia3(blk)-1 !!$ ia(nzin_+k) = irw+i-1
k=k+1 !!$ ja(nzin_+k) = ka_(ja_(col)+rb)
val(nzin_+k) = a%aspk(ja_(col)+rb) !!$ end do
ia(nzin_+k) = irw+i-1 !!$ end if
ja(nzin_+k) = ka_(ja_(col)+rb) !!$ ! extract second part of the row from the csr tail
end do !!$ row=ia3(blk)+rb
end if !!$ if(present(iren))then
! extract second part of the row from the csr tail !!$ do j=ja_(row), ja_(row+1)-1
row=ia3(blk)+rb !!$ k=k+1
if(present(iren))then !!$ val(nzin_+k) = a%aspk(j)
do j=ja_(row), ja_(row+1)-1 !!$ ia(nzin_+k) = iren(irw+i-1)
k=k+1 !!$ ja(nzin_+k) = iren(ka_(j))
val(nzin_+k) = a%aspk(j) !!$ end do
ia(nzin_+k) = iren(irw+i-1) !!$ else
ja(nzin_+k) = iren(ka_(j)) !!$ do j=ja_(row), ja_(row+1)-1
end do !!$ k=k+1
else !!$ val(nzin_+k) = a%aspk(j)
do j=ja_(row), ja_(row+1)-1 !!$ ia(nzin_+k) = irw+i-1
k=k+1 !!$ ja(nzin_+k) = ka_(j)
val(nzin_+k) = a%aspk(j) !!$ end do
ia(nzin_+k) = irw+i-1 !!$ end if
ja(nzin_+k) = ka_(j) !!$ end do
end do !!$
end if !!$ else
end do !!$ ! There might be some problems
!!$ info=134
else !!$ end if
! There might be some problems !!$
info=134 !!$ end subroutine jad_sspgtrow
end if
end subroutine jad_sspgtrow
!!$ subroutine csr_dspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren) !!$ subroutine csr_dspgtrow(irw,a,nz,ia,ja,val,nzin,append,lrw,info,iren)

640
base/serial/psb_regen_mod.f90
Unescape Escape View File

@ -32,334 +32,334 @@
module psb_regen_mod module psb_regen_mod
interface csr_regen interface csr_regen
module procedure csr_ssp_regen, csr_csp_regen, csr_zsp_regen module procedure csr_csp_regen, csr_zsp_regen
end interface end interface
interface coo_regen interface coo_regen
module procedure coo_ssp_regen, coo_csp_regen, coo_zsp_regen module procedure coo_csp_regen, coo_zsp_regen
end interface end interface
interface jad_regen interface jad_regen
module procedure jad_ssp_regen, jad_csp_regen, jad_zsp_regen module procedure jad_csp_regen, jad_zsp_regen
end interface end interface
contains contains
subroutine csr_ssp_regen(a,info) !!$ subroutine csr_ssp_regen(a,info)
!!$
use psb_spmat_type !!$ use psb_spmat_type
use psb_const_mod !!$ use psb_const_mod
use psb_error_mod !!$ use psb_error_mod
implicit none !!$ implicit none
!!$
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer :: info !!$ integer :: info
!!$
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt !!$ integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(psb_spk_), allocatable :: work(:) !!$ real(psb_spk_), allocatable :: work(:)
integer :: err_act !!$ integer :: err_act
character(len=20) :: name !!$ character(len=20) :: name
integer :: debug_level, debug_unit !!$ integer :: debug_level, debug_unit
!!$
!!$
name='psb_spcnv' !!$ name='psb_spcnv'
info = 0 !!$ info = 0
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() !!$ debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() !!$ debug_level = psb_get_debug_level()
!!$
!!$
! !!$ !
! dupl_ and upd_ fields should not be changed. !!$ ! dupl_ and upd_ fields should not be changed.
! !!$ !
select case(psb_sp_getifld(psb_upd_,a,info)) !!$ select case(psb_sp_getifld(psb_upd_,a,info))
!!$
case(psb_upd_perm_) !!$ case(psb_upd_perm_)
!!$
allocate(work(size(a%aspk)+1000),stat=info) !!$ allocate(work(size(a%aspk)+1000),stat=info)
if (info /= 0) then !!$ if (info /= 0) then
info=2040 !!$ info=2040
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_' !!$ & write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_'
ip1 = psb_sp_getifld(psb_upd_pnt_,a,info) !!$ ip1 = psb_sp_getifld(psb_upd_pnt_,a,info)
ip2 = a%ia2(ip1+psb_ip2_) !!$ ip2 = a%ia2(ip1+psb_ip2_)
nnz = a%ia2(ip1+psb_nnz_) !!$ nnz = a%ia2(ip1+psb_nnz_)
iflag = a%ia2(ip1+psb_iflag_) !!$ iflag = a%ia2(ip1+psb_iflag_)
ichk = a%ia2(ip1+psb_ichk_) !!$ ichk = a%ia2(ip1+psb_ichk_)
nnzt = a%ia2(ip1+psb_nnzt_) !!$ nnzt = a%ia2(ip1+psb_nnzt_)
if (debug_level >= psb_debug_serial_) & !!$ if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),'Regeneration start: ',& !!$ & write(debug_unit,*) trim(name),'Regeneration start: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info
!!$
if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then !!$ if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then
info = 8889 !!$ info = 8889
write(debug_unit,*) trim(name),'Regeneration start error: ',& !!$ write(debug_unit,*) trim(name),'Regeneration start error: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
endif !!$ endif
do i= 1, nnz !!$ do i= 1, nnz
work(i) = dzero !!$ work(i) = dzero
enddo !!$ enddo
select case(iflag) !!$ select case(iflag)
case(psb_dupl_ovwrt_,psb_dupl_err_) !!$ case(psb_dupl_ovwrt_,psb_dupl_err_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia2(ip2+i-1)) = a%aspk(i) !!$ work(a%ia2(ip2+i-1)) = a%aspk(i)
enddo !!$ enddo
case(psb_dupl_add_) !!$ case(psb_dupl_add_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia2(ip2+i-1)) = a%aspk(i) + work(a%ia2(ip2+i-1)) !!$ work(a%ia2(ip2+i-1)) = a%aspk(i) + work(a%ia2(ip2+i-1))
enddo !!$ enddo
case default !!$ case default
info = 8887 !!$ info = 8887
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
do i=1, nnz !!$ do i=1, nnz
a%aspk(i) = work(i) !!$ a%aspk(i) = work(i)
enddo !!$ enddo
!!$
!!$
case(psb_upd_srch_) !!$ case(psb_upd_srch_)
! Nothing to be done here. !!$ ! Nothing to be done here.
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),& !!$ & write(debug_unit,*) trim(name),&
& 'Going through on regeneration with psb_upd_srch_' !!$ & 'Going through on regeneration with psb_upd_srch_'
case default !!$ case default
! Wrong value !!$ ! Wrong value
info = 8888 !!$ info = 8888
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
!!$
end select !!$ end select
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 continue !!$9999 continue
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then !!$ if (err_act == psb_act_abort_) then
call psb_error() !!$ call psb_error()
return !!$ return
end if !!$ end if
return !!$ return
!!$
end subroutine csr_ssp_regen !!$ end subroutine csr_ssp_regen
!!$
subroutine coo_ssp_regen(a,info) !!$ subroutine coo_ssp_regen(a,info)
!!$
use psb_spmat_type !!$ use psb_spmat_type
use psb_const_mod !!$ use psb_const_mod
use psb_error_mod !!$ use psb_error_mod
implicit none !!$ implicit none
!!$
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer :: info !!$ integer :: info
!!$
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt !!$ integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(psb_spk_), allocatable :: work(:) !!$ real(psb_spk_), allocatable :: work(:)
integer :: err_act !!$ integer :: err_act
character(len=20) :: name !!$ character(len=20) :: name
integer :: debug_level, debug_unit !!$ integer :: debug_level, debug_unit
!!$
!!$
name='psb_spcnv' !!$ name='psb_spcnv'
info = 0 !!$ info = 0
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() !!$ debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() !!$ debug_level = psb_get_debug_level()
!!$
!!$
! !!$ !
! dupl_ and upd_ fields should not be changed. !!$ ! dupl_ and upd_ fields should not be changed.
! !!$ !
select case(psb_sp_getifld(psb_upd_,a,info)) !!$ select case(psb_sp_getifld(psb_upd_,a,info))
!!$
case(psb_upd_perm_) !!$ case(psb_upd_perm_)
!!$
allocate(work(size(a%aspk)+1000),stat=info) !!$ allocate(work(size(a%aspk)+1000),stat=info)
if (info /= 0) then !!$ if (info /= 0) then
info=2040 !!$ info=2040
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_' !!$ & write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_'
ip1 = psb_sp_getifld(psb_upd_pnt_,a,info) !!$ ip1 = psb_sp_getifld(psb_upd_pnt_,a,info)
ip2 = a%ia2(ip1+psb_ip2_) !!$ ip2 = a%ia2(ip1+psb_ip2_)
nnz = a%ia2(ip1+psb_nnz_) !!$ nnz = a%ia2(ip1+psb_nnz_)
iflag = a%ia2(ip1+psb_iflag_) !!$ iflag = a%ia2(ip1+psb_iflag_)
ichk = a%ia2(ip1+psb_ichk_) !!$ ichk = a%ia2(ip1+psb_ichk_)
nnzt = a%ia2(ip1+psb_nnzt_) !!$ nnzt = a%ia2(ip1+psb_nnzt_)
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),'Regeneration start: ',& !!$ & write(debug_unit,*) trim(name),'Regeneration start: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info
!!$
if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then !!$ if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then
info = 8889 !!$ info = 8889
write(debug_unit,*) trim(name),'Regeneration start error: ',& !!$ write(debug_unit,*) trim(name),'Regeneration start error: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
endif !!$ endif
do i= 1, nnz !!$ do i= 1, nnz
work(i) = dzero !!$ work(i) = dzero
enddo !!$ enddo
select case(iflag) !!$ select case(iflag)
case(psb_dupl_ovwrt_,psb_dupl_err_) !!$ case(psb_dupl_ovwrt_,psb_dupl_err_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia2(ip2+i-1)) = a%aspk(i) !!$ work(a%ia2(ip2+i-1)) = a%aspk(i)
enddo !!$ enddo
case(psb_dupl_add_) !!$ case(psb_dupl_add_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia2(ip2+i-1)) = a%aspk(i) + work(a%ia2(ip2+i-1)) !!$ work(a%ia2(ip2+i-1)) = a%aspk(i) + work(a%ia2(ip2+i-1))
enddo !!$ enddo
case default !!$ case default
info = 8887 !!$ info = 8887
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
do i=1, nnz !!$ do i=1, nnz
a%aspk(i) = work(i) !!$ a%aspk(i) = work(i)
enddo !!$ enddo
!!$
!!$
case(psb_upd_srch_) !!$ case(psb_upd_srch_)
! Nothing to be done here. !!$ ! Nothing to be done here.
if (debug_level >= psb_debug_serial_) & !!$ if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),& !!$ & write(debug_unit,*) trim(name),&
& 'Going through on regeneration with psb_upd_srch_' !!$ & 'Going through on regeneration with psb_upd_srch_'
case default !!$ case default
! Wrong value !!$ ! Wrong value
info = 8888 !!$ info = 8888
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
!!$
end select !!$ end select
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 continue !!$9999 continue
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then !!$ if (err_act == psb_act_abort_) then
call psb_error() !!$ call psb_error()
return !!$ return
end if !!$ end if
return !!$ return
!!$
end subroutine coo_ssp_regen !!$ end subroutine coo_ssp_regen
!!$
subroutine jad_ssp_regen(a,info) !!$ subroutine jad_ssp_regen(a,info)
!!$
use psb_spmat_type !!$ use psb_spmat_type
use psb_const_mod !!$ use psb_const_mod
use psb_error_mod !!$ use psb_error_mod
implicit none !!$ implicit none
!!$
type(psb_sspmat_type), intent(inout) :: a !!$ type(psb_sspmat_type), intent(inout) :: a
integer :: info !!$ integer :: info
!!$
integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt !!$ integer :: i, ip1,ip2,nnz,iflag,ichk,nnzt
real(psb_spk_), allocatable :: work(:) !!$ real(psb_spk_), allocatable :: work(:)
integer :: err_act !!$ integer :: err_act
character(len=20) :: name !!$ character(len=20) :: name
integer :: debug_level, debug_unit !!$ integer :: debug_level, debug_unit
!!$
name='psb_spcnv' !!$ name='psb_spcnv'
info = 0 !!$ info = 0
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() !!$ debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() !!$ debug_level = psb_get_debug_level()
!!$
!!$
! !!$ !
! dupl_ and upd_ fields should not be changed. !!$ ! dupl_ and upd_ fields should not be changed.
! !!$ !
select case(psb_sp_getifld(psb_upd_,a,info)) !!$ select case(psb_sp_getifld(psb_upd_,a,info))
!!$
case(psb_upd_perm_) !!$ case(psb_upd_perm_)
!!$
allocate(work(size(a%aspk)+1000),stat=info) !!$ allocate(work(size(a%aspk)+1000),stat=info)
if (info /= 0) then !!$ if (info /= 0) then
info=2040 !!$ info=2040
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_' !!$ & write(debug_unit,*) trim(name),'Regeneration with psb_upd_perm_'
ip1 = psb_sp_getifld(psb_upd_pnt_,a,info) !!$ ip1 = psb_sp_getifld(psb_upd_pnt_,a,info)
ip2 = a%ia1(ip1+psb_ip2_) !!$ ip2 = a%ia1(ip1+psb_ip2_)
nnz = a%ia1(ip1+psb_nnz_) !!$ nnz = a%ia1(ip1+psb_nnz_)
iflag = a%ia1(ip1+psb_iflag_) !!$ iflag = a%ia1(ip1+psb_iflag_)
ichk = a%ia1(ip1+psb_ichk_) !!$ ichk = a%ia1(ip1+psb_ichk_)
nnzt = a%ia1(ip1+psb_nnzt_) !!$ nnzt = a%ia1(ip1+psb_nnzt_)
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),'Regeneration start: ',& !!$ & write(debug_unit,*) trim(name),'Regeneration start: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,info
!!$
if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then !!$ if ((ichk/=nnzt+iflag).or.(nnz/=nnzt)) then
info = 8889 !!$ info = 8889
write(debug_unit,*) trim(name),'Regeneration start error: ',& !!$ write(debug_unit,*) trim(name),'Regeneration start error: ',&
& a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk !!$ & a%infoa(psb_upd_),psb_upd_perm_,nnz,nnzt ,iflag,ichk
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
endif !!$ endif
do i= 1, nnz !!$ do i= 1, nnz
work(i) = dzero !!$ work(i) = dzero
enddo !!$ enddo
select case(iflag) !!$ select case(iflag)
case(psb_dupl_ovwrt_,psb_dupl_err_) !!$ case(psb_dupl_ovwrt_,psb_dupl_err_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia1(ip2+i-1)) = a%aspk(i) !!$ work(a%ia1(ip2+i-1)) = a%aspk(i)
enddo !!$ enddo
case(psb_dupl_add_) !!$ case(psb_dupl_add_)
do i=1, nnz !!$ do i=1, nnz
work(a%ia1(ip2+i-1)) = a%aspk(i) + work(a%ia1(ip2+i-1)) !!$ work(a%ia1(ip2+i-1)) = a%aspk(i) + work(a%ia1(ip2+i-1))
enddo !!$ enddo
case default !!$ case default
info = 8887 !!$ info = 8887
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
do i=1, nnz !!$ do i=1, nnz
a%aspk(i) = work(i) !!$ a%aspk(i) = work(i)
enddo !!$ enddo
!!$
!!$
case(psb_upd_srch_) !!$ case(psb_upd_srch_)
! Nothing to be done here. !!$ ! Nothing to be done here.
if (debug_level >= psb_debug_serial_)& !!$ if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),& !!$ & write(debug_unit,*) trim(name),&
& 'Going through on regeneration with psb_upd_srch_' !!$ & 'Going through on regeneration with psb_upd_srch_'
case default !!$ case default
! Wrong value !!$ ! Wrong value
info = 8888 !!$ info = 8888
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
!!$
end select !!$ end select
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 continue !!$9999 continue
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then !!$ if (err_act == psb_act_abort_) then
call psb_error() !!$ call psb_error()
return !!$ return
end if !!$ end if
return !!$ return
!!$
end subroutine jad_ssp_regen !!$ end subroutine jad_ssp_regen
!!$
!!$ subroutine csr_dsp_regen(a,info) !!$ subroutine csr_dsp_regen(a,info)
!!$ !!$
!!$ use psb_spmat_type !!$ use psb_spmat_type

1404
base/serial/psb_update_mod.f90
View File

File diff suppressed because it is too large Load Diff

4
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -78,8 +78,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
#endif #endif
! .. Array Arguments .. ! .. Array Arguments ..
integer, intent(in) :: novr integer, intent(in) :: novr
Type(psb_d_sparse_mat), Intent(in) :: a Type(psb_d_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info integer, intent(out) :: info

2
base/tools/psb_dspalloc.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...

2
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none

6
base/tools/psb_dspfree.f90
Unescape Escape View File

@ -44,13 +44,13 @@ subroutine psb_dspfree(a, desc_a,info)
use psb_descriptor_type use psb_descriptor_type
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_d_sparse_mat), intent(inout) :: a type(psb_d_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
!...locals.... !...locals....
integer :: ictxt,err_act integer :: ictxt,err_act
character(len=20) :: name character(len=20) :: name

4
base/tools/psb_dspins.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
@ -242,7 +242,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...

14
base/tools/psb_linmap.f90
Unescape Escape View File

@ -193,11 +193,11 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
use psb_base_mod, psb_protect_name => psb_s_linmap use psb_base_mod, psb_protect_name => psb_s_linmap
implicit none implicit none
type(psb_slinmap_type) :: this type(psb_slinmap_type) :: this
type(psb_desc_type), target :: desc_X, desc_Y type(psb_desc_type), target :: desc_X, desc_Y
type(psb_sspmat_type), intent(in) :: map_X2Y, map_Y2X type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X
integer, intent(in) :: map_kind integer, intent(in) :: map_kind
integer, intent(in), optional :: iaggr(:), naggr(:) integer, intent(in), optional :: iaggr(:), naggr(:)
! !
integer :: info integer :: info
character(len=20), parameter :: name='psb_linmap' character(len=20), parameter :: name='psb_linmap'
@ -254,8 +254,8 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
end select end select
if (info == 0) call psb_sp_clone(map_X2Y,this%map_X2Y,info) if (info == 0) call psb_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_Y2X,this%map_Y2X,info)
if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info) if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info)
if (info == 0) then if (info == 0) then
call psb_set_map_kind(map_kind, this) call psb_set_map_kind(map_kind, this)

67
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -67,6 +67,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_realloc_mod use psb_realloc_mod
use psb_mat_mod
use psi_mod use psi_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -77,15 +78,15 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
#endif #endif
! .. Array Arguments .. ! .. Array Arguments ..
integer, intent(in) :: novr integer, intent(in) :: novr
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov Type(psb_desc_type), Intent(out) :: desc_ov
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in),optional :: extype integer, intent(in),optional :: extype
! .. Local Scalars .. ! .. 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),& & ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),&
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,&
@ -94,7 +95,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer :: icomm, err_act integer :: icomm, err_act
type(psb_sspmat_type) :: blk integer, allocatable :: irow(:), icol(:)
Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:)
Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),&
& t_halo_out(:),temp(:),maskr(:) & t_halo_out(:),temp(:),maskr(:)
@ -122,7 +123,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
extype_ = psb_ovt_xhal_ extype_ = psb_ovt_xhal_
endif endif
m = psb_cd_get_local_rows(desc_a) m = psb_cd_get_local_rows(desc_a)
nnzero = Size(a%aspk)
n_row = psb_cd_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-m nhalo = n_col-m
@ -169,7 +169,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average ! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average
! nonzeros per row is the same as the global. ! nonzeros per row is the same as the global.
! !
nztot = psb_sp_get_nnzeros(a) nztot = a%get_nzeros()
if (nztot>0) then if (nztot>0) then
lovr = ((nztot+m-1)/m)*nhalo*novr lovr = ((nztot+m-1)/m)*nhalo*novr
lworks = ((nztot+m-1)/m)*nhalo lworks = ((nztot+m-1)/m)*nhalo
@ -210,16 +210,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
goto 9999 goto 9999
end if 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),& 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) & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info)
if (info /= 0) then if (info /= 0) then
@ -414,35 +404,20 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
! Prepare to exchange the halo rows with the other proc. ! Prepare to exchange the halo rows with the other proc.
! !
If (i_ovr <= (novr)) Then If (i_ovr <= (novr)) Then
n_elem = psb_sp_get_nnz_row(idx,a) call a%csget(idx,idx,n_elem,irow,icol,info)
call psb_ensure_size((idxs+tot_elem+n_elem),works,info)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_ensure_size') call psb_errpush(info,name,a_err='csget')
goto 9999 goto 9999
end if end if
If((n_elem) > size(blk%ia2)) Then call psb_ensure_size((idxs+tot_elem+n_elem),works,info)
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 if (info /= 0) then
info=4010 info=4010
ch_err='psb_sp_getblk' call psb_errpush(info,name,a_err='psb_ensure_size')
call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
& desc_ov%idxmap,info) & desc_ov%idxmap,info)
tot_elem=tot_elem+n_elem tot_elem=tot_elem+n_elem
@ -734,15 +709,21 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
call psb_icdasb(desc_ov,info,ext_hv=.true.) call psb_icdasb(desc_ov,info,ext_hv=.true.)
call psb_cd_set_ovl_asb(desc_ov,info)
if (info == 0) call psb_sp_free(blk,info)
if (info /= 0) then if (info /= 0) then
ch_err='sp_free' call psb_errpush(4010,name,a_err='icdasdb')
call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
goto 9999 goto 9999
end if end if
call psb_cd_set_ovl_asb(desc_ov,info)
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_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'

7
base/tools/psb_sspalloc.f90
Unescape Escape View File

@ -44,16 +44,15 @@
subroutine psb_sspalloc(a, desc_a, info, nnz) subroutine psb_sspalloc(a, desc_a, info, nnz)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(out) :: a type(psb_s_sparse_mat), intent(out) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: nnz integer, optional, intent(in) :: nnz
@ -108,7 +107,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
!....allocate aspk, ia1, ia2..... !....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 if(info /= 0) then
info=4010 info=4010
ch_err='sp_all' ch_err='sp_all'

28
base/tools/psb_sspasb.f90
Unescape Escape View File

@ -48,24 +48,24 @@
! psb_dupl_err_ raise an error. ! psb_dupl_err_ raise an error.
! !
! !
subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl) subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod use psb_const_mod
use psi_mod use psi_mod
use psb_error_mod use psb_error_mod
use psb_string_mod use psb_string_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
!...Parameters.... !...Parameters....
type(psb_sspmat_type), intent (inout) :: a type(psb_s_sparse_mat), intent (inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer,optional, intent(in) :: dupl, upd integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: afmt character(len=*), optional, intent(in) :: afmt
class(psb_s_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer :: int_err(5) integer :: int_err(5)
integer :: np,me,n_col, err_act integer :: np,me,n_col, err_act
@ -106,23 +106,27 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl)
!check on errors encountered in psdspins !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. ! First case: we come from a fresh build.
! !
n_row = psb_cd_get_local_rows(desc_a) n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a) n_col = psb_cd_get_local_cols(desc_a)
a%m = n_row call a%set_nrows(n_row)
a%k = n_col call a%set_ncols(n_col)
end if 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',& IF (debug_level >= psb_debug_ext_) then
& info,' ',A%FIDA ch_err=a%get_fmt()
write(debug_unit, *) me,' ',trim(name),': From SPCNV',&
& info,' ',ch_err
end IF
if (info /= psb_no_err_) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_spcnv' ch_err='psb_spcnv'

18
base/tools/psb_sspfree.f90
Unescape Escape View File

@ -42,16 +42,15 @@
subroutine psb_sspfree(a, desc_a,info) subroutine psb_sspfree(a, desc_a,info)
!...free sparse matrix structure... !...free sparse matrix structure...
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
!...locals.... !...locals....
integer :: ictxt,err_act integer :: ictxt,err_act
character(len=20) :: name character(len=20) :: name
@ -70,14 +69,7 @@ subroutine psb_sspfree(a, desc_a,info)
end if end if
!...deallocate a.... !...deallocate a....
call psb_sp_free(a,info) call a%free()
if(info /= 0) then
info=2045
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

85
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -60,7 +60,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data) & rowscale,colscale,outfmt,data)
use psb_const_mod use psb_const_mod
use psb_serial_mod use psb_string_mod
use psb_mat_mod
use psb_descriptor_type use psb_descriptor_type
use psb_realloc_mod use psb_realloc_mod
use psb_tools_mod, psb_protect_name => psb_ssphalo use psb_tools_mod, psb_protect_name => psb_ssphalo
@ -74,8 +75,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h' include 'mpif.h'
#endif #endif
Type(psb_sspmat_type),Intent(in) :: a Type(psb_s_sparse_mat),Intent(in) :: a
Type(psb_sspmat_type),Intent(inout) :: blk Type(psb_s_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a Type(psb_desc_type),Intent(in), target :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
@ -90,6 +91,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
real(psb_spk_), allocatable :: valsnd(:) real(psb_spk_), allocatable :: valsnd(:)
type(psb_s_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:) integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
@ -144,7 +146,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Call psb_info(ictxt, me, np) Call psb_info(ictxt, me, np)
Allocate(sdid(np,3),rvid(np,3),brvindx(np+1),& 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 if (info /= 0) then
info=4000 info=4000
@ -181,8 +183,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
idx = 0 idx = 0
idxs = 0 idxs = 0
idxr = 0 idxr = 0
blk%k = a%k call acoo%allocate(0,a%get_ncols(),info)
blk%m = 0
! For all rows in the halo descriptor, extract and send/receive. ! For all rows in the halo descriptor, extract and send/receive.
Do Do
proc=idxv(counter) proc=idxv(counter)
@ -193,13 +194,11 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
tot_elem = 0 tot_elem = 0
Do j=0,n_el_send-1 Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j) 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 tot_elem = tot_elem+n_elem
Enddo Enddo
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
call acoo%set_nrows(acoo%get_nrows() + n_el_recv)
blk%m = blk%m + n_el_recv
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
@ -229,9 +228,9 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Enddo Enddo
iszr=sum(rvsz) iszr=sum(rvsz)
call psb_sp_all(blk,max(iszr,1),info) call acoo%reallocate(max(iszr,1))
if (debug_level >= psb_debug_outer_)& 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(:) & ' Send:',sdsz(:),' Receive:',rvsz(:)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -260,9 +259,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Do j=0,n_el_send-1 Do j=0,n_el_send-1
idx = idxv(counter+psb_elem_send_+j) idx = idxv(counter+psb_elem_send_+j)
n_elem = psb_sp_get_nnz_row(idx,a) n_elem = a%get_nz_row(idx)
call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,&
call psb_sp_getrow(idx,a,ngtz,iasnd,jasnd,valsnd,info,&
& append=.true.,nzin=tot_elem) & append=.true.,nzin=tot_elem)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
@ -272,9 +270,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
tot_elem=tot_elem+n_elem tot_elem=tot_elem+n_elem
Enddo Enddo
ipx = ipx + 1 ipx = ipx + 1
counter = counter+n_el_send+3 counter = counter+n_el_send+3
Enddo Enddo
nz = tot_elem nz = tot_elem
@ -290,11 +286,11 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_real,&
& blk%aspk,rvsz,brvindx,mpi_real,icomm,info) & acoo%val,rvsz,brvindx,mpi_real,icomm,info)
call mpi_alltoallv(iasnd,sdsz,bsdindx,mpi_integer,& 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,& 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 if (info /= 0) then
info=4010 info=4010
ch_err='mpi_alltoallv' ch_err='mpi_alltoallv'
@ -305,8 +301,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
! !
! Convert into local numbering ! Convert into local numbering
! !
if (rowcnv_) call psb_glob_to_loc(blk%ia1(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(blk%ia2(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 if (info /= 0) then
info=4010 info=4010
@ -316,21 +312,21 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end if end if
l1 = 0 l1 = 0
blk%m=0 call acoo%set_nrows(0)
! !
irmin = huge(irmin) irmin = huge(irmin)
icmin = huge(icmin) icmin = huge(icmin)
irmax = 0 irmax = 0
icmax = 0 icmax = 0
Do i=1,iszr Do i=1,iszr
r=(blk%ia1(i)) r=(acoo%ia(i))
k=(blk%ia2(i)) k=(acoo%ja(i))
! Just in case some of the conversions were out-of-range ! Just in case some of the conversions were out-of-range
If ((r>0).and.(k>0)) Then If ((r>0).and.(k>0)) Then
l1=l1+1 l1=l1+1
blk%aspk(l1) = blk%aspk(i) acoo%val(l1) = acoo%val(i)
blk%ia1(l1) = r acoo%ia(l1) = r
blk%ia2(l1) = k acoo%ja(l1) = k
irmin = min(irmin,r) irmin = min(irmin,r)
irmax = max(irmax,r) irmax = max(irmax,r)
icmin = min(icmin,k) icmin = min(icmin,k)
@ -338,37 +334,28 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
End If End If
Enddo Enddo
if (rowscale_) then if (rowscale_) then
blk%m = max(irmax-irmin+1,0) call acoo%set_nrows(max(irmax-irmin+1,0))
blk%ia1(1:l1) = blk%ia1(1:l1) - irmin + 1 acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1
else else
blk%m = irmax call acoo%set_nrows(irmax)
end if end if
if (colscale_) then if (colscale_) then
blk%k = max(icmax-icmin+1,0) call acoo%set_ncols(max(icmax-icmin+1,0))
blk%ia2(1:l1) = blk%ia2(1:l1) - icmin + 1 acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1
else else
blk%k = icmax call acoo%set_ncols(icmax)
end if 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_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & 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???? ! 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 if (info /= 0) then
info=4010 info=4010
ch_err='psb_spcnv' ch_err='psb_spcnv'

29
base/tools/psb_sspins.f90
Unescape Escape View File

@ -52,16 +52,15 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_tools_mod, psb_protect_name => psb_sspins use psb_tools_mod, psb_protect_name => psb_sspins
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:) integer, intent(in) :: nz,ia(:),ja(:)
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -120,7 +119,6 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false. rebuild_ = .false.
endif endif
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_a)) then if (psb_is_bld_desc(desc_a)) then
if (psb_is_large_desc(desc_a)) then if (psb_is_large_desc(desc_a)) then
@ -139,8 +137,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then if (a%is_bld()) then
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 if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'
@ -164,8 +162,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
if (spstate == psb_spmat_bld_) then if (a%is_bld()) then
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc) call a%csput(nz,ia,ja,val,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'
@ -198,8 +196,7 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,& call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info)
& info,rebuild=rebuild_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'
@ -210,8 +207,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
else else
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& call a%csput(nz,ia,ja,val,1,nrow,1,ncol,&
& info,gtl=desc_a%idxmap%glob_to_loc,rebuild=rebuild_) & info,gtl=desc_a%idxmap%glob_to_loc)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'
@ -242,17 +239,16 @@ end subroutine psb_sspins
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) 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_tools_mod, psb_protect_name => psb_sspins_2desc
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type
use psb_serial_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
implicit none implicit none
!....parameters... !....parameters...
type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(in) :: desc_ar
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
type(psb_sspmat_type), intent(inout) :: a type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(in) :: nz,ia(:),ja(:) integer, intent(in) :: nz,ia(:),ja(:)
real(kind=psb_spk_), intent(in) :: val(:) real(kind=psb_spk_), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -308,7 +304,6 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
end if end if
if (nz==0) return if (nz==0) return
spstate = a%infoa(psb_state_)
if (psb_is_bld_desc(desc_ac)) then if (psb_is_bld_desc(desc_ac)) then
allocate(ila(nz),jla(nz),stat=info) allocate(ila(nz),jla(nz),stat=info)
@ -332,7 +327,7 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
nrow = psb_cd_get_local_rows(desc_ar) nrow = psb_cd_get_local_rows(desc_ar)
ncol = psb_cd_get_local_cols(desc_ac) 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 if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'

11
base/tools/psb_ssprn.f90
Unescape Escape View File

@ -44,7 +44,7 @@
Subroutine psb_ssprn(a, desc_a,info,clear) Subroutine psb_ssprn(a, desc_a,info,clear)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_mat_mod
use psb_serial_mod use psb_serial_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
@ -53,7 +53,7 @@ Subroutine psb_ssprn(a, desc_a,info,clear)
!....Parameters... !....Parameters...
Type(psb_desc_type), intent(in) :: desc_a Type(psb_desc_type), intent(in) :: desc_a
Type(psb_sspmat_type), intent(inout) :: a Type(psb_s_sparse_mat), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
@ -87,13 +87,8 @@ Subroutine psb_ssprn(a, desc_a,info,clear)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif 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 (info /= 0) goto 9999
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &

30
krylov/psb_krylov_mod.f90
Unescape Escape View File

@ -45,9 +45,9 @@ Module psb_krylov_mod
interface psb_cg interface psb_cg
subroutine psb_scg(a,prec,b,x,eps,& subroutine psb_scg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop,cond) & desc_a,info,itmax,iter,err,itrace,istop,cond)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -108,9 +108,9 @@ Module psb_krylov_mod
interface psb_bicg interface psb_bicg
subroutine psb_sbicg(a,prec,b,x,eps,& subroutine psb_sbicg(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -171,9 +171,9 @@ Module psb_krylov_mod
interface psb_bicgstab interface psb_bicgstab
subroutine psb_scgstab(a,prec,b,x,eps,& subroutine psb_scgstab(a,prec,b,x,eps,&
& desc_a,info,itmax,iter,err,itrace,istop) & desc_a,info,itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: b(:)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
@ -234,9 +234,9 @@ Module psb_krylov_mod
interface psb_bicgstabl interface psb_bicgstabl
Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,& Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err, itrace,irst,istop) &itmax,iter,err, itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)
@ -297,9 +297,9 @@ Module psb_krylov_mod
interface psb_rgmres interface psb_rgmres
Subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,& Subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop) &itmax,iter,err,itrace,irst,istop)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)
@ -360,9 +360,9 @@ Module psb_krylov_mod
interface psb_cgs interface psb_cgs
subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,& subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: b(:)
@ -462,7 +462,7 @@ contains
! BICGSTABL ! BICGSTABL
! RGMRES ! RGMRES
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -498,7 +498,7 @@ contains
use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type
character(len=*) :: method character(len=*) :: method
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)
@ -996,7 +996,7 @@ contains
implicit none implicit none
character(len=*), intent(in) :: methdname character(len=*), intent(in) :: methdname
integer, intent(in) :: stopc, trace,itmax integer, intent(in) :: stopc, trace,itmax
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: b(:), eps real(psb_spk_), intent(in) :: b(:), eps
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat

4
krylov/psb_sbicg.f90
Unescape Escape View File

@ -62,7 +62,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -101,7 +101,7 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none implicit none
!!$ parameters !!$ parameters
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: b(:)

4
krylov/psb_scg.F90
Unescape Escape View File

@ -63,7 +63,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -102,7 +102,7 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond)
implicit none implicit none
!!$ Parameters !!$ Parameters
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec Type(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)

4
krylov/psb_scgs.f90
Unescape Escape View File

@ -62,7 +62,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -101,7 +101,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
implicit none implicit none
!!$ parameters !!$ parameters
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_sprec_type), Intent(in) :: prec Type(psb_sprec_type), Intent(in) :: prec
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)

10
krylov/psb_scgstab.F90
Unescape Escape View File

@ -62,7 +62,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -100,7 +100,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
use psb_krylov_mod, psb_protect_name => psb_scgstab use psb_krylov_mod, psb_protect_name => psb_scgstab
Implicit None Implicit None
!!$ parameters !!$ parameters
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec Type(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)
@ -272,7 +272,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
rho_old = rho rho_old = rho
rho = psb_gedot(q,r,desc_a,info) rho = psb_gedot(q,r,desc_a,info)
if (rho==dzero) then if (rho==szero) then
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' Iteration breakdown R',rho & ' Iteration breakdown R',rho
@ -302,7 +302,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
#endif #endif
sigma = psb_gedot(q,v,desc_a,info) sigma = psb_gedot(q,v,desc_a,info)
if (sigma==dzero) then if (sigma==szero) then
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' Iteration breakdown S1', sigma & ' Iteration breakdown S1', sigma
@ -339,7 +339,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
end if end if
sigma = psb_gedot(t,t,desc_a,info) sigma = psb_gedot(t,t,desc_a,info)
if (sigma==dzero) then if (sigma==szero) then
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' Iteration breakdown S2', sigma & ' Iteration breakdown S2', sigma

4
krylov/psb_scgstabl.f90
Unescape Escape View File

@ -69,7 +69,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -110,7 +110,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is
implicit none implicit none
!!$ parameters !!$ parameters
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec Type(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)

4
krylov/psb_srgmres.f90
Unescape Escape View File

@ -73,7 +73,7 @@
! !
! Arguments: ! Arguments:
! !
! a - type(psb_sspmat_type) Input: sparse matrix containing A. ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A.
! prec - type(psb_sprec_type) Input: preconditioner ! prec - type(psb_sprec_type) Input: preconditioner
! b - real,dimension(:) Input: vector containing the ! b - real,dimension(:) Input: vector containing the
! right hand side B ! right hand side B
@ -113,7 +113,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist
implicit none implicit none
!!$ Parameters !!$ Parameters
Type(psb_sspmat_type), Intent(in) :: a Type(psb_s_sparse_mat), Intent(in) :: a
Type(psb_sprec_type), Intent(in) :: prec Type(psb_sprec_type), Intent(in) :: prec
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(in) :: b(:)

8
prec/psb_dbjac_aply.f90
Unescape Escape View File

@ -108,18 +108,18 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case('N') case('N')
call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,ww,desc_data,info,& call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,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 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& 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 if(info /=0) goto 9999
case('T','C') case('T','C')
call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,& call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,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 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& 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 if(info /=0) goto 9999
end select end select

27
prec/psb_dbjac_bld.f90
Unescape Escape View File

@ -46,7 +46,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
integer :: i, m integer :: i, m
integer :: int_err(5) integer :: int_err(5)
character :: trans, unitd character :: trans, unitd
!!$ type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat), allocatable :: lf, uf type(psb_d_csr_sparse_mat), allocatable :: lf, uf
real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8 real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8
integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer nztota, err_act, n_row, nrow_a,n_col, nhalo
@ -72,7 +71,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif endif
trans = 'N' trans = 'N'
unitd = 'U' unitd = 'U'
!!$ call psb_nullify_sp(atmp)
call psb_cdcpy(desc_a,p%desc_data,info) call psb_cdcpy(desc_a,p%desc_data,info)
if(info /= 0) then if(info /= 0) then
@ -91,11 +89,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
if (size(p%av) < psb_bp_ilu_avsz) then if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av) do i=1,size(p%av)
call p%av(i)%free() call p%av(i)%free()
!!$ if (info /= 0) then
!!$ ! Actually, we don't care here about this.
!!$ ! Just let it go.
!!$ ! return
!!$ end if
enddo enddo
deallocate(p%av,stat=info) deallocate(p%av,stat=info)
endif endif
@ -119,9 +112,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
if (info == 0) call lf%allocate(n_row,n_row,nztota) 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) call uf%allocate(n_row,n_row,nztota)
!!$ call p%av(psb_l_pr_)%csall(n_row,n_row,info,nztota)
!!$ if (info == 0) call p%av(psb_u_pr_)%csall(n_row,n_row,info,nztota)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -144,15 +134,11 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif endif
t3 = psb_wtime() t3 = psb_wtime()
! This is where we have no renumbering, thus no need ! This is where we have no renumbering, thus no need
! for ATMP
!!$ call p%av(psb_l_pr_)%cscnv(info,type='CSR')
!!$ call p%av(psb_u_pr_)%cscnv(info,type='CSR')
call psb_ilu_fct(a,lf,uf,p%d,info) call psb_ilu_fct(a,lf,uf,p%d,info)
if(info==0) then if(info==0) then
call move_alloc(lf,p%av(psb_l_pr_)%a) call p%av(psb_l_pr_)%mv_from(lf)
call move_alloc(uf,p%av(psb_u_pr_)%a) call p%av(psb_u_pr_)%mv_from(uf)
call p%av(psb_l_pr_)%set_asb() call p%av(psb_l_pr_)%set_asb()
call p%av(psb_u_pr_)%set_asb() call p%av(psb_u_pr_)%set_asb()
call p%av(psb_l_pr_)%trim() call p%av(psb_l_pr_)%trim()
@ -163,15 +149,6 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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_) case(psb_f_none_)
info=4010 info=4010

13
prec/psb_ddiagsc_bld.f90
Unescape Escape View File

@ -105,19 +105,6 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
endif endif
end do 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_dgelp'
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
!!$ endif
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

67
prec/psb_dilu_fct.f90
Unescape Escape View File

@ -49,7 +49,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
integer :: l1,l2,m,err_act integer :: l1,l2,m,err_act
type(psb_d_sparse_mat), pointer :: blck_ type(psb_d_sparse_mat), pointer :: blck_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dcsrlu' name='psb_ilu_fct'
info = 0 info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! .. Executable Statements .. ! .. Executable Statements ..
@ -115,7 +115,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
contains contains
subroutine psb_dilu_fctint(m,ma,a,mb,b,& subroutine psb_dilu_fctint(m,ma,a,mb,b,&
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
use psb_d_base_mat_mod use psb_mat_mod
implicit none implicit none
@ -129,9 +129,6 @@ contains
real(psb_dpk_) :: dia,temp real(psb_dpk_) :: dia,temp
integer, parameter :: nrb=60 integer, parameter :: nrb=60
type(psb_d_coo_sparse_mat) :: trw type(psb_d_coo_sparse_mat) :: trw
integer, allocatable :: irow(:), icol(:)
real(psb_dpk_), allocatable :: val(:)
integer :: int_err(5) integer :: int_err(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -275,36 +272,36 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = dzero d(i) = dzero
!!$ if ((mod(i,nrb) == 1).or.(nrb==1)) then if ((mod(i,nrb) == 1).or.(nrb==1)) then
!!$ irb = min(ma-i+1,nrb) irb = min(ma-i+1,nrb)
!!$ call b%csget(i-ma,i-ma+irb-1,trw,info) call b%a%csget(i-ma,i-ma+irb-1,trw,info)
!!$ nz = trw%get_nzeros() nz = trw%get_nzeros()
!!$ if(info /= 0) then if(info /= 0) then
!!$ info=4010 info=4010
!!$ ch_err='a%csget' ch_err='a%csget'
!!$ call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ ktrw=1 ktrw=1
!!$ end if end if
!!$
!!$ do do
!!$ if (ktrw > nz ) exit if (ktrw > nz ) exit
!!$ if (trw%ia(ktrw) > i) exit if (trw%ia(ktrw) > i) exit
!!$ k = trw%ja(ktrw) k = trw%ja(ktrw)
!!$ if ((k < i).and.(k >= 1)) then if ((k < i).and.(k >= 1)) then
!!$ l1 = l1 + 1 l1 = l1 + 1
!!$ laspk(l1) = trw%val(ktrw) laspk(l1) = trw%val(ktrw)
!!$ lia1(l1) = k lia1(l1) = k
!!$ else if (k == i) then else if (k == i) then
!!$ d(i) = trw%val(ktrw) d(i) = trw%val(ktrw)
!!$ else if ((k > i).and.(k <= m)) then else if ((k > i).and.(k <= m)) then
!!$ l2 = l2 + 1 l2 = l2 + 1
!!$ uaspk(l2) = trw%val(ktrw) uaspk(l2) = trw%val(ktrw)
!!$ uia1(l2) = k uia1(l2) = k
!!$ end if end if
!!$ ktrw = ktrw + 1 ktrw = ktrw + 1
!!$ enddo enddo
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1

9
prec/psb_dprecbld.f90
Unescape Escape View File

@ -29,13 +29,13 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
subroutine psb_dprecbld(aa,desc_a,p,info,upd) subroutine psb_dprecbld(a,desc_a,p,info,upd)
use psb_base_mod use psb_base_mod
use psb_prec_mod, psb_protect_name => psb_dprecbld use psb_prec_mod, psb_protect_name => psb_dprecbld
Implicit None Implicit None
type(psb_d_sparse_mat), intent(in), target :: aa type(psb_d_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a type(psb_desc_type), intent(in), target :: desc_a
type(psb_dprec_type),intent(inout) :: p type(psb_dprec_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
@ -86,7 +86,6 @@ subroutine psb_dprecbld(aa,desc_a,p,info,upd)
call psb_nullify_desc(p%desc_data) call psb_nullify_desc(p%desc_data)
select case(p%iprcparm(psb_p_type_)) select case(p%iprcparm(psb_p_type_))
case (psb_noprec_) case (psb_noprec_)
! Do nothing. ! Do nothing.
@ -100,7 +99,7 @@ subroutine psb_dprecbld(aa,desc_a,p,info,upd)
case (psb_diag_) case (psb_diag_)
call psb_diagsc_bld(aa,desc_a,p,upd_,info) call psb_diagsc_bld(a,desc_a,p,upd_,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_diagsc_bld' ch_err='psb_diagsc_bld'
@ -113,7 +112,7 @@ subroutine psb_dprecbld(aa,desc_a,p,info,upd)
call psb_check_def(p%iprcparm(psb_f_type_),'fact',& call psb_check_def(p%iprcparm(psb_f_type_),'fact',&
& psb_f_ilu_n_,is_legal_ml_fact) & psb_f_ilu_n_,is_legal_ml_fact)
call psb_bjac_bld(aa,desc_a,p,upd_,info) call psb_bjac_bld(a,desc_a,p,upd_,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_bjac_bld') call psb_errpush(4010,name,a_err='psb_bjac_bld')

35
prec/psb_prec_mod.f90
Unescape Escape View File

@ -35,10 +35,10 @@ module psb_prec_mod
interface psb_precbld interface psb_precbld
subroutine psb_sprecbld(a,desc_a,prec,info,upd) subroutine psb_sprecbld(a,desc_a,prec,info,upd)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a type(psb_desc_type), intent(in), target :: desc_a
type(psb_sprec_type), intent(inout) :: prec type(psb_sprec_type), intent(inout) :: prec
integer, intent(out) :: info integer, intent(out) :: info
@ -78,7 +78,7 @@ module psb_prec_mod
interface psb_precinit interface psb_precinit
subroutine psb_sprecinit(prec,ptype,info) subroutine psb_sprecinit(prec,ptype,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
implicit none implicit none
type(psb_sprec_type), intent(inout) :: prec type(psb_sprec_type), intent(inout) :: prec
@ -113,7 +113,7 @@ module psb_prec_mod
interface psb_precset interface psb_precset
subroutine psb_sprecseti(prec,what,val,info) subroutine psb_sprecseti(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
implicit none implicit none
type(psb_sprec_type), intent(inout) :: prec type(psb_sprec_type), intent(inout) :: prec
@ -121,7 +121,7 @@ module psb_prec_mod
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sprecseti end subroutine psb_sprecseti
subroutine psb_sprecsets(prec,what,val,info) subroutine psb_sprecsets(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
implicit none implicit none
type(psb_sprec_type), intent(inout) :: prec type(psb_sprec_type), intent(inout) :: prec
@ -185,7 +185,7 @@ module psb_prec_mod
interface psb_precaply interface psb_precaply
subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work) subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
@ -196,7 +196,7 @@ module psb_prec_mod
real(psb_spk_),intent(inout), optional, target :: work(:) real(psb_spk_),intent(inout), optional, target :: work(:)
end subroutine psb_sprc_aply end subroutine psb_sprc_aply
subroutine psb_sprc_aply1(prec,x,desc_data,info,trans) subroutine psb_sprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
@ -269,7 +269,7 @@ module psb_prec_mod
interface psb_bjac_aply interface psb_bjac_aply
subroutine psb_sbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine psb_sbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
@ -320,11 +320,12 @@ module psb_prec_mod
interface psb_ilu_fct interface psb_ilu_fct
subroutine psb_silu_fct(a,l,u,d,info,blck) subroutine psb_silu_fct(a,l,u,d,info,blck)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat,&
& psb_s_csr_sparse_mat, psb_spk_
integer, intent(out) :: info integer, intent(out) :: info
type(psb_sspmat_type),intent(in) :: a type(psb_s_sparse_mat),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u type(psb_s_csr_sparse_mat),intent(inout) :: l,u
type(psb_sspmat_type),intent(in), optional, target :: blck type(psb_s_sparse_mat),intent(in), optional, target :: blck
real(psb_spk_), intent(inout) :: d(:) real(psb_spk_), intent(inout) :: d(:)
end subroutine psb_silu_fct end subroutine psb_silu_fct
subroutine psb_dilu_fct(a,l,u,d,info,blck) subroutine psb_dilu_fct(a,l,u,d,info,blck)
@ -356,10 +357,10 @@ module psb_prec_mod
interface psb_bjac_bld interface psb_bjac_bld
subroutine psb_sbjac_bld(a,desc_a,p,upd,info) subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
integer, intent(out) :: info integer, intent(out) :: info
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_sprec_type), intent(inout) :: p type(psb_sprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd character, intent(in) :: upd
@ -395,10 +396,10 @@ module psb_prec_mod
interface psb_diagsc_bld interface psb_diagsc_bld
subroutine psb_sdiagsc_bld(a,desc_a,p,upd,info) subroutine psb_sdiagsc_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
integer, intent(out) :: info integer, intent(out) :: info
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_sprec_type), intent(inout) :: p type(psb_sprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd character, intent(in) :: upd
@ -435,7 +436,7 @@ module psb_prec_mod
interface psb_gprec_aply interface psb_gprec_aply
subroutine psb_sgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) subroutine psb_sgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ use psb_base_mod, only : psb_desc_type, psb_s_sparse_mat, psb_spk_
use psb_prec_type, only : psb_sprec_type use psb_prec_type, only : psb_sprec_type
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec

46
prec/psb_prec_type.f90
Unescape Escape View File

@ -37,11 +37,11 @@
module psb_prec_type module psb_prec_type
! Reduces size of .mod file. ! Reduces size of .mod file.
use psb_base_mod, only : psb_sspmat_type, psb_cspmat_type,& use psb_base_mod, only : psb_cspmat_type,&
& psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,& & psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,& & psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,&
& psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus
use psb_d_mat_mod, only : psb_d_sparse_mat use psb_mat_mod, only : psb_s_sparse_mat, psb_d_sparse_mat
integer, parameter :: psb_min_prec_=0, psb_noprec_=0, psb_diag_=1, & integer, parameter :: psb_min_prec_=0, psb_noprec_=0, psb_diag_=1, &
& psb_bjac_=2, psb_max_prec_=2 & psb_bjac_=2, psb_max_prec_=2
@ -66,23 +66,23 @@ module psb_prec_type
type psb_sprec_type type psb_sprec_type
type(psb_sspmat_type), allocatable :: av(:) type(psb_s_sparse_mat), allocatable :: av(:)
real(psb_spk_), allocatable :: d(:) real(psb_spk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer, allocatable :: iprcparm(:) integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:) real(psb_spk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:) integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec integer :: prec, base_prec
end type psb_sprec_type end type psb_sprec_type
type psb_dprec_type type psb_dprec_type
type(psb_d_sparse_mat), allocatable :: av(:) type(psb_d_sparse_mat), allocatable :: av(:)
real(psb_dpk_), allocatable :: d(:) real(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data type(psb_desc_type) :: desc_data
integer, allocatable :: iprcparm(:) integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:) integer, allocatable :: perm(:), invperm(:)
integer :: prec, base_prec integer :: prec, base_prec
end type psb_dprec_type end type psb_dprec_type
type psb_cprec_type type psb_cprec_type
@ -331,12 +331,7 @@ contains
if (allocated(p%av)) then if (allocated(p%av)) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
enddo enddo
deallocate(p%av,stat=info) deallocate(p%av,stat=info)
end if end if
@ -403,13 +398,7 @@ contains
if (allocated(p%av)) then if (allocated(p%av)) then
do i=1,size(p%av) do i=1,size(p%av)
!!$ call psb_sp_free(p%av(i),info)
call p%av(i)%free() call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
enddo enddo
deallocate(p%av,stat=info) deallocate(p%av,stat=info)
end if end if
@ -602,7 +591,7 @@ contains
function psb_dprec_sizeof(prec) result(val) function psb_dprec_sizeof(prec) result(val)
use psb_d_mat_mod use psb_mat_mod
type(psb_dprec_type), intent(in) :: prec type(psb_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer :: i
@ -622,6 +611,7 @@ contains
end function psb_dprec_sizeof end function psb_dprec_sizeof
function psb_sprec_sizeof(prec) result(val) function psb_sprec_sizeof(prec) result(val)
use psb_mat_mod
type(psb_sprec_type), intent(in) :: prec type(psb_sprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val integer(psb_long_int_k_) :: val
integer :: i integer :: i

8
prec/psb_sbjac_aply.f90
Unescape Escape View File

@ -108,18 +108,18 @@ subroutine psb_sbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
case('N') case('N')
call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,ww,desc_data,info,& call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,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 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& 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 if(info /=0) goto 9999
case('T','C') case('T','C')
call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,& call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,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 if(info /=0) goto 9999
call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& 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 if(info /=0) goto 9999
end select end select

54
prec/psb_sbjac_bld.f90
Unescape Escape View File

@ -37,7 +37,7 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
! .. Scalar Arguments .. ! .. Scalar Arguments ..
integer, intent(out) :: info integer, intent(out) :: info
! .. array Arguments .. ! .. array Arguments ..
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_sprec_type), intent(inout) :: p type(psb_sprec_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
character, intent(in) :: upd character, intent(in) :: upd
@ -46,8 +46,8 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
integer :: i, m integer :: i, m
integer :: int_err(5) integer :: int_err(5)
character :: trans, unitd character :: trans, unitd
type(psb_sspmat_type) :: atmp type(psb_s_csr_sparse_mat), allocatable :: lf, uf
real(psb_spk_) :: t1,t2,t3,t4,t5,t6, t7, t8 real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8
integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer nztota, err_act, n_row, nrow_a,n_col, nhalo
integer :: ictxt,np,me integer :: ictxt,np,me
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -61,7 +61,7 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
ictxt=psb_cd_get_context(desc_a) ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
m = a%m m = a%get_nrows()
if (m < 0) then if (m < 0) then
info = 10 info = 10
int_err(1) = 1 int_err(1) = 1
@ -71,7 +71,6 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
endif endif
trans = 'N' trans = 'N'
unitd = 'U' unitd = 'U'
call psb_nullify_sp(atmp)
call psb_cdcpy(desc_a,p%desc_data,info) call psb_cdcpy(desc_a,p%desc_data,info)
if(info /= 0) then if(info /= 0) then
@ -89,12 +88,7 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
if (allocated(p%av)) then if (allocated(p%av)) then
if (size(p%av) < psb_bp_ilu_avsz) then if (size(p%av) < psb_bp_ilu_avsz) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
! return
end if
enddo enddo
deallocate(p%av,stat=info) deallocate(p%av,stat=info)
endif endif
@ -108,17 +102,16 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
endif endif
nrow_a = psb_cd_get_local_rows(desc_a) 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) n_col = psb_cd_get_local_cols(desc_a)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) 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 allocate(lf,uf,stat=info)
p%av(psb_u_pr_)%m = n_row if (info == 0) call lf%allocate(n_row,n_row,nztota)
p%av(psb_u_pr_)%k = n_row if (info == 0) call uf%allocate(n_row,n_row,nztota)
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)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -140,26 +133,23 @@ subroutine psb_sbjac_bld(a,desc_a,p,upd,info)
endif endif
t3 = psb_wtime() t3 = psb_wtime()
! This is where we have mo renumbering, thus no need ! This is where we have no renumbering, thus no need
! for ATMP 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 info=4010
ch_err='psb_ilu_fct' ch_err='psb_ilu_fct'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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_) case(psb_f_none_)
info=4010 info=4010
ch_err='Inconsistent prec psb_f_none_' ch_err='Inconsistent prec psb_f_none_'

23
prec/psb_sdiagsc_bld.f90
Unescape Escape View File

@ -35,7 +35,7 @@ subroutine psb_sdiagsc_bld(a,desc_a,p,upd,info)
use psb_prec_mod, psb_protect_name => psb_sdiagsc_bld use psb_prec_mod, psb_protect_name => psb_sdiagsc_bld
Implicit None Implicit None
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_sprec_type),intent(inout) :: p type(psb_sprec_type),intent(inout) :: p
character, intent(in) :: upd character, intent(in) :: upd
@ -76,7 +76,7 @@ subroutine psb_sdiagsc_bld(a,desc_a,p,upd,info)
! !
! Retrieve the diagonal entries of the matrix A ! 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 if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_getdiag' ch_err='psb_sp_getdiag'
@ -98,26 +98,13 @@ subroutine psb_sdiagsc_bld(a,desc_a,p,upd,info)
! it is set to one/a_ii ! it is set to one/a_ii
! !
do i=1,n_row do i=1,n_row
if (p%d(i) == dzero) then if (p%d(i) == szero) then
p%d(i) = done p%d(i) = sone
else else
p%d(i) = done/p%d(i) p%d(i) = sone/p%d(i)
endif endif
end do 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) call psb_erractionrestore(err_act)
return return

246
prec/psb_silu_fct.f90
Unescape Escape View File

@ -41,13 +41,13 @@ subroutine psb_silu_fct(a,l,u,d,info,blck)
! .. Scalar Arguments .. ! .. Scalar Arguments ..
integer, intent(out) :: info integer, intent(out) :: info
! .. Array Arguments .. ! .. Array Arguments ..
type(psb_sspmat_type),intent(in) :: a type(psb_s_sparse_mat),intent(in) :: a
type(psb_sspmat_type),intent(inout) :: l,u type(psb_s_csr_sparse_mat),intent(inout) :: l,u
type(psb_sspmat_type),intent(in), optional, target :: blck type(psb_s_sparse_mat),intent(in), optional, target :: blck
real(psb_spk_), intent(inout) :: d(:) real(psb_spk_), intent(inout) :: d(:)
! .. Local Scalars .. ! .. Local Scalars ..
integer :: l1,l2,m,err_act integer :: l1,l2,m,err_act
type(psb_sspmat_type), pointer :: blck_ type(psb_s_sparse_mat), pointer :: blck_
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_ilu_fct' name='psb_ilu_fct'
info = 0 info = 0
@ -64,41 +64,34 @@ subroutine psb_silu_fct(a,l,u,d,info,blck)
goto 9999 goto 9999
end if end if
call psb_nullify_sp(blck_) ! Why do we need this? Who knows.... call blck_%csall(0,0,info,1)
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
blck_%m=0
endif endif
call psb_silu_fctint(m,a%m,a,blck_%m,blck_,& call psb_silu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,&
& d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) & d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_silu_fctint' ch_err='psb_silu_fctint'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
l%infoa(1) = l1 call l%set_triangle()
l%fida = 'CSR' call l%set_lower()
l%descra = 'TLU' call l%set_unit()
u%infoa(1) = l2 call u%set_triangle()
u%fida = 'CSR' call u%set_upper()
u%descra = 'TUU' call u%set_unit()
l%m = m call l%set_nrows(m)
l%k = m call l%set_ncols(m)
u%m = m call u%set_nrows(m)
u%k = m call u%set_ncols(m)
if (present(blck)) then if (present(blck)) then
blck_ => null() blck_ => null()
else else
call psb_sp_free(blck_,info) call blck_%free()
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_free' ch_err='psb_sp_free'
@ -122,17 +115,20 @@ subroutine psb_silu_fct(a,l,u,d,info,blck)
contains contains
subroutine psb_silu_fctint(m,ma,a,mb,b,& subroutine psb_silu_fctint(m,ma,a,mb,b,&
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
use psb_mat_mod
implicit none implicit none
type(psb_sspmat_type) :: a,b type(psb_s_sparse_mat) :: a
type(psb_s_sparse_mat) :: b
integer :: m,ma,mb,l1,l2,info integer :: m,ma,mb,l1,l2,info
integer, dimension(:) :: lia1,lia2,uia1,uia2 integer, dimension(:) :: lia1,lia2,uia1,uia2
real(psb_spk_), dimension(:) :: laspk,uaspk,d real(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
real(psb_spk_) :: dia,temp real(psb_spk_) :: dia,temp
integer, parameter :: nrb=16 integer, parameter :: nrb=60
type(psb_sspmat_type) :: trw type(psb_s_coo_sparse_mat) :: trw
integer :: int_err(5) integer :: int_err(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -140,11 +136,7 @@ contains
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_nullify_sp(trw) call trw%allocate(0,0,info)
trw%m=0
trw%k=0
call psb_sp_all(trw,1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -159,64 +151,39 @@ contains
m = ma+mb m = ma+mb
do i = 1, ma do i = 1, ma
d(i) = dzero d(i) = szero
! !
! Here we take a fast shortcut if possible, otherwise
! use spgtblk, slower but able (in principle) to handle
! anything.
! !
if (a%fida=='CSR') then if ((mod(i,nrb) == 1).or.(nrb==1)) then
do j = a%ia2(i), a%ia2(i+1) - 1 irb = min(ma-i+1,nrb)
k = a%ia1(j) call a%a%csget(i,i+irb-1,trw,info)
! write(0,*)'KKKKK',k if(info /= 0) then
if ((k < i).and.(k >= 1)) then info=4010
l1 = l1 + 1 ch_err='a%csget'
laspk(l1) = a%aspk(j) call psb_errpush(info,name,a_err=ch_err)
lia1(l1) = k goto 9999
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
end if end if
nz = trw%get_nzeros()
do ktrw=1
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
end if 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 lia2(i+1) = l1 + 1
@ -291,7 +258,7 @@ contains
call psb_errpush(info,name,i_err=int_err,a_err=ch_err) call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
goto 9999 goto 9999
else else
dia = done/dia dia = sone/dia
end if end if
d(i) = dia d(i) = dia
! write(6,*)'diag(',i,')=',d(i) ! write(6,*)'diag(',i,')=',d(i)
@ -302,63 +269,38 @@ contains
enddo enddo
do i = ma+1, m do i = ma+1, m
d(i) = dzero d(i) = szero
if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (b%fida=='CSR') then irb = min(ma-i+1,nrb)
call b%a%csget(i-ma,i-ma+irb-1,trw,info)
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1 nz = trw%get_nzeros()
k = b%ia1(j) if(info /= 0) then
! if (me == 2) write(0,*)'ecco k=',k info=4010
if ((k < i).and.(k >= 1)) then ch_err='a%csget'
l1 = l1 + 1 call psb_errpush(info,name,a_err=ch_err)
laspk(l1) = b%aspk(j) goto 9999
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
end if end if
ktrw=1
do end if
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit do
k = trw%ia2(ktrw) if (ktrw > nz ) exit
! write(0,*)'KKKKK',k if (trw%ia(ktrw) > i) exit
if ((k < i).and.(k >= 1)) then k = trw%ja(ktrw)
l1 = l1 + 1 if ((k < i).and.(k >= 1)) then
laspk(l1) = trw%aspk(ktrw) l1 = l1 + 1
lia1(l1) = k laspk(l1) = trw%val(ktrw)
else if (k == i) then lia1(l1) = k
d(i) = trw%aspk(ktrw) else if (k == i) then
else if ((k > i).and.(k <= m)) then d(i) = trw%val(ktrw)
l2 = l2 + 1 else if ((k > i).and.(k <= m)) then
uaspk(l2) = trw%aspk(ktrw) l2 = l2 + 1
uia1(l2) = k uaspk(l2) = trw%val(ktrw)
end if uia1(l2) = k
ktrw = ktrw + 1 end if
enddo ktrw = ktrw + 1
enddo
endif
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -431,7 +373,7 @@ contains
call psb_errpush(info,name,i_err=int_err,a_err=ch_err) call psb_errpush(info,name,i_err=int_err,a_err=ch_err)
goto 9999 goto 9999
else else
dia = done/dia dia = sone/dia
end if end if
d(i) = dia d(i) = dia
! Scale row i of upper triangle ! Scale row i of upper triangle
@ -440,13 +382,7 @@ contains
enddo enddo
enddo enddo
call psb_sp_free(trw,info) call trw%free()
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 psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

2
prec/psb_sprecbld.f90
Unescape Escape View File

@ -35,7 +35,7 @@ subroutine psb_sprecbld(a,desc_a,p,info,upd)
use psb_prec_mod, psb_protect_name => psb_sprecbld use psb_prec_mod, psb_protect_name => psb_sprecbld
Implicit None Implicit None
type(psb_sspmat_type), intent(in), target :: a type(psb_s_sparse_mat), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a type(psb_desc_type), intent(in), target :: desc_a
type(psb_sprec_type),intent(inout) :: p type(psb_sprec_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info

4
test/pargen/Makefile
Unescape Escape View File

@ -22,8 +22,8 @@ ppde: ppde.o psb_d_csc_impl.o psb_d_csc_mat_mod.o
psb_d_csc_impl.o ppde.o: psb_d_csc_mat_mod.o psb_d_csc_impl.o ppde.o: psb_d_csc_mat_mod.o
spde: spde.o spde: spde.o enablecore.o
$(F90LINK) spde.o -o spde $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) spde.o enablecore.o -o spde $(PSBLAS_LIB) $(LDLIBS)
/bin/mv spde $(EXEDIR) /bin/mv spde $(EXEDIR)
.f90.o: .f90.o:

4
test/pargen/ppde.f90
Unescape Escape View File

@ -78,7 +78,6 @@ program ppde
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_d_sparse_mat) :: a type(psb_d_sparse_mat) :: a
!!$ type(psb_dspmat_type) :: a
type(psb_dprec_type) :: prec type(psb_dprec_type) :: prec
! descriptor ! descriptor
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
@ -110,7 +109,6 @@ program ppde
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde90' name='pde90'
call psb_set_errverbosity(2) call psb_set_errverbosity(2)
! !
! get parameters ! get parameters
! !
@ -611,7 +609,7 @@ contains
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ictxt) call psb_barrier(ictxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
!!$ call a%print(20+iam)
call psb_amx(ictxt,talc) call psb_amx(ictxt,talc)
call psb_amx(ictxt,tgen) call psb_amx(ictxt,tgen)
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)

2
test/pargen/runs/ppde.inp
Unescape Escape View File

@ -5,7 +5,7 @@ CSR Storage format for matrix A: CSR COO JAD
060 Domain size (acutal system is this**3) 060 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion
0400 MAXIT 0400 MAXIT
-01 ITRACE 001 ITRACE
20 IRST restart for RGMRES and BiCGSTABL 20 IRST restart for RGMRES and BiCGSTABL

24
test/pargen/spde.f90
Unescape Escape View File

@ -73,11 +73,11 @@ program ppde
integer :: idim integer :: idim
! miscellaneous ! miscellaneous
real(psb_spk_), parameter :: one = 1.d0 real(psb_spk_), parameter :: one = 1.0
real(psb_spk_) :: t1, t2, tprec real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_sspmat_type) :: a type(psb_s_sparse_mat) :: a
type(psb_sprec_type) :: prec type(psb_sprec_type) :: prec
! descriptor ! descriptor
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
@ -92,7 +92,7 @@ program ppde
real(psb_spk_) :: err, eps real(psb_spk_) :: err, eps
! other variables ! other variables
integer :: info integer :: info, i
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info=0 info=0
@ -109,6 +109,7 @@ program ppde
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde90' name='pde90'
call psb_set_errverbosity(2) call psb_set_errverbosity(2)
call enablecore()
! !
! get parameters ! get parameters
! !
@ -128,7 +129,6 @@ program ppde
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
if (iam == psb_root_) write(*,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) write(*,'("Overall matrix creation time : ",es12.5)')t2
if (iam == psb_root_) write(*,'(" ")') if (iam == psb_root_) write(*,'(" ")')
! !
@ -153,7 +153,6 @@ program ppde
if (iam == psb_root_) write(*,'("Preconditioner time : ",es12.5)')tprec if (iam == psb_root_) write(*,'("Preconditioner time : ",es12.5)')tprec
if (iam == psb_root_) write(*,'(" ")') if (iam == psb_root_) write(*,'(" ")')
! !
! iterative method parameters ! iterative method parameters
! !
@ -181,6 +180,7 @@ program ppde
call psb_sum(ictxt,amatsize) call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize) call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize) call psb_sum(ictxt,precsize)
if (iam == psb_root_) then if (iam == psb_root_) then
write(*,'(" ")') write(*,'(" ")')
write(*,'("Time to solve matrix : ",es12.5)')t2 write(*,'("Time to solve matrix : ",es12.5)')t2
@ -341,6 +341,7 @@ contains
! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation. ! Note that if a1=a2=a3=a4=0., the PDE is the well-known Laplace equation.
! !
use psb_base_mod use psb_base_mod
use psb_mat_mod
implicit none implicit none
integer :: idim integer :: idim
integer, parameter :: nb=20 integer, parameter :: nb=20
@ -348,7 +349,9 @@ contains
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer :: ictxt, info integer :: ictxt, info
character :: afmt*5 character :: afmt*5
type(psb_sspmat_type) :: a type(psb_s_sparse_mat) :: a
type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat) :: acsr
real(psb_spk_) :: zt(nb),glob_x,glob_y,glob_z real(psb_spk_) :: zt(nb),glob_x,glob_y,glob_z
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
integer :: x,y,z,ia,indx_owner integer :: x,y,z,ia,indx_owner
@ -365,7 +368,7 @@ contains
external :: a1, a2, a3, a4, b1, b2, b3 external :: a1, a2, a3, a4, b1, b2, b3
integer :: err_act integer :: err_act
character(len=20) :: name, ch_err character(len=20) :: name, ch_err,tmpfmt
info = 0 info = 0
name = 'create_matrix' name = 'create_matrix'
@ -585,7 +588,7 @@ contains
t1 = psb_wtime() t1 = psb_wtime()
call psb_cdasb(desc_a,info) call psb_cdasb(desc_a,info)
if (info == 0) & if (info == 0) &
& call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) & call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=acsr)
call psb_barrier(ictxt) call psb_barrier(ictxt)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
@ -610,8 +613,9 @@ contains
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)
call psb_amx(ictxt,ttot) call psb_amx(ictxt,ttot)
if(iam == psb_root_) then if(iam == psb_root_) then
tmpfmt = a%get_fmt()
write(*,'("The matrix has been generated and assembled in ",a3," format.")')& write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3) & tmpfmt
write(*,'("-allocation time : ",es12.5)') talc write(*,'("-allocation time : ",es12.5)') talc
write(*,'("-coeff. gen. time : ",es12.5)') tgen write(*,'("-coeff. gen. time : ",es12.5)') tgen
write(*,'("-assembly time : ",es12.5)') tasb write(*,'("-assembly time : ",es12.5)') tasb

88
util/psb_hbio_mod.f90
Unescape Escape View File

@ -44,7 +44,7 @@ contains
subroutine shb_read(a, iret, iunit, filename,b,g,x,mtitle) subroutine shb_read(a, iret, iunit, filename,b,g,x,mtitle)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(psb_sspmat_type), intent(out) :: a type(psb_s_sparse_mat), intent(out) :: a
integer, intent(out) :: iret integer, intent(out) :: iret
integer, optional, intent(in) :: iunit integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename character(len=*), optional, intent(in) :: filename
@ -56,6 +56,8 @@ contains
character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
integer :: indcrd, ptrcrd, totcrd,& integer :: indcrd, ptrcrd, totcrd,&
& valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
type(psb_s_csr_sparse_mat) :: acsr
type(psb_s_coo_sparse_mat) :: acoo
integer :: ircode, i,nzr,infile, info integer :: ircode, i,nzr,infile, info
character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
character(len=*), parameter :: fmt11='(a3,11x,2i14)' character(len=*), parameter :: fmt11='(a3,11x,2i14)'
@ -82,31 +84,29 @@ contains
endif endif
endif endif
read(infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode) call acsr%allocate(nrow,ncol,nnzero)
if (ircode /= 0 ) then if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed' write(0,*) 'Memory allocation failed'
goto 993 goto 993
end if end if
if (present(mtitle)) mtitle=mtitle_ if (present(mtitle)) mtitle=mtitle_
a%m = nrow
a%k = ncol
a%fida = 'CSR'
a%descra='G'
if (psb_tolower(type(1:1)) == 'r') then if (psb_tolower(type(1:1)) == 'r') then
if (psb_tolower(type(2:2)) == 'u') then if (psb_tolower(type(2:2)) == 'u') then
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
call a%mv_from(acsr)
if (present(b)) then if (present(b)) then
if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then
call psb_realloc(nrow,1,b,info) call psb_realloc(nrow,1,b,info)
@ -131,9 +131,9 @@ contains
! we are generally working with non-symmetric matrices, so ! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero)
if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero)
if (present(b)) then if (present(b)) then
@ -155,23 +155,24 @@ contains
endif endif
endif endif
call psb_spcnv(a,ircode,afmt='csr')
if (ircode /= 0) goto 993 call acoo%mv_from_fmt(acsr,info)
call acoo%reallocate(2*nnzero)
call psb_sp_reall(a,2*nnzero,ircode)
! A is now in COO format ! A is now in COO format
nzr = nnzero nzr = nnzero
do i=1,nnzero do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then if (acoo%ia(i) /= acoo%ja(i)) then
nzr = nzr + 1 nzr = nzr + 1
a%aspk(nzr) = a%aspk(i) acoo%val(nzr) = acoo%val(i)
a%ia1(nzr) = a%ia2(i) acoo%ia(nzr) = acoo%ja(i)
a%ia2(nzr) = a%ia1(i) acoo%ja(nzr) = acoo%ia(i)
end if end if
end do end do
a%infoa(psb_nnz_) = nzr call acoo%set_nzeros(nzr)
call psb_spcnv(a,ircode,afmt='csr') call acoo%fix(ircode)
if (ircode /= 0) goto 993 if (ircode==0) call a%mv_from(acoo)
if (ircode==0) call a%cscnv(ircode,type='csr')
if (ircode/=0) goto 993
else else
write(0,*) 'read_matrix: matrix type not yet supported' write(0,*) 'read_matrix: matrix type not yet supported'
@ -197,11 +198,10 @@ contains
return return
end subroutine shb_read end subroutine shb_read
subroutine shb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) subroutine shb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
integer, intent(out) :: iret integer, intent(out) :: iret
character(len=*), optional, intent(in) :: mtitle character(len=*), optional, intent(in) :: mtitle
integer, optional, intent(in) :: iunit integer, optional, intent(in) :: iunit
@ -258,11 +258,13 @@ contains
key_ = 'PSBMAT00' key_ = 'PSBMAT00'
endif endif
if (psb_toupper(a%fida) == 'CSR') then
select type(aa=>a%a)
type is (psb_s_csr_sparse_mat)
nrow = a%m nrow = aa%get_nrows()
ncol = a%k ncol = aa%get_ncols()
nnzero = a%ia2(nrow+1)-1 nnzero = aa%get_nzeros()
neltvl = 0 neltvl = 0
@ -286,7 +288,8 @@ contains
rhscrd = 0 rhscrd = 0
nrhs = 0 nrhs = 0
end if end if
totcrd = ptrcrd + indcrd + valcrd + rhscrd totcrd = ptrcrd + indcrd + valcrd + rhscrd
nrhsix = nrhs*nrow nrhsix = nrhs*nrow
if (present(g)) then if (present(g)) then
@ -295,24 +298,24 @@ contains
if (present(x)) then if (present(x)) then
rhstype(3:3) = 'X' rhstype(3:3) = 'X'
end if end if
type = 'RUA' type = 'RUA'
write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
write (iout,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1)
write (iout,fmt=indfmt) (a%ia1(i),i=1,nnzero) write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero)
if (valcrd > 0) write (iout,fmt=valfmt) (a%aspk(i),i=1,nnzero) if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero)
if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow)
if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow)
else
write(0,*) 'format: ',a%fida,' not yet implemented' class default
endif write(0,*) 'format: ',a%get_fmt(),' not yet implemented'
end select
if (iout /= 6) close(iout) if (iout /= 6) close(iout)
@ -325,6 +328,7 @@ contains
return return
end subroutine shb_write end subroutine shb_write
subroutine dhb_read(a, iret, iunit, filename,b,g,x,mtitle) subroutine dhb_read(a, iret, iunit, filename,b,g,x,mtitle)
use psb_base_mod use psb_base_mod
implicit none implicit none

27
util/psb_mat_dist_mod.f90
Unescape Escape View File

@ -97,14 +97,15 @@ contains
! on exit : unchanged. ! on exit : unchanged.
! !
use psb_base_mod use psb_base_mod
use psb_mat_mod
implicit none implicit none
! parameters ! parameters
type(psb_sspmat_type) :: a_glob type(psb_s_sparse_mat) :: a_glob
real(psb_spk_) :: b_glob(:) real(psb_spk_) :: b_glob(:)
integer :: ictxt integer :: ictxt
type(psb_sspmat_type) :: a type(psb_s_sparse_mat) :: a
real(psb_spk_), allocatable :: b(:) real(psb_spk_), allocatable :: b(:)
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional :: inroot integer, optional :: inroot
@ -148,22 +149,15 @@ contains
end if end if
call psb_info(ictxt, iam, np) call psb_info(ictxt, iam, np)
if (iam == root) then if (iam == root) then
! extract information from a_glob nrow = a_glob%get_nrows()
if (a_glob%fida /= 'CSR') then ncol = a_glob%get_ncols()
info=135
ch_err='CSR'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
nrow = a_glob%m
ncol = a_glob%k
if (nrow /= ncol) then if (nrow /= ncol) then
write(0,*) 'a rectangular matrix ? ',nrow,ncol write(0,*) 'a rectangular matrix ? ',nrow,ncol
info=-1 info=-1
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
nnzero = size(a_glob%aspk) nnzero = a_glob%get_nzeros()
nrhs = 1 nrhs = 1
endif endif
@ -268,7 +262,7 @@ contains
ll = 0 ll = 0
do i= i_count, j_count-1 do i= i_count, j_count-1
call psb_sp_getrow(i,a_glob,nz,& call a_glob%csget(i,i,nz,&
& irow,icol,val,info,nzin=ll,append=.true.) & irow,icol,val,info,nzin=ll,append=.true.)
if (info /= 0) then if (info /= 0) then
if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then
@ -356,7 +350,7 @@ contains
ll = 0 ll = 0
do i= i_count, i_count do i= i_count, i_count
call psb_sp_getrow(i,a_glob,nz,& call a_glob%csget(i,i,nz,&
& irow,icol,val,info,nzin=ll,append=.true.) & irow,icol,val,info,nzin=ll,append=.true.)
if (info /= 0) then if (info /= 0) then
if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then
@ -488,6 +482,7 @@ contains
end subroutine smatdist end subroutine smatdist
subroutine dmatdist(a_glob, a, ictxt, desc_a,& subroutine dmatdist(a_glob, a, ictxt, desc_a,&
& b_glob, b, info, parts, v, inroot,fmt) & b_glob, b, info, parts, v, inroot,fmt)
! !
@ -547,7 +542,7 @@ contains
! on exit : unchanged. ! on exit : unchanged.
! !
use psb_base_mod use psb_base_mod
use psb_d_mat_mod use psb_mat_mod
implicit none implicit none
! parameters ! parameters

19
util/psb_metispart_mod.F90
Unescape Escape View File

@ -60,7 +60,7 @@ module psb_metispart_mod
integer, allocatable, save :: graph_vect(:) integer, allocatable, save :: graph_vect(:)
interface build_mtpart interface build_mtpart
module procedure build_mtpart, d_mat_build_mtpart module procedure build_mtpart, d_mat_build_mtpart, s_mat_build_mtpart
end interface end interface
contains contains
@ -150,6 +150,23 @@ contains
end subroutine d_mat_build_mtpart end subroutine d_mat_build_mtpart
subroutine s_mat_build_mtpart(a,nparts)
use psb_base_mod
type(psb_s_sparse_mat), intent(in) :: a
integer :: nparts
select type (aa=>a%a)
type is (psb_s_csr_sparse_mat)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
class default
write(0,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine s_mat_build_mtpart
subroutine build_mtpart(n,fida,ia1,ia2,nparts) subroutine build_mtpart(n,fida,ia1,ia2,nparts)
use psb_base_mod use psb_base_mod

55
util/psb_mmio_mod.f90
Unescape Escape View File

@ -341,11 +341,10 @@ contains
end subroutine mm_zvet_read end subroutine mm_zvet_read
subroutine smm_mat_read(a, info, iunit, filename) subroutine smm_mat_read(a, info, iunit, filename)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(psb_sspmat_type), intent(out) :: a type(psb_s_sparse_mat), intent(out) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: iunit integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename character(len=*), optional, intent(in) :: filename
@ -353,6 +352,7 @@ contains
character(1024) :: line character(1024) :: line
integer :: nrow, ncol, nnzero integer :: nrow, ncol, nnzero
integer :: ircode, i,nzr,infile integer :: ircode, i,nzr,infile
type(psb_s_coo_sparse_mat), allocatable :: acoo
info = 0 info = 0
@ -388,46 +388,51 @@ contains
if (line(1:1) /= '%') exit if (line(1:1) /= '%') exit
end do end do
read(line,fmt=*) nrow,ncol,nnzero read(line,fmt=*) nrow,ncol,nnzero
allocate(acoo, stat=ircode)
if (ircode /= 0) goto 993
if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then
call psb_sp_all(nrow,ncol,a,nnzero,ircode) call acoo%allocate(nrow,ncol,nnzero)
a%fida = 'COO'
a%descra = 'G'
if (ircode /= 0) goto 993
do i=1,nnzero do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),a%aspk(i) read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i)
end do end do
a%infoa(psb_nnz_) = nnzero call acoo%set_nzeros(nnzero)
call psb_spcnv(a,ircode,afmt='csr') call acoo%fix(info)
call a%mv_from(acoo)
call a%cscnv(ircode,type='csr')
else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so ! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read ! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) call acoo%allocate(nrow,ncol,nnzero)
a%fida = 'COO'
a%descra = 'G'
if (ircode /= 0) goto 993
do i=1,nnzero do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),a%aspk(i) read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i)
end do end do
nzr = nnzero nzr = nnzero
do i=1,nnzero do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then if (acoo%ia(i) /= acoo%ja(i)) then
nzr = nzr + 1 nzr = nzr + 1
a%aspk(nzr) = a%aspk(i) acoo%val(nzr) = acoo%val(i)
a%ia1(nzr) = a%ia2(i) acoo%ia(nzr) = acoo%ja(i)
a%ia2(nzr) = a%ia1(i) acoo%ja(nzr) = acoo%ia(i)
end if end if
end do end do
a%infoa(psb_nnz_) = nzr call acoo%set_nzeros(nzr)
call psb_spcnv(a,ircode,afmt='csr') call acoo%fix(info)
call a%mv_from(acoo)
call a%cscnv(ircode,type='csr')
else else
write(0,*) 'read_matrix: matrix type not yet supported' write(0,*) 'read_matrix: matrix type not yet supported'
info=904 info=904
end if end if
if (infile/=5) close(infile) if (infile/=5) close(infile)
return return
! open failed ! open failed
@ -446,7 +451,7 @@ contains
subroutine smm_mat_write(a,mtitle,info,iunit,filename) subroutine smm_mat_write(a,mtitle,info,iunit,filename)
use psb_base_mod use psb_base_mod
implicit none implicit none
type(psb_sspmat_type), intent(in) :: a type(psb_s_sparse_mat), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
character(len=*), intent(in) :: mtitle character(len=*), intent(in) :: mtitle
integer, optional, intent(in) :: iunit integer, optional, intent(in) :: iunit
@ -475,7 +480,7 @@ contains
endif endif
endif endif
call psb_csprt(iout,a,head=mtitle) call a%print(iout,head=mtitle)
if (iout /= 6) close(iout) if (iout /= 6) close(iout)
@ -487,6 +492,8 @@ contains
write(0,*) 'Error while opening ',filename write(0,*) 'Error while opening ',filename
return return
end subroutine smm_mat_write end subroutine smm_mat_write
subroutine dmm_mat_read(a, info, iunit, filename) subroutine dmm_mat_read(a, info, iunit, filename)
use psb_base_mod use psb_base_mod

Write Preview
Loading…
Cancel
Save