mld2p4-2:

mlprec/impl/mld_caggrmat_biz_asb.f90
 mlprec/impl/mld_caggrmat_minnrg_asb.f90
 mlprec/impl/mld_daggrmat_biz_asb.f90
 mlprec/impl/mld_daggrmat_minnrg_asb.f90
 mlprec/impl/mld_saggrmat_biz_asb.f90
 mlprec/impl/mld_saggrmat_minnrg_asb.f90
 mlprec/impl/mld_zaggrmat_biz_asb.f90
 mlprec/impl/mld_zaggrmat_minnrg_asb.f90

Fixed handling of rowsize/colsize of prolongators and restrictors.
stopcriterion
Salvatore Filippone 9 years ago
parent b1bdcad2b5
commit b33a57b3bb

@ -97,7 +97,7 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
& 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(:)
@ -350,29 +350,29 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1)
call psb_rwextd(ncol,op_prol,info)
call op_prol%clone(tmp_prol,info)
call psb_rwextd(ncol,tmp_prol,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
goto 9999
end if
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%transp(op_restr)
call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call tmp_prol%free()
call psb_rwextd(ncol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')

@ -120,7 +120,7 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
character(len=20) :: name
type(psb_cspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_cspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
type(psb_cspmat_type) :: dat, datp, datdatp, atmp3
type(psb_cspmat_type) :: dat, datp, datdatp, atmp3, tmp_prol
type(psb_c_coo_sparse_mat) :: tmpcoo
type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsr, acsrf
type(psb_c_csc_sparse_mat) :: csc_dap, csc_dadap, csc_datp, csc_datdatp, acsc
@ -512,9 +512,10 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Now we have to gather the halo of op_prol, and add it to itself
! to multiply it by A,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call op_prol%clone(tmp_prol,info)
if (info == psb_success_) 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
@ -547,13 +548,13 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2'

@ -97,7 +97,7 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
& 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(:)
@ -350,29 +350,29 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1)
call psb_rwextd(ncol,op_prol,info)
call op_prol%clone(tmp_prol,info)
call psb_rwextd(ncol,tmp_prol,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
goto 9999
end if
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%transp(op_restr)
call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call tmp_prol%free()
call psb_rwextd(ncol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')

@ -120,7 +120,7 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
character(len=20) :: name
type(psb_dspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_dspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
type(psb_dspmat_type) :: dat, datp, datdatp, atmp3
type(psb_dspmat_type) :: dat, datp, datdatp, atmp3, tmp_prol
type(psb_d_coo_sparse_mat) :: tmpcoo
type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsr, acsrf
type(psb_d_csc_sparse_mat) :: csc_dap, csc_dadap, csc_datp, csc_datdatp, acsc
@ -512,9 +512,10 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Now we have to gather the halo of op_prol, and add it to itself
! to multiply it by A,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call op_prol%clone(tmp_prol,info)
if (info == psb_success_) 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
@ -547,13 +548,13 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2'

@ -97,7 +97,7 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
& 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(:)
@ -350,29 +350,29 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1)
call psb_rwextd(ncol,op_prol,info)
call op_prol%clone(tmp_prol,info)
call psb_rwextd(ncol,tmp_prol,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
goto 9999
end if
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%transp(op_restr)
call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call tmp_prol%free()
call psb_rwextd(ncol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')

@ -120,7 +120,7 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
character(len=20) :: name
type(psb_sspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_sspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
type(psb_sspmat_type) :: dat, datp, datdatp, atmp3
type(psb_sspmat_type) :: dat, datp, datdatp, atmp3, tmp_prol
type(psb_s_coo_sparse_mat) :: tmpcoo
type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsr, acsrf
type(psb_s_csc_sparse_mat) :: csc_dap, csc_dadap, csc_datp, csc_datdatp, acsc
@ -512,9 +512,10 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Now we have to gather the halo of op_prol, and add it to itself
! to multiply it by A,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call op_prol%clone(tmp_prol,info)
if (info == psb_success_) 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
@ -547,13 +548,13 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2'

@ -97,7 +97,7 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
& 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(:)
@ -350,29 +350,29 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call acsr1%set_dupl(psb_dupl_add_)
call op_prol%mv_from(acsr1)
call psb_rwextd(ncol,op_prol,info)
call op_prol%clone(tmp_prol,info)
call psb_rwextd(ncol,tmp_prol,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Halo of op_prol')
goto 9999
end if
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%transp(op_restr)
call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call tmp_prol%free()
call psb_rwextd(ncol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')

@ -120,7 +120,7 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
character(len=20) :: name
type(psb_zspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp
type(psb_zspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
type(psb_zspmat_type) :: dat, datp, datdatp, atmp3
type(psb_zspmat_type) :: dat, datp, datdatp, atmp3, tmp_prol
type(psb_z_coo_sparse_mat) :: tmpcoo
type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsr, acsrf
type(psb_z_csc_sparse_mat) :: csc_dap, csc_dadap, csc_datp, csc_datdatp, acsc
@ -512,9 +512,10 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
! Now we have to gather the halo of op_prol, and add it to itself
! to multiply it by A,
!
call psb_sphalo(op_prol,desc_a,am4,info,&
call op_prol%clone(tmp_prol,info)
if (info == psb_success_) 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
@ -547,13 +548,13 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd'
call psb_symbmm(a,op_prol,am3,info)
call psb_symbmm(a,tmp_prol,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='symbmm 2')
goto 9999
end if
call psb_numbmm(a,op_prol,am3)
call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2'

Loading…
Cancel
Save