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

Changes for compilation

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 5ca07fc901
commit 386e970512
46 changed files with 698 additions and 690 deletions
Show Stats Download Patch File Download Diff File

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

@ -147,7 +147,7 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
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
integer(psb_ipk_) :: nzl,ntaggr integer(psb_ipk_) :: nzl,ntaggr

2
mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90
Unescape Escape View File

@ -87,7 +87,7 @@ subroutine mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr integer(psb_ipk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

2
mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
! Local variables ! Local variables
type(psb_cspmat_type) :: atmp, atrans type(psb_cspmat_type) :: atmp, atrans
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr integer(psb_ipk_) :: ntaggr, nr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

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

@ -147,7 +147,7 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
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
integer(psb_ipk_) :: nzl,ntaggr integer(psb_ipk_) :: nzl,ntaggr

2
mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90
Unescape Escape View File

@ -87,7 +87,7 @@ subroutine mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr integer(psb_ipk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

2
mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
! Local variables ! Local variables
type(psb_dspmat_type) :: atmp, atrans type(psb_dspmat_type) :: atmp, atrans
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr integer(psb_ipk_) :: ntaggr, nr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

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

@ -147,7 +147,7 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
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
integer(psb_ipk_) :: nzl,ntaggr integer(psb_ipk_) :: nzl,ntaggr

2
mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90
Unescape Escape View File

@ -87,7 +87,7 @@ subroutine mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr integer(psb_ipk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

2
mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
! Local variables ! Local variables
type(psb_sspmat_type) :: atmp, atrans type(psb_sspmat_type) :: atmp, atrans
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr integer(psb_ipk_) :: ntaggr, nr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

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

@ -147,7 +147,7 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
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
integer(psb_ipk_) :: nzl,ntaggr integer(psb_ipk_) :: nzl,ntaggr

2
mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90
Unescape Escape View File

@ -87,7 +87,7 @@ subroutine mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr integer(psb_ipk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

2
mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90
Unescape Escape View File

@ -91,7 +91,7 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
! Local variables ! Local variables
type(psb_zspmat_type) :: atmp, atrans type(psb_zspmat_type) :: atmp, atrans
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr integer(psb_ipk_) :: ntaggr, nr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit

16
mlprec/impl/level/mld_c_base_onelev_mat_asb.f90
Unescape Escape View File

@ -95,8 +95,9 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
class(mld_c_onelev_type), intent(inout), target :: lv class(mld_c_onelev_type), intent(inout), target :: lv
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_ipk_), intent(inout) :: nlaggr(:)
type(psb_cspmat_type), intent(inout) :: op_prol integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -104,10 +105,11 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_cspmat_type) :: ac, op_restr type(psb_lcspmat_type) :: lac, op_restr
type(psb_c_coo_sparse_mat) :: acoo, bcoo type(psb_cspmat_type) :: ac
type(psb_c_csr_sparse_mat) :: acsr1 type(psb_lc_coo_sparse_mat) :: acoo, bcoo
integer(psb_ipk_) :: nzl, ntaggr type(psb_lc_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
name='mld_c_onelev_mat_asb' name='mld_c_onelev_mat_asb'
@ -137,7 +139,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
! !
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

16
mlprec/impl/level/mld_d_base_onelev_mat_asb.f90
Unescape Escape View File

@ -95,8 +95,9 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
class(mld_d_onelev_type), intent(inout), target :: lv class(mld_d_onelev_type), intent(inout), target :: lv
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_ipk_), intent(inout) :: nlaggr(:)
type(psb_dspmat_type), intent(inout) :: op_prol integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -104,10 +105,11 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_dspmat_type) :: ac, op_restr type(psb_ldspmat_type) :: lac, op_restr
type(psb_d_coo_sparse_mat) :: acoo, bcoo type(psb_dspmat_type) :: ac
type(psb_d_csr_sparse_mat) :: acsr1 type(psb_ld_coo_sparse_mat) :: acoo, bcoo
integer(psb_ipk_) :: nzl, ntaggr type(psb_ld_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
name='mld_d_onelev_mat_asb' name='mld_d_onelev_mat_asb'
@ -137,7 +139,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
! !
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

16
mlprec/impl/level/mld_s_base_onelev_mat_asb.f90
Unescape Escape View File

@ -95,8 +95,9 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
class(mld_s_onelev_type), intent(inout), target :: lv class(mld_s_onelev_type), intent(inout), target :: lv
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_ipk_), intent(inout) :: nlaggr(:)
type(psb_sspmat_type), intent(inout) :: op_prol integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -104,10 +105,11 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_sspmat_type) :: ac, op_restr type(psb_lsspmat_type) :: lac, op_restr
type(psb_s_coo_sparse_mat) :: acoo, bcoo type(psb_sspmat_type) :: ac
type(psb_s_csr_sparse_mat) :: acsr1 type(psb_ls_coo_sparse_mat) :: acoo, bcoo
integer(psb_ipk_) :: nzl, ntaggr type(psb_ls_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
name='mld_s_onelev_mat_asb' name='mld_s_onelev_mat_asb'
@ -137,7 +139,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
! !
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

16
mlprec/impl/level/mld_z_base_onelev_mat_asb.f90
Unescape Escape View File

@ -95,8 +95,9 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
class(mld_z_onelev_type), intent(inout), target :: lv class(mld_z_onelev_type), intent(inout), target :: lv
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_ipk_), intent(inout) :: nlaggr(:)
type(psb_zspmat_type), intent(inout) :: op_prol integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -104,10 +105,11 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
type(psb_zspmat_type) :: ac, op_restr type(psb_lzspmat_type) :: lac, op_restr
type(psb_z_coo_sparse_mat) :: acoo, bcoo type(psb_zspmat_type) :: ac
type(psb_z_csr_sparse_mat) :: acsr1 type(psb_lz_coo_sparse_mat) :: acoo, bcoo
integer(psb_ipk_) :: nzl, ntaggr type(psb_lz_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
name='mld_z_onelev_mat_asb' name='mld_z_onelev_mat_asb'
@ -137,7 +139,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
! !
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

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

@ -363,149 +363,149 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_ !!$ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& !!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle) !!$ & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& !!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) !!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
nlaggr(me+1) = op_restr%get_nrows() !!$ nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then !!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_ !!$ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') !!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_sum(ictxt,nlaggr) !!$ call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr) !!$ ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols() !!$ ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& !!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
& op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() !!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols()
! !!$ !
! Compute local part of AC !!$ ! Compute local part of AC
! !!$ !
call op_prol%clone(am2,info) !!$ call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& !!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free() !!$ if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info) !!$ 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
end if !!$ end if
call psb_sphalo(am3,desc_a,am4,info,& !!$ call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am3,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='Extend am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_spspmm(op_restr,am3,ac,info) !!$ call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call am3%free() !!$ if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
select case(p%parms%coarse_mat) !!$ select case(p%parms%coarse_mat)
!!$
case(mld_distr_mat_) !!$ case(mld_distr_mat_)
!!$
call ac%mv_to(bcoo) !!$ call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros() !!$ nzl = bcoo%get_nzeros()
!!$
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) !!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%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 p%desc_ac and converting ac') !!$ & a_err='Creating p%desc_ac and converting ac')
goto 9999 !!$ goto 9999
end if !!$ end if
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 p%ac%mv_from(bcoo) !!$ call p%ac%mv_from(bcoo)
!!$
call p%ac%set_nrows(p%desc_ac%get_local_rows()) !!$ call p%ac%set_nrows(p%desc_ac%get_local_rows())
call p%ac%set_ncols(p%desc_ac%get_local_cols()) !!$ call p%ac%set_ncols(p%desc_ac%get_local_cols())
call p%ac%set_asb() !!$ call p%ac%set_asb()
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (np>1) then !!$ if (np>1) then
call op_prol%mv_to(acsr1) !!$ call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros() !!$ nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') !!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999 !!$ goto 9999
end if !!$ end if
call op_prol%mv_from(acsr1) !!$ call op_prol%mv_from(acsr1)
endif !!$ endif
call op_prol%set_ncols(p%desc_ac%get_local_cols()) !!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
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(acoo)
nzl = acoo%get_nzeros() !!$ nzl = acoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') !!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) !!$ call acoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) !!$ if (info == psb_success_) call op_restr%mv_from(acoo)
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,&
& a_err='Converting op_restr to local') !!$ & a_err='Converting op_restr to local')
goto 9999 !!$ goto 9999
end if !!$ end if
end if !!$ end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& !!$ & write(debug_unit,*) me,' ',trim(name),&
& 'Done ac ' !!$ & 'Done ac '
!!$
case(mld_repl_mat_) !!$ case(mld_repl_mat_)
! !!$ !
! !!$ !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) !!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) !!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
if (info /= psb_success_) goto 9999 !!$ if (info /= psb_success_) goto 9999
!!$
case default !!$ case default
info = psb_err_internal_error_ !!$ info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') !!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ call p%ac%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') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
! !!$ !
! Copy the prolongation/restriction matrices into the descriptor map. !!$ ! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator !!$ ! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator !!$ ! op_prol => PR i.e. prolongation operator
! !!$ !
!!$
p%map = psb_linmap(psb_map_aggr_,desc_a,& !!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) !!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -363,149 +363,149 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_ !!$ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& !!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle) !!$ & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& !!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) !!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
nlaggr(me+1) = op_restr%get_nrows() !!$ nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then !!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_ !!$ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') !!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_sum(ictxt,nlaggr) !!$ call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr) !!$ ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols() !!$ ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& !!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
& op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() !!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols()
! !!$ !
! Compute local part of AC !!$ ! Compute local part of AC
! !!$ !
call op_prol%clone(am2,info) !!$ call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& !!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free() !!$ if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info) !!$ 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
end if !!$ end if
call psb_sphalo(am3,desc_a,am4,info,& !!$ call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am3,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='Extend am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_spspmm(op_restr,am3,ac,info) !!$ call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call am3%free() !!$ if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
select case(p%parms%coarse_mat) !!$ select case(p%parms%coarse_mat)
!!$
case(mld_distr_mat_) !!$ case(mld_distr_mat_)
!!$
call ac%mv_to(bcoo) !!$ call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros() !!$ nzl = bcoo%get_nzeros()
!!$
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) !!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%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 p%desc_ac and converting ac') !!$ & a_err='Creating p%desc_ac and converting ac')
goto 9999 !!$ goto 9999
end if !!$ end if
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 p%ac%mv_from(bcoo) !!$ call p%ac%mv_from(bcoo)
!!$
call p%ac%set_nrows(p%desc_ac%get_local_rows()) !!$ call p%ac%set_nrows(p%desc_ac%get_local_rows())
call p%ac%set_ncols(p%desc_ac%get_local_cols()) !!$ call p%ac%set_ncols(p%desc_ac%get_local_cols())
call p%ac%set_asb() !!$ call p%ac%set_asb()
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (np>1) then !!$ if (np>1) then
call op_prol%mv_to(acsr1) !!$ call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros() !!$ nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') !!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999 !!$ goto 9999
end if !!$ end if
call op_prol%mv_from(acsr1) !!$ call op_prol%mv_from(acsr1)
endif !!$ endif
call op_prol%set_ncols(p%desc_ac%get_local_cols()) !!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
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(acoo)
nzl = acoo%get_nzeros() !!$ nzl = acoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') !!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) !!$ call acoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) !!$ if (info == psb_success_) call op_restr%mv_from(acoo)
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,&
& a_err='Converting op_restr to local') !!$ & a_err='Converting op_restr to local')
goto 9999 !!$ goto 9999
end if !!$ end if
end if !!$ end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& !!$ & write(debug_unit,*) me,' ',trim(name),&
& 'Done ac ' !!$ & 'Done ac '
!!$
case(mld_repl_mat_) !!$ case(mld_repl_mat_)
! !!$ !
! !!$ !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) !!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) !!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
if (info /= psb_success_) goto 9999 !!$ if (info /= psb_success_) goto 9999
!!$
case default !!$ case default
info = psb_err_internal_error_ !!$ info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') !!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ call p%ac%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') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
! !!$ !
! Copy the prolongation/restriction matrices into the descriptor map. !!$ ! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator !!$ ! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator !!$ ! op_prol => PR i.e. prolongation operator
! !!$ !
!!$
p%map = psb_linmap(psb_map_aggr_,desc_a,& !!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) !!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -363,149 +363,149 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_ !!$ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& !!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle) !!$ & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& !!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) !!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
nlaggr(me+1) = op_restr%get_nrows() !!$ nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then !!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_ !!$ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') !!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_sum(ictxt,nlaggr) !!$ call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr) !!$ ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols() !!$ ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& !!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
& op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() !!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols()
! !!$ !
! Compute local part of AC !!$ ! Compute local part of AC
! !!$ !
call op_prol%clone(am2,info) !!$ call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& !!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free() !!$ if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info) !!$ 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
end if !!$ end if
call psb_sphalo(am3,desc_a,am4,info,& !!$ call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am3,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='Extend am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_spspmm(op_restr,am3,ac,info) !!$ call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call am3%free() !!$ if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
select case(p%parms%coarse_mat) !!$ select case(p%parms%coarse_mat)
!!$
case(mld_distr_mat_) !!$ case(mld_distr_mat_)
!!$
call ac%mv_to(bcoo) !!$ call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros() !!$ nzl = bcoo%get_nzeros()
!!$
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) !!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%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 p%desc_ac and converting ac') !!$ & a_err='Creating p%desc_ac and converting ac')
goto 9999 !!$ goto 9999
end if !!$ end if
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 p%ac%mv_from(bcoo) !!$ call p%ac%mv_from(bcoo)
!!$
call p%ac%set_nrows(p%desc_ac%get_local_rows()) !!$ call p%ac%set_nrows(p%desc_ac%get_local_rows())
call p%ac%set_ncols(p%desc_ac%get_local_cols()) !!$ call p%ac%set_ncols(p%desc_ac%get_local_cols())
call p%ac%set_asb() !!$ call p%ac%set_asb()
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (np>1) then !!$ if (np>1) then
call op_prol%mv_to(acsr1) !!$ call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros() !!$ nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') !!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999 !!$ goto 9999
end if !!$ end if
call op_prol%mv_from(acsr1) !!$ call op_prol%mv_from(acsr1)
endif !!$ endif
call op_prol%set_ncols(p%desc_ac%get_local_cols()) !!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
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(acoo)
nzl = acoo%get_nzeros() !!$ nzl = acoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') !!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) !!$ call acoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) !!$ if (info == psb_success_) call op_restr%mv_from(acoo)
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,&
& a_err='Converting op_restr to local') !!$ & a_err='Converting op_restr to local')
goto 9999 !!$ goto 9999
end if !!$ end if
end if !!$ end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& !!$ & write(debug_unit,*) me,' ',trim(name),&
& 'Done ac ' !!$ & 'Done ac '
!!$
case(mld_repl_mat_) !!$ case(mld_repl_mat_)
! !!$ !
! !!$ !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) !!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) !!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
if (info /= psb_success_) goto 9999 !!$ if (info /= psb_success_) goto 9999
!!$
case default !!$ case default
info = psb_err_internal_error_ !!$ info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') !!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ call p%ac%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') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
! !!$ !
! Copy the prolongation/restriction matrices into the descriptor map. !!$ ! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator !!$ ! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator !!$ ! op_prol => PR i.e. prolongation operator
! !!$ !
!!$
p%map = psb_linmap(psb_map_aggr_,desc_a,& !!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) !!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

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

@ -363,149 +363,149 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_ !!$ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& !!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle) !!$ & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& !!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) !!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
nlaggr(me+1) = op_restr%get_nrows() !!$ nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then !!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_ !!$ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') !!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_sum(ictxt,nlaggr) !!$ call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr) !!$ ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols() !!$ ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& !!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
& op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() !!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols()
! !!$ !
! Compute local part of AC !!$ ! Compute local part of AC
! !!$ !
call op_prol%clone(am2,info) !!$ call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& !!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free() !!$ if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info) !!$ 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
end if !!$ end if
call psb_sphalo(am3,desc_a,am4,info,& !!$ call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) !!$ & colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) !!$ if (info == psb_success_) call psb_rwextd(ncol,am3,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='Extend am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_spspmm(op_restr,am3,ac,info) !!$ call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call am3%free() !!$ if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') !!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
select case(p%parms%coarse_mat) !!$ select case(p%parms%coarse_mat)
!!$
case(mld_distr_mat_) !!$ case(mld_distr_mat_)
!!$
call ac%mv_to(bcoo) !!$ call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros() !!$ nzl = bcoo%get_nzeros()
!!$
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) !!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I')
if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') !!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%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 p%desc_ac and converting ac') !!$ & a_err='Creating p%desc_ac and converting ac')
goto 9999 !!$ goto 9999
end if !!$ end if
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 p%ac%mv_from(bcoo) !!$ call p%ac%mv_from(bcoo)
!!$
call p%ac%set_nrows(p%desc_ac%get_local_rows()) !!$ call p%ac%set_nrows(p%desc_ac%get_local_rows())
call p%ac%set_ncols(p%desc_ac%get_local_cols()) !!$ call p%ac%set_ncols(p%desc_ac%get_local_cols())
call p%ac%set_asb() !!$ call p%ac%set_asb()
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
if (np>1) then !!$ if (np>1) then
call op_prol%mv_to(acsr1) !!$ call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros() !!$ nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') !!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999 !!$ goto 9999
end if !!$ end if
call op_prol%mv_from(acsr1) !!$ call op_prol%mv_from(acsr1)
endif !!$ endif
call op_prol%set_ncols(p%desc_ac%get_local_cols()) !!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
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(acoo)
nzl = acoo%get_nzeros() !!$ nzl = acoo%get_nzeros()
if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') !!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I')
call acoo%set_dupl(psb_dupl_add_) !!$ call acoo%set_dupl(psb_dupl_add_)
if (info == psb_success_) call op_restr%mv_from(acoo) !!$ if (info == psb_success_) call op_restr%mv_from(acoo)
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,&
& a_err='Converting op_restr to local') !!$ & a_err='Converting op_restr to local')
goto 9999 !!$ goto 9999
end if !!$ end if
end if !!$ end if
call op_restr%set_nrows(p%desc_ac%get_local_cols()) !!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& !!$ & write(debug_unit,*) me,' ',trim(name),&
& 'Done ac ' !!$ & 'Done ac '
!!$
case(mld_repl_mat_) !!$ case(mld_repl_mat_)
! !!$ !
! !!$ !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) !!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(p%desc_ac,info) !!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info)
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) !!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
if (info /= psb_success_) goto 9999 !!$ if (info /= psb_success_) goto 9999
!!$
case default !!$ case default
info = psb_err_internal_error_ !!$ info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') !!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) !!$ call p%ac%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') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
! !!$ !
! Copy the prolongation/restriction matrices into the descriptor map. !!$ ! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator !!$ ! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator !!$ ! op_prol => PR i.e. prolongation operator
! !!$ !
!!$
p%map = psb_linmap(psb_map_aggr_,desc_a,& !!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) !!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999 !!$ goto 9999
end if !!$ end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

2
mlprec/impl/solver/mld_c_mumps_solver_apply.F90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine c_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)

2
mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -59,7 +59,7 @@ subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_mumps_solver_apply_vect' character(len=20) :: name='c_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_c_mumps_solver_bld.F90
Unescape Escape View File

@ -63,7 +63,7 @@
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level
character(len=20) :: name='c_mumps_solver_bld', ch_err character(len=20) :: name='c_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info=psb_success_ info=psb_success_

2
mlprec/impl/solver/mld_d_mumps_solver_apply.F90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine d_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)

2
mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -59,7 +59,7 @@ subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_mumps_solver_apply_vect' character(len=20) :: name='d_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_d_mumps_solver_bld.F90
Unescape Escape View File

@ -63,7 +63,7 @@
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level
character(len=20) :: name='d_mumps_solver_bld', ch_err character(len=20) :: name='d_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info=psb_success_ info=psb_success_

2
mlprec/impl/solver/mld_s_mumps_solver_apply.F90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine s_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)

2
mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -59,7 +59,7 @@ subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_mumps_solver_apply_vect' character(len=20) :: name='s_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_s_mumps_solver_bld.F90
Unescape Escape View File

@ -63,7 +63,7 @@
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level
character(len=20) :: name='s_mumps_solver_bld', ch_err character(len=20) :: name='s_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info=psb_success_ info=psb_success_

2
mlprec/impl/solver/mld_z_mumps_solver_apply.F90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine z_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_ info = psb_success_
trans_ = psb_toupper(trans) trans_ = psb_toupper(trans)
select case(trans_) select case(trans_)

2
mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90
Unescape Escape View File

@ -59,7 +59,7 @@ subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='z_mumps_solver_apply_vect' character(len=20) :: name='z_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_z_mumps_solver_bld.F90
Unescape Escape View File

@ -63,7 +63,7 @@
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level
character(len=20) :: name='z_mumps_solver_bld', ch_err character(len=20) :: name='z_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_) #if defined(HAVE_MUMPS_) && !defined(LPK8)
info=psb_success_ info=psb_success_

4
mlprec/mld_c_mumps_solver.F90
Unescape Escape View File

@ -55,7 +55,7 @@ module mld_c_mumps_solver
#endif #endif
use mld_c_base_solver_mod use mld_c_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_c_base_solver_type) :: mld_c_mumps_solver_type type, extends(mld_c_base_solver_type) :: mld_c_mumps_solver_type
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize ! val = val + sv%numsize
return return
end function c_mumps_solver_sizeof end function c_mumps_solver_sizeof
#endif
function c_mumps_get_fmt() result(val) function c_mumps_get_fmt() result(val)
implicit none implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_ val = mld_mumps_
end function c_mumps_get_id end function c_mumps_get_id
#endif
end module mld_c_mumps_solver end module mld_c_mumps_solver

2
mlprec/mld_c_slu_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_c_slu_solver
use iso_c_binding use iso_c_binding
use mld_c_base_solver_mod use mld_c_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_c_base_solver_type) :: mld_c_slu_solver_type type, extends(mld_c_base_solver_type) :: mld_c_slu_solver_type

4
mlprec/mld_d_mumps_solver.F90
Unescape Escape View File

@ -55,7 +55,7 @@ module mld_d_mumps_solver
#endif #endif
use mld_d_base_solver_mod use mld_d_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_d_base_solver_type) :: mld_d_mumps_solver_type type, extends(mld_d_base_solver_type) :: mld_d_mumps_solver_type
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize ! val = val + sv%numsize
return return
end function d_mumps_solver_sizeof end function d_mumps_solver_sizeof
#endif
function d_mumps_get_fmt() result(val) function d_mumps_get_fmt() result(val)
implicit none implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_ val = mld_mumps_
end function d_mumps_get_id end function d_mumps_get_id
#endif
end module mld_d_mumps_solver end module mld_d_mumps_solver

2
mlprec/mld_d_slu_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_d_slu_solver
use iso_c_binding use iso_c_binding
use mld_d_base_solver_mod use mld_d_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_d_base_solver_type) :: mld_d_slu_solver_type type, extends(mld_d_base_solver_type) :: mld_d_slu_solver_type

2
mlprec/mld_d_sludist_solver.F90
Unescape Escape View File

@ -52,7 +52,7 @@ module mld_d_sludist_solver
use iso_c_binding use iso_c_binding
use mld_d_base_solver_mod use mld_d_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_d_base_solver_type) :: mld_d_sludist_solver_type type, extends(mld_d_base_solver_type) :: mld_d_sludist_solver_type

2
mlprec/mld_d_umf_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_d_umf_solver
use iso_c_binding use iso_c_binding
use mld_d_base_solver_mod use mld_d_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_d_base_solver_type) :: mld_d_umf_solver_type type, extends(mld_d_base_solver_type) :: mld_d_umf_solver_type
end type mld_d_umf_solver_type end type mld_d_umf_solver_type

4
mlprec/mld_s_mumps_solver.F90
Unescape Escape View File

@ -55,7 +55,7 @@ module mld_s_mumps_solver
#endif #endif
use mld_s_base_solver_mod use mld_s_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_s_base_solver_type) :: mld_s_mumps_solver_type type, extends(mld_s_base_solver_type) :: mld_s_mumps_solver_type
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize ! val = val + sv%numsize
return return
end function s_mumps_solver_sizeof end function s_mumps_solver_sizeof
#endif
function s_mumps_get_fmt() result(val) function s_mumps_get_fmt() result(val)
implicit none implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_ val = mld_mumps_
end function s_mumps_get_id end function s_mumps_get_id
#endif
end module mld_s_mumps_solver end module mld_s_mumps_solver

2
mlprec/mld_s_slu_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_s_slu_solver
use iso_c_binding use iso_c_binding
use mld_s_base_solver_mod use mld_s_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_s_base_solver_type) :: mld_s_slu_solver_type type, extends(mld_s_base_solver_type) :: mld_s_slu_solver_type

4
mlprec/mld_z_mumps_solver.F90
Unescape Escape View File

@ -55,7 +55,7 @@ module mld_z_mumps_solver
#endif #endif
use mld_z_base_solver_mod use mld_z_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_z_base_solver_type) :: mld_z_mumps_solver_type type, extends(mld_z_base_solver_type) :: mld_z_mumps_solver_type
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize ! val = val + sv%numsize
return return
end function z_mumps_solver_sizeof end function z_mumps_solver_sizeof
#endif
function z_mumps_get_fmt() result(val) function z_mumps_get_fmt() result(val)
implicit none implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_ val = mld_mumps_
end function z_mumps_get_id end function z_mumps_get_id
#endif
end module mld_z_mumps_solver end module mld_z_mumps_solver

2
mlprec/mld_z_slu_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_z_slu_solver
use iso_c_binding use iso_c_binding
use mld_z_base_solver_mod use mld_z_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_z_base_solver_type) :: mld_z_slu_solver_type type, extends(mld_z_base_solver_type) :: mld_z_slu_solver_type

2
mlprec/mld_z_sludist_solver.F90
Unescape Escape View File

@ -52,7 +52,7 @@ module mld_z_sludist_solver
use iso_c_binding use iso_c_binding
use mld_z_base_solver_mod use mld_z_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_z_base_solver_type) :: mld_z_sludist_solver_type type, extends(mld_z_base_solver_type) :: mld_z_sludist_solver_type

2
mlprec/mld_z_umf_solver.F90
Unescape Escape View File

@ -51,7 +51,7 @@ module mld_z_umf_solver
use iso_c_binding use iso_c_binding
use mld_z_base_solver_mod use mld_z_base_solver_mod
#if defined(LONG_INTEGERS) #if defined(LPK8)
type, extends(mld_z_base_solver_type) :: mld_z_umf_solver_type type, extends(mld_z_base_solver_type) :: mld_z_umf_solver_type
end type mld_z_umf_solver_type end type mld_z_umf_solver_type

2
tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90
Unescape Escape View File

@ -147,7 +147,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
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
integer(psb_ipk_) :: nzl,ntaggr integer(psb_ipk_) :: nzl,ntaggr

2
tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr
type(bcm_CSRMatrix) :: C, P type(bcm_CSRMatrix) :: C, P
integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_mpik_) :: ictxt, np, me integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act, ierr integer(psb_ipk_) :: err_act, ierr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols

Write Preview
Loading…
Cancel
Save