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

More conversions.

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 265f8b5e99
commit 281c5531da
4 changed files with 76 additions and 64 deletions
Show Stats Download Patch File Download Diff File

35
mlprec/impl/aggregator/mld_caggrmat_smth_asb.f90
Unescape Escape View File

@ -117,33 +117,35 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
implicit none implicit none
! Arguments ! Arguments
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(inout) :: op_prol type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_cspmat_type), intent(out) :: ac,op_restr type(psb_lcspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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, tmp_prol type(psb_lcspmat_type) :: la, am3, am4, tmp_prol
type(psb_c_coo_sparse_mat) :: tmpcoo type(psb_lc_coo_sparse_mat) :: tmpcoo
type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_lc_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
complex(psb_spk_), allocatable :: adiag(:) complex(psb_spk_), allocatable :: adiag(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
logical :: filter_mat logical :: filter_mat
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit, err_act
integer(psb_ipk_), parameter :: ncmax=16 integer(psb_ipk_), parameter :: ncmax=16
real(psb_spk_) :: anorm, omega, tmp, dg, theta real(psb_spk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_smth_asb' name='mld_aggrmat_smth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -176,6 +178,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& call psb_realloc(ncol,adiag,info) & call psb_realloc(ncol,adiag,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_halo(adiag,desc_a,info) & call psb_halo(adiag,desc_a,info)
if (info == psb_success_) call a%cp_to_l(la)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@ -185,7 +188,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 1. Allocate Ptilde in sparse matrix form ! 1. Allocate Ptilde in sparse matrix form
call op_prol%mv_to(tmpcoo) call op_prol%mv_to(tmpcoo)
call ptilde%mv_from_coo(tmpcoo,info) call ptilde%mv_from_coo(tmpcoo,info)
if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -342,7 +345,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_spspmm(a,tmp_prol,am3,info) call psb_spspmm(la,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

35
mlprec/impl/aggregator/mld_daggrmat_smth_asb.f90
Unescape Escape View File

@ -117,33 +117,35 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
implicit none implicit none
! Arguments ! Arguments
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(inout) :: op_prol type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_dspmat_type), intent(out) :: ac,op_restr type(psb_ldspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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, tmp_prol type(psb_ldspmat_type) :: la, am3, am4, tmp_prol
type(psb_d_coo_sparse_mat) :: tmpcoo type(psb_ld_coo_sparse_mat) :: tmpcoo
type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_ld_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
real(psb_dpk_), allocatable :: adiag(:) real(psb_dpk_), allocatable :: adiag(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
logical :: filter_mat logical :: filter_mat
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit, err_act
integer(psb_ipk_), parameter :: ncmax=16 integer(psb_ipk_), parameter :: ncmax=16
real(psb_dpk_) :: anorm, omega, tmp, dg, theta real(psb_dpk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_smth_asb' name='mld_aggrmat_smth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -176,6 +178,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& call psb_realloc(ncol,adiag,info) & call psb_realloc(ncol,adiag,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_halo(adiag,desc_a,info) & call psb_halo(adiag,desc_a,info)
if (info == psb_success_) call a%cp_to_l(la)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@ -185,7 +188,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 1. Allocate Ptilde in sparse matrix form ! 1. Allocate Ptilde in sparse matrix form
call op_prol%mv_to(tmpcoo) call op_prol%mv_to(tmpcoo)
call ptilde%mv_from_coo(tmpcoo,info) call ptilde%mv_from_coo(tmpcoo,info)
if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -342,7 +345,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_spspmm(a,tmp_prol,am3,info) call psb_spspmm(la,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

35
mlprec/impl/aggregator/mld_saggrmat_smth_asb.f90
Unescape Escape View File

@ -117,33 +117,35 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
implicit none implicit none
! Arguments ! Arguments
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_sml_parms), intent(inout) :: parms type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(inout) :: op_prol type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_sspmat_type), intent(out) :: ac,op_restr type(psb_lsspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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, tmp_prol type(psb_lsspmat_type) :: la, am3, am4, tmp_prol
type(psb_s_coo_sparse_mat) :: tmpcoo type(psb_ls_coo_sparse_mat) :: tmpcoo
type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_ls_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
real(psb_spk_), allocatable :: adiag(:) real(psb_spk_), allocatable :: adiag(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
logical :: filter_mat logical :: filter_mat
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit, err_act
integer(psb_ipk_), parameter :: ncmax=16 integer(psb_ipk_), parameter :: ncmax=16
real(psb_spk_) :: anorm, omega, tmp, dg, theta real(psb_spk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_smth_asb' name='mld_aggrmat_smth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -176,6 +178,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& call psb_realloc(ncol,adiag,info) & call psb_realloc(ncol,adiag,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_halo(adiag,desc_a,info) & call psb_halo(adiag,desc_a,info)
if (info == psb_success_) call a%cp_to_l(la)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@ -185,7 +188,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 1. Allocate Ptilde in sparse matrix form ! 1. Allocate Ptilde in sparse matrix form
call op_prol%mv_to(tmpcoo) call op_prol%mv_to(tmpcoo)
call ptilde%mv_from_coo(tmpcoo,info) call ptilde%mv_from_coo(tmpcoo,info)
if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -342,7 +345,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_spspmm(a,tmp_prol,am3,info) call psb_spspmm(la,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

35
mlprec/impl/aggregator/mld_zaggrmat_smth_asb.f90
Unescape Escape View File

@ -117,33 +117,35 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
implicit none implicit none
! Arguments ! Arguments
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_dml_parms), intent(inout) :: parms type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(inout) :: op_prol type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_zspmat_type), intent(out) :: ac,op_restr type(psb_lzspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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, tmp_prol type(psb_lzspmat_type) :: la, am3, am4, tmp_prol
type(psb_z_coo_sparse_mat) :: tmpcoo type(psb_lz_coo_sparse_mat) :: tmpcoo
type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde type(psb_lz_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde
complex(psb_dpk_), allocatable :: adiag(:) complex(psb_dpk_), allocatable :: adiag(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
logical :: filter_mat logical :: filter_mat
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit, err_act
integer(psb_ipk_), parameter :: ncmax=16 integer(psb_ipk_), parameter :: ncmax=16
real(psb_dpk_) :: anorm, omega, tmp, dg, theta real(psb_dpk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_smth_asb' name='mld_aggrmat_smth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
@ -176,6 +178,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
& call psb_realloc(ncol,adiag,info) & call psb_realloc(ncol,adiag,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_halo(adiag,desc_a,info) & call psb_halo(adiag,desc_a,info)
if (info == psb_success_) call a%cp_to_l(la)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag')
@ -185,7 +188,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
! 1. Allocate Ptilde in sparse matrix form ! 1. Allocate Ptilde in sparse matrix form
call op_prol%mv_to(tmpcoo) call op_prol%mv_to(tmpcoo)
call ptilde%mv_from_coo(tmpcoo,info) call ptilde%mv_from_coo(tmpcoo,info)
if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -342,7 +345,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_spspmm(a,tmp_prol,am3,info) call psb_spspmm(la,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

Write Preview
Loading…
Cancel
Save