fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
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.
This commit is contained in:
Salvatore Filippone
2016-07-17 17:51:50 +00:00
parent d59d8edf45
commit b1bdcad2b5
12 changed files with 84 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/mld_c_extprol_bld.f90
+7 -2
View File
@@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
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_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false.
@@ -392,7 +392,12 @@ contains
!
! 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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
mlprec/impl/mld_caggrmat_asb.f90
+4 -1
View File
@@ -227,7 +227,10 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999
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_) &
& write(debug_unit,*) me,' ',trim(name),&
mlprec/impl/mld_caggrmat_smth_asb.f90
+10 -8
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
integer(psb_ipk_) ::ictxt, np, me
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_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
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 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,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call psb_sphalo(tmp_prol,desc_a,am4,info,&
& 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_) 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
end if
call psb_spspmm(a,op_prol,am3,info)
call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
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),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo)
call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp()
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 op_restr%mv_from(tmpcoo)
call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999
mlprec/impl/mld_d_extprol_bld.f90
+7 -2
View File
@@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
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_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false.
@@ -392,7 +392,12 @@ contains
!
! 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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
mlprec/impl/mld_daggrmat_asb.f90
+4 -1
View File
@@ -227,7 +227,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999
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_) &
& write(debug_unit,*) me,' ',trim(name),&
mlprec/impl/mld_daggrmat_smth_asb.f90
+10 -8
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
integer(psb_ipk_) ::ictxt, np, me
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_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
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 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,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call psb_sphalo(tmp_prol,desc_a,am4,info,&
& 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_) 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
end if
call psb_spspmm(a,op_prol,am3,info)
call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
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),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo)
call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp()
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 op_restr%mv_from(tmpcoo)
call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999
mlprec/impl/mld_s_extprol_bld.f90
+7 -2
View File
@@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
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_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false.
@@ -392,7 +392,12 @@ contains
!
! 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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
mlprec/impl/mld_saggrmat_asb.f90
+4 -1
View File
@@ -227,7 +227,10 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999
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_) &
& write(debug_unit,*) me,' ',trim(name),&
mlprec/impl/mld_saggrmat_smth_asb.f90
+10 -8
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
integer(psb_ipk_) ::ictxt, np, me
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_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
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 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,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call psb_sphalo(tmp_prol,desc_a,am4,info,&
& 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_) 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
end if
call psb_spspmm(a,op_prol,am3,info)
call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
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),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo)
call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp()
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 op_restr%mv_from(tmpcoo)
call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999
mlprec/impl/mld_z_extprol_bld.f90
+7 -2
View File
@@ -358,7 +358,7 @@ contains
integer(psb_mpik_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
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_csr_sparse_mat) :: acsr1
logical, parameter :: debug=.false.
@@ -392,7 +392,12 @@ contains
!
! 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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
mlprec/impl/mld_zaggrmat_asb.f90
+4 -1
View File
@@ -227,7 +227,10 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
goto 9999
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_) &
& write(debug_unit,*) me,' ',trim(name),&
mlprec/impl/mld_zaggrmat_smth_asb.f90
+10 -8
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
integer(psb_ipk_) ::ictxt, np, me
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_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
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 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,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call psb_sphalo(tmp_prol,desc_a,am4,info,&
& 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_) 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
end if
call psb_spspmm(a,op_prol,am3,info)
call psb_spspmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
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),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo)
call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp()
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 op_restr%mv_from(tmpcoo)
call op_restr%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr')
goto 9999