diff --git a/mlprec/impl/mld_c_extprol_bld.f90 b/mlprec/impl/mld_c_extprol_bld.f90 index da912024..ecfa2407 100644 --- a/mlprec/impl/mld_c_extprol_bld.f90 +++ b/mlprec/impl/mld_c_extprol_bld.f90 @@ -358,7 +358,7 @@ contains integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) - type(psb_cspmat_type) :: ac, am3, am4 + type(psb_cspmat_type) :: ac, am2, am3, am4 type(psb_c_coo_sparse_mat) :: acoo, bcoo type(psb_c_csr_sparse_mat) :: acsr1 logical, parameter :: debug=.false. @@ -392,7 +392,12 @@ contains ! ! Compute local part of AC ! - call psb_spspmm(a,op_prol,am3,info) + call op_prol%clone(am2,info) + if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) + if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) + if (info == psb_success_) call am4%free() + call psb_spspmm(a,am2,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/mld_caggrmat_asb.f90 b/mlprec/impl/mld_caggrmat_asb.f90 index 5bafe5d2..82d654e0 100644 --- a/mlprec/impl/mld_caggrmat_asb.f90 +++ b/mlprec/impl/mld_caggrmat_asb.f90 @@ -227,7 +227,10 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) goto 9999 end if end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) + ! + ! Clip to local rows. + ! + call op_restr%set_nrows(p%desc_ac%get_local_rows()) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_caggrmat_smth_asb.f90 b/mlprec/impl/mld_caggrmat_smth_asb.f90 index a54f5484..0f24e6d6 100644 --- a/mlprec/impl/mld_caggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_caggrmat_smth_asb.f90 @@ -112,7 +112,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_cspmat_type) :: am3, am4 + type(psb_cspmat_type) :: am3, am4, tmp_prol type(psb_c_coo_sparse_mat) :: tmpcoo type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde complex(psb_spk_), allocatable :: adiag(:) @@ -335,21 +335,22 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest call ptilde%free() call acsr1%set_dupl(psb_dupl_add_) - call op_prol%mv_from(acsr1) + call op_prol%cp_from(acsr1) + call tmp_prol%mv_from(acsr1) ! - ! Now we have to gather the halo of op_prol, and add it to itself + ! Now we have to gather the halo of tmp_prol, and add it to itself ! to multiply it by A, ! - call psb_sphalo(op_prol,desc_a,am4,info,& + call psb_sphalo(tmp_prol,desc_a,am4,info,& & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) + if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4) if (info == psb_success_) call am4%free() if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') + call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol') goto 9999 end if - call psb_spspmm(a,op_prol,am3,info) + call psb_spspmm(a,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 @@ -359,7 +360,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ - call op_prol%cp_to(tmpcoo) + call tmp_prol%cp_to(tmpcoo) call tmpcoo%transp() nzl = tmpcoo%get_nzeros() @@ -380,6 +381,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! call tmpcoo%trim() call op_restr%mv_from(tmpcoo) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') goto 9999 diff --git a/mlprec/impl/mld_d_extprol_bld.f90 b/mlprec/impl/mld_d_extprol_bld.f90 index 40b340b3..84d49460 100644 --- a/mlprec/impl/mld_d_extprol_bld.f90 +++ b/mlprec/impl/mld_d_extprol_bld.f90 @@ -358,7 +358,7 @@ contains integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) - type(psb_dspmat_type) :: ac, am3, am4 + type(psb_dspmat_type) :: ac, am2, am3, am4 type(psb_d_coo_sparse_mat) :: acoo, bcoo type(psb_d_csr_sparse_mat) :: acsr1 logical, parameter :: debug=.false. @@ -392,7 +392,12 @@ contains ! ! Compute local part of AC ! - call psb_spspmm(a,op_prol,am3,info) + call op_prol%clone(am2,info) + if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) + if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) + if (info == psb_success_) call am4%free() + call psb_spspmm(a,am2,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/mld_daggrmat_asb.f90 b/mlprec/impl/mld_daggrmat_asb.f90 index 46f612da..82613c50 100644 --- a/mlprec/impl/mld_daggrmat_asb.f90 +++ b/mlprec/impl/mld_daggrmat_asb.f90 @@ -227,7 +227,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) goto 9999 end if end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) + ! + ! Clip to local rows. + ! + call op_restr%set_nrows(p%desc_ac%get_local_rows()) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_daggrmat_smth_asb.f90 b/mlprec/impl/mld_daggrmat_smth_asb.f90 index 01ae8661..db400747 100644 --- a/mlprec/impl/mld_daggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_daggrmat_smth_asb.f90 @@ -112,7 +112,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_dspmat_type) :: am3, am4 + type(psb_dspmat_type) :: am3, am4, tmp_prol type(psb_d_coo_sparse_mat) :: tmpcoo type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde real(psb_dpk_), allocatable :: adiag(:) @@ -335,21 +335,22 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest call ptilde%free() call acsr1%set_dupl(psb_dupl_add_) - call op_prol%mv_from(acsr1) + call op_prol%cp_from(acsr1) + call tmp_prol%mv_from(acsr1) ! - ! Now we have to gather the halo of op_prol, and add it to itself + ! Now we have to gather the halo of tmp_prol, and add it to itself ! to multiply it by A, ! - call psb_sphalo(op_prol,desc_a,am4,info,& + call psb_sphalo(tmp_prol,desc_a,am4,info,& & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) + if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4) if (info == psb_success_) call am4%free() if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') + call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol') goto 9999 end if - call psb_spspmm(a,op_prol,am3,info) + call psb_spspmm(a,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 @@ -359,7 +360,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ - call op_prol%cp_to(tmpcoo) + call tmp_prol%cp_to(tmpcoo) call tmpcoo%transp() nzl = tmpcoo%get_nzeros() @@ -380,6 +381,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! call tmpcoo%trim() call op_restr%mv_from(tmpcoo) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') goto 9999 diff --git a/mlprec/impl/mld_s_extprol_bld.f90 b/mlprec/impl/mld_s_extprol_bld.f90 index ed429863..1b17d255 100644 --- a/mlprec/impl/mld_s_extprol_bld.f90 +++ b/mlprec/impl/mld_s_extprol_bld.f90 @@ -358,7 +358,7 @@ contains integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) - type(psb_sspmat_type) :: ac, am3, am4 + type(psb_sspmat_type) :: ac, am2, am3, am4 type(psb_s_coo_sparse_mat) :: acoo, bcoo type(psb_s_csr_sparse_mat) :: acsr1 logical, parameter :: debug=.false. @@ -392,7 +392,12 @@ contains ! ! Compute local part of AC ! - call psb_spspmm(a,op_prol,am3,info) + call op_prol%clone(am2,info) + if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) + if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) + if (info == psb_success_) call am4%free() + call psb_spspmm(a,am2,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/mld_saggrmat_asb.f90 b/mlprec/impl/mld_saggrmat_asb.f90 index e9290a32..c0fe4b22 100644 --- a/mlprec/impl/mld_saggrmat_asb.f90 +++ b/mlprec/impl/mld_saggrmat_asb.f90 @@ -227,7 +227,10 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) goto 9999 end if end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) + ! + ! Clip to local rows. + ! + call op_restr%set_nrows(p%desc_ac%get_local_rows()) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_saggrmat_smth_asb.f90 b/mlprec/impl/mld_saggrmat_smth_asb.f90 index 595a1580..1d00dda1 100644 --- a/mlprec/impl/mld_saggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_saggrmat_smth_asb.f90 @@ -112,7 +112,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_sspmat_type) :: am3, am4 + type(psb_sspmat_type) :: am3, am4, tmp_prol type(psb_s_coo_sparse_mat) :: tmpcoo type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde real(psb_spk_), allocatable :: adiag(:) @@ -335,21 +335,22 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest call ptilde%free() call acsr1%set_dupl(psb_dupl_add_) - call op_prol%mv_from(acsr1) + call op_prol%cp_from(acsr1) + call tmp_prol%mv_from(acsr1) ! - ! Now we have to gather the halo of op_prol, and add it to itself + ! Now we have to gather the halo of tmp_prol, and add it to itself ! to multiply it by A, ! - call psb_sphalo(op_prol,desc_a,am4,info,& + call psb_sphalo(tmp_prol,desc_a,am4,info,& & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) + if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4) if (info == psb_success_) call am4%free() if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') + call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol') goto 9999 end if - call psb_spspmm(a,op_prol,am3,info) + call psb_spspmm(a,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 @@ -359,7 +360,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ - call op_prol%cp_to(tmpcoo) + call tmp_prol%cp_to(tmpcoo) call tmpcoo%transp() nzl = tmpcoo%get_nzeros() @@ -380,6 +381,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! call tmpcoo%trim() call op_restr%mv_from(tmpcoo) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') goto 9999 diff --git a/mlprec/impl/mld_z_extprol_bld.f90 b/mlprec/impl/mld_z_extprol_bld.f90 index f6a63d85..aea3b91d 100644 --- a/mlprec/impl/mld_z_extprol_bld.f90 +++ b/mlprec/impl/mld_z_extprol_bld.f90 @@ -358,7 +358,7 @@ contains integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) - type(psb_zspmat_type) :: ac, am3, am4 + type(psb_zspmat_type) :: ac, am2, am3, am4 type(psb_z_coo_sparse_mat) :: acoo, bcoo type(psb_z_csr_sparse_mat) :: acsr1 logical, parameter :: debug=.false. @@ -392,7 +392,12 @@ contains ! ! Compute local part of AC ! - call psb_spspmm(a,op_prol,am3,info) + call op_prol%clone(am2,info) + if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& + & colcnv=.false.,rowscale=.true.) + if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) + if (info == psb_success_) call am4%free() + call psb_spspmm(a,am2,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/mld_zaggrmat_asb.f90 b/mlprec/impl/mld_zaggrmat_asb.f90 index 12268cc7..c6ebe19a 100644 --- a/mlprec/impl/mld_zaggrmat_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_asb.f90 @@ -227,7 +227,10 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) goto 9999 end if end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) + ! + ! Clip to local rows. + ! + call op_restr%set_nrows(p%desc_ac%get_local_rows()) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_zaggrmat_smth_asb.f90 b/mlprec/impl/mld_zaggrmat_smth_asb.f90 index 9e1065c3..794210b5 100644 --- a/mlprec/impl/mld_zaggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_smth_asb.f90 @@ -112,7 +112,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_zspmat_type) :: am3, am4 + type(psb_zspmat_type) :: am3, am4, tmp_prol type(psb_z_coo_sparse_mat) :: tmpcoo type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde complex(psb_dpk_), allocatable :: adiag(:) @@ -335,21 +335,22 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest call ptilde%free() call acsr1%set_dupl(psb_dupl_add_) - call op_prol%mv_from(acsr1) + call op_prol%cp_from(acsr1) + call tmp_prol%mv_from(acsr1) ! - ! Now we have to gather the halo of op_prol, and add it to itself + ! Now we have to gather the halo of tmp_prol, and add it to itself ! to multiply it by A, ! - call psb_sphalo(op_prol,desc_a,am4,info,& + call psb_sphalo(tmp_prol,desc_a,am4,info,& & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) + if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4) if (info == psb_success_) call am4%free() if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') + call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol') goto 9999 end if - call psb_spspmm(a,op_prol,am3,info) + call psb_spspmm(a,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 @@ -359,7 +360,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ - call op_prol%cp_to(tmpcoo) + call tmp_prol%cp_to(tmpcoo) call tmpcoo%transp() nzl = tmpcoo%get_nzeros() @@ -380,6 +381,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! call tmpcoo%trim() call op_restr%mv_from(tmpcoo) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') goto 9999