Fixed op_restr build for unsmoothed aggregation.

stopcriterion
Salvatore Filippone 7 years ago
parent 0f5ce22c8f
commit fa1b5dcdea

@ -101,7 +101,7 @@ subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Local variables ! Local variables
character(len=20) :: name character(len=24) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_cspmat_type) :: ac, op_restr type(psb_cspmat_type) :: ac, op_restr

@ -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 integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: ierr(5) 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 type(psb_c_csr_sparse_mat) :: acsr1, acsr2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & 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' name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -140,12 +140,33 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggr = nlaggr(me+1) naggr = nlaggr(me+1)
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
call acoo%allocate(ncol,ntaggr,ncol)
call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
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 if (info /= psb_success_) goto 9999
call op_prol%transp(op_restr)
call a%cp_to(ac_coo) call a%cp_to(ac_coo)

@ -101,7 +101,7 @@ subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Local variables ! Local variables
character(len=20) :: name character(len=24) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_dspmat_type) :: ac, op_restr type(psb_dspmat_type) :: ac, op_restr

@ -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 integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: ierr(5) 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 type(psb_d_csr_sparse_mat) :: acsr1, acsr2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & 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' name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -140,12 +140,33 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggr = nlaggr(me+1) naggr = nlaggr(me+1)
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
call acoo%allocate(ncol,ntaggr,ncol)
call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
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 if (info /= psb_success_) goto 9999
call op_prol%transp(op_restr)
call a%cp_to(ac_coo) call a%cp_to(ac_coo)

@ -101,7 +101,7 @@ subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Local variables ! Local variables
character(len=20) :: name character(len=24) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_sspmat_type) :: ac, op_restr type(psb_sspmat_type) :: ac, op_restr

@ -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 integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: ierr(5) 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 type(psb_s_csr_sparse_mat) :: acsr1, acsr2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & 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' name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -140,12 +140,33 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggr = nlaggr(me+1) naggr = nlaggr(me+1)
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
call acoo%allocate(ncol,ntaggr,ncol)
call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
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 if (info /= psb_success_) goto 9999
call op_prol%transp(op_restr)
call a%cp_to(ac_coo) call a%cp_to(ac_coo)

@ -101,7 +101,7 @@ subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Local variables ! Local variables
character(len=20) :: name character(len=24) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_zspmat_type) :: ac, op_restr type(psb_zspmat_type) :: ac, op_restr

@ -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 integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=20) :: name character(len=20) :: name
integer(psb_ipk_) :: ierr(5) 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 type(psb_z_csr_sparse_mat) :: acsr1, acsr2
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & 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' name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -140,12 +140,33 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggr = nlaggr(me+1) naggr = nlaggr(me+1)
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
call acoo%allocate(ncol,ntaggr,ncol)
call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_) call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
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 if (info /= psb_success_) goto 9999
call op_prol%transp(op_restr)
call a%cp_to(ac_coo) call a%cp_to(ac_coo)

Loading…
Cancel
Save