diff --git a/mlprec/impl/mld_c_lev_aggrmat_asb.f90 b/mlprec/impl/mld_c_lev_aggrmat_asb.f90 index 78391efb..5aa1730e 100644 --- a/mlprec/impl/mld_c_lev_aggrmat_asb.f90 +++ b/mlprec/impl/mld_c_lev_aggrmat_asb.f90 @@ -101,7 +101,7 @@ subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) ! Local variables - character(len=20) :: name + character(len=24) :: name integer(psb_mpik_) :: ictxt, np, me integer(psb_ipk_) :: err_act type(psb_cspmat_type) :: ac, op_restr diff --git a/mlprec/impl/mld_caggrmat_nosmth_asb.f90 b/mlprec/impl/mld_caggrmat_nosmth_asb.f90 index a19b5539..bbf1f218 100644 --- a/mlprec/impl/mld_caggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_caggrmat_nosmth_asb.f90 @@ -117,11 +117,11 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) - type(psb_c_coo_sparse_mat) :: ac_coo, acoo + type(psb_c_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_c_csr_sparse_mat) :: acsr1, acsr2 integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & naggr, nzt, naggrm1, i, k + & naggr, nzt, naggrm1, naggrp1, i, k name='mld_aggrmat_nosmth_asb' if(psb_get_errstatus().ne.0) return @@ -137,16 +137,37 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ncol = desc_a%get_local_cols() - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1=sum(nlaggr(1:me)) - - call acoo%allocate(ncol,ntaggr,ncol) + naggr = nlaggr(me+1) + ntaggr = sum(nlaggr) + naggrm1 = sum(nlaggr(1:me)) + naggrp1 = sum(nlaggr(1:me+1)) + + call op_prol%cp_to(tmpcoo) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) goto 9999 - call op_prol%transp(op_restr) + call tmpcoo%transp() + nzl = tmpcoo%get_nzeros() + i=0 + ! + ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct + ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) + ! + do k=1, nzl + if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then + i = i+1 + tmpcoo%val(i) = tmpcoo%val(k) + tmpcoo%ia(i) = tmpcoo%ia(k) + tmpcoo%ja(i) = tmpcoo%ja(k) + end if + end do + call tmpcoo%set_nzeros(i) + ! call tmpcoo%trim() + call op_restr%mv_from(tmpcoo) + call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + + if (info /= psb_success_) goto 9999 + call a%cp_to(ac_coo) nzt = ac_coo%get_nzeros() diff --git a/mlprec/impl/mld_d_lev_aggrmat_asb.f90 b/mlprec/impl/mld_d_lev_aggrmat_asb.f90 index e5f969b6..98c579a6 100644 --- a/mlprec/impl/mld_d_lev_aggrmat_asb.f90 +++ b/mlprec/impl/mld_d_lev_aggrmat_asb.f90 @@ -101,7 +101,7 @@ subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) ! Local variables - character(len=20) :: name + character(len=24) :: name integer(psb_mpik_) :: ictxt, np, me integer(psb_ipk_) :: err_act type(psb_dspmat_type) :: ac, op_restr diff --git a/mlprec/impl/mld_daggrmat_nosmth_asb.f90 b/mlprec/impl/mld_daggrmat_nosmth_asb.f90 index 3d2d4309..8c507876 100644 --- a/mlprec/impl/mld_daggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_daggrmat_nosmth_asb.f90 @@ -117,11 +117,11 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) - type(psb_d_coo_sparse_mat) :: ac_coo, acoo + type(psb_d_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_d_csr_sparse_mat) :: acsr1, acsr2 integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & naggr, nzt, naggrm1, i, k + & naggr, nzt, naggrm1, naggrp1, i, k name='mld_aggrmat_nosmth_asb' if(psb_get_errstatus().ne.0) return @@ -137,16 +137,37 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ncol = desc_a%get_local_cols() - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1=sum(nlaggr(1:me)) - - call acoo%allocate(ncol,ntaggr,ncol) + naggr = nlaggr(me+1) + ntaggr = sum(nlaggr) + naggrm1 = sum(nlaggr(1:me)) + naggrp1 = sum(nlaggr(1:me+1)) + + call op_prol%cp_to(tmpcoo) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) goto 9999 - call op_prol%transp(op_restr) + call tmpcoo%transp() + nzl = tmpcoo%get_nzeros() + i=0 + ! + ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct + ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) + ! + do k=1, nzl + if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then + i = i+1 + tmpcoo%val(i) = tmpcoo%val(k) + tmpcoo%ia(i) = tmpcoo%ia(k) + tmpcoo%ja(i) = tmpcoo%ja(k) + end if + end do + call tmpcoo%set_nzeros(i) + ! call tmpcoo%trim() + call op_restr%mv_from(tmpcoo) + call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + + if (info /= psb_success_) goto 9999 + call a%cp_to(ac_coo) nzt = ac_coo%get_nzeros() diff --git a/mlprec/impl/mld_s_lev_aggrmat_asb.f90 b/mlprec/impl/mld_s_lev_aggrmat_asb.f90 index 93932d65..2433a1a0 100644 --- a/mlprec/impl/mld_s_lev_aggrmat_asb.f90 +++ b/mlprec/impl/mld_s_lev_aggrmat_asb.f90 @@ -101,7 +101,7 @@ subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) ! Local variables - character(len=20) :: name + character(len=24) :: name integer(psb_mpik_) :: ictxt, np, me integer(psb_ipk_) :: err_act type(psb_sspmat_type) :: ac, op_restr diff --git a/mlprec/impl/mld_saggrmat_nosmth_asb.f90 b/mlprec/impl/mld_saggrmat_nosmth_asb.f90 index 990d6f52..c4805080 100644 --- a/mlprec/impl/mld_saggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_saggrmat_nosmth_asb.f90 @@ -117,11 +117,11 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) - type(psb_s_coo_sparse_mat) :: ac_coo, acoo + type(psb_s_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_s_csr_sparse_mat) :: acsr1, acsr2 integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & naggr, nzt, naggrm1, i, k + & naggr, nzt, naggrm1, naggrp1, i, k name='mld_aggrmat_nosmth_asb' if(psb_get_errstatus().ne.0) return @@ -137,16 +137,37 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ncol = desc_a%get_local_cols() - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1=sum(nlaggr(1:me)) - - call acoo%allocate(ncol,ntaggr,ncol) + naggr = nlaggr(me+1) + ntaggr = sum(nlaggr) + naggrm1 = sum(nlaggr(1:me)) + naggrp1 = sum(nlaggr(1:me+1)) + + call op_prol%cp_to(tmpcoo) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) goto 9999 - call op_prol%transp(op_restr) + call tmpcoo%transp() + nzl = tmpcoo%get_nzeros() + i=0 + ! + ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct + ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) + ! + do k=1, nzl + if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then + i = i+1 + tmpcoo%val(i) = tmpcoo%val(k) + tmpcoo%ia(i) = tmpcoo%ia(k) + tmpcoo%ja(i) = tmpcoo%ja(k) + end if + end do + call tmpcoo%set_nzeros(i) + ! call tmpcoo%trim() + call op_restr%mv_from(tmpcoo) + call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + + if (info /= psb_success_) goto 9999 + call a%cp_to(ac_coo) nzt = ac_coo%get_nzeros() diff --git a/mlprec/impl/mld_z_lev_aggrmat_asb.f90 b/mlprec/impl/mld_z_lev_aggrmat_asb.f90 index f1bbee94..07cac52e 100644 --- a/mlprec/impl/mld_z_lev_aggrmat_asb.f90 +++ b/mlprec/impl/mld_z_lev_aggrmat_asb.f90 @@ -101,7 +101,7 @@ subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) ! Local variables - character(len=20) :: name + character(len=24) :: name integer(psb_mpik_) :: ictxt, np, me integer(psb_ipk_) :: err_act type(psb_zspmat_type) :: ac, op_restr diff --git a/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 b/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 index 5dfc77c1..8dde35d7 100644 --- a/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 @@ -117,11 +117,11 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) - type(psb_z_coo_sparse_mat) :: ac_coo, acoo + type(psb_z_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_z_csr_sparse_mat) :: acsr1, acsr2 integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & naggr, nzt, naggrm1, i, k + & naggr, nzt, naggrm1, naggrp1, i, k name='mld_aggrmat_nosmth_asb' if(psb_get_errstatus().ne.0) return @@ -137,16 +137,37 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ncol = desc_a%get_local_cols() - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1=sum(nlaggr(1:me)) - - call acoo%allocate(ncol,ntaggr,ncol) + naggr = nlaggr(me+1) + ntaggr = sum(nlaggr) + naggrm1 = sum(nlaggr(1:me)) + naggrp1 = sum(nlaggr(1:me+1)) + + call op_prol%cp_to(tmpcoo) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) goto 9999 - call op_prol%transp(op_restr) + call tmpcoo%transp() + nzl = tmpcoo%get_nzeros() + i=0 + ! + ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct + ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) + ! + do k=1, nzl + if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then + i = i+1 + tmpcoo%val(i) = tmpcoo%val(k) + tmpcoo%ia(i) = tmpcoo%ia(k) + tmpcoo%ja(i) = tmpcoo%ja(k) + end if + end do + call tmpcoo%set_nzeros(i) + ! call tmpcoo%trim() + call op_restr%mv_from(tmpcoo) + call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_) + + if (info /= psb_success_) goto 9999 + call a%cp_to(ac_coo) nzt = ac_coo%get_nzeros()