base/modules/psb_c_mat_mod.f90
 base/modules/psb_c_tools_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_s_tools_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/modules/psb_z_tools_mod.f90
 base/tools/psb_casb.f90
 base/tools/psb_sasb.f90
 base/tools/psb_zasb.f90
 krylov/psb_dcgstab.F90
 test/kernel/runs/spmv.inp
 test/pargen/runs/ppde.inp

Defined asb(scratch) for all variants; used in dcgstab.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 3d6e8bc1a7
commit db5fa89381

@ -109,6 +109,7 @@ module psb_c_mat_mod
procedure, pass(a) :: c_cscnv_ip => psb_c_cscnv_ip procedure, pass(a) :: c_cscnv_ip => psb_c_cscnv_ip
procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base
generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base
procedure, pass(a) :: clone => psb_cspmat_type_clone
procedure, pass(a) :: reinit => psb_c_reinit procedure, pass(a) :: reinit => psb_c_reinit
procedure, pass(a) :: print_i => psb_c_sparse_print procedure, pass(a) :: print_i => psb_c_sparse_print
procedure, pass(a) :: print_n => psb_c_n_sparse_print procedure, pass(a) :: print_n => psb_c_n_sparse_print

@ -80,21 +80,23 @@ Module psb_c_tools_mod
complex(psb_spk_), allocatable, intent(inout) :: x(:) complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_casbv end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info,mold) subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_ use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_c_vect_mod use psb_c_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_casb_vect end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info,mold) subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_ use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_c_vect_mod use psb_c_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x(:) type(psb_c_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_casb_vect_r2 end subroutine psb_casb_vect_r2
end interface end interface

@ -109,6 +109,7 @@ module psb_s_mat_mod
procedure, pass(a) :: s_cscnv_ip => psb_s_cscnv_ip procedure, pass(a) :: s_cscnv_ip => psb_s_cscnv_ip
procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base
generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base
procedure, pass(a) :: clone => psb_sspmat_type_clone
procedure, pass(a) :: reinit => psb_s_reinit procedure, pass(a) :: reinit => psb_s_reinit
procedure, pass(a) :: print_i => psb_s_sparse_print procedure, pass(a) :: print_i => psb_s_sparse_print
procedure, pass(a) :: print_n => psb_s_n_sparse_print procedure, pass(a) :: print_n => psb_s_n_sparse_print

@ -80,21 +80,23 @@ Module psb_s_tools_mod
real(psb_spk_), allocatable, intent(inout) :: x(:) real(psb_spk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_sasbv end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info,mold) subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_ use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_s_vect_mod use psb_s_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info,mold) subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_ use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_s_vect_mod use psb_s_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x(:) type(psb_s_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect_r2 end subroutine psb_sasb_vect_r2
end interface end interface

@ -109,6 +109,7 @@ module psb_z_mat_mod
procedure, pass(a) :: z_cscnv_ip => psb_z_cscnv_ip procedure, pass(a) :: z_cscnv_ip => psb_z_cscnv_ip
procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base
generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base
procedure, pass(a) :: clone => psb_zspmat_type_clone
procedure, pass(a) :: reinit => psb_z_reinit procedure, pass(a) :: reinit => psb_z_reinit
procedure, pass(a) :: print_i => psb_z_sparse_print procedure, pass(a) :: print_i => psb_z_sparse_print
procedure, pass(a) :: print_n => psb_z_n_sparse_print procedure, pass(a) :: print_n => psb_z_n_sparse_print

@ -79,21 +79,23 @@ Module psb_z_tools_mod
complex(psb_dpk_), allocatable, intent(inout) :: x(:) complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zasbv end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info,mold) subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_dpk_ use psb_descriptor_type, only : psb_desc_type, psb_dpk_
use psb_z_vect_mod use psb_z_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info,mold) subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_dpk_ use psb_descriptor_type, only : psb_desc_type, psb_dpk_
use psb_z_vect_mod use psb_z_vect_mod
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x(:) type(psb_z_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect_r2 end subroutine psb_zasb_vect_r2
end interface end interface

@ -250,7 +250,7 @@ subroutine psb_casbv(x, desc_a, info)
end subroutine psb_casbv end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info, mold) subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect use psb_base_mod, psb_protect_name => psb_casb_vect
implicit none implicit none
@ -258,10 +258,12 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
type(psb_c_vect_type), intent(inout) :: x type(psb_c_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -293,6 +297,10 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info) call x%asb(ncol,info)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x,desc_a,info) call psb_halo(x,desc_a,info)
@ -304,6 +312,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
if (present(mold)) then if (present(mold)) then
call x%cnv(mold) call x%cnv(mold)
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -321,7 +330,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
end subroutine psb_casb_vect end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info, mold) subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect_r2 use psb_base_mod, psb_protect_name => psb_casb_vect_r2
implicit none implicit none
@ -329,10 +338,12 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
type(psb_c_vect_type), intent(inout) :: x(:) type(psb_c_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me, i, n integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -365,6 +378,14 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n do i=1, n
call x(i)%asb(ncol,info) call x(i)%asb(ncol,info)
if (info /= 0) exit if (info /= 0) exit
@ -380,6 +401,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'

@ -250,7 +250,7 @@ subroutine psb_sasbv(x, desc_a, info)
end subroutine psb_sasbv end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info, mold) subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect use psb_base_mod, psb_protect_name => psb_sasb_vect
implicit none implicit none
@ -258,10 +258,12 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
type(psb_s_vect_type), intent(inout) :: x type(psb_s_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -293,6 +297,10 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info) call x%asb(ncol,info)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x,desc_a,info) call psb_halo(x,desc_a,info)
@ -304,6 +312,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
if (present(mold)) then if (present(mold)) then
call x%cnv(mold) call x%cnv(mold)
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -321,7 +330,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
end subroutine psb_sasb_vect end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info, mold) subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect_r2 use psb_base_mod, psb_protect_name => psb_sasb_vect_r2
implicit none implicit none
@ -329,10 +338,12 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
type(psb_s_vect_type), intent(inout) :: x(:) type(psb_s_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me, i, n integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -365,6 +378,13 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n do i=1, n
call x(i)%asb(ncol,info) call x(i)%asb(ncol,info)
if (info /= 0) exit if (info /= 0) exit
@ -380,6 +400,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'

@ -250,7 +250,7 @@ subroutine psb_zasbv(x, desc_a, info)
end subroutine psb_zasbv end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info, mold) subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_zasb_vect use psb_base_mod, psb_protect_name => psb_zasb_vect
implicit none implicit none
@ -258,10 +258,12 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
type(psb_z_vect_type), intent(inout) :: x type(psb_z_vect_type), intent(inout) :: x
integer, intent(out) :: info integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -293,6 +297,10 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info) call x%asb(ncol,info)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x,desc_a,info) call psb_halo(x,desc_a,info)
@ -304,6 +312,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
if (present(mold)) then if (present(mold)) then
call x%cnv(mold) call x%cnv(mold)
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -321,7 +330,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
end subroutine psb_zasb_vect end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info, mold) subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_zasb_vect_r2 use psb_base_mod, psb_protect_name => psb_zasb_vect_r2
implicit none implicit none
@ -329,10 +338,12 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
type(psb_z_vect_type), intent(inout) :: x(:) type(psb_z_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables ! local variables
integer :: ictxt,np,me, i, n integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
@ -365,6 +378,13 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n do i=1, n
call x(i)%asb(ncol,info) call x(i)%asb(ncol,info)
if (info /= 0) exit if (info /= 0) exit
@ -380,6 +400,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'

@ -442,8 +442,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
Real(psb_dpk_), Optional, Intent(out) :: err Real(psb_dpk_), Optional, Intent(out) :: err
!!$ Local data !!$ Local data
Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:) Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:)
!!$ Real(psb_dpk_), Pointer :: q(:),&
!!$ & r(:), p(:), v(:), s(:), t(:), z(:), f(:)
type(psb_d_vect_type) :: q, r, p, v, s, t, z, f type(psb_d_vect_type) :: q, r, p, v, s, t, z, f
Integer :: itmax_, naux, mglob, it,itrace_,& Integer :: itmax_, naux, mglob, it,itrace_,&
@ -518,23 +516,14 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
End If End If
call psb_geall(q,desc_a,info) call psb_geasb(q,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(r,desc_a,info) call psb_geasb(r,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(p,desc_a,info) call psb_geasb(p,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(v,desc_a,info) call psb_geasb(v,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(s,desc_a,info) call psb_geasb(s,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(t,desc_a,info) call psb_geasb(t,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(z,desc_a,info) call psb_geasb(z,desc_a,info,mold=x%v,scratch=.true.)
call psb_geall(f,desc_a,info) call psb_geasb(f,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(q,desc_a,info,mold=x%v)
call psb_geasb(r,desc_a,info,mold=x%v)
call psb_geasb(p,desc_a,info,mold=x%v)
call psb_geasb(v,desc_a,info,mold=x%v)
call psb_geasb(s,desc_a,info,mold=x%v)
call psb_geasb(t,desc_a,info,mold=x%v)
call psb_geasb(z,desc_a,info,mold=x%v)
call psb_geasb(f,desc_a,info,mold=x%v)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then

@ -1,3 +1,5 @@
ASIC_100ks.mtx ASIC_100ks.mtx
MM MM
0 0

@ -1,5 +1,5 @@
7 Number of entries below this 7 Number of entries below this
BICGSTABL Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD CSR Storage format for matrix A: CSR COO JAD
040 Domain size (acutal system is this**3) 040 Domain size (acutal system is this**3)

Loading…
Cancel
Save