mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-07 07:04:59 +00:00
Compare commits
3
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Salvatore Filippone
|
bbed340405 | ||
|
Salvatore Filippone
|
51a9d16975 | ||
|
Salvatore Filippone
|
a04f7b4cf0 |
+3
-3
@@ -12,9 +12,9 @@ config.log
|
||||
config.status
|
||||
|
||||
# generated folder
|
||||
/include/
|
||||
/modules/
|
||||
/docs/src/tmp
|
||||
include/
|
||||
modules/
|
||||
docs/src/tmp
|
||||
autom4te.cache
|
||||
|
||||
# the executable from tests
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
Changelog. A lot less detailed than usual, at least for past
|
||||
history.
|
||||
2022/05/20: Restart ChangeLog. Updated to new name AMG4PSBLAS, now using PSB3.8
|
||||
2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
|
||||
2018/10/10: ICTXT argument in prec%init().
|
||||
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples.
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
|
||||
|
||||
AMG4PSBLAS version 1.1
|
||||
AMG4PSBLAS version 1.0
|
||||
Algebraic Multigrid Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.8)
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
(C) Copyright 2022
|
||||
(C) Copyright 2021
|
||||
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
|
||||
@@ -1,13 +1,10 @@
|
||||
include Make.inc
|
||||
|
||||
|
||||
all: objs lib
|
||||
all: library
|
||||
|
||||
objs: amgp cbnd
|
||||
|
||||
lib: libdir objs
|
||||
cd amgprec && $(MAKE) lib
|
||||
cd cbind && $(MAKE) lib
|
||||
library: libdir amgp cbnd
|
||||
#cbnd
|
||||
|
||||
libdir:
|
||||
(if test ! -d lib ; then mkdir lib; fi)
|
||||
@@ -17,11 +14,10 @@ libdir:
|
||||
|
||||
|
||||
amgp:
|
||||
cd amgprec && $(MAKE) objs
|
||||
$(MAKE) -C amgprec all
|
||||
cbnd: amgp
|
||||
cd cbind && $(MAKE) objs
|
||||
|
||||
install: lib
|
||||
$(MAKE) -C cbind all
|
||||
install: all
|
||||
mkdir -p $(INSTALL_LIBDIR) &&\
|
||||
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
|
||||
mkdir -p $(INSTALL_INCLUDEDIR) &&\
|
||||
@@ -45,14 +41,14 @@ cleanlib:
|
||||
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
|
||||
veryclean: cleanlib
|
||||
(cd amgprec && $(MAKE) veryclean)
|
||||
(cd samples/simple/fileread && $(MAKE) clean)
|
||||
(cd samples/simple/pdegen && $(MAKE) clean)
|
||||
(cd samples/advanced/fileread && $(MAKE) clean)
|
||||
(cd samples/advanced/pdegen && $(MAKE) clean)
|
||||
(cd amgprec; make veryclean)
|
||||
(cd samples/simple/fileread; make clean)
|
||||
(cd samples/simple/pdegen; make clean)
|
||||
(cd samples/advanced/fileread; make clean)
|
||||
(cd samples/advanced/pdegen; make clean)
|
||||
|
||||
check: all
|
||||
make check -C samples/advanced/pdegen
|
||||
|
||||
clean:
|
||||
(cd amgprec && $(MAKE) clean)
|
||||
(cd amgprec; make clean)
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
|
||||
AMG4PSBLAS
|
||||
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.8)
|
||||
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
|
||||
Pasqua D'Ambra (IAC-CNR, Naples, IT)
|
||||
|
||||
+6
-9
@@ -62,20 +62,17 @@ OBJS=$(MODOBJS)
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: objs impld
|
||||
all: lib impld
|
||||
|
||||
objs: $(OBJS)
|
||||
/bin/cp -p amg_const.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
impld: objs
|
||||
cd impl && $(MAKE)
|
||||
impld: $(OBJS)
|
||||
$(MAKE) -C impl
|
||||
|
||||
lib: $(OBJS) impld
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p amg_const.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
|
||||
@@ -221,4 +218,4 @@ clean: implclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
cd impl && $(MAKE) clean
|
||||
$(MAKE) -C impl clean
|
||||
|
||||
+56
-139
@@ -64,7 +64,7 @@ module amg_base_prec_type
|
||||
!
|
||||
use psb_const_mod
|
||||
use psb_base_mod, only :&
|
||||
& psb_desc_type, psb_ctxt_type,&
|
||||
& psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
|
||||
& psb_ipk_, psb_dpk_, psb_spk_, psb_epk_, &
|
||||
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
|
||||
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
|
||||
@@ -81,10 +81,10 @@ module amg_base_prec_type
|
||||
!
|
||||
! Version numbers
|
||||
!
|
||||
character(len=*), parameter :: amg_version_string_ = "1.1.0"
|
||||
character(len=*), parameter :: amg_version_string_ = "1.0.1"
|
||||
integer(psb_ipk_), parameter :: amg_version_major_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_version_minor_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
|
||||
integer(psb_ipk_), parameter :: amg_version_minor_ = 0
|
||||
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
|
||||
|
||||
type amg_ml_parms
|
||||
integer(psb_ipk_) :: sweeps_pre, sweeps_post
|
||||
@@ -94,7 +94,6 @@ module amg_base_prec_type
|
||||
integer(psb_ipk_) :: aggr_omega_alg, aggr_eig, aggr_filter
|
||||
integer(psb_ipk_) :: coarse_mat, coarse_solve
|
||||
contains
|
||||
procedure, pass(pm) :: get_coarse_mat => ml_parms_get_coarse_mat
|
||||
procedure, pass(pm) :: get_coarse => ml_parms_get_coarse
|
||||
procedure, pass(pm) :: clone => ml_parms_clone
|
||||
procedure, pass(pm) :: descr => ml_parms_descr
|
||||
@@ -578,33 +577,6 @@ contains
|
||||
end select
|
||||
end function amg_stringval
|
||||
|
||||
function amg_get_coarse_mat_name(val) result(res)
|
||||
character(len=15) :: res
|
||||
integer :: val
|
||||
select case(val)
|
||||
case (0,1)
|
||||
res = matrix_names(val)
|
||||
case default
|
||||
res = 'Unknown '
|
||||
end select
|
||||
end function amg_get_coarse_mat_name
|
||||
|
||||
subroutine amg_warn_coarse_mat(val,expected)
|
||||
integer(psb_ipk_) :: val, expected
|
||||
if (val /= expected) then
|
||||
write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
|
||||
& amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected)
|
||||
end if
|
||||
end subroutine amg_warn_coarse_mat
|
||||
|
||||
|
||||
function ml_parms_get_coarse_mat(pm) result(res)
|
||||
implicit none
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_) :: res
|
||||
res = pm%coarse_mat
|
||||
end function ml_parms_get_coarse_mat
|
||||
|
||||
subroutine ml_parms_get_coarse(pm,pmin)
|
||||
implicit none
|
||||
class(amg_ml_parms), intent(inout) :: pm
|
||||
@@ -677,52 +649,43 @@ contains
|
||||
end if
|
||||
end subroutine ml_parms_mlcycledsc
|
||||
|
||||
subroutine ml_parms_mldescr(pm,iout,info,prefix)
|
||||
subroutine ml_parms_mldescr(pm,iout,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
|
||||
|
||||
|
||||
write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',&
|
||||
write(iout,*) ' Parallel aggregation algorithm: ',&
|
||||
& par_aggr_alg_names(pm%par_aggr_alg)
|
||||
if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',&
|
||||
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
|
||||
& aggr_type_names(pm%aggr_type)
|
||||
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
|
||||
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
|
||||
& write(iout,*) trim(prefix),' with initial ordering: ',&
|
||||
& write(iout,*) ' with initial ordering: ',&
|
||||
& ord_names(pm%aggr_ord)
|
||||
write(iout,*) trim(prefix),' Aggregation prolongator: ', &
|
||||
write(iout,*) ' Aggregation prolongator: ', &
|
||||
& aggr_prols(pm%aggr_prol)
|
||||
if (pm%aggr_prol /= amg_no_smooth_) then
|
||||
write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter)
|
||||
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
|
||||
if (pm%aggr_omega_alg == amg_eig_est_) then
|
||||
write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
|
||||
write(iout,*) trim(prefix),' Spectral radius estimate: ', &
|
||||
write(iout,*) ' Damping omega computation: spectral radius estimate'
|
||||
write(iout,*) ' Spectral radius estimate: ', &
|
||||
& eigen_estimates(pm%aggr_eig)
|
||||
else if (pm%aggr_omega_alg == amg_user_choice_) then
|
||||
write(iout,*) trim(prefix),' Damping omega computation: user defined value.'
|
||||
write(iout,*) ' Damping omega computation: user defined value.'
|
||||
else
|
||||
write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!'
|
||||
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
|
||||
end if
|
||||
end if
|
||||
!end if
|
||||
else
|
||||
write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
|
||||
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
|
||||
& pm%ml_cycle
|
||||
end if
|
||||
|
||||
@@ -730,16 +693,15 @@ contains
|
||||
|
||||
end subroutine ml_parms_mldescr
|
||||
|
||||
subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
|
||||
subroutine ml_parms_descr(pm,iout,info,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
logical :: coarse_
|
||||
|
||||
info = psb_success_
|
||||
@@ -750,7 +712,7 @@ contains
|
||||
end if
|
||||
|
||||
if (coarse_) then
|
||||
call pm%coarsedescr(iout,info,prefix=prefix)
|
||||
call pm%coarsedescr(iout,info)
|
||||
end if
|
||||
|
||||
return
|
||||
@@ -758,126 +720,81 @@ contains
|
||||
end subroutine ml_parms_descr
|
||||
|
||||
|
||||
subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
|
||||
subroutine ml_parms_coarsedescr(pm,iout,info)
|
||||
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
class(amg_ml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix),' Coarse matrix: ',&
|
||||
write(iout,*) ' Coarse matrix: ',&
|
||||
& matrix_names(pm%coarse_mat)
|
||||
select case(pm%coarse_solve)
|
||||
case (amg_bjac_,amg_as_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
write(iout,*) ' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
write(iout,*) ' Coarse solver: ',&
|
||||
& 'Block Jacobi'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_l1_bjac_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
write(iout,*) ' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
write(iout,*) ' Coarse solver: ',&
|
||||
& 'L1-Block Jacobi'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_jac_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
write(iout,*) ' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
write(iout,*) ' Coarse solver: ',&
|
||||
& 'Point Jacobi'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_l1_jac_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
& 'L1-Jacobi'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_l1_fbgs_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_l1_gs_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
& 'L1 Gauss-Seidel (Hybrid)'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case (amg_fbgs_)
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
& 'Forward-Backward Gauss-Seidel (Hybrid)'
|
||||
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
||||
& pm%sweeps_pre
|
||||
case default
|
||||
write(iout,*) trim(prefix),' Coarse solver: ',&
|
||||
write(iout,*) ' Coarse solver: ',&
|
||||
& amg_fact_names(pm%coarse_solve)
|
||||
end select
|
||||
|
||||
|
||||
end subroutine ml_parms_coarsedescr
|
||||
|
||||
subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
|
||||
subroutine s_ml_parms_descr(pm,iout,info,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_sml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
class(amg_sml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
|
||||
call pm%amg_ml_parms%descr(iout,info,coarse)
|
||||
if (pm%aggr_prol /= amg_no_smooth_) then
|
||||
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
|
||||
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
|
||||
end if
|
||||
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
|
||||
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_ml_parms_descr
|
||||
|
||||
subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
|
||||
subroutine d_ml_parms_descr(pm,iout,info,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_dml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
class(amg_dml_parms), intent(in) :: pm
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
info = psb_success_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
|
||||
call pm%amg_ml_parms%descr(iout,info,coarse)
|
||||
if (pm%aggr_prol /= amg_no_smooth_) then
|
||||
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
|
||||
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
|
||||
end if
|
||||
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
|
||||
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -58,7 +58,6 @@ module amg_c_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_c_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_c_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_c_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr
|
||||
@@ -86,16 +85,6 @@ module amg_c_ainv_solver
|
||||
end subroutine amg_c_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -209,7 +198,7 @@ module amg_c_ainv_solver
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -219,7 +208,7 @@ module amg_c_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine c_as_smoother_default
|
||||
|
||||
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_c_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_descr
|
||||
|
||||
@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_c_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -184,23 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_c_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_dec_aggregator_descr
|
||||
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine c_diag_solver_free
|
||||
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -359,7 +352,7 @@ module amg_c_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+12
-26
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine c_gs_solver_free
|
||||
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function c_gs_solver_is_iterative
|
||||
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine c_id_solver_free
|
||||
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_c_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine c_ilu_solver_free
|
||||
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_c_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_c_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
|
||||
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
|
||||
@@ -74,17 +73,6 @@ module amg_c_invk_solver
|
||||
end subroutine amg_c_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -135,7 +123,7 @@ module amg_c_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,7 +133,7 @@ module amg_c_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_invk_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_c_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr
|
||||
@@ -74,17 +73,6 @@ module amg_c_invt_solver
|
||||
end subroutine amg_c_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -146,17 +134,16 @@ module amg_c_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_c_invt_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -219,13 +219,12 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_c_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_c_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -314,13 +313,12 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_c_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_c_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -436,7 +436,7 @@ contains
|
||||
val = "KRM solver"
|
||||
end function c_krm_solver_get_fmt
|
||||
|
||||
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_krm_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -444,14 +444,12 @@ contains
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,22 +458,23 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -313,24 +313,22 @@ subroutine c_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine c_mumps_solver_finalize
|
||||
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
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_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -339,13 +337,8 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -189,7 +189,6 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_c_base_onelev_descr
|
||||
procedure, pass(lv) :: default => c_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_c_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => c_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_c_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_c_base_onelev_dump
|
||||
@@ -258,7 +257,7 @@ module amg_c_onelev_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
|
||||
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
|
||||
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
|
||||
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
@@ -269,7 +268,6 @@ module amg_c_onelev_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_onelev_descr
|
||||
end interface
|
||||
|
||||
@@ -286,7 +284,7 @@ module amg_c_onelev_mod
|
||||
end subroutine amg_c_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_c_base_onelev_free(lv,info)
|
||||
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
|
||||
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
|
||||
@@ -298,18 +296,6 @@ module amg_c_onelev_mod
|
||||
end subroutine amg_c_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_free_smoothers(lv,info)
|
||||
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
|
||||
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
implicit none
|
||||
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_check(lv,info)
|
||||
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
|
||||
|
||||
@@ -135,9 +135,7 @@ module amg_c_prec_type
|
||||
procedure, pass(prec) :: build => amg_cprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_c_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_c_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_c_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_c_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_c_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_cfile_prec_descr
|
||||
end type amg_cprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ module amg_c_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity)
|
||||
import :: amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_cfile_prec_descr
|
||||
end interface
|
||||
|
||||
@@ -347,14 +344,6 @@ module amg_c_prec_type
|
||||
end subroutine amg_c_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_c_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_c_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -628,68 +617,6 @@ contains
|
||||
|
||||
end subroutine amg_c_prec_free
|
||||
|
||||
subroutine amg_c_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_smoothers_free
|
||||
|
||||
subroutine amg_c_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -385,22 +385,20 @@ contains
|
||||
|
||||
end subroutine c_slu_solver_finalize
|
||||
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_c_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -409,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_c_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_c_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_c_symdec_aggregator_descr
|
||||
|
||||
@@ -58,7 +58,6 @@ module amg_d_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_d_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_d_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_d_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr
|
||||
@@ -86,16 +85,6 @@ module amg_d_ainv_solver
|
||||
end subroutine amg_d_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -209,7 +198,7 @@ module amg_d_ainv_solver
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -219,7 +208,7 @@ module amg_d_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine d_as_smoother_default
|
||||
|
||||
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_d_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_descr
|
||||
|
||||
@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_d_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -184,23 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_d_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_dec_aggregator_descr
|
||||
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine d_diag_solver_free
|
||||
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -359,7 +352,7 @@ module amg_d_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+12
-26
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine d_gs_solver_free
|
||||
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function d_gs_solver_is_iterative
|
||||
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine d_id_solver_free
|
||||
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_d_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine d_ilu_solver_free
|
||||
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_d_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_d_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
|
||||
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
|
||||
@@ -74,17 +73,6 @@ module amg_d_invk_solver
|
||||
end subroutine amg_d_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -135,7 +123,7 @@ module amg_d_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,7 +133,7 @@ module amg_d_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_invk_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_d_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr
|
||||
@@ -74,17 +73,6 @@ module amg_d_invt_solver
|
||||
end subroutine amg_d_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -146,17 +134,16 @@ module amg_d_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_d_invt_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -219,13 +219,12 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_d_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_d_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -314,13 +313,12 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_d_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_d_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -436,7 +436,7 @@ contains
|
||||
val = "KRM solver"
|
||||
end function d_krm_solver_get_fmt
|
||||
|
||||
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_krm_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -444,14 +444,12 @@ contains
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,22 +458,23 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -143,10 +143,9 @@ contains
|
||||
type(psb_ld_coo_sparse_mat) :: tmpcoo
|
||||
logical :: display_out_, print_out_, reproducible_
|
||||
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
|
||||
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
|
||||
& debug_ilaggr=.false., debug_sync=.false.
|
||||
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
call psb_info(ictxt,iam,np)
|
||||
@@ -188,7 +187,7 @@ contains
|
||||
call desc_a%l2gip(ilv,info,owned=.false.)
|
||||
|
||||
call psb_geall(ilaggr,desc_a,info)
|
||||
ilaggr = ilaggr_neginit
|
||||
ilaggr = -1
|
||||
call psb_geasb(ilaggr,desc_a,info)
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
@@ -214,20 +213,7 @@ contains
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == 0) write(0,*)' out from buildmatching:', info
|
||||
end if
|
||||
if (debug_mate) then
|
||||
block
|
||||
integer(psb_lpk_), allocatable :: ckmate(:)
|
||||
allocate(ckmate(nr))
|
||||
ckmate(1:nr) = mate(1:nr)
|
||||
call psb_msort(ckmate(1:nr))
|
||||
do i=1,nr-1
|
||||
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
|
||||
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
|
||||
end if
|
||||
end do
|
||||
end block
|
||||
end if
|
||||
|
||||
|
||||
if (info == 0) then
|
||||
if (do_timings) call psb_tic(idx_phase2)
|
||||
if (debug_sync) then
|
||||
@@ -273,7 +259,7 @@ contains
|
||||
cycle
|
||||
else
|
||||
|
||||
if (ilaggr(k) == ilaggr_neginit) then
|
||||
if (ilaggr(k) == -1) then
|
||||
|
||||
wk = w(k)
|
||||
widx = w(idx)
|
||||
@@ -281,7 +267,7 @@ contains
|
||||
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
|
||||
if (nrmagg > epsilon(nrmagg)) then
|
||||
if (idx <= nr) then
|
||||
if (ilaggr(idx) == ilaggr_neginit) then
|
||||
if (ilaggr(idx) == -1) then
|
||||
! Now, if both vertices are local, the aggregate is local
|
||||
! (kinda obvious).
|
||||
nlaggr(iam) = nlaggr(iam) + 1
|
||||
@@ -289,9 +275,6 @@ contains
|
||||
ilaggr(idx) = nlaggr(iam)
|
||||
wtemp(k) = w(k)/nrmagg
|
||||
wtemp(idx) = w(idx)/nrmagg
|
||||
else
|
||||
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
|
||||
&mate(idx),ilaggr(idx)
|
||||
end if
|
||||
nlpairs = nlpairs+1
|
||||
else if (idx <= nc) then
|
||||
@@ -311,7 +294,7 @@ contains
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
nlpairs = nlpairs+1
|
||||
else
|
||||
ilaggr(k) = ilaggr_nonlocal
|
||||
ilaggr(k) = -2
|
||||
end if
|
||||
else
|
||||
! Use a statistically unbiased tie-breaking rule,
|
||||
@@ -326,7 +309,7 @@ contains
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
nlpairs = nlpairs+1
|
||||
else
|
||||
ilaggr(k) = ilaggr_nonlocal
|
||||
ilaggr(k) = -2
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
@@ -342,12 +325,6 @@ contains
|
||||
nlsingl = nlsingl + 1
|
||||
end if
|
||||
end if
|
||||
if (ilaggr(k) == ilaggr_neginit) then
|
||||
write(0,*) iam,' Error: no update to ',k,mate(k),&
|
||||
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
|
||||
end if
|
||||
else
|
||||
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
@@ -355,7 +332,7 @@ contains
|
||||
if (do_timings) call psb_tic(idx_phase3)
|
||||
|
||||
! Ok, now compute offsets, gather halo and fix non-local
|
||||
! aggregates (those where ilaggr == ilaggr_nonlocal)
|
||||
! aggregates (those where ilaggr == -2)
|
||||
call psb_sum(ictxt,nlaggr)
|
||||
ntaggr = sum(nlaggr(0:np-1))
|
||||
naggrm1 = sum(nlaggr(0:iam-1))
|
||||
@@ -370,7 +347,7 @@ contains
|
||||
call psb_halo(wtemp,desc_a,info)
|
||||
! Cleanup as yet unmarked entries
|
||||
do k=1,nr
|
||||
if (ilaggr(k) == ilaggr_nonlocal) then
|
||||
if (ilaggr(k) == -2) then
|
||||
idx = mate(k)
|
||||
if (idx > nr) then
|
||||
i = ilaggr(idx)
|
||||
@@ -382,14 +359,9 @@ contains
|
||||
else
|
||||
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
|
||||
end if
|
||||
else if (ilaggr(k) <0) then
|
||||
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
|
||||
write(0,*) iam,' : : ',nr,nc,mate(k)
|
||||
if (mate(k) <= nr) then
|
||||
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
|
||||
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
|
||||
end if
|
||||
flush(0)
|
||||
end if
|
||||
if (ilaggr(k) <0) then
|
||||
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
|
||||
end if
|
||||
end do
|
||||
if (debug_sync) then
|
||||
@@ -442,7 +414,7 @@ contains
|
||||
|
||||
end block
|
||||
if (iam == 0) then
|
||||
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
|
||||
write(0,*) 'Matching statistics: Unmatched nodes ',&
|
||||
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
|
||||
end if
|
||||
|
||||
|
||||
@@ -313,24 +313,22 @@ subroutine d_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine d_mumps_solver_finalize
|
||||
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
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_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -339,13 +337,8 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -190,7 +190,6 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_d_base_onelev_descr
|
||||
procedure, pass(lv) :: default => d_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_d_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => d_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_d_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_d_base_onelev_dump
|
||||
@@ -259,7 +258,7 @@ module amg_d_onelev_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
|
||||
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
@@ -270,7 +269,6 @@ module amg_d_onelev_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_onelev_descr
|
||||
end interface
|
||||
|
||||
@@ -287,7 +285,7 @@ module amg_d_onelev_mod
|
||||
end subroutine amg_d_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_d_base_onelev_free(lv,info)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
|
||||
@@ -299,18 +297,6 @@ module amg_d_onelev_mod
|
||||
end subroutine amg_d_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_free_smoothers(lv,info)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
implicit none
|
||||
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_check(lv,info)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
|
||||
@@ -390,25 +390,18 @@ contains
|
||||
|
||||
end function amg_d_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Parallel Matching Aggregator'
|
||||
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_descr
|
||||
|
||||
@@ -135,9 +135,7 @@ module amg_d_prec_type
|
||||
procedure, pass(prec) :: build => amg_dprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_d_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_d_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_d_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_d_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_d_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_dfile_prec_descr
|
||||
end type amg_dprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ module amg_d_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity)
|
||||
import :: amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_dfile_prec_descr
|
||||
end interface
|
||||
|
||||
@@ -347,14 +344,6 @@ module amg_d_prec_type
|
||||
end subroutine amg_d_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_d_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_d_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -628,68 +617,6 @@ contains
|
||||
|
||||
end subroutine amg_d_prec_free
|
||||
|
||||
subroutine amg_d_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_smoothers_free
|
||||
|
||||
subroutine amg_d_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -385,22 +385,20 @@ contains
|
||||
|
||||
end subroutine d_slu_solver_finalize
|
||||
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -409,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -270,13 +270,13 @@ contains
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_lpk_), allocatable :: gia(:), gja(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_lpk_) :: lfrst
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer(psb_ipk_) :: ifrst, ibcheck
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_sludist_solver_bld', ch_err
|
||||
character(len=20) :: name='d_sludist_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -325,6 +325,7 @@ contains
|
||||
acsr%ja(:) = acsr%ja(:) - 1
|
||||
acsr%irp(:) = acsr%irp(:) - 1
|
||||
ifrst = lfrst - 1
|
||||
|
||||
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
|
||||
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
|
||||
& npr,npc)
|
||||
@@ -421,16 +422,15 @@ contains
|
||||
|
||||
end subroutine d_sludist_solver_finalize
|
||||
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_sludist_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
@@ -438,7 +438,6 @@ contains
|
||||
integer :: me, np
|
||||
character(len=20), parameter :: name='amg_d_sludist_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -447,13 +446,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_d_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_d_symdec_aggregator_descr
|
||||
|
||||
@@ -390,22 +390,20 @@ contains
|
||||
|
||||
end subroutine d_umf_solver_finalize
|
||||
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_umf_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_umf_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -414,13 +412,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
|
||||
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -58,7 +58,6 @@ module amg_s_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_s_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_s_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_s_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr
|
||||
@@ -86,16 +85,6 @@ module amg_s_ainv_solver
|
||||
end subroutine amg_s_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -209,7 +198,7 @@ module amg_s_ainv_solver
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -219,7 +208,7 @@ module amg_s_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine s_as_smoother_default
|
||||
|
||||
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_s_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_descr
|
||||
|
||||
@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_s_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -184,23 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_s_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_dec_aggregator_descr
|
||||
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine s_diag_solver_free
|
||||
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -359,7 +352,7 @@ module amg_s_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+12
-26
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine s_gs_solver_free
|
||||
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function s_gs_solver_is_iterative
|
||||
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine s_id_solver_free
|
||||
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_s_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine s_ilu_solver_free
|
||||
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_s_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_s_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
|
||||
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
|
||||
@@ -74,17 +73,6 @@ module amg_s_invk_solver
|
||||
end subroutine amg_s_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -135,7 +123,7 @@ module amg_s_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,7 +133,7 @@ module amg_s_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_invk_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_s_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr
|
||||
@@ -74,17 +73,6 @@ module amg_s_invt_solver
|
||||
end subroutine amg_s_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -146,17 +134,16 @@ module amg_s_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_s_invt_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -219,13 +219,12 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_s_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_s_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -314,13 +313,12 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_s_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_s_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -436,7 +436,7 @@ contains
|
||||
val = "KRM solver"
|
||||
end function s_krm_solver_get_fmt
|
||||
|
||||
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_krm_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -444,14 +444,12 @@ contains
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,22 +458,23 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -143,10 +143,9 @@ contains
|
||||
type(psb_ls_coo_sparse_mat) :: tmpcoo
|
||||
logical :: display_out_, print_out_, reproducible_
|
||||
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
|
||||
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
|
||||
& debug_ilaggr=.false., debug_sync=.false.
|
||||
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
|
||||
|
||||
ictxt = desc_a%get_ctxt()
|
||||
call psb_info(ictxt,iam,np)
|
||||
@@ -188,7 +187,7 @@ contains
|
||||
call desc_a%l2gip(ilv,info,owned=.false.)
|
||||
|
||||
call psb_geall(ilaggr,desc_a,info)
|
||||
ilaggr = ilaggr_neginit
|
||||
ilaggr = -1
|
||||
call psb_geasb(ilaggr,desc_a,info)
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
@@ -214,20 +213,7 @@ contains
|
||||
call psb_barrier(ictxt)
|
||||
if (iam == 0) write(0,*)' out from buildmatching:', info
|
||||
end if
|
||||
if (debug_mate) then
|
||||
block
|
||||
integer(psb_lpk_), allocatable :: ckmate(:)
|
||||
allocate(ckmate(nr))
|
||||
ckmate(1:nr) = mate(1:nr)
|
||||
call psb_msort(ckmate(1:nr))
|
||||
do i=1,nr-1
|
||||
if ((ckmate(i)>0) .and. (ckmate(i) == ckmate(i+1))) then
|
||||
write(0,*) iam,' Duplicate mate entry at',i,' :',ckmate(i)
|
||||
end if
|
||||
end do
|
||||
end block
|
||||
end if
|
||||
|
||||
|
||||
if (info == 0) then
|
||||
if (do_timings) call psb_tic(idx_phase2)
|
||||
if (debug_sync) then
|
||||
@@ -273,7 +259,7 @@ contains
|
||||
cycle
|
||||
else
|
||||
|
||||
if (ilaggr(k) == ilaggr_neginit) then
|
||||
if (ilaggr(k) == -1) then
|
||||
|
||||
wk = w(k)
|
||||
widx = w(idx)
|
||||
@@ -281,7 +267,7 @@ contains
|
||||
nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2)
|
||||
if (nrmagg > epsilon(nrmagg)) then
|
||||
if (idx <= nr) then
|
||||
if (ilaggr(idx) == ilaggr_neginit) then
|
||||
if (ilaggr(idx) == -1) then
|
||||
! Now, if both vertices are local, the aggregate is local
|
||||
! (kinda obvious).
|
||||
nlaggr(iam) = nlaggr(iam) + 1
|
||||
@@ -289,9 +275,6 @@ contains
|
||||
ilaggr(idx) = nlaggr(iam)
|
||||
wtemp(k) = w(k)/nrmagg
|
||||
wtemp(idx) = w(idx)/nrmagg
|
||||
else
|
||||
write(0,*) iam,' Inconsistent mate? ',k,mate(k),idx,&
|
||||
&mate(idx),ilaggr(idx)
|
||||
end if
|
||||
nlpairs = nlpairs+1
|
||||
else if (idx <= nc) then
|
||||
@@ -311,7 +294,7 @@ contains
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
nlpairs = nlpairs+1
|
||||
else
|
||||
ilaggr(k) = ilaggr_nonlocal
|
||||
ilaggr(k) = -2
|
||||
end if
|
||||
else
|
||||
! Use a statistically unbiased tie-breaking rule,
|
||||
@@ -326,7 +309,7 @@ contains
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
nlpairs = nlpairs+1
|
||||
else
|
||||
ilaggr(k) = ilaggr_nonlocal
|
||||
ilaggr(k) = -2
|
||||
end if
|
||||
end if
|
||||
end if
|
||||
@@ -342,12 +325,6 @@ contains
|
||||
nlsingl = nlsingl + 1
|
||||
end if
|
||||
end if
|
||||
if (ilaggr(k) == ilaggr_neginit) then
|
||||
write(0,*) iam,' Error: no update to ',k,mate(k),&
|
||||
& abs(w(k)),nrmagg,epsilon(nrmagg),wtemp(k)
|
||||
end if
|
||||
else
|
||||
if (ilaggr(k)<0) write(0,*) 'Strange? ',k,ilaggr(k)
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
@@ -355,7 +332,7 @@ contains
|
||||
if (do_timings) call psb_tic(idx_phase3)
|
||||
|
||||
! Ok, now compute offsets, gather halo and fix non-local
|
||||
! aggregates (those where ilaggr == ilaggr_nonlocal)
|
||||
! aggregates (those where ilaggr == -2)
|
||||
call psb_sum(ictxt,nlaggr)
|
||||
ntaggr = sum(nlaggr(0:np-1))
|
||||
naggrm1 = sum(nlaggr(0:iam-1))
|
||||
@@ -370,7 +347,7 @@ contains
|
||||
call psb_halo(wtemp,desc_a,info)
|
||||
! Cleanup as yet unmarked entries
|
||||
do k=1,nr
|
||||
if (ilaggr(k) == ilaggr_nonlocal) then
|
||||
if (ilaggr(k) == -2) then
|
||||
idx = mate(k)
|
||||
if (idx > nr) then
|
||||
i = ilaggr(idx)
|
||||
@@ -382,14 +359,9 @@ contains
|
||||
else
|
||||
write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx)
|
||||
end if
|
||||
else if (ilaggr(k) <0) then
|
||||
write(0,*) iam,'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
|
||||
write(0,*) iam,' : : ',nr,nc,mate(k)
|
||||
if (mate(k) <= nr) then
|
||||
write(0,*) iam,' : : ',ilaggr(mate(k)),mate(mate(k)),&
|
||||
& ilv(k),ilv(mate(k)), ilv(mate(mate(k))),ilaggr(mate(mate(k)))
|
||||
end if
|
||||
flush(0)
|
||||
end if
|
||||
if (ilaggr(k) <0) then
|
||||
write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k)
|
||||
end if
|
||||
end do
|
||||
if (debug_sync) then
|
||||
@@ -442,7 +414,7 @@ contains
|
||||
|
||||
end block
|
||||
if (iam == 0) then
|
||||
write(0,*) iam,'Matching statistics: Unmatched nodes ',&
|
||||
write(0,*) 'Matching statistics: Unmatched nodes ',&
|
||||
& nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs
|
||||
end if
|
||||
|
||||
|
||||
@@ -313,24 +313,22 @@ subroutine s_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine s_mumps_solver_finalize
|
||||
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
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_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -339,13 +337,8 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -190,7 +190,6 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_s_base_onelev_descr
|
||||
procedure, pass(lv) :: default => s_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_s_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => s_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_s_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_s_base_onelev_dump
|
||||
@@ -259,7 +258,7 @@ module amg_s_onelev_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
|
||||
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
@@ -270,7 +269,6 @@ module amg_s_onelev_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_onelev_descr
|
||||
end interface
|
||||
|
||||
@@ -287,7 +285,7 @@ module amg_s_onelev_mod
|
||||
end subroutine amg_s_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_s_base_onelev_free(lv,info)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
|
||||
@@ -299,18 +297,6 @@ module amg_s_onelev_mod
|
||||
end subroutine amg_s_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_free_smoothers(lv,info)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
implicit none
|
||||
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_check(lv,info)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
|
||||
@@ -390,25 +390,18 @@ contains
|
||||
|
||||
end function amg_s_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Parallel Matching Aggregator'
|
||||
write(iout,*) ' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) ' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_descr
|
||||
|
||||
@@ -135,9 +135,7 @@ module amg_s_prec_type
|
||||
procedure, pass(prec) :: build => amg_sprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_s_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_s_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_s_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_s_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_s_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_sfile_prec_descr
|
||||
end type amg_sprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ module amg_s_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity)
|
||||
import :: amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_sfile_prec_descr
|
||||
end interface
|
||||
|
||||
@@ -347,14 +344,6 @@ module amg_s_prec_type
|
||||
end subroutine amg_s_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_s_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_s_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -628,68 +617,6 @@ contains
|
||||
|
||||
end subroutine amg_s_prec_free
|
||||
|
||||
subroutine amg_s_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_s_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_s_smoothers_free
|
||||
|
||||
subroutine amg_s_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_s_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_s_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -385,22 +385,20 @@ contains
|
||||
|
||||
end subroutine s_slu_solver_finalize
|
||||
|
||||
subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine s_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_s_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -409,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_s_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_s_symdec_aggregator_descr
|
||||
|
||||
@@ -58,7 +58,6 @@ module amg_z_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_z_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_z_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_z_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_z_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_z_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_z_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_z_ainv_solver_csetr
|
||||
@@ -86,16 +85,6 @@ module amg_z_ainv_solver
|
||||
end subroutine amg_z_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -209,7 +198,7 @@ module amg_z_ainv_solver
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -219,7 +208,7 @@ module amg_z_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_z_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -396,23 +396,21 @@ contains
|
||||
end subroutine z_as_smoother_default
|
||||
|
||||
|
||||
subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine z_as_smoother_descr(sm,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -426,21 +424,16 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -275,22 +275,15 @@ contains
|
||||
val = .false.
|
||||
end function amg_z_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_z_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_z_base_aggregator_descr
|
||||
|
||||
@@ -272,7 +272,7 @@ module amg_z_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_z_base_smoother_descr(sm,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
|
||||
& amg_z_base_smoother_type, psb_ipk_
|
||||
@@ -281,7 +281,6 @@ module amg_z_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_z_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -270,7 +270,7 @@ module amg_z_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_z_base_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, &
|
||||
& amg_z_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_z_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_z_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -184,23 +184,16 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_z_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_z_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_z_dec_aggregator_descr
|
||||
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine z_diag_solver_free
|
||||
|
||||
subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,13 +228,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -242,13 +240,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -359,7 +352,7 @@ module amg_z_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -368,13 +361,11 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -382,13 +373,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+12
-26
@@ -433,22 +433,20 @@ contains
|
||||
return
|
||||
end subroutine z_gs_solver_free
|
||||
|
||||
subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_gs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -457,17 +455,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -533,22 +526,20 @@ contains
|
||||
val = .true.
|
||||
end function z_gs_solver_is_iterative
|
||||
|
||||
subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -557,17 +548,12 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine z_id_solver_free
|
||||
|
||||
subroutine z_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_id_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,14 +165,12 @@ contains
|
||||
class(amg_z_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -180,13 +178,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
write(iout_,*) ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine z_ilu_solver_free
|
||||
|
||||
subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_ilu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,14 +414,12 @@ contains
|
||||
class(amg_z_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -430,20 +428,15 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_z_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_z_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_z_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_z_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_z_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_z_invk_solver_cseti
|
||||
procedure, pass(sv) :: descr => amg_z_invk_solver_descr
|
||||
@@ -74,17 +73,6 @@ module amg_z_invk_solver
|
||||
end subroutine amg_z_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_z_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
@@ -135,7 +123,7 @@ module amg_z_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_z_invk_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -145,7 +133,7 @@ module amg_z_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_z_invk_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -52,7 +52,6 @@ module amg_z_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_z_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_z_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_z_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_z_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_z_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_z_invt_solver_csetr
|
||||
@@ -74,17 +73,6 @@ module amg_z_invt_solver
|
||||
end subroutine amg_z_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_z_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
@@ -146,17 +134,16 @@ module amg_z_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine amg_z_invt_solver_descr(sv,info,iout,coarse)
|
||||
import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
end subroutine amg_z_invt_solver_descr
|
||||
end interface
|
||||
|
||||
@@ -219,13 +219,12 @@ module amg_z_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_z_jac_smoother_type, psb_ipk_
|
||||
class(amg_z_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_z_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -314,13 +313,12 @@ module amg_z_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
import :: amg_z_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_z_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
end subroutine amg_z_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -436,7 +436,7 @@ contains
|
||||
val = "KRM solver"
|
||||
end function z_krm_solver_get_fmt
|
||||
|
||||
subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_krm_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -444,14 +444,12 @@ contains
|
||||
class(amg_z_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -460,22 +458,23 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
write(iout_,*) ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
write(iout_,*) ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -313,24 +313,22 @@ subroutine z_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine z_mumps_solver_finalize
|
||||
|
||||
subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_mumps_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
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_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -339,13 +337,8 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -189,7 +189,6 @@ module amg_z_onelev_mod
|
||||
procedure, pass(lv) :: descr => amg_z_base_onelev_descr
|
||||
procedure, pass(lv) :: default => z_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_z_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_z_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => z_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_z_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_z_base_onelev_dump
|
||||
@@ -258,7 +257,7 @@ module amg_z_onelev_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
|
||||
subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity)
|
||||
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
|
||||
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
@@ -269,7 +268,6 @@ module amg_z_onelev_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_z_base_onelev_descr
|
||||
end interface
|
||||
|
||||
@@ -286,7 +284,7 @@ module amg_z_onelev_mod
|
||||
end subroutine amg_z_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_z_base_onelev_free(lv,info)
|
||||
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
|
||||
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
|
||||
@@ -298,18 +296,6 @@ module amg_z_onelev_mod
|
||||
end subroutine amg_z_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_base_onelev_free_smoothers(lv,info)
|
||||
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
|
||||
& psb_zlinmap_type, psb_dpk_, amg_z_onelev_type, &
|
||||
& psb_ipk_, psb_epk_, psb_desc_type
|
||||
implicit none
|
||||
|
||||
class(amg_z_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_base_onelev_check(lv,info)
|
||||
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
|
||||
|
||||
@@ -135,9 +135,7 @@ module amg_z_prec_type
|
||||
procedure, pass(prec) :: build => amg_zprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_z_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_z_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_z_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_z_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_z_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_zfile_prec_descr
|
||||
end type amg_zprec_type
|
||||
|
||||
@@ -157,16 +155,15 @@ module amg_z_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity)
|
||||
import :: amg_zprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_zprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(amg_zprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_zfile_prec_descr
|
||||
end interface
|
||||
|
||||
@@ -347,14 +344,6 @@ module amg_z_prec_type
|
||||
end subroutine amg_z_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_z_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_z_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -628,68 +617,6 @@ contains
|
||||
|
||||
end subroutine amg_z_prec_free
|
||||
|
||||
subroutine amg_z_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_zprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_z_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_z_smoothers_free
|
||||
|
||||
subroutine amg_z_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_zprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_z_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_z_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
|
||||
@@ -385,22 +385,20 @@ contains
|
||||
|
||||
end subroutine z_slu_solver_finalize
|
||||
|
||||
subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_slu_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_z_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -409,13 +407,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -270,13 +270,13 @@ contains
|
||||
! Local variables
|
||||
type(psb_zspmat_type) :: atmp
|
||||
type(psb_z_csr_sparse_mat) :: acsr
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_lpk_), allocatable :: gia(:), gja(:)
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_lpk_) :: lfrst
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer(psb_ipk_) :: ifrst, ibcheck
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='z_sludist_solver_bld', ch_err
|
||||
character(len=20) :: name='z_sludist_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -324,7 +324,7 @@ contains
|
||||
acsr%ja(1:nztota) = gja(1:nztota)
|
||||
acsr%ja(:) = acsr%ja(:) - 1
|
||||
acsr%irp(:) = acsr%irp(:) - 1
|
||||
ifrst = lfrst - 1
|
||||
ifrst = lfrst - 1
|
||||
info = amg_zsludist_fact(nglob,nrow_a,nztota,ifrst,&
|
||||
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
|
||||
& npr,npc)
|
||||
@@ -421,16 +421,15 @@ contains
|
||||
|
||||
end subroutine z_sludist_solver_finalize
|
||||
|
||||
subroutine z_sludist_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_sludist_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_sludist_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
@@ -438,7 +437,6 @@ contains
|
||||
integer :: me, np
|
||||
character(len=20), parameter :: name='amg_z_sludist_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -447,13 +445,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -88,25 +88,16 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_z_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_z_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine amg_z_symdec_aggregator_descr
|
||||
|
||||
@@ -390,22 +390,20 @@ contains
|
||||
|
||||
end subroutine z_umf_solver_finalize
|
||||
|
||||
subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix)
|
||||
subroutine z_umf_solver_descr(sv,info,iout,coarse)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_umf_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_z_umf_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -414,13 +412,8 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
|
||||
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
+11
-14
@@ -67,25 +67,22 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS)
|
||||
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
objs: $(OBJS) aggrd levd smoothd solvd
|
||||
|
||||
lib: $(OBJS) aggrd levd smoothd solvd
|
||||
cd aggregator && $(MAKE) lib
|
||||
cd level && $(MAKE) lib
|
||||
cd smoother && $(MAKE) lib
|
||||
cd solver && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
aggrd:
|
||||
cd aggregator && $(MAKE) objs
|
||||
$(MAKE) -C aggregator
|
||||
levd:
|
||||
cd level && $(MAKE) objs
|
||||
$(MAKE) -C level
|
||||
smoothd:
|
||||
cd smoother && $(MAKE) objs
|
||||
$(MAKE) -C smoother
|
||||
solvd:
|
||||
cd solver && $(MAKE) objs
|
||||
$(MAKE) -C solver
|
||||
|
||||
mpobjs:
|
||||
(make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)")
|
||||
(make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)")
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(LIBNAME)
|
||||
@@ -94,10 +91,10 @@ clean: solvclean smoothclean levclean aggrclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
aggrclean:
|
||||
cd aggregator && $(MAKE) clean
|
||||
$(MAKE) -C aggregator clean
|
||||
levclean:
|
||||
cd level && $(MAKE) clean
|
||||
$(MAKE) -C level clean
|
||||
smoothclean:
|
||||
cd smoother && $(MAKE) clean
|
||||
$(MAKE) -C smoother clean
|
||||
solvclean:
|
||||
cd solver && $(MAKE) clean
|
||||
$(MAKE) -C solver clean
|
||||
|
||||
@@ -62,30 +62,13 @@ amg_s_parmatch_smth_bld.o \
|
||||
amg_s_parmatch_spmm_bld_inner.o
|
||||
|
||||
MPCOBJS=MatchBoxPC.o \
|
||||
sendBundledMessages.o \
|
||||
initialize.o \
|
||||
extractUChunk.o \
|
||||
isAlreadyMatched.o \
|
||||
findOwnerOfGhost.o \
|
||||
clean.o \
|
||||
computeCandidateMate.o \
|
||||
parallelComputeCandidateMateB.o \
|
||||
processMatchedVertices.o \
|
||||
processMatchedVerticesAndSendMessages.o \
|
||||
processCrossEdge.o \
|
||||
queueTransfer.o \
|
||||
processMessages.o \
|
||||
processExposedVertex.o \
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o
|
||||
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o
|
||||
|
||||
OBJS = $(FOBJS) $(MPCOBJS)
|
||||
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
objs: $(OBJS)
|
||||
|
||||
lib: objs
|
||||
lib: $(OBJS)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
|
||||
|
||||
@@ -60,43 +60,17 @@ void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card ) {
|
||||
#if !defined(SERIAL_MPI)
|
||||
MPI_Comm C_comm=MPI_Comm_f2c(icomm);
|
||||
|
||||
#ifdef DEBUG
|
||||
fprintf(stderr,"MatchBoxPC: rank %d nlver %ld nledge %ld [ %ld %ld ]\n",
|
||||
myRank,NLVer, NLEdge,verDistance[0],verDistance[1]);
|
||||
#endif
|
||||
|
||||
|
||||
#define TIME_TRACKER
|
||||
#ifdef TIME_TRACKER
|
||||
double tmr = MPI_Wtime();
|
||||
#endif
|
||||
|
||||
#define OMP
|
||||
#ifdef OMP
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(NLVer, NLEdge,
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
|
||||
verLocPtr, verLocInd, edgeLocWeight,
|
||||
verDistance, Mate,
|
||||
myRank, numProcs, C_comm,
|
||||
msgIndSent, msgActualSent, msgPercent,
|
||||
ph0_time, ph1_time, ph2_time,
|
||||
ph1_card, ph2_card );
|
||||
#else
|
||||
dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge,
|
||||
verLocPtr, verLocInd, edgeLocWeight,
|
||||
verDistance, Mate,
|
||||
myRank, numProcs, C_comm,
|
||||
msgIndSent, msgActualSent, msgPercent,
|
||||
ph0_time, ph1_time, ph2_time,
|
||||
ph1_card, ph2_card );
|
||||
#endif
|
||||
|
||||
|
||||
#ifdef TIME_TRACKER
|
||||
tmr = MPI_Wtime() - tmr;
|
||||
fprintf(stderr, "Elaboration time: %f for %ld nodes\n", tmr, NLVer);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
@@ -52,412 +52,145 @@
|
||||
|
||||
#ifndef _matchboxpC_H_
|
||||
#define _matchboxpC_H_
|
||||
// Turn on a lot of debugging information with this switch:
|
||||
//Turn on a lot of debugging information with this switch:
|
||||
//#define PRINT_DEBUG_INFO_
|
||||
#include <stdio.h>
|
||||
#include <iostream>
|
||||
#include <assert.h>
|
||||
#include <map>
|
||||
#include <vector>
|
||||
#include "omp.h"
|
||||
// #include "matchboxp.h"
|
||||
#include "primitiveDataTypeDefinitions.h"
|
||||
#include "dataStrStaticQueue.h"
|
||||
|
||||
using namespace std;
|
||||
|
||||
const int NUM_THREAD = 4;
|
||||
const int UCHUNK = 10;
|
||||
|
||||
const MilanLongInt REQUEST = 1;
|
||||
const MilanLongInt SUCCESS = 2;
|
||||
const MilanLongInt FAILURE = 3;
|
||||
const MilanLongInt SIZEINFO = 4;
|
||||
|
||||
const int ComputeTag = 7; // Predefined tag
|
||||
const int BundleTag = 9; // Predefined tag
|
||||
|
||||
static vector<MilanLongInt> DEFAULT_VECTOR;
|
||||
|
||||
// MPI type map
|
||||
template <typename T>
|
||||
MPI_Datatype TypeMap();
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
|
||||
template <>
|
||||
inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
|
||||
#define MilanMpiLongInt MPI_LONG_LONG
|
||||
|
||||
#define MilanMpiLongInt MPI_LONG_LONG
|
||||
|
||||
#ifndef _primitiveDataType_Definition_
|
||||
#define _primitiveDataType_Definition_
|
||||
// Regular integer:
|
||||
#ifndef INTEGER_H
|
||||
#define INTEGER_H
|
||||
typedef int32_t MilanInt;
|
||||
#endif
|
||||
//Regular integer:
|
||||
#ifndef INTEGER_H
|
||||
#define INTEGER_H
|
||||
typedef int32_t MilanInt;
|
||||
#endif
|
||||
|
||||
// Regular long integer:
|
||||
#ifndef LONG_INT_H
|
||||
#define LONG_INT_H
|
||||
#ifdef BIT64
|
||||
typedef int64_t MilanLongInt;
|
||||
typedef MPI_LONG MilanMpiLongInt;
|
||||
#else
|
||||
typedef int32_t MilanLongInt;
|
||||
typedef MPI_INT MilanMpiLongInt;
|
||||
#endif
|
||||
#endif
|
||||
//Regular long integer:
|
||||
#ifndef LONG_INT_H
|
||||
#define LONG_INT_H
|
||||
#ifdef BIT64
|
||||
typedef int64_t MilanLongInt;
|
||||
typedef MPI_LONG MilanMpiLongInt;
|
||||
#else
|
||||
typedef int32_t MilanLongInt;
|
||||
typedef MPI_INT MilanMpiLongInt;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
// Regular boolean
|
||||
#ifndef BOOL_H
|
||||
#define BOOL_H
|
||||
typedef bool MilanBool;
|
||||
#endif
|
||||
//Regular boolean
|
||||
#ifndef BOOL_H
|
||||
#define BOOL_H
|
||||
typedef bool MilanBool;
|
||||
#endif
|
||||
|
||||
// Regular double and absolute value computation:
|
||||
#ifndef REAL_H
|
||||
#define REAL_H
|
||||
typedef double MilanReal;
|
||||
typedef MPI_DOUBLE MilanMpiReal;
|
||||
inline MilanReal MilanAbs(MilanReal value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
//Regular double and absolute value computation:
|
||||
#ifndef REAL_H
|
||||
#define REAL_H
|
||||
typedef double MilanReal;
|
||||
typedef MPI_DOUBLE MilanMpiReal;
|
||||
inline MilanReal MilanAbs(MilanReal value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
|
||||
// Regular float and absolute value computation:
|
||||
#ifndef FLOAT_H
|
||||
#define FLOAT_H
|
||||
typedef float MilanFloat;
|
||||
typedef MPI_FLOAT MilanMpiFloat;
|
||||
inline MilanFloat MilanAbsFloat(MilanFloat value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
//Regular float and absolute value computation:
|
||||
#ifndef FLOAT_H
|
||||
#define FLOAT_H
|
||||
typedef float MilanFloat;
|
||||
typedef MPI_FLOAT MilanMpiFloat;
|
||||
inline MilanFloat MilanAbsFloat(MilanFloat value)
|
||||
{
|
||||
return fabs(value);
|
||||
}
|
||||
#endif
|
||||
|
||||
//// Define the limits:
|
||||
#ifndef LIMITS_H
|
||||
#define LIMITS_H
|
||||
// Integer Maximum and Minimum:
|
||||
// #define MilanIntMax INT_MAX
|
||||
// #define MilanIntMin INT_MIN
|
||||
#define MilanIntMax INT32_MAX
|
||||
#define MilanIntMin INT32_MIN
|
||||
//// Define the limits:
|
||||
#ifndef LIMITS_H
|
||||
#define LIMITS_H
|
||||
//Integer Maximum and Minimum:
|
||||
// #define MilanIntMax INT_MAX
|
||||
// #define MilanIntMin INT_MIN
|
||||
#define MilanIntMax INT32_MAX
|
||||
#define MilanIntMin INT32_MIN
|
||||
|
||||
#ifdef BIT64
|
||||
#define MilanLongIntMax INT64_MAX
|
||||
#define MilanLongIntMin -INT64_MAX
|
||||
#else
|
||||
#define MilanLongIntMax INT32_MAX
|
||||
#define MilanLongIntMin -INT32_MAX
|
||||
#endif
|
||||
#ifdef BIT64
|
||||
#define MilanLongIntMax INT64_MAX
|
||||
#define MilanLongIntMin -INT64_MAX
|
||||
#else
|
||||
#define MilanLongIntMax INT32_MAX
|
||||
#define MilanLongIntMin -INT32_MAX
|
||||
#endif
|
||||
|
||||
#endif
|
||||
#endif
|
||||
|
||||
// +INFINITY
|
||||
const double PLUS_INFINITY = numeric_limits<int>::infinity();
|
||||
const double MINUS_INFINITY = -PLUS_INFINITY;
|
||||
//#define MilanRealMax LDBL_MAX
|
||||
#define MilanRealMax PLUS_INFINITY
|
||||
#define MilanRealMin MINUS_INFINITY
|
||||
//#define MilanRealMax LDBL_MAX
|
||||
#define MilanRealMax PLUS_INFINITY
|
||||
#define MilanRealMin MINUS_INFINITY
|
||||
#endif
|
||||
|
||||
// Function of find the owner of a ghost vertex using binary search:
|
||||
MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
|
||||
MilanInt myRank, MilanInt numProcs);
|
||||
//Function of find the owner of a ghost vertex using binary search:
|
||||
inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance,
|
||||
MilanInt myRank, MilanInt numProcs);
|
||||
|
||||
MilanLongInt firstComputeCandidateMate(MilanLongInt adj1,
|
||||
MilanLongInt adj2,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanReal *edgeLocWeight);
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
|
||||
(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
void queuesTransfer(vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC
|
||||
(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
bool isAlreadyMatched(MilanLongInt node,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
|
||||
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanReal* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
MilanLongInt computeCandidateMate(MilanLongInt adj1,
|
||||
MilanLongInt adj2,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt k,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap);
|
||||
|
||||
void initialize(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt StartIndex, MilanLongInt EndIndex,
|
||||
MilanLongInt *numGhostEdgesPtr,
|
||||
MilanLongInt *numGhostVerticesPtr,
|
||||
MilanLongInt *S,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verLocPtr,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
vector<MilanLongInt> &Counter,
|
||||
vector<MilanLongInt> &verGhostPtr,
|
||||
vector<MilanLongInt> &verGhostInd,
|
||||
vector<MilanLongInt> &tempCounter,
|
||||
vector<MilanLongInt> &GMate,
|
||||
vector<MilanLongInt> &Message,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
MilanLongInt *&candidateMate,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void clean(MilanLongInt NLVer,
|
||||
MilanInt myRank,
|
||||
MilanLongInt MessageIndex,
|
||||
vector<MPI_Request> &SRequest,
|
||||
vector<MPI_Status> &SStatus,
|
||||
MilanInt BufferSize,
|
||||
MilanLongInt *Buffer,
|
||||
MilanLongInt msgActual,
|
||||
MilanLongInt *msgActualSent,
|
||||
MilanLongInt msgInd,
|
||||
MilanLongInt *msgIndSent,
|
||||
MilanLongInt NumMessagesBundled,
|
||||
MilanReal *msgPercent);
|
||||
|
||||
void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanInt myRank,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *candidateMate);
|
||||
|
||||
void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer,
|
||||
MilanLongInt *candidateMate,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *Mate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void PROCESS_CROSS_EDGE(MilanLongInt *edge,
|
||||
MilanLongInt *SPtr);
|
||||
|
||||
void processMatchedVertices(
|
||||
MilanLongInt NLVer,
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
MilanLongInt *candidateMate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner);
|
||||
|
||||
void processMatchedVerticesAndSendMessages(
|
||||
MilanLongInt NLVer,
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *NumMessagesBundledPtr,
|
||||
MilanLongInt *SPtr,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *PCounter,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanInt myRank,
|
||||
MilanInt numProcs,
|
||||
MilanLongInt *candidateMate,
|
||||
vector<MilanLongInt> &GMate,
|
||||
MilanLongInt *Mate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
MilanReal *edgeLocWeight,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MilanLongInt> &privateQLocalVtx,
|
||||
vector<MilanLongInt> &privateQGhostVtx,
|
||||
vector<MilanLongInt> &privateQMsgType,
|
||||
vector<MilanInt> &privateQOwner,
|
||||
MPI_Comm comm,
|
||||
MilanLongInt *msgActual,
|
||||
vector<MilanLongInt> &Message);
|
||||
|
||||
void sendBundledMessages(MilanLongInt *numGhostEdgesPtr,
|
||||
MilanInt *BufferSizePtr,
|
||||
MilanLongInt *Buffer,
|
||||
vector<MilanLongInt> &PCumulative,
|
||||
vector<MilanLongInt> &PMessageBundle,
|
||||
vector<MilanLongInt> &PSizeInfoMessages,
|
||||
MilanLongInt *PCounter,
|
||||
MilanLongInt NumMessagesBundled,
|
||||
MilanLongInt *msgActualPtr,
|
||||
MilanLongInt *MessageIndexPtr,
|
||||
MilanInt numProcs,
|
||||
MilanInt myRank,
|
||||
MPI_Comm comm,
|
||||
vector<MilanLongInt> &QLocalVtx,
|
||||
vector<MilanLongInt> &QGhostVtx,
|
||||
vector<MilanLongInt> &QMsgType,
|
||||
vector<MilanInt> &QOwner,
|
||||
vector<MPI_Request> &SRequest,
|
||||
vector<MPI_Status> &SStatus);
|
||||
|
||||
void processMessages(
|
||||
MilanLongInt NLVer,
|
||||
MilanLongInt *Mate,
|
||||
MilanLongInt *candidateMate,
|
||||
map<MilanLongInt, MilanLongInt> &Ghost2LocalMap,
|
||||
vector<MilanLongInt> &GMate,
|
||||
vector<MilanLongInt> &Counter,
|
||||
MilanLongInt StartIndex,
|
||||
MilanLongInt EndIndex,
|
||||
MilanLongInt *myCardPtr,
|
||||
MilanLongInt *msgIndPtr,
|
||||
MilanLongInt *msgActualPtr,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *verLocPtr,
|
||||
MilanLongInt k,
|
||||
MilanLongInt *verLocInd,
|
||||
MilanInt numProcs,
|
||||
MilanInt myRank,
|
||||
MPI_Comm comm,
|
||||
vector<MilanLongInt> &Message,
|
||||
MilanLongInt numGhostEdges,
|
||||
MilanLongInt u,
|
||||
MilanLongInt v,
|
||||
MilanLongInt *SPtr,
|
||||
vector<MilanLongInt> &U);
|
||||
|
||||
void extractUChunk(
|
||||
vector<MilanLongInt> &UChunkBeingProcessed,
|
||||
vector<MilanLongInt> &U,
|
||||
vector<MilanLongInt> &privateU);
|
||||
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void salgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void dMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
|
||||
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd, MilanFloat *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent, MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card);
|
||||
void sMatchBoxPC(MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt* verLocPtr, MilanLongInt* verLocInd, MilanFloat* edgeLocWeight,
|
||||
MilanLongInt* verDistance,
|
||||
MilanLongInt* Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MilanInt icomm,
|
||||
MilanLongInt* msgIndSent, MilanLongInt* msgActualSent, MilanReal* msgPercent,
|
||||
MilanReal* ph0_time, MilanReal* ph1_time, MilanReal* ph2_time,
|
||||
MilanLongInt* ph1_card, MilanLongInt* ph2_card );
|
||||
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
|
||||
@@ -72,6 +72,12 @@
|
||||
|
||||
#ifdef SERIAL_MPI
|
||||
#else
|
||||
//MPI type map
|
||||
template<typename T> MPI_Datatype TypeMap();
|
||||
template<> inline MPI_Datatype TypeMap<int64_t>() { return MPI_LONG_LONG; }
|
||||
template<> inline MPI_Datatype TypeMap<int>() { return MPI_INT; }
|
||||
template<> inline MPI_Datatype TypeMap<double>() { return MPI_DOUBLE; }
|
||||
template<> inline MPI_Datatype TypeMap<float>() { return MPI_FLOAT; }
|
||||
|
||||
// DOUBLE PRECISION VERSION
|
||||
//WARNING: The vertex block on a given rank is contiguous
|
||||
|
||||
-554
@@ -1,554 +0,0 @@
|
||||
#include "MatchBoxPC.h"
|
||||
|
||||
// ***********************************************************************
|
||||
//
|
||||
// MatchboxP: A C++ library for approximate weighted matching
|
||||
// Mahantesh Halappanavar (hala@pnnl.gov)
|
||||
// Pacific Northwest National Laboratory
|
||||
//
|
||||
// ***********************************************************************
|
||||
//
|
||||
// Copyright (2021) Battelle Memorial Institute
|
||||
// All rights reserved.
|
||||
//
|
||||
// Redistribution and use in source and binary forms, with or without
|
||||
// modification, are permitted provided that the following conditions
|
||||
// are met:
|
||||
//
|
||||
// 1. Redistributions of source code must retain the above copyright
|
||||
// notice, this list of conditions and the following disclaimer.
|
||||
//
|
||||
// 2. Redistributions in binary form must reproduce the above copyright
|
||||
// notice, this list of conditions and the following disclaimer in the
|
||||
// documentation and/or other materials provided with the distribution.
|
||||
//
|
||||
// 3. Neither the name of the copyright holder nor the names of its
|
||||
// contributors may be used to endorse or promote products derived from
|
||||
// this software without specific prior written permission.
|
||||
//
|
||||
// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
// "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
// LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
||||
// FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
// COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
// INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
||||
// BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
|
||||
// LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
// CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
// LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
// POSSIBILITY OF SUCH DAMAGE.
|
||||
//
|
||||
// ************************************************************************
|
||||
//////////////////////////////////////////////////////////////////////////////////////
|
||||
/////////////////////////// DOMINATING EDGES MODEL ///////////////////////////////////
|
||||
//////////////////////////////////////////////////////////////////////////////////////
|
||||
/* Function : algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate()
|
||||
*
|
||||
* Date : New update: Feb 17, 2019, Richland, Washington.
|
||||
* Date : Original development: May 17, 2009, E&CS Bldg.
|
||||
*
|
||||
* Purpose : Compute Approximate Maximum Weight Matching in Linear Time
|
||||
*
|
||||
* Args : inputMatrix - instance of Compressed-Col format of Matrix
|
||||
* Mate - The Mate array
|
||||
*
|
||||
* Returns : By Value: (void)
|
||||
* By Reference: Mate
|
||||
*
|
||||
* Comments : 1/2 Approx Algorithm. Picks the locally available heaviest edge.
|
||||
* Assumption: The Mate Array is empty.
|
||||
*/
|
||||
|
||||
/*
|
||||
NLVer = #of vertices, NLEdge = #of edges
|
||||
CSR/CSC/Compressed format: verLocPtr = Pointer, verLocInd = Index, edgeLocWeight = edge weights (positive real numbers)
|
||||
verDistance = A vector of size |P|+1 containing the cumulative number of vertices per process
|
||||
Mate = A vector of size |V_p| (local subgraph) to store the output (matching)
|
||||
MPI: myRank, numProcs, comm,
|
||||
Statistics: msgIndSent, msgActualSent, msgPercent : Size: |P| number of processes in the comm-world
|
||||
Statistics: ph0_time, ph1_time, ph2_time: Runtimes
|
||||
Statistics: ph1_card, ph2_card : Size: |P| number of processes in the comm-world (number of matched edges in Phase 1 and Phase 2)
|
||||
*/
|
||||
//#define DEBUG_HANG_
|
||||
#ifdef SERIAL_MPI
|
||||
#else
|
||||
|
||||
// DOUBLE PRECISION VERSION
|
||||
// WARNING: The vertex block on a given rank is contiguous
|
||||
void dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(
|
||||
MilanLongInt NLVer, MilanLongInt NLEdge,
|
||||
MilanLongInt *verLocPtr, MilanLongInt *verLocInd,
|
||||
MilanReal *edgeLocWeight,
|
||||
MilanLongInt *verDistance,
|
||||
MilanLongInt *Mate,
|
||||
MilanInt myRank, MilanInt numProcs, MPI_Comm comm,
|
||||
MilanLongInt *msgIndSent, MilanLongInt *msgActualSent,
|
||||
MilanReal *msgPercent,
|
||||
MilanReal *ph0_time, MilanReal *ph1_time, MilanReal *ph2_time,
|
||||
MilanLongInt *ph1_card, MilanLongInt *ph2_card)
|
||||
{
|
||||
|
||||
/*
|
||||
* verDistance: it's a vector long as the number of processors.
|
||||
* verDistance[i] contains the first node index of the i-th processor
|
||||
* verDistance[i + 1] contains the last node index of the i-th processor
|
||||
* NLVer: number of elements in the LocPtr
|
||||
* NLEdge: number of edges assigned to the current processor
|
||||
*
|
||||
* Contains the portion of matrix assigned to the processor in
|
||||
* Yale notation
|
||||
* verLocInd: contains the positions on row of the matrix
|
||||
* verLocPtr: i-th value is the position of the first element on the i-th row and
|
||||
* i+1-th value is the position of the first element on the i+1-th row
|
||||
*/
|
||||
|
||||
#if !defined(SERIAL_MPI)
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")Within algoEdgeApproxDominatingEdgesLinearSearchMessageBundling()";
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ") verDistance [" ;
|
||||
for (int i = 0; i < numProcs; i++)
|
||||
cout << verDistance[i] << "," << verDistance[i+1];
|
||||
cout << "]\n";
|
||||
fflush(stdout);
|
||||
#endif
|
||||
#ifdef DEBUG_HANG_
|
||||
if (myRank == 0) {
|
||||
cout << "\n(" << myRank << ") verDistance [" ;
|
||||
for (int i = 0; i < numProcs; i++)
|
||||
cout << verDistance[i] << "," ;
|
||||
cout << verDistance[numProcs]<< "]\n";
|
||||
}
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
MilanLongInt StartIndex = verDistance[myRank]; // The starting vertex owned by the current rank
|
||||
MilanLongInt EndIndex = verDistance[myRank + 1] - 1; // The ending vertex owned by the current rank
|
||||
|
||||
MPI_Status computeStatus;
|
||||
|
||||
MilanLongInt msgActual = 0, msgInd = 0;
|
||||
MilanReal heaviestEdgeWt = 0.0f; // Assumes positive weight
|
||||
MilanReal startTime, finishTime;
|
||||
|
||||
startTime = MPI_Wtime();
|
||||
|
||||
// Data structures for sending and receiving messages:
|
||||
vector<MilanLongInt> Message; // [ u, v, message_type ]
|
||||
Message.resize(3, -1);
|
||||
// Data structures for Message Bundling:
|
||||
// Although up to two messages can be sent along any cross edge,
|
||||
// only one message will be sent in the initialization phase -
|
||||
// one of: REQUEST/FAILURE/SUCCESS
|
||||
vector<MilanLongInt> QLocalVtx, QGhostVtx, QMsgType;
|
||||
vector<MilanInt> QOwner; // Changed by Fabio to be an integer, addresses needs to be integers!
|
||||
|
||||
MilanLongInt *PCounter = new MilanLongInt[numProcs];
|
||||
for (int i = 0; i < numProcs; i++)
|
||||
PCounter[i] = 0;
|
||||
|
||||
MilanLongInt NumMessagesBundled = 0;
|
||||
// TODO when the last computational section will be refactored this could be eliminated
|
||||
MilanInt ghostOwner = 0; // Changed by Fabio to be an integer, addresses needs to be integers!
|
||||
MilanLongInt *candidateMate = nullptr;
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")NV: " << NLVer << " Edges: " << NLEdge;
|
||||
fflush(stdout);
|
||||
cout << "\n(" << myRank << ")StartIndex: " << StartIndex << " EndIndex: " << EndIndex;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
// Other Variables:
|
||||
MilanLongInt u = -1, v = -1, w = -1, i = 0;
|
||||
MilanLongInt k = -1, adj1 = -1, adj2 = -1;
|
||||
MilanLongInt k1 = -1, adj11 = -1, adj12 = -1;
|
||||
MilanLongInt myCard = 0;
|
||||
|
||||
// Build the Ghost Vertex Set: Vg
|
||||
map<MilanLongInt, MilanLongInt> Ghost2LocalMap; // Map each ghost vertex to a local vertex
|
||||
vector<MilanLongInt> Counter; // Store the edge count for each ghost vertex
|
||||
MilanLongInt numGhostVertices = 0, numGhostEdges = 0; // Number of Ghost vertices
|
||||
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
|
||||
fflush(stdout);
|
||||
#endif
|
||||
#ifdef DEBUG_HANG_
|
||||
if (myRank == 0)
|
||||
cout << "\n(" << myRank << ")About to compute Ghost Vertices...";
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
// Define Adjacency Lists for Ghost Vertices:
|
||||
// cout<<"Building Ghost data structures ... \n\n";
|
||||
vector<MilanLongInt> verGhostPtr, verGhostInd, tempCounter;
|
||||
// Mate array for ghost vertices:
|
||||
vector<MilanLongInt> GMate; // Proportional to the number of ghost vertices
|
||||
MilanLongInt S;
|
||||
MilanLongInt privateMyCard = 0;
|
||||
vector<MilanLongInt> PCumulative, PMessageBundle, PSizeInfoMessages;
|
||||
vector<MPI_Request> SRequest; // Requests that are used for each send message
|
||||
vector<MPI_Status> SStatus; // Status of sent messages, used in MPI_Wait
|
||||
MilanLongInt MessageIndex = 0; // Pointer for current message
|
||||
MilanInt BufferSize;
|
||||
MilanLongInt *Buffer;
|
||||
|
||||
vector<MilanLongInt> privateQLocalVtx, privateQGhostVtx, privateQMsgType;
|
||||
vector<MilanInt> privateQOwner;
|
||||
vector<MilanLongInt> U, privateU;
|
||||
|
||||
initialize(NLVer, NLEdge, StartIndex,
|
||||
EndIndex, &numGhostEdges,
|
||||
&numGhostVertices, &S,
|
||||
verLocInd, verLocPtr,
|
||||
Ghost2LocalMap, Counter,
|
||||
verGhostPtr, verGhostInd,
|
||||
tempCounter, GMate,
|
||||
Message, QLocalVtx,
|
||||
QGhostVtx, QMsgType, QOwner,
|
||||
candidateMate, U,
|
||||
privateU,
|
||||
privateQLocalVtx,
|
||||
privateQGhostVtx,
|
||||
privateQMsgType,
|
||||
privateQOwner);
|
||||
|
||||
finishTime = MPI_Wtime();
|
||||
*ph0_time = finishTime - startTime; // Time taken for Phase-0: Initialization
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << myRank << " Finished initialization" << endl;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
startTime = MPI_Wtime();
|
||||
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
//////////////////////////////////// INITIALIZATION /////////////////////////////////////
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
// Compute the Initial Matching Set:
|
||||
|
||||
/*
|
||||
* OMP PARALLEL_COMPUTE_CANDIDATE_MATE_B has been splitted from
|
||||
* PARALLEL_PROCESS_EXPOSED_VERTEX_B in order to better parallelize
|
||||
* the two.
|
||||
* PARALLEL_COMPUTE_CANDIDATE_MATE_B is now totally parallel.
|
||||
*/
|
||||
|
||||
PARALLEL_COMPUTE_CANDIDATE_MATE_B(NLVer,
|
||||
verLocPtr,
|
||||
verLocInd,
|
||||
myRank,
|
||||
edgeLocWeight,
|
||||
candidateMate);
|
||||
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << myRank << " Finished Exposed Vertex" << endl;
|
||||
fflush(stdout);
|
||||
#if 0
|
||||
cout << myRank << " candidateMate after parallelCompute " <<endl;
|
||||
for (int i=0; i<NLVer; i++) {
|
||||
cout << candidateMate[i] << " " ;
|
||||
}
|
||||
cout << endl;
|
||||
#endif
|
||||
#endif
|
||||
/*
|
||||
* PARALLEL_PROCESS_EXPOSED_VERTEX_B
|
||||
* TODO: write comment
|
||||
*
|
||||
* TODO: Test when it's actually more efficient to execute this code
|
||||
* in parallel.
|
||||
*/
|
||||
PARALLEL_PROCESS_EXPOSED_VERTEX_B(NLVer,
|
||||
candidateMate,
|
||||
verLocInd,
|
||||
verLocPtr,
|
||||
StartIndex,
|
||||
EndIndex,
|
||||
Mate,
|
||||
GMate,
|
||||
Ghost2LocalMap,
|
||||
edgeLocWeight,
|
||||
&myCard,
|
||||
&msgInd,
|
||||
&NumMessagesBundled,
|
||||
&S,
|
||||
verDistance,
|
||||
PCounter,
|
||||
Counter,
|
||||
myRank,
|
||||
numProcs,
|
||||
U,
|
||||
privateU,
|
||||
QLocalVtx,
|
||||
QGhostVtx,
|
||||
QMsgType,
|
||||
QOwner,
|
||||
privateQLocalVtx,
|
||||
privateQGhostVtx,
|
||||
privateQMsgType,
|
||||
privateQOwner);
|
||||
|
||||
tempCounter.clear(); // Do not need this any more
|
||||
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << myRank << " Finished Exposed Vertex" << endl;
|
||||
fflush(stdout);
|
||||
#if 0
|
||||
cout << myRank << " Mate after Exposed Vertices " <<endl;
|
||||
for (int i=0; i<NLVer; i++) {
|
||||
cout << Mate[i] << " " ;
|
||||
}
|
||||
cout << endl;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
/////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
// TODO what would be the optimal UCHUNK
|
||||
vector<MilanLongInt> UChunkBeingProcessed;
|
||||
UChunkBeingProcessed.reserve(UCHUNK);
|
||||
|
||||
processMatchedVertices(NLVer,
|
||||
UChunkBeingProcessed,
|
||||
U,
|
||||
privateU,
|
||||
StartIndex,
|
||||
EndIndex,
|
||||
&myCard,
|
||||
&msgInd,
|
||||
&NumMessagesBundled,
|
||||
&S,
|
||||
verLocPtr,
|
||||
verLocInd,
|
||||
verDistance,
|
||||
PCounter,
|
||||
Counter,
|
||||
myRank,
|
||||
numProcs,
|
||||
candidateMate,
|
||||
GMate,
|
||||
Mate,
|
||||
Ghost2LocalMap,
|
||||
edgeLocWeight,
|
||||
QLocalVtx,
|
||||
QGhostVtx,
|
||||
QMsgType,
|
||||
QOwner,
|
||||
privateQLocalVtx,
|
||||
privateQGhostVtx,
|
||||
privateQMsgType,
|
||||
privateQOwner);
|
||||
|
||||
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << myRank << " Finished Process Vertices" << endl;
|
||||
fflush(stdout);
|
||||
#if 0
|
||||
cout << myRank << " Mate after Matched Vertices " <<endl;
|
||||
for (int i=0; i<NLVer; i++) {
|
||||
cout << Mate[i] << " " ;
|
||||
}
|
||||
cout << endl;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
///////////////////////////// SEND BUNDLED MESSAGES /////////////////////////////////////
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
sendBundledMessages(&numGhostEdges,
|
||||
&BufferSize,
|
||||
Buffer,
|
||||
PCumulative,
|
||||
PMessageBundle,
|
||||
PSizeInfoMessages,
|
||||
PCounter,
|
||||
NumMessagesBundled,
|
||||
&msgActual,
|
||||
&MessageIndex,
|
||||
numProcs,
|
||||
myRank,
|
||||
comm,
|
||||
QLocalVtx,
|
||||
QGhostVtx,
|
||||
QMsgType,
|
||||
QOwner,
|
||||
SRequest,
|
||||
SStatus);
|
||||
|
||||
///////////////////////// END OF SEND BUNDLED MESSAGES //////////////////////////////////
|
||||
|
||||
finishTime = MPI_Wtime();
|
||||
*ph1_time = finishTime - startTime; // Time taken for Phase-1
|
||||
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << myRank << " Finished sendBundles" << endl;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
*ph1_card = myCard; // Cardinality at the end of Phase-1
|
||||
startTime = MPI_Wtime();
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
//////////////////////////////////////// MAIN LOOP //////////////////////////////////////
|
||||
/////////////////////////////////////////////////////////////////////////////////////////
|
||||
// Main While Loop:
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << "=========================************===============================" << endl;
|
||||
fflush(stdout);
|
||||
fflush(stdout);
|
||||
#endif
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")Entering While(true) loop..";
|
||||
fflush(stdout);
|
||||
#endif
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << "=========================************===============================" << endl;
|
||||
fflush(stdout);
|
||||
fflush(stdout);
|
||||
#endif
|
||||
|
||||
while (true) {
|
||||
#ifdef DEBUG_HANG_
|
||||
//if (myRank == 0)
|
||||
cout << "\n(" << myRank << ") Main loop" << endl;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
/////////////////////////// PROCESS MATCHED VERTICES //////////////////////////////
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
processMatchedVerticesAndSendMessages(NLVer,
|
||||
UChunkBeingProcessed,
|
||||
U,
|
||||
privateU,
|
||||
StartIndex,
|
||||
EndIndex,
|
||||
&myCard,
|
||||
&msgInd,
|
||||
&NumMessagesBundled,
|
||||
&S,
|
||||
verLocPtr,
|
||||
verLocInd,
|
||||
verDistance,
|
||||
PCounter,
|
||||
Counter,
|
||||
myRank,
|
||||
numProcs,
|
||||
candidateMate,
|
||||
GMate,
|
||||
Mate,
|
||||
Ghost2LocalMap,
|
||||
edgeLocWeight,
|
||||
QLocalVtx,
|
||||
QGhostVtx,
|
||||
QMsgType,
|
||||
QOwner,
|
||||
privateQLocalVtx,
|
||||
privateQGhostVtx,
|
||||
privateQMsgType,
|
||||
privateQOwner,
|
||||
comm,
|
||||
&msgActual,
|
||||
Message);
|
||||
|
||||
///////////////////////// END OF PROCESS MATCHED VERTICES /////////////////////////
|
||||
|
||||
//// BREAK IF NO MESSAGES EXPECTED /////////
|
||||
#ifdef DEBUG_HANG_
|
||||
#if 0
|
||||
cout << myRank << " Mate after ProcessMatchedAndSend phase "<<S <<endl;
|
||||
for (int i=0; i<NLVer; i++) {
|
||||
cout << Mate[i] << " " ;
|
||||
}
|
||||
cout << endl;
|
||||
#endif
|
||||
#endif
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")Deciding whether to break: S= " << S << endl;
|
||||
#endif
|
||||
|
||||
if (S == 0) {
|
||||
#ifdef DEBUG_HANG_
|
||||
cout << "\n(" << myRank << ") Breaking out" << endl;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
/////////////////////////// PROCESS MESSAGES //////////////////////////////////////
|
||||
///////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
processMessages(NLVer,
|
||||
Mate,
|
||||
candidateMate,
|
||||
Ghost2LocalMap,
|
||||
GMate,
|
||||
Counter,
|
||||
StartIndex,
|
||||
EndIndex,
|
||||
&myCard,
|
||||
&msgInd,
|
||||
&msgActual,
|
||||
edgeLocWeight,
|
||||
verDistance,
|
||||
verLocPtr,
|
||||
k,
|
||||
verLocInd,
|
||||
numProcs,
|
||||
myRank,
|
||||
comm,
|
||||
Message,
|
||||
numGhostEdges,
|
||||
u,
|
||||
v,
|
||||
&S,
|
||||
U);
|
||||
|
||||
///////////////////////// END OF PROCESS MESSAGES /////////////////////////////////
|
||||
#ifdef DEBUG_HANG_
|
||||
#if 0
|
||||
cout << myRank << " Mate after ProcessMessages phase "<<S <<endl;
|
||||
for (int i=0; i<NLVer; i++) {
|
||||
cout << Mate[i] << " " ;
|
||||
}
|
||||
cout << endl;
|
||||
#endif
|
||||
#endif
|
||||
#ifdef PRINT_DEBUG_INFO_
|
||||
cout << "\n(" << myRank << ")Finished Message processing phase: S= " << S;
|
||||
fflush(stdout);
|
||||
cout << "\n(" << myRank << ")** SENT : ACTUAL= " << msgActual;
|
||||
fflush(stdout);
|
||||
cout << "\n(" << myRank << ")** SENT : INDIVIDUAL= " << msgInd << endl;
|
||||
fflush(stdout);
|
||||
#endif
|
||||
} // End of while (true)
|
||||
|
||||
clean(NLVer,
|
||||
myRank,
|
||||
MessageIndex,
|
||||
SRequest,
|
||||
SStatus,
|
||||
BufferSize,
|
||||
Buffer,
|
||||
msgActual,
|
||||
msgActualSent,
|
||||
msgInd,
|
||||
msgIndSent,
|
||||
NumMessagesBundled,
|
||||
msgPercent);
|
||||
|
||||
finishTime = MPI_Wtime();
|
||||
*ph2_time = finishTime - startTime; // Time taken for Phase-2
|
||||
*ph2_card = myCard; // Cardinality at the end of Phase-2
|
||||
}
|
||||
// End of algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMate
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@@ -97,8 +97,6 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
integer(psb_lpk_) :: ntaggr
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
logical :: clean_zeros
|
||||
integer(psb_ipk_), save :: idx_map_bld=-1, idx_map_tprol=-1
|
||||
logical, parameter :: do_timings=.false.
|
||||
|
||||
name='amg_c_dec_aggregator_tprol'
|
||||
call psb_erractionsave(err_act)
|
||||
@@ -110,10 +108,6 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
info = psb_success_
|
||||
ctxt = desc_a%get_context()
|
||||
call psb_info(ctxt,me,np)
|
||||
if ((do_timings).and.(idx_map_bld==-1)) &
|
||||
& idx_map_bld = psb_get_timer_idx("DEC_TPROL: map_bld")
|
||||
if ((do_timings).and.(idx_map_tprol==-1)) &
|
||||
& idx_map_tprol = psb_get_timer_idx("DEC_TPROL: map_tprol")
|
||||
|
||||
call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
|
||||
& amg_mult_ml_,is_legal_ml_cycle)
|
||||
@@ -127,14 +121,10 @@ subroutine amg_c_dec_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
! The decoupled aggregator based on SOC measures ignores
|
||||
! ag_data except for clean_zeros; soc_map_bld is a procedure pointer.
|
||||
!
|
||||
if (do_timings) call psb_tic(idx_map_bld)
|
||||
clean_zeros = ag%do_clean_zeros
|
||||
call ag%soc_map_bld(parms%aggr_ord,parms%aggr_thresh,clean_zeros,a,desc_a,nlaggr,ilaggr,info)
|
||||
if (do_timings) call psb_toc(idx_map_bld)
|
||||
if (do_timings) call psb_tic(idx_map_tprol)
|
||||
|
||||
if (info==psb_success_) call amg_map_to_tprol(desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
if (do_timings) call psb_toc(idx_map_tprol)
|
||||
if (info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err='soc_map_bld/map_to_tprol')
|
||||
|
||||
@@ -76,7 +76,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
integer(psb_ipk_) :: nrow, ncol, nrl, nzl, ip, nzt, i, k
|
||||
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
|
||||
logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1, idx_cpytrans1=-1, idx_cpytrans2=-1
|
||||
integer(psb_ipk_), save :: idx_spspmm=-1
|
||||
|
||||
name='amg_ptap_bld'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
@@ -93,11 +93,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
ncol = desc_a%get_local_cols()
|
||||
|
||||
if ((do_timings).and.(idx_spspmm==-1)) &
|
||||
& idx_spspmm = psb_get_timer_idx("PTAP_BLD: par_spspmm")
|
||||
if ((do_timings).and.(idx_cpytrans1==-1)) &
|
||||
& idx_cpytrans1 = psb_get_timer_idx("PTAP_BLD: cpy&trans1")
|
||||
if ((do_timings).and.(idx_cpytrans2==-1)) &
|
||||
& idx_cpytrans2 = psb_get_timer_idx("PTAP_BLD: cpy&trans2")
|
||||
& idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm")
|
||||
|
||||
naggr = nlaggr(me+1)
|
||||
ntaggr = sum(nlaggr)
|
||||
@@ -132,7 +128,6 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
! Ok first product done.
|
||||
|
||||
if (present(desc_ax)) then
|
||||
if (do_timings) call psb_tic(idx_cpytrans1)
|
||||
block
|
||||
call coo_prol%cp_to_coo(coo_restr,info)
|
||||
call coo_restr%set_ncols(desc_ac%get_local_cols())
|
||||
@@ -142,7 +137,7 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
call coo_restr%set_ncols(desc_ax%get_local_cols())
|
||||
end block
|
||||
call csr_restr%cp_from_coo(coo_restr,info)
|
||||
if (do_timings) call psb_toc(idx_cpytrans1)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
|
||||
goto 9999
|
||||
@@ -172,28 +167,27 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
|
||||
|
||||
call coo_restr%transp()
|
||||
nzl = coo_restr%get_nzeros()
|
||||
nrl = desc_ac%get_local_rows()
|
||||
call coo_restr%fix(info)
|
||||
i=coo_restr%get_nzeros()
|
||||
nrl = desc_ac%get_local_rows()
|
||||
i=0
|
||||
!
|
||||
! Only keep local rows
|
||||
!
|
||||
search: do k=i,1,-1
|
||||
if (coo_restr%ia(k) <= nrl) then
|
||||
call coo_restr%set_nzeros(k)
|
||||
exit search
|
||||
do k=1, nzl
|
||||
if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then
|
||||
i = i+1
|
||||
coo_restr%val(i) = coo_restr%val(k)
|
||||
coo_restr%ia(i) = coo_restr%ia(k)
|
||||
coo_restr%ja(i) = coo_restr%ja(k)
|
||||
end if
|
||||
end do search
|
||||
|
||||
end do
|
||||
call coo_restr%set_nzeros(i)
|
||||
call coo_restr%fix(info)
|
||||
nzl = coo_restr%get_nzeros()
|
||||
call coo_restr%set_nrows(desc_ac%get_local_rows())
|
||||
call coo_restr%set_ncols(desc_a%get_local_cols())
|
||||
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
|
||||
if (do_timings) call psb_tic(idx_cpytrans2)
|
||||
|
||||
call csr_restr%cp_from_coo(coo_restr,info)
|
||||
|
||||
if (do_timings) call psb_toc(idx_cpytrans2)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
|
||||
goto 9999
|
||||
|
||||
+21
-218
@@ -72,9 +72,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
use psb_base_mod
|
||||
use amg_base_prec_type
|
||||
use amg_c_inner_mod
|
||||
#if defined(OPENMP)
|
||||
use omp_lib
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
@@ -87,7 +85,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_), allocatable :: neigh(:), irow(:), icol(:),&
|
||||
integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
|
||||
& ideg(:), idxs(:)
|
||||
integer(psb_lpk_), allocatable :: tmpaggr(:)
|
||||
complex(psb_spk_), allocatable :: val(:), diag(:)
|
||||
@@ -101,9 +99,6 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
integer(psb_ipk_) :: nrow, ncol, n_ne
|
||||
integer(psb_lpk_) :: nrglob
|
||||
character(len=20) :: name, ch_err
|
||||
integer(psb_ipk_), save :: idx_soc1_p1=-1, idx_soc1_p2=-1, idx_soc1_p3=-1
|
||||
integer(psb_ipk_), save :: idx_soc1_p0=-1
|
||||
logical, parameter :: do_timings=.true.
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_soc1_map_bld'
|
||||
@@ -119,14 +114,6 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
nrow = desc_a%get_local_rows()
|
||||
ncol = desc_a%get_local_cols()
|
||||
nrglob = desc_a%get_global_rows()
|
||||
if ((do_timings).and.(idx_soc1_p0==-1)) &
|
||||
& idx_soc1_p0 = psb_get_timer_idx("SOC1_MAP: phase0")
|
||||
if ((do_timings).and.(idx_soc1_p1==-1)) &
|
||||
& idx_soc1_p1 = psb_get_timer_idx("SOC1_MAP: phase1")
|
||||
if ((do_timings).and.(idx_soc1_p2==-1)) &
|
||||
& idx_soc1_p2 = psb_get_timer_idx("SOC1_MAP: phase2")
|
||||
if ((do_timings).and.(idx_soc1_p3==-1)) &
|
||||
& idx_soc1_p3 = psb_get_timer_idx("SOC1_MAP: phase3")
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
@@ -146,204 +133,41 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (do_timings) call psb_tic(idx_soc1_p0)
|
||||
call a%cp_to(acsr)
|
||||
if (do_timings) call psb_toc(idx_soc1_p0)
|
||||
if (clean_zeros) call acsr%clean_zeros(info)
|
||||
if (iorder == amg_aggr_ord_nat_) then
|
||||
!$omp parallel do private(i) schedule(static)
|
||||
do i=1, nr
|
||||
ilaggr(i) = -(nr+1)
|
||||
idxs(i) = i
|
||||
idxs(i) = i
|
||||
end do
|
||||
!$omp end parallel do
|
||||
else
|
||||
!$omp parallel do private(i) schedule(static)
|
||||
else
|
||||
do i=1, nr
|
||||
ilaggr(i) = -(nr+1)
|
||||
ideg(i) = acsr%irp(i+1) - acsr%irp(i)
|
||||
end do
|
||||
!$omp end parallel do
|
||||
call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
|
||||
end if
|
||||
if (do_timings) call psb_tic(idx_soc1_p1)
|
||||
|
||||
|
||||
!
|
||||
! Phase one: Start with disjoint groups.
|
||||
!
|
||||
naggr = 0
|
||||
#if defined(OPENMP)
|
||||
block
|
||||
integer(psb_ipk_), allocatable :: bnds(:), locnaggr(:)
|
||||
integer(psb_ipk_) :: myth,nths, kk
|
||||
! The parallelization makes use of a locaggr(:) array; each thread
|
||||
! keeps its own version of naggr, and when the loop ends, a prefix is applied
|
||||
! to locnaggr to determine:
|
||||
! 1. The total number of aggregaters NAGGR;
|
||||
! 2. How much should each thread shift its own aggregates
|
||||
! Part 2 requires to keep track of which thread defined each entry
|
||||
! of ilaggr(), so that each entry can be adjusted correctly: even
|
||||
! if an entry I belongs to the range BNDS(TH)>BNDS(TH+1)-1, it may have
|
||||
! been set because it is strongly connected to an entry J belonging to a
|
||||
! different thread.
|
||||
|
||||
!$omp parallel shared(bnds,idxs,locnaggr,ilaggr,nr,naggr,diag,theta,nths,info) &
|
||||
!$omp private(icol,val,myth,kk)
|
||||
block
|
||||
integer(psb_ipk_) :: ii,nlp,k,kp,n,ia,isz, nc, i,j,m, nz, ilg, ip, rsz
|
||||
integer(psb_lpk_) :: itmp
|
||||
!$omp master
|
||||
nths = omp_get_num_threads()
|
||||
allocate(bnds(0:nths),locnaggr(0:nths+1))
|
||||
locnaggr(:) = 0
|
||||
bnds(0) = 1
|
||||
!$omp end master
|
||||
!$omp barrier
|
||||
myth = omp_get_thread_num()
|
||||
rsz = nr/nths
|
||||
if (myth < mod(nr,nths)) rsz = rsz + 1
|
||||
bnds(myth+1) = rsz
|
||||
!$omp barrier
|
||||
!$omp master
|
||||
do i=1,nths
|
||||
bnds(i) = bnds(i) + bnds(i-1)
|
||||
end do
|
||||
info = 0
|
||||
!$omp end master
|
||||
!$omp barrier
|
||||
|
||||
!$omp do schedule(static) private(disjoint)
|
||||
do kk=0, nths-1
|
||||
step1: do ii=bnds(kk), bnds(kk+1)-1
|
||||
i = idxs(ii)
|
||||
if (info /= 0) cycle step1
|
||||
if ((i<1).or.(i>nr)) then
|
||||
!$omp atomic write
|
||||
info=psb_err_internal_error_
|
||||
!$omp end atomic
|
||||
call psb_errpush(info,name)
|
||||
cycle step1
|
||||
!goto 9999
|
||||
end if
|
||||
|
||||
if (ilaggr(i) == -(nr+1)) then
|
||||
nz = (acsr%irp(i+1)-acsr%irp(i))
|
||||
if ((nz<0).or.(nz>size(icol))) then
|
||||
!$omp atomic write
|
||||
info=psb_err_internal_error_
|
||||
!$omp end atomic
|
||||
call psb_errpush(info,name)
|
||||
cycle step1
|
||||
!goto 9999
|
||||
end if
|
||||
|
||||
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
|
||||
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
|
||||
|
||||
!
|
||||
! Build the set of all strongly coupled nodes
|
||||
!
|
||||
ip = 0
|
||||
do k=1, nz
|
||||
j = icol(k)
|
||||
! If any of the neighbours is already assigned,
|
||||
! we will not reset.
|
||||
if (j>nr) cycle step1
|
||||
if (ilaggr(j) > 0) cycle step1
|
||||
if (abs(val(k)) > theta*sqrt(abs(diag(i)*diag(j)))) then
|
||||
ip = ip + 1
|
||||
icol(ip) = icol(k)
|
||||
end if
|
||||
enddo
|
||||
|
||||
!
|
||||
! If the whole strongly coupled neighborhood of I is
|
||||
! as yet unconnected, turn it into the next aggregate.
|
||||
! Same if ip==0 (in which case, neighborhood only
|
||||
! contains I even if it does not look like it from matrix)
|
||||
! The fact that DISJOINT is private and not under lock
|
||||
! generates a certain un-repeatability, in that between
|
||||
! computing DISJOINT and assigning, another thread might
|
||||
! alter the values of ILAGGR.
|
||||
! However, a certain unrepeatability is already present
|
||||
! because the sequence of aggregates is computed with a
|
||||
! different order than in serial mode.
|
||||
! In any case, even if the enteries of ILAGGR may be
|
||||
! overwritten, the important thing is that each entry is
|
||||
! consistent and they generate a correct aggregation map.
|
||||
!
|
||||
disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
|
||||
if (disjoint) then
|
||||
locnaggr(kk) = locnaggr(kk) + 1
|
||||
itmp = (bnds(kk)-1+locnaggr(kk))*nths+kk
|
||||
if (itmp < (bnds(kk)-1+locnaggr(kk))) then
|
||||
!$omp atomic update
|
||||
info = max(12345678,info)
|
||||
!$omp end atomic
|
||||
cycle step1
|
||||
end if
|
||||
!$omp atomic write
|
||||
ilaggr(i) = itmp
|
||||
!$omp end atomic
|
||||
do k=1, ip
|
||||
!$omp atomic write
|
||||
ilaggr(icol(k)) = itmp
|
||||
!$omp end atomic
|
||||
end do
|
||||
end if
|
||||
end if
|
||||
enddo step1
|
||||
end do
|
||||
!$omp end do
|
||||
|
||||
!$omp master
|
||||
naggr = sum(locnaggr(0:nths-1))
|
||||
do i=1,nths
|
||||
locnaggr(i) = locnaggr(i) + locnaggr(i-1)
|
||||
end do
|
||||
do i=nths+1,1,-1
|
||||
locnaggr(i) = locnaggr(i-1)
|
||||
end do
|
||||
locnaggr(0) = 0
|
||||
!$omp end master
|
||||
!$omp barrier
|
||||
!$omp do schedule(static)
|
||||
do kk=0, nths-1
|
||||
do ii=bnds(kk), bnds(kk+1)-1
|
||||
if (ilaggr(ii) > 0) then
|
||||
kp = mod(ilaggr(ii),nths)
|
||||
ilaggr(ii) = (ilaggr(ii)/nths)- (bnds(kp)-1) + locnaggr(kp)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
!$omp end do
|
||||
end block
|
||||
!$omp end parallel
|
||||
end block
|
||||
if (info /= 0) then
|
||||
if (info == 12345678) write(0,*) 'Overflow in encoding ILAGGR'
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
#else
|
||||
icnt = 0
|
||||
step1: do ii=1, nr
|
||||
if (info /= 0) cycle
|
||||
i = idxs(ii)
|
||||
if ((i<1).or.(i>nr)) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
cycle step1
|
||||
!goto 9999
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (ilaggr(i) == -(nr+1)) then
|
||||
nz = (acsr%irp(i+1)-acsr%irp(i))
|
||||
if ((nz<0).or.(nz>size(icol))) then
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
cycle step1
|
||||
!goto 9999
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
|
||||
@@ -352,7 +176,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
!
|
||||
! Build the set of all strongly coupled nodes
|
||||
!
|
||||
ip = 0
|
||||
ip = 0
|
||||
do k=1, nz
|
||||
j = icol(k)
|
||||
if ((1<=j).and.(j<=nr)) then
|
||||
@@ -370,7 +194,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
! contains I even if it does not look like it from matrix)
|
||||
!
|
||||
disjoint = all(ilaggr(icol(1:ip)) == -(nr+1)).or.(ip==0)
|
||||
if (disjoint) then
|
||||
if (disjoint) then
|
||||
icnt = icnt + 1
|
||||
naggr = naggr + 1
|
||||
do k=1, ip
|
||||
ilaggr(icol(k)) = naggr
|
||||
@@ -379,22 +204,16 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
end if
|
||||
endif
|
||||
enddo step1
|
||||
#endif
|
||||
|
||||
if (debug_level >= psb_debug_outer_) then
|
||||
write(debug_unit,*) me,' ',trim(name),&
|
||||
& ' Check 1:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
|
||||
& count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
|
||||
& ' Check 1:',count(ilaggr == -(nr+1))
|
||||
end if
|
||||
if (do_timings) call psb_toc(idx_soc1_p1)
|
||||
if (do_timings) call psb_tic(idx_soc1_p2)
|
||||
|
||||
!
|
||||
! Phase two: join the neighbours
|
||||
!
|
||||
!$omp workshare
|
||||
tmpaggr = ilaggr
|
||||
!$omp end workshare
|
||||
!$omp parallel do schedule(static) shared(tmpaggr,ilaggr,nr,naggr,diag,theta)&
|
||||
!$omp private(ii,i,j,k,nz,icol,val,ip,cpling)
|
||||
step2: do ii=1,nr
|
||||
i = idxs(ii)
|
||||
|
||||
@@ -425,15 +244,8 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
end if
|
||||
end if
|
||||
end do step2
|
||||
!$omp end parallel do
|
||||
if (do_timings) call psb_toc(idx_soc1_p2)
|
||||
if (debug_level >= psb_debug_outer_) then
|
||||
write(debug_unit,*) me,' ',trim(name),&
|
||||
& ' Check 1.5:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
|
||||
& count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
|
||||
end if
|
||||
|
||||
if (do_timings) call psb_tic(idx_soc1_p3)
|
||||
|
||||
!
|
||||
! Phase three: sweep over leftovers, if any
|
||||
!
|
||||
@@ -462,6 +274,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
end if
|
||||
enddo
|
||||
if (ip > 0) then
|
||||
icnt = icnt + 1
|
||||
naggr = naggr + 1
|
||||
ilaggr(i) = naggr
|
||||
do k=1, ip
|
||||
@@ -479,10 +292,7 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
end do step3
|
||||
|
||||
! Any leftovers?
|
||||
!$omp parallel do schedule(static) shared(ilaggr,info)&
|
||||
!$omp private(ii,i,j,k,nz,icol,val,ip)
|
||||
do i=1, nr
|
||||
if (info /= 0) cycle
|
||||
if (ilaggr(i) < 0) then
|
||||
nz = (acsr%irp(i+1)-acsr%irp(i))
|
||||
if (nz == 1) then
|
||||
@@ -493,18 +303,15 @@ subroutine amg_c_soc1_map_bld(iorder,theta,clean_zeros,a,desc_a,nlaggr,ilaggr,in
|
||||
! other processes.
|
||||
ilaggr(i) = -(nrglob+nr)
|
||||
else
|
||||
!$omp atomic write
|
||||
info=psb_err_internal_error_
|
||||
!$omp end atomic
|
||||
call psb_errpush(info,name,a_err='Fatal error: non-singleton leftovers')
|
||||
cycle
|
||||
goto 9999
|
||||
endif
|
||||
end if
|
||||
end do
|
||||
!$omp end parallel do
|
||||
if (info /= 0) goto 9999
|
||||
if (do_timings) call psb_toc(idx_soc1_p3)
|
||||
|
||||
if (naggr > ncol) then
|
||||
!write(0,*) name,'Error : naggr > ncol',naggr,ncol
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
|
||||
goto 9999
|
||||
@@ -529,13 +336,9 @@ 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(ctxt,nlaggr(1:np))
|
||||
if (debug_level >= psb_debug_outer_) then
|
||||
write(debug_unit,*) me,' ',trim(name),&
|
||||
& ' Check 2:',naggr,count(ilaggr(1:nr) == -(nr+1)), count(ilaggr(1:nr)>0),&
|
||||
& count(ilaggr(1:nr) == -(nr+1))+count(ilaggr(1:nr)>0),nr
|
||||
end if
|
||||
|
||||
call acsr%free()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user