From 86b8a261efd23d244a034a2b1826cdc3ecae2c43 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 19 Jan 2023 08:36:22 -0500 Subject: [PATCH] Fixed conversion bug, changed SPASB interface --- base/modules/tools/psb_c_tools_mod.F90 | 3 ++- base/modules/tools/psb_d_tools_mod.F90 | 3 ++- base/modules/tools/psb_s_tools_mod.F90 | 3 ++- base/modules/tools/psb_z_tools_mod.F90 | 3 ++- base/psblas/psb_cspmm.f90 | 6 +++--- base/psblas/psb_dspmm.f90 | 6 +++--- base/psblas/psb_sspmm.f90 | 6 +++--- base/psblas/psb_zspmm.f90 | 6 +++--- base/serial/impl/psb_c_csr_impl.f90 | 9 +++------ base/serial/impl/psb_d_csr_impl.f90 | 9 +++------ base/serial/impl/psb_s_csr_impl.f90 | 9 +++------ base/serial/impl/psb_z_csr_impl.f90 | 9 +++------ base/tools/psb_cspasb.f90 | 28 ++++++++++++++++++++------ base/tools/psb_dspasb.f90 | 28 ++++++++++++++++++++------ base/tools/psb_sspasb.f90 | 28 ++++++++++++++++++++------ base/tools/psb_zspasb.f90 | 28 ++++++++++++++++++++------ test/pargen/psb_d_pde3d.F90 | 4 ++-- test/pargen/runs/ppde.inp | 6 +++--- 18 files changed, 125 insertions(+), 69 deletions(-) diff --git a/base/modules/tools/psb_c_tools_mod.F90 b/base/modules/tools/psb_c_tools_mod.F90 index 2de8f906..0ed2d82c 100644 --- a/base/modules/tools/psb_c_tools_mod.F90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -250,7 +250,7 @@ Module psb_c_tools_mod end interface interface psb_spasb - subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) + subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold, bld_and) import implicit none type(psb_cspmat_type), intent (inout) :: a @@ -259,6 +259,7 @@ Module psb_c_tools_mod integer(psb_ipk_),optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_c_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and end subroutine psb_cspasb end interface diff --git a/base/modules/tools/psb_d_tools_mod.F90 b/base/modules/tools/psb_d_tools_mod.F90 index 30e45d53..26f83201 100644 --- a/base/modules/tools/psb_d_tools_mod.F90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -250,7 +250,7 @@ Module psb_d_tools_mod end interface interface psb_spasb - subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) + subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and) import implicit none type(psb_dspmat_type), intent (inout) :: a @@ -259,6 +259,7 @@ Module psb_d_tools_mod integer(psb_ipk_),optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_d_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and end subroutine psb_dspasb end interface diff --git a/base/modules/tools/psb_s_tools_mod.F90 b/base/modules/tools/psb_s_tools_mod.F90 index 5d2f8d00..0f70a31a 100644 --- a/base/modules/tools/psb_s_tools_mod.F90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -250,7 +250,7 @@ Module psb_s_tools_mod end interface interface psb_spasb - subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) + subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold, bld_and) import implicit none type(psb_sspmat_type), intent (inout) :: a @@ -259,6 +259,7 @@ Module psb_s_tools_mod integer(psb_ipk_),optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_s_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and end subroutine psb_sspasb end interface diff --git a/base/modules/tools/psb_z_tools_mod.F90 b/base/modules/tools/psb_z_tools_mod.F90 index 9d6bd77b..1f24e05a 100644 --- a/base/modules/tools/psb_z_tools_mod.F90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -250,7 +250,7 @@ Module psb_z_tools_mod end interface interface psb_spasb - subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) + subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold, bld_and) import implicit none type(psb_zspmat_type), intent (inout) :: a @@ -259,6 +259,7 @@ Module psb_z_tools_mod integer(psb_ipk_),optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_z_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and end subroutine psb_zspasb end interface diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index 555461df..84d8a7d8 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -179,11 +179,11 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& if (trans_ == 'N') then ! Matrix is not transposed - if (.true.) then - call psi_swapdata(psb_swap_send_,& + if (allocated(a%ad)) then + if (doswap_) call psi_swapdata(psb_swap_send_,& & czero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%ad%spmm(alpha,x%v,beta,y%v,info) - call psi_swapdata(psb_swap_recv_,& + if (doswap_) call psi_swapdata(psb_swap_recv_,& & czero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%and%spmm(alpha,x%v,cone,y%v,info) diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index be8a493f..d5897f82 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -179,11 +179,11 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& if (trans_ == 'N') then ! Matrix is not transposed - if (.true.) then - call psi_swapdata(psb_swap_send_,& + if (allocated(a%ad)) then + if (doswap_) call psi_swapdata(psb_swap_send_,& & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%ad%spmm(alpha,x%v,beta,y%v,info) - call psi_swapdata(psb_swap_recv_,& + if (doswap_) call psi_swapdata(psb_swap_recv_,& & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%and%spmm(alpha,x%v,done,y%v,info) diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 79bfbdd1..7c1e0ab3 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -179,11 +179,11 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& if (trans_ == 'N') then ! Matrix is not transposed - if (.true.) then - call psi_swapdata(psb_swap_send_,& + if (allocated(a%ad)) then + if (doswap_) call psi_swapdata(psb_swap_send_,& & szero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%ad%spmm(alpha,x%v,beta,y%v,info) - call psi_swapdata(psb_swap_recv_,& + if (doswap_) call psi_swapdata(psb_swap_recv_,& & szero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%and%spmm(alpha,x%v,sone,y%v,info) diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index f248db8b..4dc73f83 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -179,11 +179,11 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& if (trans_ == 'N') then ! Matrix is not transposed - if (.true.) then - call psi_swapdata(psb_swap_send_,& + if (allocated(a%ad)) then + if (doswap_) call psi_swapdata(psb_swap_send_,& & zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%ad%spmm(alpha,x%v,beta,y%v,info) - call psi_swapdata(psb_swap_recv_,& + if (doswap_) call psi_swapdata(psb_swap_recv_,& & zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) call a%and%spmm(alpha,x%v,zone,y%v,info) diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 1fed09ba..4744d947 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -3643,9 +3643,8 @@ subroutine psb_c_ecsr_csmv(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (((beta == cone).and..not.(tra.or.ctra))& - & .or.(a%is_triangle()).or.(a%is_unit())) then - + if ((beta == cone).and.& + & .not.(tra.or.ctra.or.(a%is_triangle()).or.(a%is_unit()))) then call psb_c_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,& & a%nnerws,a%nerwp,x,y) else @@ -3672,9 +3671,6 @@ contains if (alpha == czero) return - - - if (alpha == cone) then !$omp parallel do private(ir,i,j,acc) do ir=1,nnerws @@ -3740,6 +3736,7 @@ subroutine psb_c_ecsr_cmp_nerwp(a,info) end if end do call psb_realloc(nnerws,a%nerwp,info) + a%nnerws = nnerws end subroutine psb_c_ecsr_cmp_nerwp subroutine psb_c_cp_ecsr_from_coo(a,b,info) diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 1bcc82a9..6d2b58ad 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -3643,9 +3643,8 @@ subroutine psb_d_ecsr_csmv(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (((beta == done).and..not.(tra.or.ctra))& - & .or.(a%is_triangle()).or.(a%is_unit())) then - + if ((beta == done).and.& + & .not.(tra.or.ctra.or.(a%is_triangle()).or.(a%is_unit()))) then call psb_d_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,& & a%nnerws,a%nerwp,x,y) else @@ -3672,9 +3671,6 @@ contains if (alpha == dzero) return - - - if (alpha == done) then !$omp parallel do private(ir,i,j,acc) do ir=1,nnerws @@ -3740,6 +3736,7 @@ subroutine psb_d_ecsr_cmp_nerwp(a,info) end if end do call psb_realloc(nnerws,a%nerwp,info) + a%nnerws = nnerws end subroutine psb_d_ecsr_cmp_nerwp subroutine psb_d_cp_ecsr_from_coo(a,b,info) diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 9670aeb9..87cfff68 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -3643,9 +3643,8 @@ subroutine psb_s_ecsr_csmv(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (((beta == sone).and..not.(tra.or.ctra))& - & .or.(a%is_triangle()).or.(a%is_unit())) then - + if ((beta == sone).and.& + & .not.(tra.or.ctra.or.(a%is_triangle()).or.(a%is_unit()))) then call psb_s_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,& & a%nnerws,a%nerwp,x,y) else @@ -3672,9 +3671,6 @@ contains if (alpha == szero) return - - - if (alpha == sone) then !$omp parallel do private(ir,i,j,acc) do ir=1,nnerws @@ -3740,6 +3736,7 @@ subroutine psb_s_ecsr_cmp_nerwp(a,info) end if end do call psb_realloc(nnerws,a%nerwp,info) + a%nnerws = nnerws end subroutine psb_s_ecsr_cmp_nerwp subroutine psb_s_cp_ecsr_from_coo(a,b,info) diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index e9847849..a4a2dd5a 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -3643,9 +3643,8 @@ subroutine psb_z_ecsr_csmv(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (((beta == zone).and..not.(tra.or.ctra))& - & .or.(a%is_triangle()).or.(a%is_unit())) then - + if ((beta == zone).and.& + & .not.(tra.or.ctra.or.(a%is_triangle()).or.(a%is_unit()))) then call psb_z_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,& & a%nnerws,a%nerwp,x,y) else @@ -3672,9 +3671,6 @@ contains if (alpha == zzero) return - - - if (alpha == zone) then !$omp parallel do private(ir,i,j,acc) do ir=1,nnerws @@ -3740,6 +3736,7 @@ subroutine psb_z_ecsr_cmp_nerwp(a,info) end if end do call psb_realloc(nnerws,a%nerwp,info) + a%nnerws = nnerws end subroutine psb_z_ecsr_cmp_nerwp subroutine psb_z_cp_ecsr_from_coo(a,b,info) diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index b4c957b0..46258139 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -44,7 +44,7 @@ ! psb_upd_perm_ Permutation(more memory) ! ! -subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) +subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold, bld_and) use psb_base_mod, psb_protect_name => psb_cspasb use psb_sort_mod use psi_mod @@ -58,6 +58,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_), optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_c_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and !....Locals.... type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act @@ -65,6 +66,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err class(psb_i_base_vect_type), allocatable :: ivm + logical :: bld_and_ info = psb_success_ name = 'psb_spasb' @@ -93,7 +95,11 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) if (debug_level >= psb_debug_ext_)& & write(debug_unit, *) me,' ',trim(name),& & ' Begin matrix assembly...' - + if (present(bld_and)) then + bld_and_ = bld_and + else + bld_and_ = .false. + end if !check on errors encountered in psdspins if (a%is_bld()) then @@ -171,19 +177,26 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) end if - if (.true.) then + if (bld_and_) then block character(len=1024) :: fname type(psb_c_coo_sparse_mat) :: acoo type(psb_c_csr_sparse_mat), allocatable :: aclip type(psb_c_ecsr_sparse_mat), allocatable :: andclip - allocate(aclip,andclip) + logical, parameter :: use_ecsr=.false. + allocate(aclip) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) - call andclip%mv_from_coo(acoo,info) - call move_alloc(andclip,a%and) + if (use_ecsr) then + allocate(andclip) + call andclip%mv_from_coo(acoo,info) + call move_alloc(andclip,a%and) + else + allocate(a%and,mold=a%a) + call a%and%mv_from_coo(acoo,info) + end if if (.false.) then write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' open(25,file=fname) @@ -200,6 +213,9 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold) &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col end if end block + else + if (allocated(a%ad)) deallocate(a%ad) + if (allocated(a%and)) deallocate(a%and) end if if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 5ebc47e8..6beb0e6f 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -44,7 +44,7 @@ ! psb_upd_perm_ Permutation(more memory) ! ! -subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) +subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and) use psb_base_mod, psb_protect_name => psb_dspasb use psb_sort_mod use psi_mod @@ -58,6 +58,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_), optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_d_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and !....Locals.... type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act @@ -65,6 +66,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err class(psb_i_base_vect_type), allocatable :: ivm + logical :: bld_and_ info = psb_success_ name = 'psb_spasb' @@ -93,7 +95,11 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) if (debug_level >= psb_debug_ext_)& & write(debug_unit, *) me,' ',trim(name),& & ' Begin matrix assembly...' - + if (present(bld_and)) then + bld_and_ = bld_and + else + bld_and_ = .false. + end if !check on errors encountered in psdspins if (a%is_bld()) then @@ -171,19 +177,26 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) end if - if (.true.) then + if (bld_and_) then block character(len=1024) :: fname type(psb_d_coo_sparse_mat) :: acoo type(psb_d_csr_sparse_mat), allocatable :: aclip type(psb_d_ecsr_sparse_mat), allocatable :: andclip - allocate(aclip,andclip) + logical, parameter :: use_ecsr=.true. + allocate(aclip) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) - call andclip%mv_from_coo(acoo,info) - call move_alloc(andclip,a%and) + if (use_ecsr) then + allocate(andclip) + call andclip%mv_from_coo(acoo,info) + call move_alloc(andclip,a%and) + else + allocate(a%and,mold=a%a) + call a%and%mv_from_coo(acoo,info) + end if if (.false.) then write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' open(25,file=fname) @@ -200,6 +213,9 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold) &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col end if end block + else + if (allocated(a%ad)) deallocate(a%ad) + if (allocated(a%and)) deallocate(a%and) end if if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 5423c2a7..0edae30e 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -44,7 +44,7 @@ ! psb_upd_perm_ Permutation(more memory) ! ! -subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) +subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold, bld_and) use psb_base_mod, psb_protect_name => psb_sspasb use psb_sort_mod use psi_mod @@ -58,6 +58,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_), optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_s_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and !....Locals.... type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act @@ -65,6 +66,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err class(psb_i_base_vect_type), allocatable :: ivm + logical :: bld_and_ info = psb_success_ name = 'psb_spasb' @@ -93,7 +95,11 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) if (debug_level >= psb_debug_ext_)& & write(debug_unit, *) me,' ',trim(name),& & ' Begin matrix assembly...' - + if (present(bld_and)) then + bld_and_ = bld_and + else + bld_and_ = .false. + end if !check on errors encountered in psdspins if (a%is_bld()) then @@ -171,19 +177,26 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) end if - if (.true.) then + if (bld_and_) then block character(len=1024) :: fname type(psb_s_coo_sparse_mat) :: acoo type(psb_s_csr_sparse_mat), allocatable :: aclip type(psb_s_ecsr_sparse_mat), allocatable :: andclip - allocate(aclip,andclip) + logical, parameter :: use_ecsr=.false. + allocate(aclip) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) - call andclip%mv_from_coo(acoo,info) - call move_alloc(andclip,a%and) + if (use_ecsr) then + allocate(andclip) + call andclip%mv_from_coo(acoo,info) + call move_alloc(andclip,a%and) + else + allocate(a%and,mold=a%a) + call a%and%mv_from_coo(acoo,info) + end if if (.false.) then write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' open(25,file=fname) @@ -200,6 +213,9 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold) &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col end if end block + else + if (allocated(a%ad)) deallocate(a%ad) + if (allocated(a%and)) deallocate(a%and) end if if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 66fc8cd7..cd77de15 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -44,7 +44,7 @@ ! psb_upd_perm_ Permutation(more memory) ! ! -subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) +subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold, bld_and) use psb_base_mod, psb_protect_name => psb_zspasb use psb_sort_mod use psi_mod @@ -58,6 +58,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_), optional, intent(in) :: upd character(len=*), optional, intent(in) :: afmt class(psb_z_base_sparse_mat), intent(in), optional :: mold + logical, intent(in), optional :: bld_and !....Locals.... type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act @@ -65,6 +66,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err class(psb_i_base_vect_type), allocatable :: ivm + logical :: bld_and_ info = psb_success_ name = 'psb_spasb' @@ -93,7 +95,11 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) if (debug_level >= psb_debug_ext_)& & write(debug_unit, *) me,' ',trim(name),& & ' Begin matrix assembly...' - + if (present(bld_and)) then + bld_and_ = bld_and + else + bld_and_ = .false. + end if !check on errors encountered in psdspins if (a%is_bld()) then @@ -171,19 +177,26 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) end if - if (.true.) then + if (bld_and_) then block character(len=1024) :: fname type(psb_z_coo_sparse_mat) :: acoo type(psb_z_csr_sparse_mat), allocatable :: aclip type(psb_z_ecsr_sparse_mat), allocatable :: andclip - allocate(aclip,andclip) + logical, parameter :: use_ecsr=.false. + allocate(aclip) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) - call andclip%mv_from_coo(acoo,info) - call move_alloc(andclip,a%and) + if (use_ecsr) then + allocate(andclip) + call andclip%mv_from_coo(acoo,info) + call move_alloc(andclip,a%and) + else + allocate(a%and,mold=a%a) + call a%and%mv_from_coo(acoo,info) + end if if (.false.) then write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' open(25,file=fname) @@ -200,6 +213,9 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold) &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col end if end block + else + if (allocated(a%ad)) deallocate(a%ad) + if (allocated(a%and)) deallocate(a%and) end if if (debug_level >= psb_debug_ext_) then ch_err=a%get_fmt() diff --git a/test/pargen/psb_d_pde3d.F90 b/test/pargen/psb_d_pde3d.F90 index d4eeccf2..cd503d29 100644 --- a/test/pargen/psb_d_pde3d.F90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -680,9 +680,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold,bld_and=.true.) else - call psb_spasb(a,desc_a,info,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt,bld_and=.true.) end if end if call psb_barrier(ctxt) diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index 57fda01a..c70a973f 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -2,11 +2,11 @@ BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO -100 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) +200 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) 3 Partition: 1 BLOCK 3 3D 2 Stopping criterion 1 2 -0100 MAXIT -05 ITRACE +0300 MAXIT +10 ITRACE 002 IRST restart for RGMRES and BiCGSTABL ILU Block Solver ILU,ILUT,INVK,AINVT,AORTH NONE If ILU : MILU or NONE othewise ignored