fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixes for build process. REPL does not work yet!

Browse Source
stopcriterion
Salvatore Filippone 5 years ago
parent b339d867da
commit ee34e9e9f7
8 changed files with 76 additions and 68 deletions
Show Stats Download Patch File Download Diff File

32
mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90
Unescape Escape View File

@ -99,9 +99,9 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
type(psb_lc_coo_sparse_mat) :: acoo, bcoo type(psb_lc_coo_sparse_mat) :: lacoo, lbcoo
type(psb_c_coo_sparse_mat) :: acoo
type(psb_lc_csr_sparse_mat) :: acsr1 type(psb_lc_csr_sparse_mat) :: acsr1
type(psb_lcspmat_type) :: lac, lac1
type(psb_cspmat_type) :: tmp_ac type(psb_cspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -125,14 +125,14 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_distr_mat_) case(mld_distr_mat_)
call ac%mv_to(bcoo) call ac%mv_to(lbcoo)
nzl = bcoo%get_nzeros() nzl = lbcoo%get_nzeros()
i_nl = nlaggr(me+1) i_nl = nlaggr(me+1)
if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl) if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl)
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,desc_ac,info) if (info == psb_success_) call psb_cdins(nzl,lbcoo%ia,lbcoo%ja,desc_ac,info)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ia(1:nzl),desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ja(1:nzl),desc_ac,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating desc_ac and converting ac') & a_err='Creating desc_ac and converting ac')
@ -141,7 +141,7 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.' & 'Assembld aux descr. distr.'
call ac%mv_from(bcoo) call ac%mv_from(lbcoo)
call ac%set_nrows(desc_ac%get_local_rows()) call ac%set_nrows(desc_ac%get_local_rows())
call ac%set_ncols(desc_ac%get_local_cols()) call ac%set_ncols(desc_ac%get_local_cols())
call ac%set_asb() call ac%set_asb()
@ -165,11 +165,11 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (np>1) then if (np>1) then
!call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) !call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo) call op_restr%mv_to(lacoo)
nzl = acoo%get_nzeros() nzl = lacoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),desc_ac,info,'I') if (info == psb_success_) call psb_glob_to_loc(lacoo%ia(1:nzl),desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) call lacoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) if (info == psb_success_) call op_restr%mv_from(lacoo)
if (info == psb_success_) call op_restr%cscnv(info,type='csr') if (info == psb_success_) call op_restr%cscnv(info,type='csr')
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -189,9 +189,13 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_repl_mat_) case(mld_repl_mat_)
! !
! !
! If we are here, it means we assume that an IPK version of the
! coarse matrix can hold all indices. User beware!
!
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call tmp_ac%mv_from_l(ac) if (info == psb_success_) call ac%mv_to(acoo)
if (info == psb_success_) call tmp_ac%mv_from(acoo)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) & call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

4
mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90
Unescape Escape View File

@ -183,7 +183,6 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
call ac%mv_from(ac_coo) call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
call tmpcoo%transp() call tmpcoo%transp()
! !
@ -201,9 +200,8 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
end if end if
end do end do
call tmpcoo%set_nzeros(i) call tmpcoo%set_nzeros(i)
! call tmpcoo%trim() call tmpcoo%trim()
call op_restr%mv_from(tmpcoo) 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

32
mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90
Unescape Escape View File

@ -99,9 +99,9 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
type(psb_ld_coo_sparse_mat) :: acoo, bcoo type(psb_ld_coo_sparse_mat) :: lacoo, lbcoo
type(psb_d_coo_sparse_mat) :: acoo
type(psb_ld_csr_sparse_mat) :: acsr1 type(psb_ld_csr_sparse_mat) :: acsr1
type(psb_ldspmat_type) :: lac, lac1
type(psb_dspmat_type) :: tmp_ac type(psb_dspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -125,14 +125,14 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_distr_mat_) case(mld_distr_mat_)
call ac%mv_to(bcoo) call ac%mv_to(lbcoo)
nzl = bcoo%get_nzeros() nzl = lbcoo%get_nzeros()
i_nl = nlaggr(me+1) i_nl = nlaggr(me+1)
if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl) if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl)
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,desc_ac,info) if (info == psb_success_) call psb_cdins(nzl,lbcoo%ia,lbcoo%ja,desc_ac,info)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ia(1:nzl),desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ja(1:nzl),desc_ac,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating desc_ac and converting ac') & a_err='Creating desc_ac and converting ac')
@ -141,7 +141,7 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.' & 'Assembld aux descr. distr.'
call ac%mv_from(bcoo) call ac%mv_from(lbcoo)
call ac%set_nrows(desc_ac%get_local_rows()) call ac%set_nrows(desc_ac%get_local_rows())
call ac%set_ncols(desc_ac%get_local_cols()) call ac%set_ncols(desc_ac%get_local_cols())
call ac%set_asb() call ac%set_asb()
@ -165,11 +165,11 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (np>1) then if (np>1) then
!call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) !call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo) call op_restr%mv_to(lacoo)
nzl = acoo%get_nzeros() nzl = lacoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),desc_ac,info,'I') if (info == psb_success_) call psb_glob_to_loc(lacoo%ia(1:nzl),desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) call lacoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) if (info == psb_success_) call op_restr%mv_from(lacoo)
if (info == psb_success_) call op_restr%cscnv(info,type='csr') if (info == psb_success_) call op_restr%cscnv(info,type='csr')
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -189,9 +189,13 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_repl_mat_) case(mld_repl_mat_)
! !
! !
! If we are here, it means we assume that an IPK version of the
! coarse matrix can hold all indices. User beware!
!
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call tmp_ac%mv_from_l(ac) if (info == psb_success_) call ac%mv_to(acoo)
if (info == psb_success_) call tmp_ac%mv_from(acoo)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) & call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

4
mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90
Unescape Escape View File

@ -183,7 +183,6 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
call ac%mv_from(ac_coo) call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
call tmpcoo%transp() call tmpcoo%transp()
! !
@ -201,9 +200,8 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
end if end if
end do end do
call tmpcoo%set_nzeros(i) call tmpcoo%set_nzeros(i)
! call tmpcoo%trim() call tmpcoo%trim()
call op_restr%mv_from(tmpcoo) 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

32
mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90
Unescape Escape View File

@ -99,9 +99,9 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
type(psb_ls_coo_sparse_mat) :: acoo, bcoo type(psb_ls_coo_sparse_mat) :: lacoo, lbcoo
type(psb_s_coo_sparse_mat) :: acoo
type(psb_ls_csr_sparse_mat) :: acsr1 type(psb_ls_csr_sparse_mat) :: acsr1
type(psb_lsspmat_type) :: lac, lac1
type(psb_sspmat_type) :: tmp_ac type(psb_sspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -125,14 +125,14 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_distr_mat_) case(mld_distr_mat_)
call ac%mv_to(bcoo) call ac%mv_to(lbcoo)
nzl = bcoo%get_nzeros() nzl = lbcoo%get_nzeros()
i_nl = nlaggr(me+1) i_nl = nlaggr(me+1)
if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl) if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl)
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,desc_ac,info) if (info == psb_success_) call psb_cdins(nzl,lbcoo%ia,lbcoo%ja,desc_ac,info)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ia(1:nzl),desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ja(1:nzl),desc_ac,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating desc_ac and converting ac') & a_err='Creating desc_ac and converting ac')
@ -141,7 +141,7 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.' & 'Assembld aux descr. distr.'
call ac%mv_from(bcoo) call ac%mv_from(lbcoo)
call ac%set_nrows(desc_ac%get_local_rows()) call ac%set_nrows(desc_ac%get_local_rows())
call ac%set_ncols(desc_ac%get_local_cols()) call ac%set_ncols(desc_ac%get_local_cols())
call ac%set_asb() call ac%set_asb()
@ -165,11 +165,11 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (np>1) then if (np>1) then
!call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) !call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo) call op_restr%mv_to(lacoo)
nzl = acoo%get_nzeros() nzl = lacoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),desc_ac,info,'I') if (info == psb_success_) call psb_glob_to_loc(lacoo%ia(1:nzl),desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) call lacoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) if (info == psb_success_) call op_restr%mv_from(lacoo)
if (info == psb_success_) call op_restr%cscnv(info,type='csr') if (info == psb_success_) call op_restr%cscnv(info,type='csr')
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -189,9 +189,13 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_repl_mat_) case(mld_repl_mat_)
! !
! !
! If we are here, it means we assume that an IPK version of the
! coarse matrix can hold all indices. User beware!
!
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call tmp_ac%mv_from_l(ac) if (info == psb_success_) call ac%mv_to(acoo)
if (info == psb_success_) call tmp_ac%mv_from(acoo)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) & call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

4
mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90
Unescape Escape View File

@ -183,7 +183,6 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
call ac%mv_from(ac_coo) call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
call tmpcoo%transp() call tmpcoo%transp()
! !
@ -201,9 +200,8 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
end if end if
end do end do
call tmpcoo%set_nzeros(i) call tmpcoo%set_nzeros(i)
! call tmpcoo%trim() call tmpcoo%trim()
call op_restr%mv_from(tmpcoo) 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

32
mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90
Unescape Escape View File

@ -99,9 +99,9 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: ictxt, np, me
type(psb_lz_coo_sparse_mat) :: acoo, bcoo type(psb_lz_coo_sparse_mat) :: lacoo, lbcoo
type(psb_z_coo_sparse_mat) :: acoo
type(psb_lz_csr_sparse_mat) :: acsr1 type(psb_lz_csr_sparse_mat) :: acsr1
type(psb_lzspmat_type) :: lac, lac1
type(psb_zspmat_type) :: tmp_ac type(psb_zspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -125,14 +125,14 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_distr_mat_) case(mld_distr_mat_)
call ac%mv_to(bcoo) call ac%mv_to(lbcoo)
nzl = bcoo%get_nzeros() nzl = lbcoo%get_nzeros()
i_nl = nlaggr(me+1) i_nl = nlaggr(me+1)
if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl) if (info == psb_success_) call psb_cdall(ictxt,desc_ac,info,nl=i_nl)
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,desc_ac,info) if (info == psb_success_) call psb_cdins(nzl,lbcoo%ia,lbcoo%ja,desc_ac,info)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ia(1:nzl),desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),desc_ac,info,iact='I') if (info == psb_success_) call psb_glob_to_loc(lbcoo%ja(1:nzl),desc_ac,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating desc_ac and converting ac') & a_err='Creating desc_ac and converting ac')
@ -141,7 +141,7 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.' & 'Assembld aux descr. distr.'
call ac%mv_from(bcoo) call ac%mv_from(lbcoo)
call ac%set_nrows(desc_ac%get_local_rows()) call ac%set_nrows(desc_ac%get_local_rows())
call ac%set_ncols(desc_ac%get_local_cols()) call ac%set_ncols(desc_ac%get_local_cols())
call ac%set_asb() call ac%set_asb()
@ -165,11 +165,11 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
if (np>1) then if (np>1) then
!call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) !call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo) call op_restr%mv_to(lacoo)
nzl = acoo%get_nzeros() nzl = lacoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),desc_ac,info,'I') if (info == psb_success_) call psb_glob_to_loc(lacoo%ia(1:nzl),desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) call lacoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) if (info == psb_success_) call op_restr%mv_from(lacoo)
if (info == psb_success_) call op_restr%cscnv(info,type='csr') if (info == psb_success_) call op_restr%cscnv(info,type='csr')
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
@ -189,9 +189,13 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
case(mld_repl_mat_) case(mld_repl_mat_)
! !
! !
! If we are here, it means we assume that an IPK version of the
! coarse matrix can hold all indices. User beware!
!
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info == psb_success_) call tmp_ac%mv_from_l(ac) if (info == psb_success_) call ac%mv_to(acoo)
if (info == psb_success_) call tmp_ac%mv_from(acoo)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) & call psb_gather(ac,tmp_ac,desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

4
mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90
Unescape Escape View File

@ -183,7 +183,6 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
call ac%mv_from(ac_coo) call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call op_prol%cscnv(info,type='csr',dupl=psb_dupl_add_)
call tmpcoo%transp() call tmpcoo%transp()
! !
@ -201,9 +200,8 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
end if end if
end do end do
call tmpcoo%set_nzeros(i) call tmpcoo%set_nzeros(i)
! call tmpcoo%trim() call tmpcoo%trim()
call op_restr%mv_from(tmpcoo) 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

Write Preview
Loading…
Cancel
Save