mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 14:44:55 +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
|
||||
end if
|
||||
|
||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
||||
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||
k = 0
|
||||
do i=1,ncol
|
||||
do i=1,nrow
|
||||
!
|
||||
! Note: at this point, a value ilaggr(i)<=0
|
||||
! 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, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
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
|
||||
|
||||
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))
|
||||
naggrp1 = sum(nlaggr(1:me+1))
|
||||
|
||||
if (.false.) then
|
||||
!
|
||||
! If we ever want to switch to explicit product when building this..
|
||||
!
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& coo_prol,tmp_desc,coo_restr,info)
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& 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 op_prol%mv_from(coo_prol)
|
||||
call op_restr%mv_from(coo_restr)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -124,9 +124,9 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
||||
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||
k = 0
|
||||
do i=1,ncol
|
||||
do i=1,nrow
|
||||
!
|
||||
! Note: at this point, a value ilaggr(i)<=0
|
||||
! 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, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
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
|
||||
|
||||
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))
|
||||
naggrp1 = sum(nlaggr(1:me+1))
|
||||
|
||||
if (.false.) then
|
||||
!
|
||||
! If we ever want to switch to explicit product when building this..
|
||||
!
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& coo_prol,tmp_desc,coo_restr,info)
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& 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 op_prol%mv_from(coo_prol)
|
||||
call op_restr%mv_from(coo_restr)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -124,9 +124,9 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
||||
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||
k = 0
|
||||
do i=1,ncol
|
||||
do i=1,nrow
|
||||
!
|
||||
! Note: at this point, a value ilaggr(i)<=0
|
||||
! 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, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
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
|
||||
|
||||
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))
|
||||
naggrp1 = sum(nlaggr(1:me+1))
|
||||
|
||||
if (.false.) then
|
||||
!
|
||||
! If we ever want to switch to explicit product when building this..
|
||||
!
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& coo_prol,tmp_desc,coo_restr,info)
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& 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 op_prol%mv_from(coo_prol)
|
||||
call op_restr%mv_from(coo_restr)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -124,9 +124,9 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call tmpcoo%allocate(ncol,ntaggr,ncol)
|
||||
call tmpcoo%allocate(nrow,ntaggr,ncol)
|
||||
k = 0
|
||||
do i=1,ncol
|
||||
do i=1,nrow
|
||||
!
|
||||
! Note: at this point, a value ilaggr(i)<=0
|
||||
! 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, &
|
||||
& nzt, naggrm1, naggrp1, i, k
|
||||
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
|
||||
|
||||
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))
|
||||
naggrp1 = sum(nlaggr(1:me+1))
|
||||
|
||||
if (.false.) then
|
||||
!
|
||||
! If we ever want to switch to explicit product when building this..
|
||||
!
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& coo_prol,tmp_desc,coo_restr,info)
|
||||
call a%cp_to(acsr)
|
||||
call op_prol%mv_to(coo_prol)
|
||||
inaggr = naggr
|
||||
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
|
||||
nzlp = coo_prol%get_nzeros()
|
||||
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
|
||||
call coo_prol%set_ncols(tmp_desc%get_local_cols())
|
||||
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
|
||||
& 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 op_prol%mv_from(coo_prol)
|
||||
call op_restr%mv_from(coo_restr)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
Reference in New Issue
Block a user