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

mld2p4-2:

Browse Source 
mlprec/impl/mld_c_extprol_bld.f90
 mlprec/impl/mld_caggrmat_asb.f90
 mlprec/impl/mld_caggrmat_smth_asb.f90
 mlprec/impl/mld_d_extprol_bld.f90
 mlprec/impl/mld_daggrmat_asb.f90
 mlprec/impl/mld_daggrmat_smth_asb.f90
 mlprec/impl/mld_s_extprol_bld.f90
 mlprec/impl/mld_saggrmat_asb.f90
 mlprec/impl/mld_saggrmat_smth_asb.f90
 mlprec/impl/mld_z_extprol_bld.f90
 mlprec/impl/mld_zaggrmat_asb.f90
 mlprec/impl/mld_zaggrmat_smth_asb.f90

Fixed handling of rowsize/colsize of prolongators and restrictors.
stopcriterion
Salvatore Filippone 9 years ago
parent d59d8edf45
commit b1bdcad2b5
12 changed files with 84 additions and 44 deletions
Show Stats Download Patch File Download Diff File

9
mlprec/impl/mld_c_extprol_bld.f90
Unescape Escape View File

@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_cspmat_type) :: ac, am3, am4 type(psb_cspmat_type) :: ac, am2, am3, am4
type(psb_c_coo_sparse_mat) :: acoo, bcoo type(psb_c_coo_sparse_mat) :: acoo, bcoo
type(psb_c_csr_sparse_mat) :: acsr1 type(psb_c_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -392,7 +392,12 @@ contains
! !
! Compute local part of AC ! Compute local part of AC
! !
call psb_spspmm(a,op_prol,am3,info) call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999

5
mlprec/impl/mld_caggrmat_asb.f90
Unescape Escape View File

@ -227,7 +227,10 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999 goto 9999
end if end if
end if end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !
! Clip to local rows.
!
call op_restr%set_nrows(p%desc_ac%get_local_rows())
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

18
mlprec/impl/mld_caggrmat_smth_asb.f90
Unescape Escape View File

@ -112,7 +112,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_ipk_) ::ictxt, np, me integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name character(len=20) :: name
type(psb_cspmat_type) :: am3, am4 type(psb_cspmat_type) :: am3, am4, tmp_prol
type(psb_c_coo_sparse_mat) :: tmpcoo type(psb_c_coo_sparse_mat) :: tmpcoo
type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
complex(psb_spk_), allocatable :: adiag(:) complex(psb_spk_), allocatable :: adiag(:)
@ -335,21 +335,22 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
call ptilde%free() call ptilde%free()
call acsr1%set_dupl(psb_dupl_add_) call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1) call op_prol%cp_from(acsr1)
call tmp_prol%mv_from(acsr1)
! !
! Now we have to gather the halo of op_prol, and add it to itself ! Now we have to gather the halo of tmp_prol, and add it to itself
! to multiply it by A, ! to multiply it by A,
! !
call psb_sphalo(op_prol,desc_a,am4,info,& call psb_sphalo(tmp_prol,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)
if (info == psb_success_) call am4%free() if (info == psb_success_) call am4%free()
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol')
goto 9999 goto 9999
end if end if
call psb_spspmm(a,op_prol,am3,info) call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
@ -359,7 +360,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
nzl = tmpcoo%get_nzeros() nzl = tmpcoo%get_nzeros()
@ -380,6 +381,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 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_) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999 goto 9999

9
mlprec/impl/mld_d_extprol_bld.f90
Unescape Escape View File

@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_dspmat_type) :: ac, am3, am4 type(psb_dspmat_type) :: ac, am2, am3, am4
type(psb_d_coo_sparse_mat) :: acoo, bcoo type(psb_d_coo_sparse_mat) :: acoo, bcoo
type(psb_d_csr_sparse_mat) :: acsr1 type(psb_d_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -392,7 +392,12 @@ contains
! !
! Compute local part of AC ! Compute local part of AC
! !
call psb_spspmm(a,op_prol,am3,info) call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999

5
mlprec/impl/mld_daggrmat_asb.f90
Unescape Escape View File

@ -227,7 +227,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999 goto 9999
end if end if
end if end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !
! Clip to local rows.
!
call op_restr%set_nrows(p%desc_ac%get_local_rows())
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

18
mlprec/impl/mld_daggrmat_smth_asb.f90
Unescape Escape View File

@ -112,7 +112,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_ipk_) ::ictxt, np, me integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name character(len=20) :: name
type(psb_dspmat_type) :: am3, am4 type(psb_dspmat_type) :: am3, am4, tmp_prol
type(psb_d_coo_sparse_mat) :: tmpcoo type(psb_d_coo_sparse_mat) :: tmpcoo
type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
real(psb_dpk_), allocatable :: adiag(:) real(psb_dpk_), allocatable :: adiag(:)
@ -335,21 +335,22 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
call ptilde%free() call ptilde%free()
call acsr1%set_dupl(psb_dupl_add_) call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1) call op_prol%cp_from(acsr1)
call tmp_prol%mv_from(acsr1)
! !
! Now we have to gather the halo of op_prol, and add it to itself ! Now we have to gather the halo of tmp_prol, and add it to itself
! to multiply it by A, ! to multiply it by A,
! !
call psb_sphalo(op_prol,desc_a,am4,info,& call psb_sphalo(tmp_prol,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)
if (info == psb_success_) call am4%free() if (info == psb_success_) call am4%free()
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol')
goto 9999 goto 9999
end if end if
call psb_spspmm(a,op_prol,am3,info) call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
@ -359,7 +360,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
nzl = tmpcoo%get_nzeros() nzl = tmpcoo%get_nzeros()
@ -380,6 +381,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 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_) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999 goto 9999

9
mlprec/impl/mld_s_extprol_bld.f90
Unescape Escape View File

@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_sspmat_type) :: ac, am3, am4 type(psb_sspmat_type) :: ac, am2, am3, am4
type(psb_s_coo_sparse_mat) :: acoo, bcoo type(psb_s_coo_sparse_mat) :: acoo, bcoo
type(psb_s_csr_sparse_mat) :: acsr1 type(psb_s_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -392,7 +392,12 @@ contains
! !
! Compute local part of AC ! Compute local part of AC
! !
call psb_spspmm(a,op_prol,am3,info) call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999

5
mlprec/impl/mld_saggrmat_asb.f90
Unescape Escape View File

@ -227,7 +227,10 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999 goto 9999
end if end if
end if end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !
! Clip to local rows.
!
call op_restr%set_nrows(p%desc_ac%get_local_rows())
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

18
mlprec/impl/mld_saggrmat_smth_asb.f90
Unescape Escape View File

@ -112,7 +112,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_ipk_) ::ictxt, np, me integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name character(len=20) :: name
type(psb_sspmat_type) :: am3, am4 type(psb_sspmat_type) :: am3, am4, tmp_prol
type(psb_s_coo_sparse_mat) :: tmpcoo type(psb_s_coo_sparse_mat) :: tmpcoo
type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
real(psb_spk_), allocatable :: adiag(:) real(psb_spk_), allocatable :: adiag(:)
@ -335,21 +335,22 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
call ptilde%free() call ptilde%free()
call acsr1%set_dupl(psb_dupl_add_) call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1) call op_prol%cp_from(acsr1)
call tmp_prol%mv_from(acsr1)
! !
! Now we have to gather the halo of op_prol, and add it to itself ! Now we have to gather the halo of tmp_prol, and add it to itself
! to multiply it by A, ! to multiply it by A,
! !
call psb_sphalo(op_prol,desc_a,am4,info,& call psb_sphalo(tmp_prol,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)
if (info == psb_success_) call am4%free() if (info == psb_success_) call am4%free()
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol')
goto 9999 goto 9999
end if end if
call psb_spspmm(a,op_prol,am3,info) call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
@ -359,7 +360,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
nzl = tmpcoo%get_nzeros() nzl = tmpcoo%get_nzeros()
@ -380,6 +381,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 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_) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999 goto 9999

9
mlprec/impl/mld_z_extprol_bld.f90
Unescape Escape View File

@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_zspmat_type) :: ac, am3, am4 type(psb_zspmat_type) :: ac, am2, am3, am4
type(psb_z_coo_sparse_mat) :: acoo, bcoo type(psb_z_coo_sparse_mat) :: acoo, bcoo
type(psb_z_csr_sparse_mat) :: acsr1 type(psb_z_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -392,7 +392,12 @@ contains
! !
! Compute local part of AC ! Compute local part of AC
! !
call psb_spspmm(a,op_prol,am3,info) call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999

5
mlprec/impl/mld_zaggrmat_asb.f90
Unescape Escape View File

@ -227,7 +227,10 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999 goto 9999
end if end if
end if end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !
! Clip to local rows.
!
call op_restr%set_nrows(p%desc_ac%get_local_rows())
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

18
mlprec/impl/mld_zaggrmat_smth_asb.f90
Unescape Escape View File

@ -112,7 +112,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act
integer(psb_ipk_) ::ictxt, np, me integer(psb_ipk_) ::ictxt, np, me
character(len=20) :: name character(len=20) :: name
type(psb_zspmat_type) :: am3, am4 type(psb_zspmat_type) :: am3, am4, tmp_prol
type(psb_z_coo_sparse_mat) :: tmpcoo type(psb_z_coo_sparse_mat) :: tmpcoo
type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
complex(psb_dpk_), allocatable :: adiag(:) complex(psb_dpk_), allocatable :: adiag(:)
@ -335,21 +335,22 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
call ptilde%free() call ptilde%free()
call acsr1%set_dupl(psb_dupl_add_) call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1) call op_prol%cp_from(acsr1)
call tmp_prol%mv_from(acsr1)
! !
! Now we have to gather the halo of op_prol, and add it to itself ! Now we have to gather the halo of tmp_prol, and add it to itself
! to multiply it by A, ! to multiply it by A,
! !
call psb_sphalo(op_prol,desc_a,am4,info,& call psb_sphalo(tmp_prol,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,op_prol,info,b=am4) if (info == psb_success_) call psb_rwextd(ncol,tmp_prol,info,b=am4)
if (info == psb_success_) call am4%free() if (info == psb_success_) call am4%free()
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol') call psb_errpush(psb_err_internal_error_,name,a_err='Halo of tmp_prol')
goto 9999 goto 9999
end if end if
call psb_spspmm(a,op_prol,am3,info) call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
@ -359,7 +360,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
nzl = tmpcoo%get_nzeros() nzl = tmpcoo%get_nzeros()
@ -380,6 +381,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 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_) call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999 goto 9999

Write Preview
Loading…
Cancel
Save