fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix name of CTXT variable

Browse Source
This commit is contained in:
Salvatore Filippone
2020-11-17 14:36:29 +01:00
parent c14ce5409e
commit b751d726a1
298 changed files with 3664 additions and 3379 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_base_prec_type.F90
+24 -24
View File
@@ -1050,49 +1050,49 @@ contains
end function pr_to_str
subroutine amg_ml_bcast(ictxt,dat,root)
subroutine amg_ml_bcast(ctxt,dat,root)
implicit none
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%sweeps_pre,root)
call psb_bcast(ictxt,dat%sweeps_post,root)
call psb_bcast(ictxt,dat%ml_cycle,root)
call psb_bcast(ictxt,dat%aggr_type,root)
call psb_bcast(ictxt,dat%par_aggr_alg,root)
call psb_bcast(ictxt,dat%aggr_ord,root)
call psb_bcast(ictxt,dat%aggr_prol,root)
call psb_bcast(ictxt,dat%aggr_omega_alg,root)
call psb_bcast(ictxt,dat%aggr_eig,root)
call psb_bcast(ictxt,dat%aggr_filter,root)
call psb_bcast(ictxt,dat%coarse_mat,root)
call psb_bcast(ictxt,dat%coarse_solve,root)
call psb_bcast(ctxt,dat%sweeps_pre,root)
call psb_bcast(ctxt,dat%sweeps_post,root)
call psb_bcast(ctxt,dat%ml_cycle,root)
call psb_bcast(ctxt,dat%aggr_type,root)
call psb_bcast(ctxt,dat%par_aggr_alg,root)
call psb_bcast(ctxt,dat%aggr_ord,root)
call psb_bcast(ctxt,dat%aggr_prol,root)
call psb_bcast(ctxt,dat%aggr_omega_alg,root)
call psb_bcast(ctxt,dat%aggr_eig,root)
call psb_bcast(ctxt,dat%aggr_filter,root)
call psb_bcast(ctxt,dat%coarse_mat,root)
call psb_bcast(ctxt,dat%coarse_solve,root)
end subroutine amg_ml_bcast
subroutine amg_sml_bcast(ictxt,dat,root)
subroutine amg_sml_bcast(ctxt,dat,root)
implicit none
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%amg_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root)
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
call psb_bcast(ctxt,dat%aggr_thresh,root)
end subroutine amg_sml_bcast
subroutine amg_dml_bcast(ictxt,dat,root)
subroutine amg_dml_bcast(ctxt,dat,root)
implicit none
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root
call psb_bcast(ictxt,dat%amg_ml_parms,root)
call psb_bcast(ictxt,dat%aggr_omega_val,root)
call psb_bcast(ictxt,dat%aggr_thresh,root)
call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root)
call psb_bcast(ctxt,dat%aggr_thresh,root)
end subroutine amg_dml_bcast
subroutine ml_parms_clone(pm,pmout,info)
amgprec/amg_c_mumps_solver.F90
+7 -6
View File
@@ -82,7 +82,7 @@ module amg_c_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => c_mumps_solver_bld
@@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt,stat=info)
if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ctxt,stat=info)
end if
sv%built=.false.
end if
@@ -324,8 +324,9 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse)
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
amgprec/amg_c_prec_type.f90
+31 -29
View File
@@ -57,7 +57,8 @@ module amg_c_prec_type
use amg_c_base_smoother_mod
use amg_c_base_aggregator_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
!
@@ -85,7 +86,6 @@ module amg_c_prec_type
integer, parameter, private :: wv_size_=4
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
!
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@@ -272,13 +272,13 @@ module amg_c_prec_type
end interface
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_, &
& amg_cprec_type, psb_ipk_
integer(psb_ipk_), intent(in) :: ictxt
class(amg_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
& amg_cprec_type, psb_ipk_, psb_ctxt_type
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
end subroutine amg_cprecinit
end interface amg_precinit
@@ -460,12 +460,12 @@ contains
class(amg_cprec_type), intent(inout) :: prec
real(psb_spk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
num = -sone
den = sone
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
@@ -477,13 +477,13 @@ contains
end if
end if
nmin = num
call psb_min(ictxt,nmin)
call psb_min(ctxt,nmin)
if (nmin < szero) then
num = szero
den = sone
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
call psb_sum(ctxt,num)
call psb_sum(ctxt,den)
end if
prec%ag_data%op_complexity = num/den
end subroutine amg_c_cmp_compl
@@ -506,14 +506,14 @@ contains
implicit none
class(amg_cprec_type), intent(inout) :: prec
real(psb_spk_) :: avgcr
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il, nl, iam, np
real(psb_spk_) :: avgcr
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero
ictxt = prec%ictxt
call psb_info(ictxt,iam,np)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
@@ -521,7 +521,7 @@ contains
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ictxt,avgcr)
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_c_cmp_avg_cr
@@ -737,14 +737,15 @@ contains
integer(psb_ipk_), intent(in), optional :: istart, iend, iproc
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
icontxt = prec%ictxt
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
@@ -810,13 +811,14 @@ contains
class(psb_cprec_type), target, intent(inout) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_cprec_type)
pout%ictxt = prec%ictxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -864,7 +866,7 @@ contains
!!$ return
endif
end if
b%ictxt = prec%ictxt
b%ctxt = prec%ctxt
b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps
amgprec/amg_c_slu_solver.F90
+6 -5
View File
@@ -137,7 +137,8 @@ contains
integer :: n_row,n_col
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(len=20) :: name='c_slu_solver_apply'
@@ -268,15 +269,16 @@ contains
type(psb_c_csc_sparse_mat) :: acsc
type(psb_c_coo_sparse_mat) :: acoo
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -395,7 +397,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_c_slu_solver_descr'
integer :: iout_
amgprec/amg_d_mumps_solver.F90
+7 -6
View File
@@ -82,7 +82,7 @@ module amg_d_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => d_mumps_solver_bld
@@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt,stat=info)
if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ctxt,stat=info)
end if
sv%built=.false.
end if
@@ -324,8 +324,9 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse)
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
amgprec/amg_d_prec_type.f90
+31 -29
View File
@@ -57,7 +57,8 @@ module amg_d_prec_type
use amg_d_base_smoother_mod
use amg_d_base_aggregator_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
!
@@ -85,7 +86,6 @@ module amg_d_prec_type
integer, parameter, private :: wv_size_=4
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
!
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@@ -272,13 +272,13 @@ module amg_d_prec_type
end interface
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_, &
& amg_dprec_type, psb_ipk_
integer(psb_ipk_), intent(in) :: ictxt
class(amg_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
& amg_dprec_type, psb_ipk_, psb_ctxt_type
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
end subroutine amg_dprecinit
end interface amg_precinit
@@ -460,12 +460,12 @@ contains
class(amg_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
num = -done
den = done
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
@@ -477,13 +477,13 @@ contains
end if
end if
nmin = num
call psb_min(ictxt,nmin)
call psb_min(ctxt,nmin)
if (nmin < dzero) then
num = dzero
den = done
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
call psb_sum(ctxt,num)
call psb_sum(ctxt,den)
end if
prec%ag_data%op_complexity = num/den
end subroutine amg_d_cmp_compl
@@ -506,14 +506,14 @@ contains
implicit none
class(amg_dprec_type), intent(inout) :: prec
real(psb_dpk_) :: avgcr
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il, nl, iam, np
real(psb_dpk_) :: avgcr
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero
ictxt = prec%ictxt
call psb_info(ictxt,iam,np)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
@@ -521,7 +521,7 @@ contains
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ictxt,avgcr)
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_d_cmp_avg_cr
@@ -737,14 +737,15 @@ contains
integer(psb_ipk_), intent(in), optional :: istart, iend, iproc
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
icontxt = prec%ictxt
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
@@ -810,13 +811,14 @@ contains
class(psb_dprec_type), target, intent(inout) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_dprec_type)
pout%ictxt = prec%ictxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -864,7 +866,7 @@ contains
!!$ return
endif
end if
b%ictxt = prec%ictxt
b%ctxt = prec%ctxt
b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps
amgprec/amg_d_slu_solver.F90
+6 -5
View File
@@ -137,7 +137,8 @@ contains
integer :: n_row,n_col
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(len=20) :: name='d_slu_solver_apply'
@@ -268,15 +269,16 @@ contains
type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -395,7 +397,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_d_slu_solver_descr'
integer :: iout_
amgprec/amg_d_sludist_solver.F90
+10 -7
View File
@@ -136,9 +136,10 @@ contains
integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='d_sludist_solver_apply'
type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_
character(len=20) :: name='d_sludist_solver_apply'
call psb_erractionsave(err_act)
@@ -271,15 +272,16 @@ contains
type(psb_d_csr_sparse_mat) :: acsr
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
npr = np
npc = 1
if (debug_level >= psb_debug_outer_) &
@@ -413,7 +415,8 @@ contains
! Local variables
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'
integer :: iout_
amgprec/amg_d_umf_solver.F90
+5 -5
View File
@@ -137,7 +137,7 @@ contains
integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: i, err_act
character :: trans_
character(len=20) :: name='d_umf_solver_apply'
@@ -271,15 +271,16 @@ contains
type(psb_dspmat_type) :: atmp
type(psb_d_csc_sparse_mat) :: acsc
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -401,7 +402,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_d_umf_solver_descr'
integer :: iout_
amgprec/amg_s_mumps_solver.F90
+7 -6
View File
@@ -82,7 +82,7 @@ module amg_s_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => s_mumps_solver_bld
@@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt,stat=info)
if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ctxt,stat=info)
end if
sv%built=.false.
end if
@@ -324,8 +324,9 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse)
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
amgprec/amg_s_prec_type.f90
+31 -29
View File
@@ -57,7 +57,8 @@ module amg_s_prec_type
use amg_s_base_smoother_mod
use amg_s_base_aggregator_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
!
@@ -85,7 +86,6 @@ module amg_s_prec_type
integer, parameter, private :: wv_size_=4
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
!
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@@ -272,13 +272,13 @@ module amg_s_prec_type
end interface
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_, &
& amg_sprec_type, psb_ipk_
integer(psb_ipk_), intent(in) :: ictxt
class(amg_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
& amg_sprec_type, psb_ipk_, psb_ctxt_type
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
end subroutine amg_sprecinit
end interface amg_precinit
@@ -460,12 +460,12 @@ contains
class(amg_sprec_type), intent(inout) :: prec
real(psb_spk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
num = -sone
den = sone
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
@@ -477,13 +477,13 @@ contains
end if
end if
nmin = num
call psb_min(ictxt,nmin)
call psb_min(ctxt,nmin)
if (nmin < szero) then
num = szero
den = sone
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
call psb_sum(ctxt,num)
call psb_sum(ctxt,den)
end if
prec%ag_data%op_complexity = num/den
end subroutine amg_s_cmp_compl
@@ -506,14 +506,14 @@ contains
implicit none
class(amg_sprec_type), intent(inout) :: prec
real(psb_spk_) :: avgcr
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il, nl, iam, np
real(psb_spk_) :: avgcr
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero
ictxt = prec%ictxt
call psb_info(ictxt,iam,np)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
@@ -521,7 +521,7 @@ contains
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ictxt,avgcr)
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_s_cmp_avg_cr
@@ -737,14 +737,15 @@ contains
integer(psb_ipk_), intent(in), optional :: istart, iend, iproc
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
icontxt = prec%ictxt
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
@@ -810,13 +811,14 @@ contains
class(psb_sprec_type), target, intent(inout) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_sprec_type)
pout%ictxt = prec%ictxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -864,7 +866,7 @@ contains
!!$ return
endif
end if
b%ictxt = prec%ictxt
b%ctxt = prec%ctxt
b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps
amgprec/amg_s_slu_solver.F90
+6 -5
View File
@@ -137,7 +137,8 @@ contains
integer :: n_row,n_col
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(len=20) :: name='s_slu_solver_apply'
@@ -268,15 +269,16 @@ contains
type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -395,7 +397,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_s_slu_solver_descr'
integer :: iout_
amgprec/amg_z_mumps_solver.F90
+7 -6
View File
@@ -82,7 +82,7 @@ module amg_z_mumps_solver
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
integer(psb_ipk_), dimension(3) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
type(psb_ctxt_type), allocatable :: local_ctxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => z_mumps_solver_bld
@@ -248,9 +248,9 @@ contains
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id, stat=info)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt,stat=info)
if (allocated(sv%local_ctxt)) then
call psb_exit(sv%local_ctxt,close=.false.)
deallocate(sv%local_ctxt,stat=info)
end if
sv%built=.false.
end if
@@ -324,8 +324,9 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse)
logical, intent(in), optional :: coarse
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, me, np
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
integer(psb_ipk_) :: iout_
amgprec/amg_z_prec_type.f90
+31 -29
View File
@@ -57,7 +57,8 @@ module amg_z_prec_type
use amg_z_base_smoother_mod
use amg_z_base_aggregator_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
!
@@ -85,7 +86,6 @@ module amg_z_prec_type
integer, parameter, private :: wv_size_=4
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
!
! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle.
@@ -272,13 +272,13 @@ module amg_z_prec_type
end interface
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_, &
& amg_zprec_type, psb_ipk_
integer(psb_ipk_), intent(in) :: ictxt
class(amg_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
& amg_zprec_type, psb_ipk_, psb_ctxt_type
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
end subroutine amg_zprecinit
end interface amg_precinit
@@ -460,12 +460,12 @@ contains
class(amg_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: num, den, nmin
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
num = -done
den = done
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
il = 1
num = prec%precv(il)%base_a%get_nzeros()
@@ -477,13 +477,13 @@ contains
end if
end if
nmin = num
call psb_min(ictxt,nmin)
call psb_min(ctxt,nmin)
if (nmin < dzero) then
num = dzero
den = done
else
call psb_sum(ictxt,num)
call psb_sum(ictxt,den)
call psb_sum(ctxt,num)
call psb_sum(ctxt,den)
end if
prec%ag_data%op_complexity = num/den
end subroutine amg_z_cmp_compl
@@ -506,14 +506,14 @@ contains
implicit none
class(amg_zprec_type), intent(inout) :: prec
real(psb_dpk_) :: avgcr
integer(psb_ipk_) :: ictxt
integer(psb_ipk_) :: il, nl, iam, np
real(psb_dpk_) :: avgcr
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero
ictxt = prec%ictxt
call psb_info(ictxt,iam,np)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
@@ -521,7 +521,7 @@ contains
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ictxt,avgcr)
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_z_cmp_avg_cr
@@ -737,14 +737,15 @@ contains
integer(psb_ipk_), intent(in), optional :: istart, iend, iproc
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
integer(psb_ipk_) :: i, j, il1, iln, lev
integer(psb_ipk_) :: icontxt, iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
integer(psb_ipk_) :: i, j, il1, iln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np, iproc_
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
! len of prefix_
info = 0
icontxt = prec%ictxt
icontxt = prec%ctxt
call psb_info(icontxt,iam,np)
iln = size(prec%precv)
@@ -810,13 +811,14 @@ contains
class(psb_zprec_type), target, intent(inout) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, ln, lev
integer(psb_ipk_) :: icontxt,iam, np
integer(psb_ipk_) :: i, j, ln, lev
type(psb_ctxt_type) :: icontxt
integer(psb_ipk_) :: iam, np
info = psb_success_
select type(pout => precout)
class is (amg_zprec_type)
pout%ictxt = prec%ictxt
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
if (allocated(prec%precv)) then
@@ -864,7 +866,7 @@ contains
!!$ return
endif
end if
b%ictxt = prec%ictxt
b%ctxt = prec%ctxt
b%ag_data = prec%ag_data
b%outer_sweeps = prec%outer_sweeps
amgprec/amg_z_slu_solver.F90
+6 -5
View File
@@ -137,7 +137,8 @@ contains
integer :: n_row,n_col
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(len=20) :: name='z_slu_solver_apply'
@@ -268,15 +269,16 @@ contains
type(psb_z_csc_sparse_mat) :: acsc
type(psb_z_coo_sparse_mat) :: acoo
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -395,7 +397,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_z_slu_solver_descr'
integer :: iout_
amgprec/amg_z_sludist_solver.F90
+10 -7
View File
@@ -136,9 +136,10 @@ contains
integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_sludist_solver_apply'
type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act
character :: trans_
character(len=20) :: name='z_sludist_solver_apply'
call psb_erractionsave(err_act)
@@ -271,15 +272,16 @@ contains
type(psb_z_csr_sparse_mat) :: acsr
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
npr = np
npc = 1
if (debug_level >= psb_debug_outer_) &
@@ -413,7 +415,8 @@ contains
! Local variables
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'
integer :: iout_
amgprec/amg_z_umf_solver.F90
+5 -5
View File
@@ -137,7 +137,7 @@ contains
integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: i, err_act
character :: trans_
character(len=20) :: name='z_umf_solver_apply'
@@ -271,15 +271,16 @@ contains
type(psb_zspmat_type) :: atmp
type(psb_z_csc_sparse_mat) :: acsc
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
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
@@ -401,7 +402,6 @@ contains
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='amg_z_umf_solver_descr'
integer :: iout_
amgprec/impl/aggregator/amg_c_dec_aggregator_mat_asb.f90
+5 -4
View File
@@ -97,7 +97,8 @@ subroutine amg_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
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_lcspmat_type) :: tmp_ac
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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
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 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_) goto 9999
amgprec/impl/aggregator/amg_c_dec_aggregator_mat_bld.f90
+8 -7
View File
@@ -151,11 +151,12 @@ subroutine amg_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
name='amg_c_dec_aggregator_mat_bld'
call psb_erractionsave(err_act)
@@ -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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
!
! Build the coarse-level matrix from the fine-level one, starting from
amgprec/impl/aggregator/amg_c_dec_aggregator_tprol.f90
+9 -8
View File
@@ -90,12 +90,13 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_c_dec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -105,8 +106,8 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_c_map_to_tprol.f90
+6 -5
View File
@@ -95,9 +95,10 @@ 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
type(psb_lc_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_map_to_tprol'
@@ -108,8 +109,8 @@ subroutine amg_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
amgprec/impl/aggregator/amg_c_ptap_bld.f90
+14 -17
View File
@@ -63,9 +63,9 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -276,10 +275,10 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
type(psb_desc_type), intent(inout), optional :: desc_ax
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -494,9 +492,9 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_lc_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_c_rap.f90
+6 -7
View File
@@ -60,10 +60,10 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_c_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_c_soc1_map_bld.f90
+8 -7
View File
@@ -94,10 +94,11 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl
logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_soc1_map_bld'
@@ -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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call acsr%free()
amgprec/impl/aggregator/amg_c_soc2_map_bld.f90
+5 -4
View File
@@ -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
logical :: disjoint
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
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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act)
return
amgprec/impl/aggregator/amg_c_symdec_aggregator_tprol.f90
+10 -9
View File
@@ -94,13 +94,14 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables
type(psb_cspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_c_symdec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -110,8 +111,8 @@ subroutine amg_c_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_caggrmat_minnrg_bld.f90
+9 -9
View File
@@ -125,8 +125,9 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name
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) :: dat, datp, datdatp, atmp3, tmp_prol
@@ -151,11 +152,10 @@ subroutine amg_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
ctxt = desc_a%get_context()
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()
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_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp
! !$ 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_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp
amgprec/impl/aggregator/amg_caggrmat_nosmth_bld.f90
+7 -7
View File
@@ -115,9 +115,10 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo
character(len=20) :: name
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name
type(psb_lc_coo_sparse_mat) :: lcoo_prol
type(psb_c_coo_sparse_mat) :: coo_prol, coo_restr
type(psb_c_csr_sparse_mat) :: acsr
@@ -134,9 +135,8 @@ subroutine amg_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows()
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 t_prol%mv_to(lcoo_prol)
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()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_caggrmat_smth_bld.f90
+6 -5
View File
@@ -125,7 +125,8 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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
type(psb_lc_coo_sparse_mat) :: tmpcoo
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_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()
nrow = desc_a%get_local_rows()
@@ -232,7 +233,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow))
call acsr%arwsum(arwsum)
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)
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)
inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_d_dec_aggregator_mat_asb.f90
+5 -4
View File
@@ -97,7 +97,8 @@ subroutine amg_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
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_ldspmat_type) :: tmp_ac
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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
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 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_) goto 9999
amgprec/impl/aggregator/amg_d_dec_aggregator_mat_bld.f90
+8 -7
View File
@@ -151,11 +151,12 @@ subroutine amg_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
name='amg_d_dec_aggregator_mat_bld'
call psb_erractionsave(err_act)
@@ -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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
!
! Build the coarse-level matrix from the fine-level one, starting from
amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90
+9 -8
View File
@@ -90,12 +90,13 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_d_dec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -105,8 +106,8 @@ subroutine amg_d_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_d_map_to_tprol.f90
+6 -5
View File
@@ -95,9 +95,10 @@ 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
type(psb_ld_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_map_to_tprol'
@@ -108,8 +109,8 @@ subroutine amg_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
amgprec/impl/aggregator/amg_d_ptap_bld.f90
+14 -17
View File
@@ -63,9 +63,9 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -276,10 +275,10 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
type(psb_desc_type), intent(inout), optional :: desc_ax
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -494,9 +492,9 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_ld_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_d_rap.f90
+6 -7
View File
@@ -60,10 +60,10 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_d_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_d_soc1_map_bld.f90
+8 -7
View File
@@ -94,10 +94,11 @@ subroutine amg_d_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl
logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_soc1_map_bld'
@@ -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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call acsr%free()
amgprec/impl/aggregator/amg_d_soc2_map_bld.f90
+5 -4
View File
@@ -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
logical :: disjoint
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
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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act)
return
amgprec/impl/aggregator/amg_d_symdec_aggregator_tprol.f90
+10 -9
View File
@@ -94,13 +94,14 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables
type(psb_dspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_d_symdec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -110,8 +111,8 @@ subroutine amg_d_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_daggrmat_minnrg_bld.f90
+9 -9
View File
@@ -125,8 +125,9 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name
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) :: dat, datp, datdatp, atmp3, tmp_prol
@@ -151,11 +152,10 @@ subroutine amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
ctxt = desc_a%get_context()
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()
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_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp
! !$ 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_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp
amgprec/impl/aggregator/amg_daggrmat_nosmth_bld.f90
+7 -7
View File
@@ -115,9 +115,10 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo
character(len=20) :: name
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name
type(psb_ld_coo_sparse_mat) :: lcoo_prol
type(psb_d_coo_sparse_mat) :: coo_prol, coo_restr
type(psb_d_csr_sparse_mat) :: acsr
@@ -134,9 +135,8 @@ subroutine amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows()
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 t_prol%mv_to(lcoo_prol)
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()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90
+6 -5
View File
@@ -125,7 +125,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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
type(psb_ld_coo_sparse_mat) :: tmpcoo
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_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()
nrow = desc_a%get_local_rows()
@@ -232,7 +233,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow))
call acsr%arwsum(arwsum)
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)
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)
inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_s_dec_aggregator_mat_asb.f90
+5 -4
View File
@@ -97,7 +97,8 @@ subroutine amg_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
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_lsspmat_type) :: tmp_ac
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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
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 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_) goto 9999
amgprec/impl/aggregator/amg_s_dec_aggregator_mat_bld.f90
+8 -7
View File
@@ -151,11 +151,12 @@ subroutine amg_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
name='amg_s_dec_aggregator_mat_bld'
call psb_erractionsave(err_act)
@@ -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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
!
! Build the coarse-level matrix from the fine-level one, starting from
amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90
+9 -8
View File
@@ -90,12 +90,13 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_s_dec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -105,8 +106,8 @@ subroutine amg_s_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_s_map_to_tprol.f90
+6 -5
View File
@@ -95,9 +95,10 @@ 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
type(psb_ls_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_map_to_tprol'
@@ -108,8 +109,8 @@ subroutine amg_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
amgprec/impl/aggregator/amg_s_ptap_bld.f90
+14 -17
View File
@@ -63,9 +63,9 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -276,10 +275,10 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
type(psb_desc_type), intent(inout), optional :: desc_ax
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -494,9 +492,9 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_ls_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_s_rap.f90
+6 -7
View File
@@ -60,10 +60,10 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_s_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_s_soc1_map_bld.f90
+8 -7
View File
@@ -94,10 +94,11 @@ subroutine amg_s_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_spk_) :: cpling, tcl
logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_soc1_map_bld'
@@ -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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call acsr%free()
amgprec/impl/aggregator/amg_s_soc2_map_bld.f90
+5 -4
View File
@@ -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
logical :: disjoint
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
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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act)
return
amgprec/impl/aggregator/amg_s_symdec_aggregator_tprol.f90
+10 -9
View File
@@ -94,13 +94,14 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables
type(psb_sspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_s_symdec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -110,8 +111,8 @@ subroutine amg_s_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_saggrmat_minnrg_bld.f90
+9 -9
View File
@@ -125,8 +125,9 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name
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) :: dat, datp, datdatp, atmp3, tmp_prol
@@ -151,11 +152,10 @@ subroutine amg_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
ctxt = desc_a%get_context()
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()
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_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp
! !$ 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_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp
amgprec/impl/aggregator/amg_saggrmat_nosmth_bld.f90
+7 -7
View File
@@ -115,9 +115,10 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo
character(len=20) :: name
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name
type(psb_ls_coo_sparse_mat) :: lcoo_prol
type(psb_s_coo_sparse_mat) :: coo_prol, coo_restr
type(psb_s_csr_sparse_mat) :: acsr
@@ -134,9 +135,8 @@ subroutine amg_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows()
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 t_prol%mv_to(lcoo_prol)
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()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90
+6 -5
View File
@@ -125,7 +125,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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
type(psb_ls_coo_sparse_mat) :: tmpcoo
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_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()
nrow = desc_a%get_local_rows()
@@ -232,7 +233,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow))
call acsr%arwsum(arwsum)
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)
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)
inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_z_dec_aggregator_mat_asb.f90
+5 -4
View File
@@ -97,7 +97,8 @@ subroutine amg_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,&
type(psb_desc_type), intent(inout) :: desc_ac
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_lzspmat_type) :: tmp_ac
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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
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 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_) goto 9999
amgprec/impl/aggregator/amg_z_dec_aggregator_mat_bld.f90
+8 -7
View File
@@ -151,11 +151,12 @@ subroutine amg_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit
name='amg_z_dec_aggregator_mat_bld'
call psb_erractionsave(err_act)
@@ -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_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
!
! Build the coarse-level matrix from the fine-level one, starting from
amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90
+9 -8
View File
@@ -90,12 +90,13 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_z_dec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -105,8 +106,8 @@ subroutine amg_z_dec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_z_map_to_tprol.f90
+6 -5
View File
@@ -95,9 +95,10 @@ 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
type(psb_lz_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_map_to_tprol'
@@ -108,8 +109,8 @@ subroutine amg_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
amgprec/impl/aggregator/amg_z_ptap_bld.f90
+14 -17
View File
@@ -63,9 +63,9 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -276,10 +275,10 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
type(psb_desc_type), intent(inout), optional :: desc_ax
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
@@ -494,9 +492,9 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
! Local variables
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
integer(psb_ipk_) :: ierr(5)
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_lz_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_z_rap.f90
+6 -7
View File
@@ -60,10 +60,10 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo
character(len=40) :: name
integer(psb_ipk_) :: ierr(5)
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, ndx
character(len=40) :: name
type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo
type(psb_z_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr
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)
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
nglob = desc_a%get_global_rows()
amgprec/impl/aggregator/amg_z_soc1_map_bld.f90
+8 -7
View File
@@ -94,10 +94,11 @@ subroutine amg_z_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
real(psb_dpk_) :: cpling, tcl
logical :: disjoint
integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: nrow, ncol, n_ne
integer(psb_lpk_) :: nrglob
character(len=20) :: name, ch_err
info=psb_success_
name = 'amg_soc1_map_bld'
@@ -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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call acsr%free()
amgprec/impl/aggregator/amg_z_soc2_map_bld.f90
+5 -4
View File
@@ -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
logical :: disjoint
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
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_level = psb_get_debug_level()
!
ictxt=desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt=desc_a%get_context()
call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols()
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(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call psb_sum(ctxt,nlaggr(1:np))
call psb_erractionrestore(err_act)
return
amgprec/impl/aggregator/amg_z_symdec_aggregator_tprol.f90
+10 -9
View File
@@ -94,13 +94,14 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
! Local variables
type(psb_zspmat_type) :: atmp, atrans
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: nr
integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: debug_level, debug_unit
logical :: clean_zeros
name='amg_z_symdec_aggregator_tprol'
call psb_erractionsave(err_act)
@@ -110,8 +111,8 @@ subroutine amg_z_symdec_aggregator_build_tprol(ag,parms,ag_data,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& amg_mult_ml_,is_legal_ml_cycle)
amgprec/impl/aggregator/amg_zaggrmat_minnrg_bld.f90
+9 -9
View File
@@ -125,8 +125,9 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
! Local variables
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt
integer(psb_ipk_) :: ictxt,np,me, icomm
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, icomm
character(len=20) :: name
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) :: dat, datp, datdatp, atmp3, tmp_prol
@@ -151,11 +152,10 @@ subroutine amg_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,&
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
ctxt = desc_a%get_context()
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()
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_dadap,csc_dadap,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(0,*) trim(name),' OMP :',omp
! !$ 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_datdatp,csc_datdatp,oden,info)
call psb_sum(ictxt,omp)
call psb_sum(ictxt,oden)
call psb_sum(ctxt,omp)
call psb_sum(ctxt,oden)
! !$ write(debug_unit,*) trim(name),' OMP_R :',omp
amgprec/impl/aggregator/amg_zaggrmat_nosmth_bld.f90
+7 -7
View File
@@ -115,9 +115,10 @@ subroutine amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ictxt, np, me, icomm, minfo
character(len=20) :: name
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
character(len=20) :: name
type(psb_lz_coo_sparse_mat) :: lcoo_prol
type(psb_z_coo_sparse_mat) :: coo_prol, coo_restr
type(psb_z_csr_sparse_mat) :: acsr
@@ -134,9 +135,8 @@ subroutine amg_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,&
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
nglob = desc_a%get_global_rows()
nrow = desc_a%get_local_rows()
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 t_prol%mv_to(lcoo_prol)
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()
call desc_ac%indxmap%g2lip_ins(lcoo_prol%ja(1:nzlp),info)
call lcoo_prol%set_ncols(desc_ac%get_local_cols())
amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90
+6 -5
View File
@@ -125,7 +125,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, &
& naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw
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
type(psb_lz_coo_sparse_mat) :: tmpcoo
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_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()
nrow = desc_a%get_local_rows()
@@ -232,7 +233,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,&
allocate(arwsum(nrow))
call acsr%arwsum(arwsum)
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)
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)
inaggr = naggr
call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
call psb_cdall(ctxt,desc_ac,info,nl=inaggr)
nzlp = tmpcoo%get_nzeros()
call desc_ac%indxmap%g2lip_ins(tmpcoo%ja(1:nzlp),info)
call tmpcoo%set_ncols(desc_ac%get_local_cols())
amgprec/impl/amg_c_extprol_bld.F90
+24 -22
View File
@@ -94,10 +94,11 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio
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_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
class(amg_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(amg_sml_parms) :: baseparms, medparms, coarseparms
@@ -120,9 +121,9 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_c_extprol_bld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
p%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -166,12 +167,12 @@ subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv)
nprolv = size(prolv)
nrestrv = size(restrv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ctxt,nprolv)
call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop
end if
end do array_build_loop
@@ -354,9 +355,10 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_cspmat_type) :: ac, am2, am3, am4
type(psb_c_coo_sparse_mat) :: acoo, bcoo
@@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
#if defined(LPK8)
info=psb_err_internal_error_
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')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
call psb_sum(ctxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
@@ -432,7 +434,7 @@ contains
call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_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_cdasb(p%desc_ac,info)
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_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
amgprec/impl/amg_c_hierarchy_bld.f90
+13 -12
View File
@@ -78,8 +78,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -106,9 +107,9 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_c_hierarchy_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -133,10 +134,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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 = max(casize,lone)
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
!
! 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
! on all processes.
!
call psb_bcast(ictxt,prec%precv(i)%parms)
call psb_bcast(ctxt,prec%precv(i)%parms)
!
! 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
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) then
!
amgprec/impl/amg_c_hierarchy_rebld.f90
+6 -5
View File
@@ -78,8 +78,9 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -105,9 +106,9 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
amgprec/impl/amg_c_smoothers_bld.f90
+9 -8
View File
@@ -96,12 +96,13 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -114,8 +115,8 @@ subroutine amg_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_c_smoothers_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& 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
!
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_cfile_prec_descr.f90
+6 -5
View File
@@ -71,9 +71,10 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np
logical :: is_symgs
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_
integer(psb_ipk_) :: root_
@@ -86,11 +87,11 @@ subroutine amg_cfile_prec_descr(prec,iout,root)
end if
if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
call psb_info(ictxt,me,np)
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
amgprec/impl/amg_cmlprec_aply.f90
+79 -70
View File
@@ -222,11 +222,12 @@ subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
complex(psb_spk_) :: beta_
logical :: do_alloc_wrk
type(amg_cmlprec_wrk_type), allocatable, target :: mlprec_wrk(:)
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -365,12 +366,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@@ -450,12 +452,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -578,12 +581,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
name = 'inner_inner_mult'
info = psb_success_
@@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
@@ -802,12 +806,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level
@@ -1166,11 +1171,12 @@ subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type amg_mlwrk_type
complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type amg_mlwrk_type
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -1285,12 +1291,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level
@@ -1368,12 +1375,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -1472,12 +1480,13 @@ contains
type(psb_c_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
amgprec/impl/amg_cmlprec_bld.f90
+9 -8
View File
@@ -94,12 +94,13 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -112,8 +113,8 @@ subroutine amg_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_cmlprec_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
amgprec/impl/amg_cprecaply.f90
+25 -21
View File
@@ -91,16 +91,17 @@ subroutine amg_cprecaply(prec,x,y,desc_data,info,trans,work)
complex(psb_spk_), pointer :: work_(:)
complex(psb_spk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
name='amg_cprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -256,8 +257,9 @@ subroutine amg_cprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
complex(psb_spk_), pointer :: ww(:), w1(:)
character(len=20) :: name
@@ -266,8 +268,8 @@ subroutine amg_cprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then
@@ -321,17 +323,18 @@ subroutine amg_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_cprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -470,17 +473,18 @@ subroutine amg_cprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables
character :: trans_
complex(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_cprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
amgprec/impl/amg_cprecbld.f90
+8 -9
View File
@@ -75,10 +75,10 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables
type(amg_cprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
@@ -94,10 +94,9 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_cprecbld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -116,7 +115,7 @@ subroutine amg_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
!
newsz = -1
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_cprecinit.F90
+8 -8
View File
@@ -88,7 +88,7 @@
! info - integer, output.
! Error code.
!
subroutine amg_cprecinit(ictxt,prec,ptype,info)
subroutine amg_cprecinit(ctxt,prec,ptype,info)
use psb_base_mod
use amg_c_prec_mod, amg_protect_name => amg_cprecinit
@@ -106,15 +106,15 @@ subroutine amg_cprecinit(ictxt,prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='amg_precinit'
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='amg_precinit'
info = psb_success_
if (allocated(prec%precv)) then
@@ -123,7 +123,7 @@ subroutine amg_cprecinit(ictxt,prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype)))
amgprec/impl/amg_d_extprol_bld.F90
+24 -22
View File
@@ -94,10 +94,11 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio
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_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
class(amg_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(amg_dml_parms) :: baseparms, medparms, coarseparms
@@ -120,9 +121,9 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_d_extprol_bld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
p%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -166,12 +167,12 @@ subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv)
nprolv = size(prolv)
nrestrv = size(restrv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ctxt,nprolv)
call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop
end if
end do array_build_loop
@@ -354,9 +355,10 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_dspmat_type) :: ac, am2, am3, am4
type(psb_d_coo_sparse_mat) :: acoo, bcoo
@@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
#if defined(LPK8)
info=psb_err_internal_error_
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')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
call psb_sum(ctxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
@@ -432,7 +434,7 @@ contains
call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_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_cdasb(p%desc_ac,info)
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_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
amgprec/impl/amg_d_hierarchy_bld.f90
+13 -12
View File
@@ -78,8 +78,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -106,9 +107,9 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_d_hierarchy_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -133,10 +134,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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 = max(casize,lone)
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
!
! 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
! on all processes.
!
call psb_bcast(ictxt,prec%precv(i)%parms)
call psb_bcast(ctxt,prec%precv(i)%parms)
!
! 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
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) then
!
amgprec/impl/amg_d_hierarchy_rebld.f90
+6 -5
View File
@@ -78,8 +78,9 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -105,9 +106,9 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
amgprec/impl/amg_d_smoothers_bld.f90
+9 -8
View File
@@ -96,12 +96,13 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -114,8 +115,8 @@ subroutine amg_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_d_smoothers_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& 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
!
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_dfile_prec_descr.f90
+6 -5
View File
@@ -71,9 +71,10 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np
logical :: is_symgs
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_
integer(psb_ipk_) :: root_
@@ -86,11 +87,11 @@ subroutine amg_dfile_prec_descr(prec,iout,root)
end if
if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
call psb_info(ictxt,me,np)
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
amgprec/impl/amg_dmlprec_aply.f90
+79 -70
View File
@@ -222,11 +222,12 @@ subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
real(psb_dpk_) :: beta_
logical :: do_alloc_wrk
type(amg_dmlprec_wrk_type), allocatable, target :: mlprec_wrk(:)
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -365,12 +366,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@@ -450,12 +452,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -578,12 +581,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
name = 'inner_inner_mult'
info = psb_success_
@@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
@@ -802,12 +806,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level
@@ -1166,11 +1171,12 @@ subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type amg_mlwrk_type
real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type amg_mlwrk_type
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -1285,12 +1291,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level
@@ -1368,12 +1375,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -1472,12 +1480,13 @@ contains
type(psb_d_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
amgprec/impl/amg_dmlprec_bld.f90
+9 -8
View File
@@ -94,12 +94,13 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -112,8 +113,8 @@ subroutine amg_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_dmlprec_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
amgprec/impl/amg_dprecaply.f90
+25 -21
View File
@@ -91,16 +91,17 @@ subroutine amg_dprecaply(prec,x,y,desc_data,info,trans,work)
real(psb_dpk_), pointer :: work_(:)
real(psb_dpk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
name='amg_dprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -256,8 +257,9 @@ subroutine amg_dprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
real(psb_dpk_), pointer :: ww(:), w1(:)
character(len=20) :: name
@@ -266,8 +268,8 @@ subroutine amg_dprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then
@@ -321,17 +323,18 @@ subroutine amg_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_dpk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_dprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -470,17 +473,18 @@ subroutine amg_dprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_dpk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_dprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
amgprec/impl/amg_dprecbld.f90
+8 -9
View File
@@ -75,10 +75,10 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables
type(amg_dprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
@@ -94,10 +94,9 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_dprecbld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -116,7 +115,7 @@ subroutine amg_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
!
newsz = -1
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_dprecinit.F90
+8 -8
View File
@@ -88,7 +88,7 @@
! info - integer, output.
! Error code.
!
subroutine amg_dprecinit(ictxt,prec,ptype,info)
subroutine amg_dprecinit(ctxt,prec,ptype,info)
use psb_base_mod
use amg_d_prec_mod, amg_protect_name => amg_dprecinit
@@ -109,15 +109,15 @@ subroutine amg_dprecinit(ictxt,prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='amg_precinit'
integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='amg_precinit'
info = psb_success_
if (allocated(prec%precv)) then
@@ -126,7 +126,7 @@ subroutine amg_dprecinit(ictxt,prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype)))
amgprec/impl/amg_s_extprol_bld.F90
+24 -22
View File
@@ -94,10 +94,11 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio
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_) :: nprolv, nrestrv
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
class(amg_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(amg_sml_parms) :: baseparms, medparms, coarseparms
@@ -120,9 +121,9 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_s_extprol_bld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
p%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -166,12 +167,12 @@ subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv)
nprolv = size(prolv)
nrestrv = size(restrv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ctxt,nprolv)
call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop
end if
end do array_build_loop
@@ -354,9 +355,10 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_sspmat_type) :: ac, am2, am3, am4
type(psb_s_coo_sparse_mat) :: acoo, bcoo
@@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
#if defined(LPK8)
info=psb_err_internal_error_
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')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
call psb_sum(ctxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
@@ -432,7 +434,7 @@ contains
call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_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_cdasb(p%desc_ac,info)
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_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
amgprec/impl/amg_s_hierarchy_bld.f90
+13 -12
View File
@@ -78,8 +78,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -106,9 +107,9 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_s_hierarchy_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -133,10 +134,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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 = max(casize,lone)
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
!
! 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
! on all processes.
!
call psb_bcast(ictxt,prec%precv(i)%parms)
call psb_bcast(ctxt,prec%precv(i)%parms)
!
! 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
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) then
!
amgprec/impl/amg_s_hierarchy_rebld.f90
+6 -5
View File
@@ -78,8 +78,9 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -105,9 +106,9 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
amgprec/impl/amg_s_smoothers_bld.f90
+9 -8
View File
@@ -96,12 +96,13 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -114,8 +115,8 @@ subroutine amg_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_s_smoothers_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& 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
!
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_sfile_prec_descr.f90
+6 -5
View File
@@ -71,9 +71,10 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np
logical :: is_symgs
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_
integer(psb_ipk_) :: root_
@@ -86,11 +87,11 @@ subroutine amg_sfile_prec_descr(prec,iout,root)
end if
if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
call psb_info(ictxt,me,np)
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else
amgprec/impl/amg_smlprec_aply.f90
+79 -70
View File
@@ -222,11 +222,12 @@ subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, nc2l, level, isweep, err_act
character(len=20) :: name
character :: trans_
real(psb_spk_) :: beta_
logical :: do_alloc_wrk
type(amg_smlprec_wrk_type), allocatable, target :: mlprec_wrk(:)
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -365,12 +366,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -385,8 +387,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
@@ -450,12 +452,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act, k
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -470,8 +473,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -578,12 +581,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
name = 'inner_inner_mult'
info = psb_success_
@@ -596,8 +600,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
@@ -802,12 +806,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -822,8 +827,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,name,' start at level ',level
@@ -1166,11 +1171,12 @@ subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name
character :: trans_
type amg_mlwrk_type
real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type amg_mlwrk_type
@@ -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_level = psb_get_debug_level()
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_inner_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -1285,12 +1291,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1305,8 +1312,8 @@ contains
& a_err='wrong call level to inner_ml')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_ml_aply at level ',level
@@ -1368,12 +1375,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1388,8 +1396,8 @@ contains
& a_err='wrong call level to inner_add')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_add at level ',level
@@ -1472,12 +1480,13 @@ contains
type(psb_s_vect_type), pointer :: current
integer(psb_ipk_) :: sweeps_post, sweeps_pre
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: i, err_act
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: nlev, ilev, sweeps
logical :: pre, post
character(len=20) :: name
@@ -1492,8 +1501,8 @@ contains
& a_err='wrong call level to inner_mult')
goto 9999
end if
ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np)
ctxt = p%precv(level)%base_desc%get_context()
call psb_info(ctxt, me, np)
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
amgprec/impl/amg_smlprec_bld.f90
+9 -8
View File
@@ -94,12 +94,13 @@ subroutine amg_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -112,8 +113,8 @@ subroutine amg_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
name = 'amg_smlprec_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
amgprec/impl/amg_sprecaply.f90
+25 -21
View File
@@ -91,16 +91,17 @@ subroutine amg_sprecaply(prec,x,y,desc_data,info,trans,work)
real(psb_spk_), pointer :: work_(:)
real(psb_spk_), allocatable :: w1(:), w2(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
character(len=20) :: name
name='amg_sprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -256,8 +257,9 @@ subroutine amg_sprecaply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
! Local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act
real(psb_spk_), pointer :: ww(:), w1(:)
character(len=20) :: name
@@ -266,8 +268,8 @@ subroutine amg_sprecaply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
allocate(ww(size(x)),w1(size(x)),stat=info)
if (info /= psb_success_) then
@@ -321,17 +323,18 @@ subroutine amg_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_sprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
@@ -470,17 +473,18 @@ subroutine amg_sprecaply1_vect(prec,x,desc_data,info,trans,work)
! Local variables
character :: trans_
real(psb_spk_), pointer :: work_(:)
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_ipk_) :: err_act,iwsz, k, nswps
logical :: do_alloc_wrk
character(len=20) :: name
name='amg_sprecaply'
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_data%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
trans_=psb_toupper(trans)
amgprec/impl/amg_sprecbld.f90
+8 -9
View File
@@ -75,10 +75,10 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
! Local Variables
type(amg_sprec_type) :: t_prec
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
type(amg_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
@@ -94,10 +94,9 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_sprecbld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
@@ -116,7 +115,7 @@ subroutine amg_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
!
newsz = -1
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_sprecinit.F90
+8 -8
View File
@@ -88,7 +88,7 @@
! info - integer, output.
! Error code.
!
subroutine amg_sprecinit(ictxt,prec,ptype,info)
subroutine amg_sprecinit(ctxt,prec,ptype,info)
use psb_base_mod
use amg_s_prec_mod, amg_protect_name => amg_sprecinit
@@ -106,15 +106,15 @@ subroutine amg_sprecinit(ictxt,prec,ptype,info)
implicit none
! Arguments
integer(psb_ipk_), intent(in) :: ictxt
type(psb_ctxt_type), intent(in) :: ctxt
class(amg_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in) :: ptype
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='amg_precinit'
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='amg_precinit'
info = psb_success_
if (allocated(prec%precv)) then
@@ -123,7 +123,7 @@ subroutine amg_sprecinit(ictxt,prec,ptype,info)
! Do we want to do something?
endif
endif
prec%ictxt = ictxt
prec%ctxt = ctxt
prec%ag_data%min_coarse_size = -1
select case(psb_toupper(trim(ptype)))
amgprec/impl/amg_z_extprol_bld.F90
+24 -22
View File
@@ -94,10 +94,11 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! !$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
integer(psb_ipk_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio
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_) :: nprolv, nrestrv
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(amg_ifpsz_), val
class(amg_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(amg_dml_parms) :: baseparms, medparms, coarseparms
@@ -120,9 +121,9 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
name = 'amg_z_extprol_bld'
info = psb_success_
int_err(1) = 0
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
p%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
p%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -166,12 +167,12 @@ subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
iszv = size(p%precv)
nprolv = size(prolv)
nrestrv = size(restrv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
call psb_bcast(ctxt,nprolv)
call psb_bcast(ctxt,nrestrv)
if (casize /= p%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) exit array_build_loop
end if
end do array_build_loop
@@ -354,9 +355,10 @@ contains
integer(psb_ipk_), intent(out) :: info
! Local variables
character(len=20) :: name
integer(psb_mpk_) :: ictxt, np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, ncol
integer(psb_ipk_) :: err_act,ntaggr,nzl
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_zspmat_type) :: ac, am2, am3, am4
type(psb_z_coo_sparse_mat) :: acoo, bcoo
@@ -369,8 +371,8 @@ contains
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)
ctxt = desc_a%get_context()
call psb_info(ctxt,me,np)
#if defined(LPK8)
info=psb_err_internal_error_
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')
goto 9999
end if
call psb_sum(ictxt,nlaggr)
call psb_sum(ctxt,nlaggr)
ntaggr = sum(nlaggr)
ncol = desc_a%get_local_cols()
if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),&
@@ -432,7 +434,7 @@ contains
call ac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == psb_success_) call psb_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_cdasb(p%desc_ac,info)
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_)
!
!
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_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
amgprec/impl/amg_z_hierarchy_bld.f90
+13 -12
View File
@@ -78,8 +78,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -106,9 +107,9 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
name = 'amg_z_hierarchy_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
@@ -133,10 +134,10 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
mnaggratio = prec%ag_data%min_cr_ratio
casize = prec%ag_data%min_coarse_size
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ctxt,iszv)
call psb_bcast(ctxt,casize)
call psb_bcast(ctxt,mxplevs)
call psb_bcast(ctxt,mnaggratio)
if (casize /= prec%ag_data%min_coarse_size) then
info=psb_err_internal_error_
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 = max(casize,lone)
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
!
! 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
! on all processes.
!
call psb_bcast(ictxt,prec%precv(i)%parms)
call psb_bcast(ctxt,prec%precv(i)%parms)
!
! 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
call psb_bcast(ictxt,newsz)
call psb_bcast(ctxt,newsz)
if (newsz > 0) then
!
amgprec/impl/amg_z_hierarchy_rebld.f90
+6 -5
View File
@@ -78,8 +78,9 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
integer(psb_ipk_), intent(out) :: info
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz,&
& nplevs, mxplevs
integer(psb_lpk_) :: iaggsize, casize
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
@@ -105,9 +106,9 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
name = 'amg_hierarchy_rebld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
prec%ictxt = ictxt
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
prec%ctxt = ctxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Entering '
amgprec/impl/amg_z_smoothers_bld.f90
+9 -8
View File
@@ -96,12 +96,13 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
integer(psb_ipk_) :: coarse_solve_id
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
info=psb_success_
err=0
@@ -114,8 +115,8 @@ subroutine amg_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
name = 'amg_z_smoothers_bld'
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& 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
!
iszv = size(prec%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ctxt,iszv)
if (iszv /= size(prec%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
amgprec/impl/amg_zfile_prec_descr.f90
+6 -5
View File
@@ -71,9 +71,10 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
integer(psb_ipk_) :: ictxt, me, np
logical :: is_symgs
integer(psb_ipk_) :: ilev, nlev, ilmin, info, nswps
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: me, np
logical :: is_symgs
character(len=20), parameter :: name='amg_file_prec_descr'
integer(psb_ipk_) :: iout_
integer(psb_ipk_) :: root_
@@ -86,11 +87,11 @@ subroutine amg_zfile_prec_descr(prec,iout,root)
end if
if (iout_ < 0) iout_ = psb_out_unit
ictxt = prec%ictxt
ctxt = prec%ctxt
if (allocated(prec%precv)) then
call psb_info(ictxt,me,np)
call psb_info(ctxt,me,np)
if (present(root)) then
root_ = root
else

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