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
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_csr_sparse_mat) :: acsr1
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
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr
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
type(psb_cspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr
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
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_csr_sparse_mat) :: acsr1
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
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr
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
type(psb_dspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr
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
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_csr_sparse_mat) :: acsr1
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
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr
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
type(psb_sspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr
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
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_csr_sparse_mat) :: acsr1
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
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr
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
type(psb_zspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpik_) :: ictxt, np, me
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ntaggr, nr
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
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_cspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
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
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_cspmat_type) :: ac, op_restr
type(psb_c_coo_sparse_mat) :: acoo, bcoo
type(psb_c_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl, ntaggr
type(psb_lcspmat_type) :: lac, op_restr
type(psb_cspmat_type) :: ac
type(psb_lc_coo_sparse_mat) :: acoo, bcoo
type(psb_lc_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
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
! 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
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
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_dspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
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
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_dspmat_type) :: ac, op_restr
type(psb_d_coo_sparse_mat) :: acoo, bcoo
type(psb_d_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl, ntaggr
type(psb_ldspmat_type) :: lac, op_restr
type(psb_dspmat_type) :: ac
type(psb_ld_coo_sparse_mat) :: acoo, bcoo
type(psb_ld_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
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
! 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
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
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_sspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
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
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_sspmat_type) :: ac, op_restr
type(psb_s_coo_sparse_mat) :: acoo, bcoo
type(psb_s_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl, ntaggr
type(psb_lsspmat_type) :: lac, op_restr
type(psb_sspmat_type) :: ac
type(psb_ls_coo_sparse_mat) :: acoo, bcoo
type(psb_ls_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
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
! 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
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
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_zspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
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
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_zspmat_type) :: ac, op_restr
type(psb_z_coo_sparse_mat) :: acoo, bcoo
type(psb_z_csr_sparse_mat) :: acsr1
integer(psb_ipk_) :: nzl, ntaggr
type(psb_lzspmat_type) :: lac, op_restr
type(psb_zspmat_type) :: ac
type(psb_lz_coo_sparse_mat) :: acoo, bcoo
type(psb_lz_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl, ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
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
! 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
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))
nlaggr = 0
ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
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()
!
! Compute local part of AC
!
call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
end if
call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)
if (info == psb_success_) call am4%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999
end if
call psb_spspmm(op_restr,am3,ac,info)
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_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999
end if
select case(p%parms%coarse_mat)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
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_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_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_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating p%desc_ac and converting ac')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call p%ac%mv_from(bcoo)
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_asb()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999
end if
if (np>1) then
call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999
end if
call op_prol%mv_from(acsr1)
endif
call op_prol%set_ncols(p%desc_ac%get_local_cols())
if (np>1) then
call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo)
nzl = acoo%get_nzeros()
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_)
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_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Converting op_restr to local')
goto 9999
end if
end if
call op_restr%set_nrows(p%desc_ac%get_local_cols())
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done ac '
case(mld_repl_mat_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999
case default
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999
end select
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999
end if
!
! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
!!$ p%parms%par_aggr_alg = mld_ext_aggr_
!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
!!$ & mld_mult_ml_,is_legal_ml_cycle)
!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
!!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
!!$ nlaggr(me+1) = op_restr%get_nrows()
!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
!!$ info=psb_err_internal_error_
!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
!!$ goto 9999
!!$ end if
!!$ call psb_sum(ictxt,nlaggr)
!!$ ntaggr = sum(nlaggr)
!!$ ncol = desc_a%get_local_cols()
!!$ 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()
!!$ !
!!$ ! Compute local part of AC
!!$ !
!!$ call op_prol%clone(am2,info)
!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
!!$ & colcnv=.false.,rowscale=.true.)
!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
!!$ if (info == psb_success_) call am4%free()
!!$ call psb_spspmm(a,am2,am3,info)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
!!$ goto 9999
!!$ end if
!!$ call psb_sphalo(am3,desc_a,am4,info,&
!!$ & colcnv=.false.,rowscale=.true.)
!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)
!!$ if (info == psb_success_) call am4%free()
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
!!$ goto 9999
!!$ end if
!!$ call psb_spspmm(op_restr,am3,ac,info)
!!$ 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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
!!$ goto 9999
!!$ end if
!!$
!!$ select case(p%parms%coarse_mat)
!!$
!!$ case(mld_distr_mat_)
!!$
!!$ call ac%mv_to(bcoo)
!!$ 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_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_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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,&
!!$ & a_err='Creating p%desc_ac and converting ac')
!!$ goto 9999
!!$ end if
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),&
!!$ & 'Assembld aux descr. distr.'
!!$ call p%ac%mv_from(bcoo)
!!$
!!$ 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_asb()
!!$
!!$ if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
!!$ goto 9999
!!$ end if
!!$
!!$ if (np>1) then
!!$ call op_prol%mv_to(acsr1)
!!$ nzl = acsr1%get_nzeros()
!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
!!$ goto 9999
!!$ end if
!!$ call op_prol%mv_from(acsr1)
!!$ endif
!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
!!$ if (np>1) then
!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
!!$ call op_restr%mv_to(acoo)
!!$ nzl = acoo%get_nzeros()
!!$ 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_)
!!$ 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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,&
!!$ & a_err='Converting op_restr to local')
!!$ goto 9999
!!$ end if
!!$ end if
!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),&
!!$ & 'Done ac '
!!$
!!$ case(mld_repl_mat_)
!!$ !
!!$ !
!!$ 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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ case default
!!$ info = psb_err_internal_error_
!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
!!$ goto 9999
!!$ end select
!!$
!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
!!$ goto 9999
!!$ end if
!!$
!!$ !
!!$ ! Copy the prolongation/restriction matrices into the descriptor map.
!!$ ! op_restr => PR^T i.e. restriction operator
!!$ ! op_prol => PR i.e. prolongation operator
!!$ !
!!$
!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
!!$ goto 9999
!!$ end if
call psb_erractionrestore(err_act)
return

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

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

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

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

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

@ -363,149 +363,149 @@ contains
allocate(nlaggr(np),ilaggr(1))
nlaggr = 0
ilaggr = 0
p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat)
nlaggr(me+1) = op_restr%get_nrows()
if (op_restr%get_nrows() /= op_prol%get_ncols()) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
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()
!
! Compute local part of AC
!
call op_prol%clone(am2,info)
if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
if (info == psb_success_) call am4%free()
call psb_spspmm(a,am2,am3,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999
end if
call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.)
if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)
if (info == psb_success_) call am4%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
goto 9999
end if
call psb_spspmm(op_restr,am3,ac,info)
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_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
goto 9999
end if
select case(p%parms%coarse_mat)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
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_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_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_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Creating p%desc_ac and converting ac')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call p%ac%mv_from(bcoo)
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_asb()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
goto 9999
end if
if (np>1) then
call op_prol%mv_to(acsr1)
nzl = acsr1%get_nzeros()
call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
goto 9999
end if
call op_prol%mv_from(acsr1)
endif
call op_prol%set_ncols(p%desc_ac%get_local_cols())
if (np>1) then
call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
call op_restr%mv_to(acoo)
nzl = acoo%get_nzeros()
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_)
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_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Converting op_restr to local')
goto 9999
end if
end if
call op_restr%set_nrows(p%desc_ac%get_local_cols())
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done ac '
case(mld_repl_mat_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
if (info /= psb_success_) goto 9999
case default
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
goto 9999
end select
call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
goto 9999
end if
!
! Copy the prolongation/restriction matrices into the descriptor map.
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
!!$ p%parms%par_aggr_alg = mld_ext_aggr_
!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
!!$ & mld_mult_ml_,is_legal_ml_cycle)
!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
!!$ & mld_distr_mat_,is_legal_ml_coarse_mat)
!!$
!!$ nlaggr(me+1) = op_restr%get_nrows()
!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then
!!$ info=psb_err_internal_error_
!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes')
!!$ goto 9999
!!$ end if
!!$ call psb_sum(ictxt,nlaggr)
!!$ ntaggr = sum(nlaggr)
!!$ ncol = desc_a%get_local_cols()
!!$ 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()
!!$ !
!!$ ! Compute local part of AC
!!$ !
!!$ call op_prol%clone(am2,info)
!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,&
!!$ & colcnv=.false.,rowscale=.true.)
!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4)
!!$ if (info == psb_success_) call am4%free()
!!$ call psb_spspmm(a,am2,am3,info)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
!!$ goto 9999
!!$ end if
!!$ call psb_sphalo(am3,desc_a,am4,info,&
!!$ & colcnv=.false.,rowscale=.true.)
!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4)
!!$ if (info == psb_success_) call am4%free()
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3')
!!$ goto 9999
!!$ end if
!!$ call psb_spspmm(op_restr,am3,ac,info)
!!$ 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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3')
!!$ goto 9999
!!$ end if
!!$
!!$ select case(p%parms%coarse_mat)
!!$
!!$ case(mld_distr_mat_)
!!$
!!$ call ac%mv_to(bcoo)
!!$ 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_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_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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,&
!!$ & a_err='Creating p%desc_ac and converting ac')
!!$ goto 9999
!!$ end if
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),&
!!$ & 'Assembld aux descr. distr.'
!!$ call p%ac%mv_from(bcoo)
!!$
!!$ 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_asb()
!!$
!!$ if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free')
!!$ goto 9999
!!$ end if
!!$
!!$ if (np>1) then
!!$ call op_prol%mv_to(acsr1)
!!$ nzl = acsr1%get_nzeros()
!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I')
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc')
!!$ goto 9999
!!$ end if
!!$ call op_prol%mv_from(acsr1)
!!$ endif
!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols())
!!$
!!$ if (np>1) then
!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_)
!!$ call op_restr%mv_to(acoo)
!!$ nzl = acoo%get_nzeros()
!!$ 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_)
!!$ 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_) then
!!$ call psb_errpush(psb_err_internal_error_,name,&
!!$ & a_err='Converting op_restr to local')
!!$ goto 9999
!!$ end if
!!$ end if
!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols())
!!$
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),&
!!$ & 'Done ac '
!!$
!!$ case(mld_repl_mat_)
!!$ !
!!$ !
!!$ 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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
!!$
!!$ if (info /= psb_success_) goto 9999
!!$
!!$ case default
!!$ info = psb_err_internal_error_
!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_')
!!$ goto 9999
!!$ end select
!!$
!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv')
!!$ goto 9999
!!$ end if
!!$
!!$ !
!!$ ! Copy the prolongation/restriction matrices into the descriptor map.
!!$ ! op_restr => PR^T i.e. restriction operator
!!$ ! op_prol => PR i.e. prolongation operator
!!$ !
!!$
!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,&
!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
!!$ if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
!!$ goto 9999
!!$ end if
call psb_erractionrestore(err_act)
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)
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_
trans_ = psb_toupper(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
character(len=20) :: name='c_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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
character(len=20) :: name='c_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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)
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_
trans_ = psb_toupper(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
character(len=20) :: name='d_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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
character(len=20) :: name='d_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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)
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_
trans_ = psb_toupper(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
character(len=20) :: name='s_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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
character(len=20) :: name='s_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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)
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
info = psb_success_
trans_ = psb_toupper(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
character(len=20) :: name='z_mumps_solver_apply_vect'
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
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
character(len=20) :: name='z_mumps_solver_bld', ch_err
#if defined(HAVE_MUMPS_)
#if defined(HAVE_MUMPS_) && !defined(LPK8)
info=psb_success_

4
mlprec/mld_c_mumps_solver.F90
Unescape Escape View File

@ -55,7 +55,7 @@ module mld_c_mumps_solver
#endif
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
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize
return
end function c_mumps_solver_sizeof
#endif
function c_mumps_get_fmt() result(val)
implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_
end function c_mumps_get_id
#endif
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 mld_c_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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
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
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize
return
end function d_mumps_solver_sizeof
#endif
function d_mumps_get_fmt() result(val)
implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_
end function d_mumps_get_id
#endif
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 mld_d_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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 mld_d_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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 mld_d_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
type, extends(mld_d_base_solver_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
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
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize
return
end function s_mumps_solver_sizeof
#endif
function s_mumps_get_fmt() result(val)
implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_
end function s_mumps_get_id
#endif
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 mld_s_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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
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
@ -480,7 +480,6 @@ contains
! val = val + sv%numsize
return
end function z_mumps_solver_sizeof
#endif
function z_mumps_get_fmt() result(val)
implicit none
@ -495,6 +494,7 @@ contains
val = mld_mumps_
end function z_mumps_get_id
#endif
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 mld_z_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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 mld_z_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
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 mld_z_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LPK8)
type, extends(mld_z_base_solver_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
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_csr_sparse_mat) :: acsr1
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
integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
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_) :: debug_level, debug_unit
integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols

Write Preview
Loading…
Cancel
Save