Fix name of CTXT variable

merge-amgext
Salvatore Filippone 4 years ago
parent c14ce5409e
commit b751d726a1

@ -1050,49 +1050,49 @@ contains
end function pr_to_str end function pr_to_str
subroutine amg_ml_bcast(ictxt,dat,root) subroutine amg_ml_bcast(ctxt,dat,root)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat type(amg_ml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%sweeps_pre,root) call psb_bcast(ctxt,dat%sweeps_pre,root)
call psb_bcast(ictxt,dat%sweeps_post,root) call psb_bcast(ctxt,dat%sweeps_post,root)
call psb_bcast(ictxt,dat%ml_cycle,root) call psb_bcast(ctxt,dat%ml_cycle,root)
call psb_bcast(ictxt,dat%aggr_type,root) call psb_bcast(ctxt,dat%aggr_type,root)
call psb_bcast(ictxt,dat%par_aggr_alg,root) call psb_bcast(ctxt,dat%par_aggr_alg,root)
call psb_bcast(ictxt,dat%aggr_ord,root) call psb_bcast(ctxt,dat%aggr_ord,root)
call psb_bcast(ictxt,dat%aggr_prol,root) call psb_bcast(ctxt,dat%aggr_prol,root)
call psb_bcast(ictxt,dat%aggr_omega_alg,root) call psb_bcast(ctxt,dat%aggr_omega_alg,root)
call psb_bcast(ictxt,dat%aggr_eig,root) call psb_bcast(ctxt,dat%aggr_eig,root)
call psb_bcast(ictxt,dat%aggr_filter,root) call psb_bcast(ctxt,dat%aggr_filter,root)
call psb_bcast(ictxt,dat%coarse_mat,root) call psb_bcast(ctxt,dat%coarse_mat,root)
call psb_bcast(ictxt,dat%coarse_solve,root) call psb_bcast(ctxt,dat%coarse_solve,root)
end subroutine amg_ml_bcast end subroutine amg_ml_bcast
subroutine amg_sml_bcast(ictxt,dat,root) subroutine amg_sml_bcast(ctxt,dat,root)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat type(amg_sml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root) call psb_bcast(ctxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root) call psb_bcast(ctxt,dat%aggr_thresh,root)
end subroutine amg_sml_bcast end subroutine amg_sml_bcast
subroutine amg_dml_bcast(ictxt,dat,root) subroutine amg_dml_bcast(ctxt,dat,root)
implicit none implicit none
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat type(amg_dml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root) call psb_bcast(ctxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root) call psb_bcast(ctxt,dat%aggr_thresh,root)
end subroutine amg_dml_bcast end subroutine amg_dml_bcast
subroutine ml_parms_clone(pm,pmout,info) subroutine ml_parms_clone(pm,pmout,info)

@ -82,7 +82,7 @@ module amg_c_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS) ! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric ! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false. logical :: built = .false.
contains contains
procedure, pass(sv) :: build => c_mumps_solver_bld procedure, pass(sv) :: build => c_mumps_solver_bld
@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
end if end if
deallocate(sv%id, stat=info) deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ictxt,close=.false.) call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ictxt,stat=info) deallocate(sv%local_ctxt,stat=info)
end if end if
sv%built=.false. sv%built=.false.
end if end if
@ -325,7 +325,8 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse)
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr' character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_

@ -57,7 +57,8 @@ module amg_c_prec_type
use amg_c_base_smoother_mod use amg_c_base_smoother_mod
use amg_c_base_aggregator_mod use amg_c_base_aggregator_mod
use amg_c_onelev_mod use amg_c_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, &
& psb_errstatus_fatal, psb_ctxt_type
use psb_prec_mod, only : psb_cprec_type use psb_prec_mod, only : psb_cprec_type
! !
@ -85,7 +86,6 @@ module amg_c_prec_type
integer, parameter, private :: wv_size_=4 integer, parameter, private :: wv_size_=4
type, extends(psb_cprec_type) :: amg_cprec_type type, extends(psb_cprec_type) :: amg_cprec_type
! integer(psb_ipk_) :: ictxt ! Now it's in the PSBLAS prec.
type(amg_saggr_data) :: ag_data type(amg_saggr_data) :: ag_data
! !
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@ -272,10 +272,10 @@ module amg_c_prec_type
end interface end interface
interface amg_precinit interface amg_precinit
subroutine amg_cprecinit(ictxt,prec,ptype,info) subroutine amg_cprecinit(ctxt,prec,ptype,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& amg_cprec_type, psb_ipk_ & amg_cprec_type, psb_ipk_, psb_ctxt_type
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -460,12 +460,12 @@ contains
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num, den, nmin real(psb_spk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il
num = -sone num = -sone
den = sone den = sone
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
il = 1 il = 1
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
@ -477,13 +477,13 @@ contains
end if end if
end if end if
nmin = num nmin = num
call psb_min(ictxt,nmin) call psb_min(ctxt,nmin)
if (nmin < szero) then if (nmin < szero) then
num = szero num = szero
den = sone den = sone
else else
call psb_sum(ictxt,num) call psb_sum(ctxt,num)
call psb_sum(ictxt,den) call psb_sum(ctxt,den)
end if end if
prec%ag_data%op_complexity = num/den prec%ag_data%op_complexity = num/den
end subroutine amg_c_cmp_compl end subroutine amg_c_cmp_compl
@ -507,13 +507,13 @@ contains
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
real(psb_spk_) :: avgcr real(psb_spk_) :: avgcr
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero avgcr = szero
ictxt = prec%ictxt ctxt = prec%ctxt
call psb_info(ictxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nl = size(prec%precv) nl = size(prec%precv)
do il=2,nl do il=2,nl
@ -521,7 +521,7 @@ contains
end do end do
avgcr = avgcr / (nl-1) avgcr = avgcr / (nl-1)
end if end if
call psb_sum(ictxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_c_cmp_avg_cr end subroutine amg_c_cmp_avg_cr
@ -738,13 +738,14 @@ contains
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_ type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
info = 0 info = 0
icontxt = prec%ictxt icontxt = prec%ctxt
call psb_info(icontxt,iam,np) call psb_info(icontxt,iam,np)
iln = size(prec%precv) iln = size(prec%precv)
@ -811,12 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local vars ! Local vars
integer(psb_ipk_) :: i, j, ln, lev integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_ info = psb_success_
select type(pout => precout) select type(pout => precout)
class is (amg_cprec_type) class is (amg_cprec_type)
pout%ictxt = prec%ictxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -864,7 +866,7 @@ contains
!!$ return !!$ return
endif endif
end if end if
b%ictxt = prec%ictxt b%ctxt = prec%ctxt
b%ag_data = prec%ag_data b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps b%outer_sweeps = prec%outer_sweeps

@ -137,7 +137,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
complex(psb_spk_), pointer :: ww(:) complex(psb_spk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='c_slu_solver_apply' character(len=20) :: name='c_slu_solver_apply'
@ -268,15 +269,16 @@ contains
type(psb_c_csc_sparse_mat) :: acsc type(psb_c_csc_sparse_mat) :: acsc
type(psb_c_coo_sparse_mat) :: acoo type(psb_c_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_slu_solver_bld', ch_err character(len=20) :: name='c_slu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -395,7 +397,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_c_slu_solver_descr' character(len=20), parameter :: name='amg_c_slu_solver_descr'
integer :: iout_ integer :: iout_

@ -82,7 +82,7 @@ module amg_d_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS) ! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric ! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false. logical :: built = .false.
contains contains
procedure, pass(sv) :: build => d_mumps_solver_bld procedure, pass(sv) :: build => d_mumps_solver_bld
@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
end if end if
deallocate(sv%id, stat=info) deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ictxt,close=.false.) call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ictxt,stat=info) deallocate(sv%local_ctxt,stat=info)
end if end if
sv%built=.false. sv%built=.false.
end if end if
@ -325,7 +325,8 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse)
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr' character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_

@ -57,7 +57,8 @@ module amg_d_prec_type
use amg_d_base_smoother_mod use amg_d_base_smoother_mod
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use amg_d_onelev_mod use amg_d_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, &
& psb_errstatus_fatal, psb_ctxt_type
use psb_prec_mod, only : psb_dprec_type use psb_prec_mod, only : psb_dprec_type
! !
@ -85,7 +86,6 @@ module amg_d_prec_type
integer, parameter, private :: wv_size_=4 integer, parameter, private :: wv_size_=4
type, extends(psb_dprec_type) :: amg_dprec_type type, extends(psb_dprec_type) :: amg_dprec_type
! integer(psb_ipk_) :: ictxt ! Now it's in the PSBLAS prec.
type(amg_daggr_data) :: ag_data type(amg_daggr_data) :: ag_data
! !
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@ -272,10 +272,10 @@ module amg_d_prec_type
end interface end interface
interface amg_precinit interface amg_precinit
subroutine amg_dprecinit(ictxt,prec,ptype,info) subroutine amg_dprecinit(ctxt,prec,ptype,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& amg_dprec_type, psb_ipk_ & amg_dprec_type, psb_ipk_, psb_ctxt_type
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -460,12 +460,12 @@ contains
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num, den, nmin real(psb_dpk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
il = 1 il = 1
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
@ -477,13 +477,13 @@ contains
end if end if
end if end if
nmin = num nmin = num
call psb_min(ictxt,nmin) call psb_min(ctxt,nmin)
if (nmin < dzero) then if (nmin < dzero) then
num = dzero num = dzero
den = done den = done
else else
call psb_sum(ictxt,num) call psb_sum(ctxt,num)
call psb_sum(ictxt,den) call psb_sum(ctxt,den)
end if end if
prec%ag_data%op_complexity = num/den prec%ag_data%op_complexity = num/den
end subroutine amg_d_cmp_compl end subroutine amg_d_cmp_compl
@ -507,13 +507,13 @@ contains
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: avgcr real(psb_dpk_) :: avgcr
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero avgcr = dzero
ictxt = prec%ictxt ctxt = prec%ctxt
call psb_info(ictxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nl = size(prec%precv) nl = size(prec%precv)
do il=2,nl do il=2,nl
@ -521,7 +521,7 @@ contains
end do end do
avgcr = avgcr / (nl-1) avgcr = avgcr / (nl-1)
end if end if
call psb_sum(ictxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_d_cmp_avg_cr end subroutine amg_d_cmp_avg_cr
@ -738,13 +738,14 @@ contains
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_ type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
info = 0 info = 0
icontxt = prec%ictxt icontxt = prec%ctxt
call psb_info(icontxt,iam,np) call psb_info(icontxt,iam,np)
iln = size(prec%precv) iln = size(prec%precv)
@ -811,12 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local vars ! Local vars
integer(psb_ipk_) :: i, j, ln, lev integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_ info = psb_success_
select type(pout => precout) select type(pout => precout)
class is (amg_dprec_type) class is (amg_dprec_type)
pout%ictxt = prec%ictxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -864,7 +866,7 @@ contains
!!$ return !!$ return
endif endif
end if end if
b%ictxt = prec%ictxt b%ctxt = prec%ctxt
b%ag_data = prec%ag_data b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps b%outer_sweeps = prec%outer_sweeps

@ -137,7 +137,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:) real(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_slu_solver_apply' character(len=20) :: name='d_slu_solver_apply'
@ -268,15 +269,16 @@ contains
type(psb_d_csc_sparse_mat) :: acsc type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo type(psb_d_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_slu_solver_bld', ch_err character(len=20) :: name='d_slu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -395,7 +397,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_d_slu_solver_descr' character(len=20), parameter :: name='amg_d_slu_solver_descr'
integer :: iout_ integer :: iout_

@ -136,7 +136,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:) real(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_sludist_solver_apply' character(len=20) :: name='d_sludist_solver_apply'
@ -271,15 +272,16 @@ contains
type(psb_d_csr_sparse_mat) :: acsr type(psb_d_csr_sparse_mat) :: acsr
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
integer :: ifrst, ibcheck integer :: ifrst, ibcheck
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_sludist_solver_bld', ch_err character(len=20) :: name='d_sludist_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
npr = np npr = np
npc = 1 npc = 1
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -413,7 +415,8 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer :: me, np
character(len=20), parameter :: name='amg_d_sludist_solver_descr' character(len=20), parameter :: name='amg_d_sludist_solver_descr'
integer :: iout_ integer :: iout_

@ -137,7 +137,7 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:) real(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='d_umf_solver_apply' character(len=20) :: name='d_umf_solver_apply'
@ -271,15 +271,16 @@ contains
type(psb_dspmat_type) :: atmp type(psb_dspmat_type) :: atmp
type(psb_d_csc_sparse_mat) :: acsc type(psb_d_csc_sparse_mat) :: acsc
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_umf_solver_bld', ch_err character(len=20) :: name='d_umf_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -401,7 +402,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_d_umf_solver_descr' character(len=20), parameter :: name='amg_d_umf_solver_descr'
integer :: iout_ integer :: iout_

@ -82,7 +82,7 @@ module amg_s_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS) ! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric ! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false. logical :: built = .false.
contains contains
procedure, pass(sv) :: build => s_mumps_solver_bld procedure, pass(sv) :: build => s_mumps_solver_bld
@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
end if end if
deallocate(sv%id, stat=info) deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ictxt,close=.false.) call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ictxt,stat=info) deallocate(sv%local_ctxt,stat=info)
end if end if
sv%built=.false. sv%built=.false.
end if end if
@ -325,7 +325,8 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse)
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr' character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_

@ -57,7 +57,8 @@ module amg_s_prec_type
use amg_s_base_smoother_mod use amg_s_base_smoother_mod
use amg_s_base_aggregator_mod use amg_s_base_aggregator_mod
use amg_s_onelev_mod use amg_s_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, &
& psb_errstatus_fatal, psb_ctxt_type
use psb_prec_mod, only : psb_sprec_type use psb_prec_mod, only : psb_sprec_type
! !
@ -85,7 +86,6 @@ module amg_s_prec_type
integer, parameter, private :: wv_size_=4 integer, parameter, private :: wv_size_=4
type, extends(psb_sprec_type) :: amg_sprec_type type, extends(psb_sprec_type) :: amg_sprec_type
! integer(psb_ipk_) :: ictxt ! Now it's in the PSBLAS prec.
type(amg_saggr_data) :: ag_data type(amg_saggr_data) :: ag_data
! !
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@ -272,10 +272,10 @@ module amg_s_prec_type
end interface end interface
interface amg_precinit interface amg_precinit
subroutine amg_sprecinit(ictxt,prec,ptype,info) subroutine amg_sprecinit(ctxt,prec,ptype,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, & import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& amg_sprec_type, psb_ipk_ & amg_sprec_type, psb_ipk_, psb_ctxt_type
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_sprec_type), intent(inout) :: prec class(amg_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -460,12 +460,12 @@ contains
class(amg_sprec_type), intent(inout) :: prec class(amg_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num, den, nmin real(psb_spk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il
num = -sone num = -sone
den = sone den = sone
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
il = 1 il = 1
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
@ -477,13 +477,13 @@ contains
end if end if
end if end if
nmin = num nmin = num
call psb_min(ictxt,nmin) call psb_min(ctxt,nmin)
if (nmin < szero) then if (nmin < szero) then
num = szero num = szero
den = sone den = sone
else else
call psb_sum(ictxt,num) call psb_sum(ctxt,num)
call psb_sum(ictxt,den) call psb_sum(ctxt,den)
end if end if
prec%ag_data%op_complexity = num/den prec%ag_data%op_complexity = num/den
end subroutine amg_s_cmp_compl end subroutine amg_s_cmp_compl
@ -507,13 +507,13 @@ contains
class(amg_sprec_type), intent(inout) :: prec class(amg_sprec_type), intent(inout) :: prec
real(psb_spk_) :: avgcr real(psb_spk_) :: avgcr
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero avgcr = szero
ictxt = prec%ictxt ctxt = prec%ctxt
call psb_info(ictxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nl = size(prec%precv) nl = size(prec%precv)
do il=2,nl do il=2,nl
@ -521,7 +521,7 @@ contains
end do end do
avgcr = avgcr / (nl-1) avgcr = avgcr / (nl-1)
end if end if
call psb_sum(ictxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_s_cmp_avg_cr end subroutine amg_s_cmp_avg_cr
@ -738,13 +738,14 @@ contains
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_ type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
info = 0 info = 0
icontxt = prec%ictxt icontxt = prec%ctxt
call psb_info(icontxt,iam,np) call psb_info(icontxt,iam,np)
iln = size(prec%precv) iln = size(prec%precv)
@ -811,12 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local vars ! Local vars
integer(psb_ipk_) :: i, j, ln, lev integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_ info = psb_success_
select type(pout => precout) select type(pout => precout)
class is (amg_sprec_type) class is (amg_sprec_type)
pout%ictxt = prec%ictxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -864,7 +866,7 @@ contains
!!$ return !!$ return
endif endif
end if end if
b%ictxt = prec%ictxt b%ctxt = prec%ctxt
b%ag_data = prec%ag_data b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps b%outer_sweeps = prec%outer_sweeps

@ -137,7 +137,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
real(psb_spk_), pointer :: ww(:) real(psb_spk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='s_slu_solver_apply' character(len=20) :: name='s_slu_solver_apply'
@ -268,15 +269,16 @@ contains
type(psb_s_csc_sparse_mat) :: acsc type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo type(psb_s_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_slu_solver_bld', ch_err character(len=20) :: name='s_slu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -395,7 +397,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_s_slu_solver_descr' character(len=20), parameter :: name='amg_s_slu_solver_descr'
integer :: iout_ integer :: iout_

@ -82,7 +82,7 @@ module amg_z_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS) ! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric ! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false. logical :: built = .false.
contains contains
procedure, pass(sv) :: build => z_mumps_solver_bld procedure, pass(sv) :: build => z_mumps_solver_bld
@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
end if end if
deallocate(sv%id, stat=info) deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ictxt,close=.false.) call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ictxt,stat=info) deallocate(sv%local_ctxt,stat=info)
end if end if
sv%built=.false. sv%built=.false.
end if end if
@ -325,7 +325,8 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse)
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr' character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_

@ -57,7 +57,8 @@ module amg_z_prec_type
use amg_z_base_smoother_mod use amg_z_base_smoother_mod
use amg_z_base_aggregator_mod use amg_z_base_aggregator_mod
use amg_z_onelev_mod use amg_z_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, &
& psb_errstatus_fatal, psb_ctxt_type
use psb_prec_mod, only : psb_zprec_type use psb_prec_mod, only : psb_zprec_type
! !
@ -85,7 +86,6 @@ module amg_z_prec_type
integer, parameter, private :: wv_size_=4 integer, parameter, private :: wv_size_=4
type, extends(psb_zprec_type) :: amg_zprec_type type, extends(psb_zprec_type) :: amg_zprec_type
! integer(psb_ipk_) :: ictxt ! Now it's in the PSBLAS prec.
type(amg_daggr_data) :: ag_data type(amg_daggr_data) :: ag_data
! !
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@ -272,10 +272,10 @@ module amg_z_prec_type
end interface end interface
interface amg_precinit interface amg_precinit
subroutine amg_zprecinit(ictxt,prec,ptype,info) subroutine amg_zprecinit(ctxt,prec,ptype,info)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & import :: psb_zspmat_type, psb_desc_type, psb_dpk_, &
& amg_zprec_type, psb_ipk_ & amg_zprec_type, psb_ipk_, psb_ctxt_type
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_zprec_type), intent(inout) :: prec class(amg_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -460,12 +460,12 @@ contains
class(amg_zprec_type), intent(inout) :: prec class(amg_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num, den, nmin real(psb_dpk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il
num = -done num = -done
den = done den = done
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
il = 1 il = 1
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
@ -477,13 +477,13 @@ contains
end if end if
end if end if
nmin = num nmin = num
call psb_min(ictxt,nmin) call psb_min(ctxt,nmin)
if (nmin < dzero) then if (nmin < dzero) then
num = dzero num = dzero
den = done den = done
else else
call psb_sum(ictxt,num) call psb_sum(ctxt,num)
call psb_sum(ictxt,den) call psb_sum(ctxt,den)
end if end if
prec%ag_data%op_complexity = num/den prec%ag_data%op_complexity = num/den
end subroutine amg_z_cmp_compl end subroutine amg_z_cmp_compl
@ -507,13 +507,13 @@ contains
class(amg_zprec_type), intent(inout) :: prec class(amg_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: avgcr real(psb_dpk_) :: avgcr
integer(psb_ipk_) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero avgcr = dzero
ictxt = prec%ictxt ctxt = prec%ctxt
call psb_info(ictxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nl = size(prec%precv) nl = size(prec%precv)
do il=2,nl do il=2,nl
@ -521,7 +521,7 @@ contains
end do end do
avgcr = avgcr / (nl-1) avgcr = avgcr / (nl-1)
end if end if
call psb_sum(ictxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_z_cmp_avg_cr end subroutine amg_z_cmp_avg_cr
@ -738,13 +738,14 @@ contains
character(len=*), intent(in), optional :: prefix, head character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_ type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_ character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_ ! len of prefix_
info = 0 info = 0
icontxt = prec%ictxt icontxt = prec%ctxt
call psb_info(icontxt,iam,np) call psb_info(icontxt,iam,np)
iln = size(prec%precv) iln = size(prec%precv)
@ -811,12 +812,13 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local vars ! Local vars
integer(psb_ipk_) :: i, j, ln, lev integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_ info = psb_success_
select type(pout => precout) select type(pout => precout)
class is (amg_zprec_type) class is (amg_zprec_type)
pout%ictxt = prec%ictxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
@ -864,7 +866,7 @@ contains
!!$ return !!$ return
endif endif
end if end if
b%ictxt = prec%ictxt b%ctxt = prec%ctxt
b%ag_data = prec%ag_data b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps b%outer_sweeps = prec%outer_sweeps

@ -137,7 +137,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:) complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_slu_solver_apply' character(len=20) :: name='z_slu_solver_apply'
@ -268,15 +269,16 @@ contains
type(psb_z_csc_sparse_mat) :: acsc type(psb_z_csc_sparse_mat) :: acsc
type(psb_z_coo_sparse_mat) :: acoo type(psb_z_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_slu_solver_bld', ch_err character(len=20) :: name='z_slu_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -395,7 +397,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_z_slu_solver_descr' character(len=20), parameter :: name='amg_z_slu_solver_descr'
integer :: iout_ integer :: iout_

@ -136,7 +136,8 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:) complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_sludist_solver_apply' character(len=20) :: name='z_sludist_solver_apply'
@ -271,15 +272,16 @@ contains
type(psb_z_csr_sparse_mat) :: acsr type(psb_z_csr_sparse_mat) :: acsr
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
integer :: ifrst, ibcheck integer :: ifrst, ibcheck
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_sludist_solver_bld', ch_err character(len=20) :: name='z_sludist_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
npr = np npr = np
npc = 1 npc = 1
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
@ -413,7 +415,8 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer :: me, np
character(len=20), parameter :: name='amg_z_sludist_solver_descr' character(len=20), parameter :: name='amg_z_sludist_solver_descr'
integer :: iout_ integer :: iout_

@ -137,7 +137,7 @@ contains
integer :: n_row,n_col integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:) complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act integer(psb_ipk_) :: i, err_act
character :: trans_ character :: trans_
character(len=20) :: name='z_umf_solver_apply' character(len=20) :: name='z_umf_solver_apply'
@ -271,15 +271,16 @@ contains
type(psb_zspmat_type) :: atmp type(psb_zspmat_type) :: atmp
type(psb_z_csc_sparse_mat) :: acsc type(psb_z_csc_sparse_mat) :: acsc
integer :: n_row,n_col, nrow_a, nztota integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_umf_solver_bld', ch_err character(len=20) :: name='z_umf_solver_bld', ch_err
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' & write(debug_unit,*) me,' ',trim(name),' start'
@ -401,7 +402,6 @@ contains
! Local variables ! Local variables
integer :: err_act integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_z_umf_solver_descr' character(len=20), parameter :: name='amg_z_umf_solver_descr'
integer :: iout_ integer :: iout_

@ -97,7 +97,8 @@ subroutine amg_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_lc_coo_sparse_mat) :: tmpcoo type(psb_lc_coo_sparse_mat) :: tmpcoo
type(psb_lcspmat_type) :: tmp_ac type(psb_lcspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
@ -111,8 +112,8 @@ subroutine amg_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
select case(parms%coarse_mat) select case(parms%coarse_mat)
@ -158,7 +159,7 @@ subroutine amg_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
call tmp_ac%mv_to(tmpcoo) call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo) call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -152,7 +152,8 @@ subroutine amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -165,8 +166,8 @@ subroutine amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from

@ -91,7 +91,8 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -105,8 +106,8 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -95,7 +95,8 @@ subroutine amg_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
type(psb_lc_coo_sparse_mat) :: tmpcoo type(psb_lc_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()

@ -63,9 +63,9 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -81,9 +81,8 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -277,9 +276,9 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -295,9 +294,8 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -494,9 +492,9 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_lc_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_lc_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -512,9 +510,8 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -61,9 +61,9 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -78,9 +78,8 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -94,7 +94,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl real(psb_spk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -334,7 +335,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call acsr%free() call acsr%free()

@ -95,7 +95,8 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl real(psb_spk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -335,7 +336,7 @@ subroutine amg_c_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -95,7 +95,8 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! 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_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -110,8 +111,8 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -125,7 +125,8 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name character(len=20) :: name
type(psb_lcspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp type(psb_lcspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp
type(psb_lcspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da type(psb_lcspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -151,11 +152,10 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -246,8 +246,8 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_dap,csc_dadap,omp,info) call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info) call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp ! !$ write(0,*) trim(name),' OMP :',omp
! !$ write(0,*) trim(name),' ODEN:',oden ! !$ write(0,*) trim(name),' ODEN:',oden
@ -404,8 +404,8 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info) call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info) call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp ! !$ write(debug_unit,*) trim(name),' OMP_R :',omp

@ -116,7 +116,8 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_lc_coo_sparse_mat) :: lcoo_prol type(psb_lc_coo_sparse_mat) :: lcoo_prol
type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
@ -134,9 +135,8 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
@ -149,7 +149,7 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call a%cp_to(acsr) call a%cp_to(acsr)
call t_prol%mv_to(lcoo_prol) call t_prol%mv_to(lcoo_prol)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = lcoo_prol%get_nzeros() nzlp = lcoo_prol%get_nzeros()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols()) call lcoo_prol%set_ncols(desc_ac%get_local_cols())

@ -125,7 +125,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
integer(psb_ipk_) :: inaggr, nzlp integer(psb_ipk_) :: inaggr, nzlp
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_lc_coo_sparse_mat) :: tmpcoo type(psb_lc_coo_sparse_mat) :: tmpcoo
type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
@ -149,9 +150,9 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -232,7 +233,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow)) allocate(arwsum(nrow))
call acsr%arwsum(arwsum) call acsr%arwsum(arwsum)
anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow))) anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
call psb_amx(ictxt,anorm) call psb_amx(ctxt,anorm)
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
parms%aggr_omega_val = omega parms%aggr_omega_val = omega
@ -258,7 +259,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call t_prol%mv_to(tmpcoo) call t_prol%mv_to(tmpcoo)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros() nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols()) call tmpcoo%set_ncols(desc_ac%get_local_cols())

@ -97,7 +97,8 @@ subroutine amg_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_ld_coo_sparse_mat) :: tmpcoo type(psb_ld_coo_sparse_mat) :: tmpcoo
type(psb_ldspmat_type) :: tmp_ac type(psb_ldspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
@ -111,8 +112,8 @@ subroutine amg_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
select case(parms%coarse_mat) select case(parms%coarse_mat)
@ -158,7 +159,7 @@ subroutine amg_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
call tmp_ac%mv_to(tmpcoo) call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo) call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -152,7 +152,8 @@ subroutine amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -165,8 +166,8 @@ subroutine amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from

@ -91,7 +91,8 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -105,8 +106,8 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -95,7 +95,8 @@ subroutine amg_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
type(psb_ld_coo_sparse_mat) :: tmpcoo type(psb_ld_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()

@ -63,9 +63,9 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -81,9 +81,8 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -277,9 +276,9 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -295,9 +294,8 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -494,9 +492,9 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_ld_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_ld_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -512,9 +510,8 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -61,9 +61,9 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -78,9 +78,8 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -94,7 +94,8 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl real(psb_dpk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -334,7 +335,7 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call acsr%free() call acsr%free()

@ -95,7 +95,8 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl real(psb_dpk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -335,7 +336,7 @@ subroutine amg_d_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -95,7 +95,8 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! 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_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -110,8 +111,8 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -125,7 +125,8 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name character(len=20) :: name
type(psb_ldspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp type(psb_ldspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp
type(psb_ldspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da type(psb_ldspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -151,11 +152,10 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -246,8 +246,8 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_dap,csc_dadap,omp,info) call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info) call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp ! !$ write(0,*) trim(name),' OMP :',omp
! !$ write(0,*) trim(name),' ODEN:',oden ! !$ write(0,*) trim(name),' ODEN:',oden
@ -404,8 +404,8 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info) call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info) call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp ! !$ write(debug_unit,*) trim(name),' OMP_R :',omp

@ -116,7 +116,8 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_ld_coo_sparse_mat) :: lcoo_prol type(psb_ld_coo_sparse_mat) :: lcoo_prol
type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr
@ -134,9 +135,8 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
@ -149,7 +149,7 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call a%cp_to(acsr) call a%cp_to(acsr)
call t_prol%mv_to(lcoo_prol) call t_prol%mv_to(lcoo_prol)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = lcoo_prol%get_nzeros() nzlp = lcoo_prol%get_nzeros()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols()) call lcoo_prol%set_ncols(desc_ac%get_local_cols())

@ -125,7 +125,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
integer(psb_ipk_) :: inaggr, nzlp integer(psb_ipk_) :: inaggr, nzlp
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_ld_coo_sparse_mat) :: tmpcoo type(psb_ld_coo_sparse_mat) :: tmpcoo
type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr
@ -149,9 +150,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -232,7 +233,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow)) allocate(arwsum(nrow))
call acsr%arwsum(arwsum) call acsr%arwsum(arwsum)
anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow))) anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
call psb_amx(ictxt,anorm) call psb_amx(ctxt,anorm)
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
parms%aggr_omega_val = omega parms%aggr_omega_val = omega
@ -258,7 +259,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call t_prol%mv_to(tmpcoo) call t_prol%mv_to(tmpcoo)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros() nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols()) call tmpcoo%set_ncols(desc_ac%get_local_cols())

@ -97,7 +97,8 @@ subroutine amg_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_ls_coo_sparse_mat) :: tmpcoo type(psb_ls_coo_sparse_mat) :: tmpcoo
type(psb_lsspmat_type) :: tmp_ac type(psb_lsspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
@ -111,8 +112,8 @@ subroutine amg_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
select case(parms%coarse_mat) select case(parms%coarse_mat)
@ -158,7 +159,7 @@ subroutine amg_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
call tmp_ac%mv_to(tmpcoo) call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo) call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -152,7 +152,8 @@ subroutine amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -165,8 +166,8 @@ subroutine amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from

@ -91,7 +91,8 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -105,8 +106,8 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -95,7 +95,8 @@ subroutine amg_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
type(psb_ls_coo_sparse_mat) :: tmpcoo type(psb_ls_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()

@ -63,9 +63,9 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -81,9 +81,8 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -277,9 +276,9 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -295,9 +294,8 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -494,9 +492,9 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_ls_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_ls_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -512,9 +510,8 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -61,9 +61,9 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -78,9 +78,8 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -94,7 +94,8 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl real(psb_spk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -334,7 +335,7 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call acsr%free() call acsr%free()

@ -95,7 +95,8 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl real(psb_spk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -335,7 +336,7 @@ subroutine amg_s_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -95,7 +95,8 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! 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_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -110,8 +111,8 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -125,7 +125,8 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name character(len=20) :: name
type(psb_lsspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp type(psb_lsspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp
type(psb_lsspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da type(psb_lsspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -151,11 +152,10 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -246,8 +246,8 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_dap,csc_dadap,omp,info) call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info) call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp ! !$ write(0,*) trim(name),' OMP :',omp
! !$ write(0,*) trim(name),' ODEN:',oden ! !$ write(0,*) trim(name),' ODEN:',oden
@ -404,8 +404,8 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info) call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info) call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp ! !$ write(debug_unit,*) trim(name),' OMP_R :',omp

@ -116,7 +116,8 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_ls_coo_sparse_mat) :: lcoo_prol type(psb_ls_coo_sparse_mat) :: lcoo_prol
type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr
@ -134,9 +135,8 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
@ -149,7 +149,7 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call a%cp_to(acsr) call a%cp_to(acsr)
call t_prol%mv_to(lcoo_prol) call t_prol%mv_to(lcoo_prol)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = lcoo_prol%get_nzeros() nzlp = lcoo_prol%get_nzeros()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols()) call lcoo_prol%set_ncols(desc_ac%get_local_cols())

@ -125,7 +125,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
integer(psb_ipk_) :: inaggr, nzlp integer(psb_ipk_) :: inaggr, nzlp
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_ls_coo_sparse_mat) :: tmpcoo type(psb_ls_coo_sparse_mat) :: tmpcoo
type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr
@ -149,9 +150,9 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -232,7 +233,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow)) allocate(arwsum(nrow))
call acsr%arwsum(arwsum) call acsr%arwsum(arwsum)
anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow))) anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
call psb_amx(ictxt,anorm) call psb_amx(ctxt,anorm)
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
parms%aggr_omega_val = omega parms%aggr_omega_val = omega
@ -258,7 +259,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call t_prol%mv_to(tmpcoo) call t_prol%mv_to(tmpcoo)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros() nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols()) call tmpcoo%set_ncols(desc_ac%get_local_cols())

@ -97,7 +97,8 @@ subroutine amg_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_lz_coo_sparse_mat) :: tmpcoo type(psb_lz_coo_sparse_mat) :: tmpcoo
type(psb_lzspmat_type) :: tmp_ac type(psb_lzspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
@ -111,8 +112,8 @@ subroutine amg_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
select case(parms%coarse_mat) select case(parms%coarse_mat)
@ -158,7 +159,7 @@ subroutine amg_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
call tmp_ac%mv_to(tmpcoo) call tmp_ac%mv_to(tmpcoo)
call ac%mv_from(tmpcoo) call ac%mv_from(tmpcoo)
call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(desc_ac,info) if (info == psb_success_) call psb_cdasb(desc_ac,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -152,7 +152,8 @@ subroutine amg_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -165,8 +166,8 @@ subroutine amg_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from

@ -91,7 +91,8 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -105,8 +106,8 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -95,7 +95,8 @@ subroutine amg_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr
type(psb_lz_coo_sparse_mat) :: tmpcoo type(psb_lz_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()

@ -63,9 +63,9 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -81,9 +81,8 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -277,9 +276,9 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -295,9 +294,8 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
@ -494,9 +492,9 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_lz_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_lz_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -512,9 +510,8 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -61,9 +61,9 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
integer(psb_ipk_) :: debug_level, debug_unit, naggr integer(psb_ipk_) :: debug_level, debug_unit, naggr
@ -78,9 +78,8 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()

@ -94,7 +94,8 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl real(psb_dpk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -334,7 +335,7 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call acsr%free() call acsr%free()

@ -95,7 +95,8 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl real(psb_dpk_) :: cpling, tcl
logical :: disjoint logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -108,8 +109,8 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
nrglob = desc_a%get_global_rows() nrglob = desc_a%get_global_rows()
@ -335,7 +336,7 @@ subroutine amg_z_soc2_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
nlaggr(:) = 0 nlaggr(:) = 0
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -95,7 +95,8 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! 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_mpk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
@ -110,8 +111,8 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)

@ -125,7 +125,8 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name character(len=20) :: name
type(psb_lzspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp type(psb_lzspmat_type) :: la, af, ptilde, rtilde, atran, atp, atdatp
type(psb_lzspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da type(psb_lzspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da
@ -151,11 +152,10 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -246,8 +246,8 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_dap,csc_dadap,omp,info) call csc_mat_col_prod(csc_dap,csc_dadap,omp,info)
call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info) call csc_mat_col_prod(csc_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp ! !$ write(0,*) trim(name),' OMP :',omp
! !$ write(0,*) trim(name),' ODEN:',oden ! !$ write(0,*) trim(name),' ODEN:',oden
@ -404,8 +404,8 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info) call csc_mat_col_prod(csc_datp,csc_datdatp,omp,info)
call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info) call csc_mat_col_prod(csc_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp) call psb_sum(ctxt,omp)
call psb_sum(ictxt,oden) call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp ! !$ write(debug_unit,*) trim(name),' OMP_R :',omp

@ -116,7 +116,8 @@ subroutine amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables ! Local variables
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_lz_coo_sparse_mat) :: lcoo_prol type(psb_lz_coo_sparse_mat) :: lcoo_prol
type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr
@ -134,9 +135,8 @@ subroutine amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() ncol = desc_a%get_local_cols()
@ -149,7 +149,7 @@ subroutine amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call a%cp_to(acsr) call a%cp_to(acsr)
call t_prol%mv_to(lcoo_prol) call t_prol%mv_to(lcoo_prol)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = lcoo_prol%get_nzeros() nzlp = lcoo_prol%get_nzeros()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols()) call lcoo_prol%set_ncols(desc_ac%get_local_cols())

@ -125,7 +125,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
integer(psb_ipk_) :: inaggr, nzlp integer(psb_ipk_) :: inaggr, nzlp
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name character(len=20) :: name
type(psb_lz_coo_sparse_mat) :: tmpcoo type(psb_lz_coo_sparse_mat) :: tmpcoo
type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr
@ -149,9 +150,9 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows() nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
@ -232,7 +233,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow)) allocate(arwsum(nrow))
call acsr%arwsum(arwsum) call acsr%arwsum(arwsum)
anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow))) anorm = maxval(abs(adiag(1:nrow)*arwsum(1:nrow)))
call psb_amx(ictxt,anorm) call psb_amx(ctxt,anorm)
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
parms%aggr_omega_val = omega parms%aggr_omega_val = omega
@ -258,7 +259,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
call t_prol%mv_to(tmpcoo) call t_prol%mv_to(tmpcoo)
inaggr = naggr inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr) call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros() nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info) call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols()) call tmpcoo%set_ncols(desc_ac%get_local_cols())

@ -94,7 +94,8 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd ! !$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv integer(psb_ipk_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
@ -120,9 +121,9 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_c_extprol_bld' name = 'amg_c_extprol_bld'
info = psb_success_ info = psb_success_
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
p%ictxt = ictxt p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -166,12 +167,12 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ctxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -313,7 +314,7 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1 newsz=i-1
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop if (newsz > 0) exit array_build_loop
end if end if
end do array_build_loop end do array_build_loop
@ -355,7 +356,8 @@ contains
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_cspmat_type) :: ac, am2, am3, am4 type(psb_cspmat_type) :: ac, am2, am3, am4
@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
#if defined(LPK8) #if defined(LPK8)
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Need fix for LPK8') call psb_errpush(info,name,a_err='Need fix for LPK8')
@ -391,7 +393,7 @@ contains
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(ctxt,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(),&
@ -432,7 +434,7 @@ contains
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(ctxt,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')
@ -491,7 +493,7 @@ contains
case(amg_repl_mat_) case(amg_repl_mat_)
! !
! !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,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.)

@ -78,7 +78,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -106,9 +107,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_c_hierarchy_bld' name = 'amg_c_hierarchy_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -133,10 +134,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -200,7 +201,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_) casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
casize = max(casize,lone) casize = max(casize,lone)
casize = casize*40_psb_lpk_ casize = casize*40_psb_lpk_
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
if (casize > huge(prec%ag_data%min_coarse_size)) then if (casize > huge(prec%ag_data%min_coarse_size)) then
! !
! computed coarse size does not fit in IPK_. ! computed coarse size does not fit in IPK_.
@ -285,7 +286,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,prec%precv(i)%parms) call psb_bcast(ctxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! Sanity checks on the parameters
@ -367,7 +368,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !

@ -78,7 +78,8 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -105,9 +106,9 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld' name = 'amg_hierarchy_rebld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '

@ -96,7 +96,8 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
@ -114,8 +115,8 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_c_smoothers_bld' name = 'amg_c_smoothers_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -132,7 +133,7 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -72,7 +72,8 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr' character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -86,11 +87,11 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
end if end if
if (iout_ < 0) iout_ = psb_out_unit if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (present(root)) then if (present(root)) then
root_ = root root_ = root
else else

@ -222,7 +222,8 @@ subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name character(len=20) :: name
@ -237,8 +238,8 @@ subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -365,7 +366,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@ -450,7 +452,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -578,7 +581,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level
@ -802,7 +806,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level write(debug_unit,*) me,name,' start at level ',level
@ -1166,7 +1171,8 @@ subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
@ -1182,8 +1188,8 @@ subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -1285,7 +1291,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
@ -1368,7 +1375,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -1472,7 +1480,8 @@ contains
type(psb_c_vect_type), pointer :: current type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level

@ -94,7 +94,8 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
@ -112,8 +113,8 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_cmlprec_bld' name = 'amg_cmlprec_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

@ -91,7 +91,8 @@ subroutine amg_cprecaply(prec,x,y,desc_data,info,trans,work)
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
complex(psb_spk_), allocatable :: w1(:), w2(:) complex(psb_spk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name character(len=20) :: name
@ -99,8 +100,8 @@ subroutine amg_cprecaply(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -256,7 +257,8 @@ subroutine amg_cprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
complex(psb_spk_), pointer :: ww(:), w1(:) complex(psb_spk_), pointer :: ww(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -266,8 +268,8 @@ subroutine amg_cprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -321,7 +323,8 @@ subroutine amg_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -330,8 +333,8 @@ subroutine amg_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -470,7 +473,8 @@ subroutine amg_cprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
complex(psb_spk_), pointer :: work_(:) complex(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -479,8 +483,8 @@ subroutine amg_cprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)

@ -75,10 +75,10 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables ! Local Variables
type(amg_cprec_type) :: t_prec type(amg_cprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(amg_dml_parms) :: prm type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -94,10 +94,9 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_cprecbld' name = 'amg_cprecbld'
info = psb_success_ info = psb_success_
int_err(1) = 0 ctxt = desc_a%get_context()
ictxt = desc_a%get_context() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np) prec%ctxt = ctxt
prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -116,7 +115,7 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
! !
newsz = -1 newsz = -1
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -88,7 +88,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_cprecinit(ictxt,prec,ptype,info) subroutine amg_cprecinit(ctxt,prec,ptype,info)
use psb_base_mod use psb_base_mod
use amg_c_prec_mod, amg_protect_name => amg_cprecinit use amg_c_prec_mod, amg_protect_name => amg_cprecinit
@ -106,7 +106,7 @@ subroutine amg_cprecinit(ictxt,prec,ptype,info)
implicit none implicit none
! Arguments ! Arguments
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -123,7 +123,7 @@ subroutine amg_cprecinit(ictxt,prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%ictxt = ictxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))

@ -94,7 +94,8 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd ! !$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv integer(psb_ipk_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
@ -120,9 +121,9 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_d_extprol_bld' name = 'amg_d_extprol_bld'
info = psb_success_ info = psb_success_
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
p%ictxt = ictxt p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -166,12 +167,12 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ctxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -313,7 +314,7 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1 newsz=i-1
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop if (newsz > 0) exit array_build_loop
end if end if
end do array_build_loop end do array_build_loop
@ -355,7 +356,8 @@ contains
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_dspmat_type) :: ac, am2, am3, am4 type(psb_dspmat_type) :: ac, am2, am3, am4
@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
#if defined(LPK8) #if defined(LPK8)
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Need fix for LPK8') call psb_errpush(info,name,a_err='Need fix for LPK8')
@ -391,7 +393,7 @@ contains
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(ctxt,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(),&
@ -432,7 +434,7 @@ contains
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(ctxt,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')
@ -491,7 +493,7 @@ contains
case(amg_repl_mat_) case(amg_repl_mat_)
! !
! !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,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.)

@ -78,7 +78,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -106,9 +107,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_d_hierarchy_bld' name = 'amg_d_hierarchy_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -133,10 +134,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -200,7 +201,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
casize = int((done*casize)**(done/(done*3)),psb_lpk_) casize = int((done*casize)**(done/(done*3)),psb_lpk_)
casize = max(casize,lone) casize = max(casize,lone)
casize = casize*40_psb_lpk_ casize = casize*40_psb_lpk_
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
if (casize > huge(prec%ag_data%min_coarse_size)) then if (casize > huge(prec%ag_data%min_coarse_size)) then
! !
! computed coarse size does not fit in IPK_. ! computed coarse size does not fit in IPK_.
@ -285,7 +286,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,prec%precv(i)%parms) call psb_bcast(ctxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! Sanity checks on the parameters
@ -367,7 +368,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !

@ -78,7 +78,8 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -105,9 +106,9 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld' name = 'amg_hierarchy_rebld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '

@ -96,7 +96,8 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
@ -114,8 +115,8 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_d_smoothers_bld' name = 'amg_d_smoothers_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -132,7 +133,7 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -72,7 +72,8 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr' character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -86,11 +87,11 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
end if end if
if (iout_ < 0) iout_ = psb_out_unit if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (present(root)) then if (present(root)) then
root_ = root root_ = root
else else

@ -222,7 +222,8 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name character(len=20) :: name
@ -237,8 +238,8 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -365,7 +366,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@ -450,7 +452,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -578,7 +581,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level
@ -802,7 +806,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level write(debug_unit,*) me,name,' start at level ',level
@ -1166,7 +1171,8 @@ subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
@ -1182,8 +1188,8 @@ subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -1285,7 +1291,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
@ -1368,7 +1375,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -1472,7 +1480,8 @@ contains
type(psb_d_vect_type), pointer :: current type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level

@ -94,7 +94,8 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
@ -112,8 +113,8 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_dmlprec_bld' name = 'amg_dmlprec_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

@ -91,7 +91,8 @@ subroutine amg_dprecaply(prec,x,y,desc_data,info,trans,work)
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
real(psb_dpk_), allocatable :: w1(:), w2(:) real(psb_dpk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name character(len=20) :: name
@ -99,8 +100,8 @@ subroutine amg_dprecaply(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -256,7 +257,8 @@ subroutine amg_dprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
real(psb_dpk_), pointer :: ww(:), w1(:) real(psb_dpk_), pointer :: ww(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -266,8 +268,8 @@ subroutine amg_dprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -321,7 +323,8 @@ subroutine amg_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -330,8 +333,8 @@ subroutine amg_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -470,7 +473,8 @@ subroutine amg_dprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_dpk_), pointer :: work_(:) real(psb_dpk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -479,8 +483,8 @@ subroutine amg_dprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)

@ -75,10 +75,10 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables ! Local Variables
type(amg_dprec_type) :: t_prec type(amg_dprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(amg_dml_parms) :: prm type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -94,10 +94,9 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_dprecbld' name = 'amg_dprecbld'
info = psb_success_ info = psb_success_
int_err(1) = 0 ctxt = desc_a%get_context()
ictxt = desc_a%get_context() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np) prec%ctxt = ctxt
prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -116,7 +115,7 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
! !
newsz = -1 newsz = -1
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -88,7 +88,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_dprecinit(ictxt,prec,ptype,info) subroutine amg_dprecinit(ctxt,prec,ptype,info)
use psb_base_mod use psb_base_mod
use amg_d_prec_mod, amg_protect_name => amg_dprecinit use amg_d_prec_mod, amg_protect_name => amg_dprecinit
@ -109,7 +109,7 @@ subroutine amg_dprecinit(ictxt,prec,ptype,info)
implicit none implicit none
! Arguments ! Arguments
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -126,7 +126,7 @@ subroutine amg_dprecinit(ictxt,prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%ictxt = ictxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))

@ -94,7 +94,8 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd ! !$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv integer(psb_ipk_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
@ -120,9 +121,9 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_s_extprol_bld' name = 'amg_s_extprol_bld'
info = psb_success_ info = psb_success_
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
p%ictxt = ictxt p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -166,12 +167,12 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ctxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -313,7 +314,7 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1 newsz=i-1
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop if (newsz > 0) exit array_build_loop
end if end if
end do array_build_loop end do array_build_loop
@ -355,7 +356,8 @@ contains
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_sspmat_type) :: ac, am2, am3, am4 type(psb_sspmat_type) :: ac, am2, am3, am4
@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
#if defined(LPK8) #if defined(LPK8)
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Need fix for LPK8') call psb_errpush(info,name,a_err='Need fix for LPK8')
@ -391,7 +393,7 @@ contains
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(ctxt,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(),&
@ -432,7 +434,7 @@ contains
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(ctxt,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')
@ -491,7 +493,7 @@ contains
case(amg_repl_mat_) case(amg_repl_mat_)
! !
! !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,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.)

@ -78,7 +78,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -106,9 +107,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_s_hierarchy_bld' name = 'amg_s_hierarchy_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -133,10 +134,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -200,7 +201,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_) casize = int((sone*casize)**(sone/(sone*3)),psb_lpk_)
casize = max(casize,lone) casize = max(casize,lone)
casize = casize*40_psb_lpk_ casize = casize*40_psb_lpk_
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
if (casize > huge(prec%ag_data%min_coarse_size)) then if (casize > huge(prec%ag_data%min_coarse_size)) then
! !
! computed coarse size does not fit in IPK_. ! computed coarse size does not fit in IPK_.
@ -285,7 +286,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,prec%precv(i)%parms) call psb_bcast(ctxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! Sanity checks on the parameters
@ -367,7 +368,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !

@ -78,7 +78,8 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -105,9 +106,9 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld' name = 'amg_hierarchy_rebld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '

@ -96,7 +96,8 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
@ -114,8 +115,8 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_s_smoothers_bld' name = 'amg_s_smoothers_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -132,7 +133,7 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -72,7 +72,8 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr' character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -86,11 +87,11 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
end if end if
if (iout_ < 0) iout_ = psb_out_unit if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (present(root)) then if (present(root)) then
root_ = root root_ = root
else else

@ -222,7 +222,8 @@ subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name character(len=20) :: name
@ -237,8 +238,8 @@ subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -365,7 +366,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@ -450,7 +452,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -578,7 +581,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level
@ -802,7 +806,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level write(debug_unit,*) me,name,' start at level ',level
@ -1166,7 +1171,8 @@ subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
@ -1182,8 +1188,8 @@ subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -1285,7 +1291,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
@ -1368,7 +1375,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add') & a_err='wrong call level to inner_add')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level write(debug_unit,*) me,' inner_add at level ',level
@ -1472,7 +1480,8 @@ contains
type(psb_s_vect_type), pointer :: current type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps integer(psb_ipk_) :: nlev, ilev, sweeps
@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult') & a_err='wrong call level to inner_mult')
goto 9999 goto 9999
end if end if
ictxt = p%precv(level)%base_desc%get_context() ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level write(debug_unit,*) me,' inner_mult at level ',level

@ -94,7 +94,8 @@ subroutine amg_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
@ -112,8 +113,8 @@ subroutine amg_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_smlprec_bld' name = 'amg_smlprec_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&

@ -91,7 +91,8 @@ subroutine amg_sprecaply(prec,x,y,desc_data,info,trans,work)
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
real(psb_spk_), allocatable :: w1(:), w2(:) real(psb_spk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name character(len=20) :: name
@ -99,8 +100,8 @@ subroutine amg_sprecaply(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -256,7 +257,8 @@ subroutine amg_sprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans character(len=1), optional :: trans
! Local variables ! Local variables
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
real(psb_spk_), pointer :: ww(:), w1(:) real(psb_spk_), pointer :: ww(:), w1(:)
character(len=20) :: name character(len=20) :: name
@ -266,8 +268,8 @@ subroutine amg_sprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info) allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -321,7 +323,8 @@ subroutine amg_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -330,8 +333,8 @@ subroutine amg_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
@ -470,7 +473,8 @@ subroutine amg_sprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables ! Local variables
character :: trans_ character :: trans_
real(psb_spk_), pointer :: work_(:) real(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk logical :: do_alloc_wrk
character(len=20) :: name character(len=20) :: name
@ -479,8 +483,8 @@ subroutine amg_sprecaply1_vect(prec,x,desc_data,info,trans,work)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)

@ -75,10 +75,10 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables ! Local Variables
type(amg_sprec_type) :: t_prec type(amg_sprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(amg_dml_parms) :: prm type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -94,10 +94,9 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_sprecbld' name = 'amg_sprecbld'
info = psb_success_ info = psb_success_
int_err(1) = 0 ctxt = desc_a%get_context()
ictxt = desc_a%get_context() call psb_info(ctxt, me, np)
call psb_info(ictxt, me, np) prec%ctxt = ctxt
prec%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -116,7 +115,7 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
! !
newsz = -1 newsz = -1
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -88,7 +88,7 @@
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! !
subroutine amg_sprecinit(ictxt,prec,ptype,info) subroutine amg_sprecinit(ctxt,prec,ptype,info)
use psb_base_mod use psb_base_mod
use amg_s_prec_mod, amg_protect_name => amg_sprecinit use amg_s_prec_mod, amg_protect_name => amg_sprecinit
@ -106,7 +106,7 @@ subroutine amg_sprecinit(ictxt,prec,ptype,info)
implicit none implicit none
! Arguments ! Arguments
integer(psb_ipk_), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
class(amg_sprec_type), intent(inout) :: prec class(amg_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -123,7 +123,7 @@ subroutine amg_sprecinit(ictxt,prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%ictxt = ictxt prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1 prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype))) select case(psb_toupper(trim(ptype)))

@ -94,7 +94,8 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd ! !$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv integer(psb_ipk_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
@ -120,9 +121,9 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_z_extprol_bld' name = 'amg_z_extprol_bld'
info = psb_success_ info = psb_success_
int_err(1) = 0 int_err(1) = 0
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
p%ictxt = ictxt p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -166,12 +167,12 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ctxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -313,7 +314,7 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1 newsz=i-1
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop if (newsz > 0) exit array_build_loop
end if end if
end do array_build_loop end do array_build_loop
@ -355,7 +356,8 @@ contains
! Local variables ! Local variables
character(len=20) :: name character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_zspmat_type) :: ac, am2, am3, am4 type(psb_zspmat_type) :: ac, am2, am3, am4
@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
#if defined(LPK8) #if defined(LPK8)
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Need fix for LPK8') call psb_errpush(info,name,a_err='Need fix for LPK8')
@ -391,7 +393,7 @@ contains
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(ctxt,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(),&
@ -432,7 +434,7 @@ contains
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(ctxt,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')
@ -491,7 +493,7 @@ contains
case(amg_repl_mat_) case(amg_repl_mat_)
! !
! !
call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) call psb_cdall(ctxt,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.)

@ -78,7 +78,8 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -106,9 +107,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_z_hierarchy_bld' name = 'amg_z_hierarchy_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
@ -133,10 +134,10 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ctxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_coarse_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
@ -200,7 +201,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
casize = int((done*casize)**(done/(done*3)),psb_lpk_) casize = int((done*casize)**(done/(done*3)),psb_lpk_)
casize = max(casize,lone) casize = max(casize,lone)
casize = casize*40_psb_lpk_ casize = casize*40_psb_lpk_
call psb_bcast(ictxt,casize) call psb_bcast(ctxt,casize)
if (casize > huge(prec%ag_data%min_coarse_size)) then if (casize > huge(prec%ag_data%min_coarse_size)) then
! !
! computed coarse size does not fit in IPK_. ! computed coarse size does not fit in IPK_.
@ -285,7 +286,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
! Check on the iprcparm contents: they should be the same ! Check on the iprcparm contents: they should be the same
! on all processes. ! on all processes.
! !
call psb_bcast(ictxt,prec%precv(i)%parms) call psb_bcast(ctxt,prec%precv(i)%parms)
! !
! Sanity checks on the parameters ! Sanity checks on the parameters
@ -367,7 +368,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
end if end if
end if end if
end if end if
call psb_bcast(ictxt,newsz) call psb_bcast(ctxt,newsz)
if (newsz > 0) then if (newsz > 0) then
! !

@ -78,7 +78,8 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,& integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs & nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize integer(psb_lpk_) :: iaggsize, casize
@ -105,9 +106,9 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld' name = 'amg_hierarchy_rebld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
prec%ictxt = ictxt prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '

@ -96,7 +96,8 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id integer(psb_ipk_) :: coarse_solve_id
@ -114,8 +115,8 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_z_smoothers_bld' name = 'amg_z_smoothers_bld'
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -132,7 +133,7 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv') call psb_errpush(info,name,a_err='Inconsistent size of precv')

@ -72,7 +72,8 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr' character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -86,11 +87,11 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
end if end if
if (iout_ < 0) iout_ = psb_out_unit if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt ctxt = prec%ctxt
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (present(root)) then if (present(root)) then
root_ = root root_ = root
else else

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save