mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
Unify build of unsmoothed, adjust map_to_tprol.
This commit is contained in:
Salvatore Filippone
@@ -124,9 +124,9 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
|||||||
goto 9999
|
goto 9999
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||||
k = 0
|
k = 0
|
||||||
do i=1,ncol
|
do i=1,nrow
|
||||||
!
|
!
|
||||||
! Note: at this point, a value ilaggr(i)<=0
|
! Note: at this point, a value ilaggr(i)<=0
|
||||||
! tags a "singleton" row, and it has to be
|
! tags a "singleton" row, and it has to be
|
||||||
|
|||||||
@@ -63,7 +63,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
|
|||||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
||||||
& nzt, naggrm1, naggrp1, i, k
|
& nzt, naggrm1, naggrp1, i, k
|
||||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||||
|
|
||||||
name='mld_spmm_bld_inner'
|
name='mld_spmm_bld_inner'
|
||||||
|
|||||||
@@ -145,71 +145,18 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
|
|||||||
naggrm1 = sum(nlaggr(1:me))
|
naggrm1 = sum(nlaggr(1:me))
|
||||||
naggrp1 = sum(nlaggr(1:me+1))
|
naggrp1 = sum(nlaggr(1:me+1))
|
||||||
|
|
||||||
if (.false.) then
|
call a%cp_to(acsr)
|
||||||
!
|
call op_prol%mv_to(coo_prol)
|
||||||
! If we ever want to switch to explicit product when building this..
|
inaggr = naggr
|
||||||
!
|
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||||
call a%cp_to(acsr)
|
nzlp = coo_prol%get_nzeros()
|
||||||
call op_prol%mv_to(coo_prol)
|
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||||
inaggr = naggr
|
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||||
nzlp = coo_prol%get_nzeros()
|
& coo_prol,tmp_desc,coo_restr,info)
|
||||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
|
||||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
call op_prol%mv_from(coo_prol)
|
||||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
call op_restr%mv_from(coo_restr)
|
||||||
& coo_prol,tmp_desc,coo_restr,info)
|
|
||||||
|
|
||||||
call op_prol%mv_from(coo_prol)
|
|
||||||
call op_restr%mv_from(coo_restr)
|
|
||||||
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
call a%cp_to(ac_coo)
|
|
||||||
nzt = ac_coo%get_nzeros()
|
|
||||||
k = 0
|
|
||||||
do i = 1, nzt
|
|
||||||
k = k + 1
|
|
||||||
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
|
|
||||||
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
|
|
||||||
ac_coo%val(k) = ac_coo%val(i)
|
|
||||||
! At this point, there may be negative entries,
|
|
||||||
! because that's how ILAGGR marks singletons
|
|
||||||
! If this is the case, roll back K
|
|
||||||
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
|
|
||||||
enddo
|
|
||||||
call ac_coo%set_nrows(naggr)
|
|
||||||
call ac_coo%set_ncols(naggr)
|
|
||||||
call ac_coo%set_nzeros(k)
|
|
||||||
call ac_coo%set_dupl(psb_dupl_add_)
|
|
||||||
call ac_coo%fix(info)
|
|
||||||
call ac_coo%trim()
|
|
||||||
call ac%mv_from(ac_coo)
|
|
||||||
|
|
||||||
call op_prol%cp_to(tmpcoo)
|
|
||||||
|
|
||||||
call tmpcoo%transp()
|
|
||||||
!
|
|
||||||
! 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(:)
|
|
||||||
!
|
|
||||||
nzl = tmpcoo%get_nzeros()
|
|
||||||
i = 0
|
|
||||||
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)
|
|
||||||
|
|
||||||
if (info /= psb_success_) goto 9999
|
|
||||||
|
|
||||||
end if
|
|
||||||
|
|
||||||
call psb_erractionrestore(err_act)
|
call psb_erractionrestore(err_act)
|
||||||
return
|
return
|
||||||
|
|||||||
@@ -124,9 +124,9 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
|||||||
goto 9999
|
goto 9999
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||||
k = 0
|
k = 0
|
||||||
do i=1,ncol
|
do i=1,nrow
|
||||||
!
|
!
|
||||||
! Note: at this point, a value ilaggr(i)<=0
|
! Note: at this point, a value ilaggr(i)<=0
|
||||||
! tags a "singleton" row, and it has to be
|
! tags a "singleton" row, and it has to be
|
||||||
|
|||||||
@@ -63,7 +63,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
|
|||||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
||||||
& nzt, naggrm1, naggrp1, i, k
|
& nzt, naggrm1, naggrp1, i, k
|
||||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||||
|
|
||||||
name='mld_spmm_bld_inner'
|
name='mld_spmm_bld_inner'
|
||||||
|
|||||||
@@ -145,71 +145,18 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
|
|||||||
naggrm1 = sum(nlaggr(1:me))
|
naggrm1 = sum(nlaggr(1:me))
|
||||||
naggrp1 = sum(nlaggr(1:me+1))
|
naggrp1 = sum(nlaggr(1:me+1))
|
||||||
|
|
||||||
if (.false.) then
|
call a%cp_to(acsr)
|
||||||
!
|
call op_prol%mv_to(coo_prol)
|
||||||
! If we ever want to switch to explicit product when building this..
|
inaggr = naggr
|
||||||
!
|
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||||
call a%cp_to(acsr)
|
nzlp = coo_prol%get_nzeros()
|
||||||
call op_prol%mv_to(coo_prol)
|
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||||
inaggr = naggr
|
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||||
nzlp = coo_prol%get_nzeros()
|
& coo_prol,tmp_desc,coo_restr,info)
|
||||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
|
||||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
call op_prol%mv_from(coo_prol)
|
||||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
call op_restr%mv_from(coo_restr)
|
||||||
& coo_prol,tmp_desc,coo_restr,info)
|
|
||||||
|
|
||||||
call op_prol%mv_from(coo_prol)
|
|
||||||
call op_restr%mv_from(coo_restr)
|
|
||||||
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
call a%cp_to(ac_coo)
|
|
||||||
nzt = ac_coo%get_nzeros()
|
|
||||||
k = 0
|
|
||||||
do i = 1, nzt
|
|
||||||
k = k + 1
|
|
||||||
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
|
|
||||||
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
|
|
||||||
ac_coo%val(k) = ac_coo%val(i)
|
|
||||||
! At this point, there may be negative entries,
|
|
||||||
! because that's how ILAGGR marks singletons
|
|
||||||
! If this is the case, roll back K
|
|
||||||
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
|
|
||||||
enddo
|
|
||||||
call ac_coo%set_nrows(naggr)
|
|
||||||
call ac_coo%set_ncols(naggr)
|
|
||||||
call ac_coo%set_nzeros(k)
|
|
||||||
call ac_coo%set_dupl(psb_dupl_add_)
|
|
||||||
call ac_coo%fix(info)
|
|
||||||
call ac_coo%trim()
|
|
||||||
call ac%mv_from(ac_coo)
|
|
||||||
|
|
||||||
call op_prol%cp_to(tmpcoo)
|
|
||||||
|
|
||||||
call tmpcoo%transp()
|
|
||||||
!
|
|
||||||
! 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(:)
|
|
||||||
!
|
|
||||||
nzl = tmpcoo%get_nzeros()
|
|
||||||
i = 0
|
|
||||||
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)
|
|
||||||
|
|
||||||
if (info /= psb_success_) goto 9999
|
|
||||||
|
|
||||||
end if
|
|
||||||
|
|
||||||
call psb_erractionrestore(err_act)
|
call psb_erractionrestore(err_act)
|
||||||
return
|
return
|
||||||
|
|||||||
@@ -124,9 +124,9 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
|||||||
goto 9999
|
goto 9999
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||||
k = 0
|
k = 0
|
||||||
do i=1,ncol
|
do i=1,nrow
|
||||||
!
|
!
|
||||||
! Note: at this point, a value ilaggr(i)<=0
|
! Note: at this point, a value ilaggr(i)<=0
|
||||||
! tags a "singleton" row, and it has to be
|
! tags a "singleton" row, and it has to be
|
||||||
|
|||||||
@@ -63,7 +63,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
|
|||||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
||||||
& nzt, naggrm1, naggrp1, i, k
|
& nzt, naggrm1, naggrp1, i, k
|
||||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||||
|
|
||||||
name='mld_spmm_bld_inner'
|
name='mld_spmm_bld_inner'
|
||||||
|
|||||||
@@ -145,71 +145,18 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
|
|||||||
naggrm1 = sum(nlaggr(1:me))
|
naggrm1 = sum(nlaggr(1:me))
|
||||||
naggrp1 = sum(nlaggr(1:me+1))
|
naggrp1 = sum(nlaggr(1:me+1))
|
||||||
|
|
||||||
if (.false.) then
|
call a%cp_to(acsr)
|
||||||
!
|
call op_prol%mv_to(coo_prol)
|
||||||
! If we ever want to switch to explicit product when building this..
|
inaggr = naggr
|
||||||
!
|
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||||
call a%cp_to(acsr)
|
nzlp = coo_prol%get_nzeros()
|
||||||
call op_prol%mv_to(coo_prol)
|
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||||
inaggr = naggr
|
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||||
nzlp = coo_prol%get_nzeros()
|
& coo_prol,tmp_desc,coo_restr,info)
|
||||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
|
||||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
call op_prol%mv_from(coo_prol)
|
||||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
call op_restr%mv_from(coo_restr)
|
||||||
& coo_prol,tmp_desc,coo_restr,info)
|
|
||||||
|
|
||||||
call op_prol%mv_from(coo_prol)
|
|
||||||
call op_restr%mv_from(coo_restr)
|
|
||||||
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
call a%cp_to(ac_coo)
|
|
||||||
nzt = ac_coo%get_nzeros()
|
|
||||||
k = 0
|
|
||||||
do i = 1, nzt
|
|
||||||
k = k + 1
|
|
||||||
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
|
|
||||||
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
|
|
||||||
ac_coo%val(k) = ac_coo%val(i)
|
|
||||||
! At this point, there may be negative entries,
|
|
||||||
! because that's how ILAGGR marks singletons
|
|
||||||
! If this is the case, roll back K
|
|
||||||
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
|
|
||||||
enddo
|
|
||||||
call ac_coo%set_nrows(naggr)
|
|
||||||
call ac_coo%set_ncols(naggr)
|
|
||||||
call ac_coo%set_nzeros(k)
|
|
||||||
call ac_coo%set_dupl(psb_dupl_add_)
|
|
||||||
call ac_coo%fix(info)
|
|
||||||
call ac_coo%trim()
|
|
||||||
call ac%mv_from(ac_coo)
|
|
||||||
|
|
||||||
call op_prol%cp_to(tmpcoo)
|
|
||||||
|
|
||||||
call tmpcoo%transp()
|
|
||||||
!
|
|
||||||
! 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(:)
|
|
||||||
!
|
|
||||||
nzl = tmpcoo%get_nzeros()
|
|
||||||
i = 0
|
|
||||||
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)
|
|
||||||
|
|
||||||
if (info /= psb_success_) goto 9999
|
|
||||||
|
|
||||||
end if
|
|
||||||
|
|
||||||
call psb_erractionrestore(err_act)
|
call psb_erractionrestore(err_act)
|
||||||
return
|
return
|
||||||
|
|||||||
@@ -124,9 +124,9 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
|||||||
goto 9999
|
goto 9999
|
||||||
end if
|
end if
|
||||||
|
|
||||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||||
k = 0
|
k = 0
|
||||||
do i=1,ncol
|
do i=1,nrow
|
||||||
!
|
!
|
||||||
! Note: at this point, a value ilaggr(i)<=0
|
! Note: at this point, a value ilaggr(i)<=0
|
||||||
! tags a "singleton" row, and it has to be
|
! tags a "singleton" row, and it has to be
|
||||||
|
|||||||
@@ -63,7 +63,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
|
|||||||
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
|
||||||
& nzt, naggrm1, naggrp1, i, k
|
& nzt, naggrm1, naggrp1, i, k
|
||||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||||
|
|
||||||
name='mld_spmm_bld_inner'
|
name='mld_spmm_bld_inner'
|
||||||
|
|||||||
@@ -145,71 +145,18 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
|
|||||||
naggrm1 = sum(nlaggr(1:me))
|
naggrm1 = sum(nlaggr(1:me))
|
||||||
naggrp1 = sum(nlaggr(1:me+1))
|
naggrp1 = sum(nlaggr(1:me+1))
|
||||||
|
|
||||||
if (.false.) then
|
call a%cp_to(acsr)
|
||||||
!
|
call op_prol%mv_to(coo_prol)
|
||||||
! If we ever want to switch to explicit product when building this..
|
inaggr = naggr
|
||||||
!
|
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||||
call a%cp_to(acsr)
|
nzlp = coo_prol%get_nzeros()
|
||||||
call op_prol%mv_to(coo_prol)
|
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||||
inaggr = naggr
|
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||||
nzlp = coo_prol%get_nzeros()
|
& coo_prol,tmp_desc,coo_restr,info)
|
||||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
|
||||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
call op_prol%mv_from(coo_prol)
|
||||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
call op_restr%mv_from(coo_restr)
|
||||||
& coo_prol,tmp_desc,coo_restr,info)
|
|
||||||
|
|
||||||
call op_prol%mv_from(coo_prol)
|
|
||||||
call op_restr%mv_from(coo_restr)
|
|
||||||
|
|
||||||
|
|
||||||
else
|
|
||||||
|
|
||||||
call a%cp_to(ac_coo)
|
|
||||||
nzt = ac_coo%get_nzeros()
|
|
||||||
k = 0
|
|
||||||
do i = 1, nzt
|
|
||||||
k = k + 1
|
|
||||||
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
|
|
||||||
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
|
|
||||||
ac_coo%val(k) = ac_coo%val(i)
|
|
||||||
! At this point, there may be negative entries,
|
|
||||||
! because that's how ILAGGR marks singletons
|
|
||||||
! If this is the case, roll back K
|
|
||||||
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
|
|
||||||
enddo
|
|
||||||
call ac_coo%set_nrows(naggr)
|
|
||||||
call ac_coo%set_ncols(naggr)
|
|
||||||
call ac_coo%set_nzeros(k)
|
|
||||||
call ac_coo%set_dupl(psb_dupl_add_)
|
|
||||||
call ac_coo%fix(info)
|
|
||||||
call ac_coo%trim()
|
|
||||||
call ac%mv_from(ac_coo)
|
|
||||||
|
|
||||||
call op_prol%cp_to(tmpcoo)
|
|
||||||
|
|
||||||
call tmpcoo%transp()
|
|
||||||
!
|
|
||||||
! 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(:)
|
|
||||||
!
|
|
||||||
nzl = tmpcoo%get_nzeros()
|
|
||||||
i = 0
|
|
||||||
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)
|
|
||||||
|
|
||||||
if (info /= psb_success_) goto 9999
|
|
||||||
|
|
||||||
end if
|
|
||||||
|
|
||||||
call psb_erractionrestore(err_act)
|
call psb_erractionrestore(err_act)
|
||||||
return
|
return
|
||||||
|
|||||||
Reference in New Issue
Block a user