diff --git a/Changelog b/Changelog index 8acc6453..b6656d54 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,6 @@ 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. diff --git a/LICENSE b/LICENSE index d3bd6111..02dedcfe 100644 --- a/LICENSE +++ b/LICENSE @@ -1,10 +1,10 @@ - AMG4PSBLAS version 1.0 + AMG4PSBLAS version 1.1 Algebraic Multigrid Package - based on PSBLAS (Parallel Sparse BLAS version 3.7) + based on PSBLAS (Parallel Sparse BLAS version 3.8) - (C) Copyright 2021 + (C) Copyright 2022 Salvatore Filippone Pasqua D'Ambra diff --git a/Makefile b/Makefile index 63b95068..fb87ee99 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,13 @@ include Make.inc -all: library +all: objs lib -library: libdir amgp cbnd -#cbnd +objs: amgp cbnd + +lib: libdir objs + cd amgprec && $(MAKE) lib + cd cbind && $(MAKE) lib libdir: (if test ! -d lib ; then mkdir lib; fi) @@ -14,10 +17,11 @@ libdir: amgp: - $(MAKE) -C amgprec all + cd amgprec && $(MAKE) objs cbnd: amgp - $(MAKE) -C cbind all -install: all + cd cbind && $(MAKE) objs + +install: lib mkdir -p $(INSTALL_LIBDIR) &&\ $(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR) mkdir -p $(INSTALL_INCLUDEDIR) &&\ @@ -41,14 +45,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) diff --git a/README.md b/README.md index fbea8c39..3be67f1f 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,5 @@ - AMG4PSBLAS - Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7) + Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.8) Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR) Pasqua D'Ambra (IAC-CNR, Naples, IT) diff --git a/amgprec/Makefile b/amgprec/Makefile index f3813c74..f74ada43 100644 --- a/amgprec/Makefile +++ b/amgprec/Makefile @@ -63,17 +63,20 @@ OBJS=$(MODOBJS) LOCAL_MODS=$(MODOBJS:.o=$(.mod)) LIBNAME=libamg_prec.a -all: lib impld +all: objs impld -impld: $(OBJS) - $(MAKE) -C impl +objs: $(OBJS) + /bin/cp -p amg_const.h $(INCDIR) + /bin/cp -p *$(.mod) $(MODDIR) + +impld: objs + cd impl && $(MAKE) 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 +224,4 @@ clean: implclean /bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod) implclean: - $(MAKE) -C impl clean + cd impl && $(MAKE) clean diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index 0e9c452a..b6c1d056 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -64,7 +64,7 @@ module amg_base_prec_type ! use psb_const_mod use psb_base_mod, only :& - & psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,& + & psb_desc_type, psb_ctxt_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,9 +81,9 @@ module amg_base_prec_type ! ! Version numbers ! - character(len=*), parameter :: amg_version_string_ = "1.0.0" + character(len=*), parameter :: amg_version_string_ = "1.1.0" integer(psb_ipk_), parameter :: amg_version_major_ = 1 - integer(psb_ipk_), parameter :: amg_version_minor_ = 0 + integer(psb_ipk_), parameter :: amg_version_minor_ = 1 integer(psb_ipk_), parameter :: amg_patchlevel_ = 0 type amg_ml_parms @@ -656,43 +656,52 @@ contains end if end subroutine ml_parms_mlcycledsc - subroutine ml_parms_mldescr(pm,iout,info) + subroutine ml_parms_mldescr(pm,iout,info,prefix) Implicit None ! Arguments - class(amg_ml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info + 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_ 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,*) ' Parallel aggregation algorithm: ',& + write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',& & par_aggr_alg_names(pm%par_aggr_alg) - if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',& + if (pm%aggr_type>0) write(iout,*) trim(prefix),' 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,*) ' with initial ordering: ',& + & write(iout,*) trim(prefix),' with initial ordering: ',& & ord_names(pm%aggr_ord) - write(iout,*) ' Aggregation prolongator: ', & + write(iout,*) trim(prefix),' Aggregation prolongator: ', & & aggr_prols(pm%aggr_prol) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' with: ', aggr_filters(pm%aggr_filter) + write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter) if (pm%aggr_omega_alg == amg_eig_est_) then - write(iout,*) ' Damping omega computation: spectral radius estimate' - write(iout,*) ' Spectral radius estimate: ', & + write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate' + write(iout,*) trim(prefix),' Spectral radius estimate: ', & & eigen_estimates(pm%aggr_eig) else if (pm%aggr_omega_alg == amg_user_choice_) then - write(iout,*) ' Damping omega computation: user defined value.' + write(iout,*) trim(prefix),' Damping omega computation: user defined value.' else - write(iout,*) ' Damping omega computation: unknown value in iprcparm!!' + write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!' end if end if !end if else - write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',& + write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',& & pm%ml_cycle end if @@ -700,15 +709,16 @@ contains end subroutine ml_parms_mldescr - subroutine ml_parms_descr(pm,iout,info,coarse) + subroutine ml_parms_descr(pm,iout,info,coarse,prefix) 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 + 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 logical :: coarse_ info = psb_success_ @@ -719,7 +729,7 @@ contains end if if (coarse_) then - call pm%coarsedescr(iout,info) + call pm%coarsedescr(iout,info,prefix=prefix) end if return @@ -727,81 +737,126 @@ contains end subroutine ml_parms_descr - subroutine ml_parms_coarsedescr(pm,iout,info) + subroutine ml_parms_coarsedescr(pm,iout,info,prefix) Implicit None ! Arguments - class(amg_ml_parms), intent(in) :: pm - integer(psb_ipk_), intent(in) :: iout - integer(psb_ipk_), intent(out) :: info + 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_ info = psb_success_ - write(iout,*) ' Coarse matrix: ',& + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout,*) trim(prefix),' Coarse matrix: ',& & matrix_names(pm%coarse_mat) select case(pm%coarse_solve) case (amg_bjac_,amg_as_) - write(iout,*) ' Number of sweeps : ',& - & pm%sweeps_pre - write(iout,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & 'Block Jacobi' - case (amg_l1_bjac_) - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre - write(iout,*) ' Coarse solver: ',& + case (amg_l1_bjac_) + write(iout,*) trim(prefix),' Coarse solver: ',& & 'L1-Block Jacobi' - case (amg_jac_) - write(iout,*) ' Number of sweeps : ',& + write(iout,*) trim(prefix),' Number of sweeps : ',& & pm%sweeps_pre - write(iout,*) ' Coarse solver: ',& + case (amg_jac_) + write(iout,*) trim(prefix),' 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,*) ' Coarse solver: ',& + write(iout,*) trim(prefix),' Coarse solver: ',& & amg_fact_names(pm%coarse_solve) end select - + end subroutine ml_parms_coarsedescr - subroutine s_ml_parms_descr(pm,iout,info,coarse) + subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix) 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 + 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_ info = psb_success_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - call pm%amg_ml_parms%descr(iout,info,coarse) + call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' Damping omega value :',pm%aggr_omega_val + write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val end if - write(iout,*) ' Aggregation threshold:',pm%aggr_thresh + write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh return end subroutine s_ml_parms_descr - subroutine d_ml_parms_descr(pm,iout,info,coarse) + subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix) 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 + 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_ info = psb_success_ + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - call pm%amg_ml_parms%descr(iout,info,coarse) + call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix) if (pm%aggr_prol /= amg_no_smooth_) then - write(iout,*) ' Damping omega value :',pm%aggr_omega_val + write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val end if - write(iout,*) ' Aggregation threshold:',pm%aggr_thresh + write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh return diff --git a/amgprec/amg_c_ainv_solver.F90 b/amgprec/amg_c_ainv_solver.F90 index e250a193..5d24179a 100644 --- a/amgprec/amg_c_ainv_solver.F90 +++ b/amgprec/amg_c_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_c_ainv_solver !!$ end interface interface - subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_ Implicit None @@ -208,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 diff --git a/amgprec/amg_c_as_smoother.f90 b/amgprec/amg_c_as_smoother.f90 index 0858d4a0..27c39e71 100644 --- a/amgprec/amg_c_as_smoother.f90 +++ b/amgprec/amg_c_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine c_as_smoother_default - subroutine c_as_smoother_descr(sm,info,iout,coarse) + subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_c_base_aggregator_mod.f90 b/amgprec/amg_c_base_aggregator_mod.f90 index 93250ba5..69cee02f 100644 --- a/amgprec/amg_c_base_aggregator_mod.f90 +++ b/amgprec/amg_c_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_c_base_aggregator_xt_desc - subroutine amg_c_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_c_base_aggregator_descr diff --git a/amgprec/amg_c_base_smoother_mod.f90 b/amgprec/amg_c_base_smoother_mod.f90 index 37e60879..3004c616 100644 --- a/amgprec/amg_c_base_smoother_mod.f90 +++ b/amgprec/amg_c_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_c_base_smoother_mod end interface interface - subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix) 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,6 +281,7 @@ 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 diff --git a/amgprec/amg_c_base_solver_mod.f90 b/amgprec/amg_c_base_solver_mod.f90 index 5c75bc8c..a113774b 100644 --- a/amgprec/amg_c_base_solver_mod.f90 +++ b/amgprec/amg_c_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_c_base_solver_mod end interface interface - subroutine amg_c_base_solver_descr(sv,info,iout,coarse) + subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix) 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 diff --git a/amgprec/amg_c_dec_aggregator_mod.f90 b/amgprec/amg_c_dec_aggregator_mod.f90 index 5763287e..175fcf97 100644 --- a/amgprec/amg_c_dec_aggregator_mod.f90 +++ b/amgprec/amg_c_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_c_dec_aggregator_fmt - subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_c_dec_aggregator_descr diff --git a/amgprec/amg_c_diag_solver.f90 b/amgprec/amg_c_diag_solver.f90 index 7a3be71c..ccf86bf2 100644 --- a/amgprec/amg_c_diag_solver.f90 +++ b/amgprec/amg_c_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine c_diag_solver_free - subroutine c_diag_solver_descr(sv,info,iout,coarse) + subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ 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 @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_c_l1_diag_solver contains - subroutine c_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ 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 @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_c_gs_solver.f90 b/amgprec/amg_c_gs_solver.f90 index 0155cd5c..39c0fa10 100644 --- a/amgprec/amg_c_gs_solver.f90 +++ b/amgprec/amg_c_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine c_gs_solver_free - subroutine c_gs_solver_descr(sv,info,iout,coarse) + subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function c_gs_solver_is_iterative - subroutine c_bwgs_solver_descr(sv,info,iout,coarse) + subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_c_id_solver.f90 b/amgprec/amg_c_id_solver.f90 index 112df716..1b277a07 100644 --- a/amgprec/amg_c_id_solver.f90 +++ b/amgprec/amg_c_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine c_id_solver_free - subroutine c_id_solver_descr(sv,info,iout,coarse) + subroutine c_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ 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 + 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_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_c_ilu_solver.f90 b/amgprec/amg_c_ilu_solver.f90 index f6ab6088..7a269d85 100644 --- a/amgprec/amg_c_ilu_solver.f90 +++ b/amgprec/amg_c_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine c_ilu_solver_free - subroutine c_ilu_solver_descr(sv,info,iout,coarse) + subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ 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 - + 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_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_c_invk_solver.f90 b/amgprec/amg_c_invk_solver.f90 index c8a6765d..f757a04f 100644 --- a/amgprec/amg_c_invk_solver.f90 +++ b/amgprec/amg_c_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_c_invk_solver end interface interface - subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_ Implicit None @@ -133,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 diff --git a/amgprec/amg_c_invt_solver.f90 b/amgprec/amg_c_invt_solver.f90 index f1569000..420b90c9 100644 --- a/amgprec/amg_c_invt_solver.f90 +++ b/amgprec/amg_c_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_c_invt_solver end interface interface - subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_invt_solver_descr end interface diff --git a/amgprec/amg_c_jac_smoother.f90 b/amgprec/amg_c_jac_smoother.f90 index 1f7d7e20..70aba712 100644 --- a/amgprec/amg_c_jac_smoother.f90 +++ b/amgprec/amg_c_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_c_jac_smoother end interface interface - subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_c_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_c_jac_smoother end interface interface - subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_c_krm_solver.f90 b/amgprec/amg_c_krm_solver.f90 index 30473dbf..4b8b1faa 100644 --- a/amgprec/amg_c_krm_solver.f90 +++ b/amgprec/amg_c_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function c_krm_solver_get_fmt - subroutine c_krm_solver_descr(sv,info,iout,coarse) + subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ 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 + 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_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,23 +460,22 @@ contains else iout_ = psb_out_unit endif - - if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) ' Krylov solver (local) ' + prefix_ = "" end if - 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) + + if (sv%global) then + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' sub_solve: ',sv%sub_solve + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps - write(iout_,*) ' fillin: ',sv%fillin - + 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 call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_mumps_solver.F90 b/amgprec/amg_c_mumps_solver.F90 index 486fbdc6..6a7acb70 100644 --- a/amgprec/amg_c_mumps_solver.F90 +++ b/amgprec/amg_c_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine c_mumps_solver_finalize(sv) end subroutine c_mumps_solver_finalize -subroutine c_mumps_solver_descr(sv,info,iout,coarse) +subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix) 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 - + 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 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_ @@ -337,8 +339,13 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index f93fb8df..7cb87bf4 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -257,7 +257,7 @@ module amg_c_onelev_mod end interface interface - subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -268,6 +268,7 @@ 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 diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index cc176861..cb9e3f31 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -155,15 +155,16 @@ module amg_c_prec_type interface amg_precdescr - subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix) 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 diff --git a/amgprec/amg_c_slu_solver.F90 b/amgprec/amg_c_slu_solver.F90 index 774a0c61..5d9e1db9 100644 --- a/amgprec/amg_c_slu_solver.F90 +++ b/amgprec/amg_c_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine c_slu_solver_finalize - subroutine c_slu_solver_descr(sv,info,iout,coarse) + subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_c_symdec_aggregator_mod.f90 b/amgprec/amg_c_symdec_aggregator_mod.f90 index 03928ab6..d820a762 100644 --- a/amgprec/amg_c_symdec_aggregator_mod.f90 +++ b/amgprec/amg_c_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_c_symdec_aggregator_fmt - subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix) 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 - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + 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) return end subroutine amg_c_symdec_aggregator_descr diff --git a/amgprec/amg_d_ainv_solver.F90 b/amgprec/amg_d_ainv_solver.F90 index 5e99027e..8d264d8f 100644 --- a/amgprec/amg_d_ainv_solver.F90 +++ b/amgprec/amg_d_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_d_ainv_solver !!$ end interface interface - subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_ Implicit None @@ -208,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 diff --git a/amgprec/amg_d_as_smoother.f90 b/amgprec/amg_d_as_smoother.f90 index 309b75b2..6e411de4 100644 --- a/amgprec/amg_d_as_smoother.f90 +++ b/amgprec/amg_d_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine d_as_smoother_default - subroutine d_as_smoother_descr(sm,info,iout,coarse) + subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_d_base_aggregator_mod.f90 b/amgprec/amg_d_base_aggregator_mod.f90 index 14e2cd64..7aed1885 100644 --- a/amgprec/amg_d_base_aggregator_mod.f90 +++ b/amgprec/amg_d_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_d_base_aggregator_xt_desc - subroutine amg_d_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_base_aggregator_descr diff --git a/amgprec/amg_d_base_smoother_mod.f90 b/amgprec/amg_d_base_smoother_mod.f90 index 809c0b84..52e52a4d 100644 --- a/amgprec/amg_d_base_smoother_mod.f90 +++ b/amgprec/amg_d_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_d_base_smoother_mod end interface interface - subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix) 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,6 +281,7 @@ 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 diff --git a/amgprec/amg_d_base_solver_mod.f90 b/amgprec/amg_d_base_solver_mod.f90 index 07a28b9a..f29e4340 100644 --- a/amgprec/amg_d_base_solver_mod.f90 +++ b/amgprec/amg_d_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_d_base_solver_mod end interface interface - subroutine amg_d_base_solver_descr(sv,info,iout,coarse) + subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix) 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 diff --git a/amgprec/amg_d_dec_aggregator_mod.f90 b/amgprec/amg_d_dec_aggregator_mod.f90 index 2f378068..eced25bd 100644 --- a/amgprec/amg_d_dec_aggregator_mod.f90 +++ b/amgprec/amg_d_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_d_dec_aggregator_fmt - subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_d_dec_aggregator_descr diff --git a/amgprec/amg_d_decmatch_mod.f90 b/amgprec/amg_d_decmatch_mod.f90 index d2d3d466..9a8fd3f4 100644 --- a/amgprec/amg_d_decmatch_mod.f90 +++ b/amgprec/amg_d_decmatch_mod.f90 @@ -496,23 +496,23 @@ contains ! ! Now call matching! ! - if (debug) write(0,*) iam,' buildmatching into PMatchBox:' + if (debug) write(0,*) iam,' buildmatching into NewMatch:' if (do_timings) call psb_tic(idx_cmboxp) info = dnew_Match_If(ipar,matching,lambda,nr,c_loc(tcsr%irp),c_loc(tcsr%ja),& & c_loc(tcsr%val),c_loc(diag),c_loc(w),c_loc(mate)) if (do_timings) call psb_toc(idx_cmboxp) - if (debug) write(0,*) iam,' buildmatching from PMatchBox:', info + if (debug) write(0,*) iam,' buildmatching from NewMatch:', info if (debug_sync) then call psb_max(ictxt,info) - if (iam == 0) write(0,*)' done PMatchBox', info + if (iam == 0) write(0,*)' done NewMatch', info end if if (do_timings) call psb_tic(idx_phase3) nunmatch = count(mate(1:nr)<=0) ! call psb_sum(ictxt,nunmatch) - if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch - ! if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',& - ! & nunmatch, count(mate(1:nr)<0) + !if (nunmatch /= 0) write(0,*) iam,' Unmatched nodes local imbalance ',nunmatch + ! if (count(mate(1:nr)<0) /= nunmatch) write(0,*) iam,' Matching results ?',& + ! & nunmatch, count(mate(1:nr)<0) if (debug_sync) then call psb_barrier(ictxt) if (iam == 0) write(0,*)' done build_matching ' diff --git a/amgprec/amg_d_diag_solver.f90 b/amgprec/amg_d_diag_solver.f90 index 06c7887f..1bc32a8b 100644 --- a/amgprec/amg_d_diag_solver.f90 +++ b/amgprec/amg_d_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine d_diag_solver_free - subroutine d_diag_solver_descr(sv,info,iout,coarse) + subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ 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 @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_d_l1_diag_solver contains - subroutine d_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ 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 @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_d_gs_solver.f90 b/amgprec/amg_d_gs_solver.f90 index 1a530853..22ed4fad 100644 --- a/amgprec/amg_d_gs_solver.f90 +++ b/amgprec/amg_d_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine d_gs_solver_free - subroutine d_gs_solver_descr(sv,info,iout,coarse) + subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function d_gs_solver_is_iterative - subroutine d_bwgs_solver_descr(sv,info,iout,coarse) + subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_d_id_solver.f90 b/amgprec/amg_d_id_solver.f90 index d94debe1..5f3d183b 100644 --- a/amgprec/amg_d_id_solver.f90 +++ b/amgprec/amg_d_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine d_id_solver_free - subroutine d_id_solver_descr(sv,info,iout,coarse) + subroutine d_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ 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 + 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_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_d_ilu_solver.f90 b/amgprec/amg_d_ilu_solver.f90 index 8c77cc87..00733655 100644 --- a/amgprec/amg_d_ilu_solver.f90 +++ b/amgprec/amg_d_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine d_ilu_solver_free - subroutine d_ilu_solver_descr(sv,info,iout,coarse) + subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ 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 - + 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_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_d_invk_solver.f90 b/amgprec/amg_d_invk_solver.f90 index b402d1de..08838fbb 100644 --- a/amgprec/amg_d_invk_solver.f90 +++ b/amgprec/amg_d_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_d_invk_solver end interface interface - subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_ Implicit None @@ -133,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 diff --git a/amgprec/amg_d_invt_solver.f90 b/amgprec/amg_d_invt_solver.f90 index 5e27d6f0..a83ed1b2 100644 --- a/amgprec/amg_d_invt_solver.f90 +++ b/amgprec/amg_d_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_d_invt_solver end interface interface - subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_invt_solver_descr end interface diff --git a/amgprec/amg_d_jac_smoother.f90 b/amgprec/amg_d_jac_smoother.f90 index aadefc0a..8f3845a0 100644 --- a/amgprec/amg_d_jac_smoother.f90 +++ b/amgprec/amg_d_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_d_jac_smoother end interface interface - subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_d_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_d_jac_smoother end interface interface - subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_d_krm_solver.f90 b/amgprec/amg_d_krm_solver.f90 index 0e76e97c..9bb48a9e 100644 --- a/amgprec/amg_d_krm_solver.f90 +++ b/amgprec/amg_d_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function d_krm_solver_get_fmt - subroutine d_krm_solver_descr(sv,info,iout,coarse) + subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ 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 + 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_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,23 +460,22 @@ contains else iout_ = psb_out_unit endif - - if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) ' Krylov solver (local) ' + prefix_ = "" end if - 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) + + if (sv%global) then + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' sub_solve: ',sv%sub_solve + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps - write(iout_,*) ' fillin: ',sv%fillin - + 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 call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_matchboxp_mod.f90 b/amgprec/amg_d_matchboxp_mod.f90 index a18d62d6..e19ce617 100644 --- a/amgprec/amg_d_matchboxp_mod.f90 +++ b/amgprec/amg_d_matchboxp_mod.f90 @@ -143,9 +143,10 @@ 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_ilaggr=.false., debug_sync=.false., debug_mate=.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) @@ -187,7 +188,7 @@ contains call desc_a%l2gip(ilv,info,owned=.false.) call psb_geall(ilaggr,desc_a,info) - ilaggr = -1 + ilaggr = ilaggr_neginit call psb_geasb(ilaggr,desc_a,info) nr = a%get_nrows() nc = a%get_ncols() @@ -213,7 +214,20 @@ 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 @@ -259,7 +273,7 @@ contains cycle else - if (ilaggr(k) == -1) then + if (ilaggr(k) == ilaggr_neginit) then wk = w(k) widx = w(idx) @@ -267,7 +281,7 @@ contains nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2) if (nrmagg > epsilon(nrmagg)) then if (idx <= nr) then - if (ilaggr(idx) == -1) then + if (ilaggr(idx) == ilaggr_neginit) then ! Now, if both vertices are local, the aggregate is local ! (kinda obvious). nlaggr(iam) = nlaggr(iam) + 1 @@ -275,6 +289,9 @@ 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 @@ -294,7 +311,7 @@ contains ilaggr(k) = nlaggr(iam) nlpairs = nlpairs+1 else - ilaggr(k) = -2 + ilaggr(k) = ilaggr_nonlocal end if else ! Use a statistically unbiased tie-breaking rule, @@ -309,7 +326,7 @@ contains ilaggr(k) = nlaggr(iam) nlpairs = nlpairs+1 else - ilaggr(k) = -2 + ilaggr(k) = ilaggr_nonlocal end if end if end if @@ -325,6 +342,12 @@ 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 @@ -332,7 +355,7 @@ contains if (do_timings) call psb_tic(idx_phase3) ! Ok, now compute offsets, gather halo and fix non-local - ! aggregates (those where ilaggr == -2) + ! aggregates (those where ilaggr == ilaggr_nonlocal) call psb_sum(ictxt,nlaggr) ntaggr = sum(nlaggr(0:np-1)) naggrm1 = sum(nlaggr(0:iam-1)) @@ -347,7 +370,7 @@ contains call psb_halo(wtemp,desc_a,info) ! Cleanup as yet unmarked entries do k=1,nr - if (ilaggr(k) == -2) then + if (ilaggr(k) == ilaggr_nonlocal) then idx = mate(k) if (idx > nr) then i = ilaggr(idx) @@ -359,9 +382,14 @@ contains else write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx) end if - end if - if (ilaggr(k) <0) then - write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k) + 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 end do if (debug_sync) then @@ -414,7 +442,7 @@ contains end block if (iam == 0) then - write(0,*) 'Matching statistics: Unmatched nodes ',& + write(0,*) iam,'Matching statistics: Unmatched nodes ',& & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs end if diff --git a/amgprec/amg_d_mumps_solver.F90 b/amgprec/amg_d_mumps_solver.F90 index 5329dea8..0e8375be 100644 --- a/amgprec/amg_d_mumps_solver.F90 +++ b/amgprec/amg_d_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine d_mumps_solver_finalize(sv) end subroutine d_mumps_solver_finalize -subroutine d_mumps_solver_descr(sv,info,iout,coarse) +subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix) 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 - + 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 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_ @@ -337,8 +339,13 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_newmatch_aggregator_mod.F90 b/amgprec/amg_d_newmatch_aggregator_mod.F90 index 7b46ee85..6a10a31d 100644 --- a/amgprec/amg_d_newmatch_aggregator_mod.F90 +++ b/amgprec/amg_d_newmatch_aggregator_mod.F90 @@ -329,17 +329,24 @@ contains val = "new matching aggregation" end function d_newmatch_aggregator_fmt - subroutine d_newmatch_aggregator_descr(ag,parms,iout,info) + subroutine d_newmatch_aggregator_descr(ag,parms,iout,info,prefix) implicit none class(amg_d_newmatch_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,*) 'NewMatch Aggregator' - write(iout,*) ' Number of Matching sweeps: ',ag%n_sweeps - write(iout,*) ' Matching algorithm : ',ag%matching_alg - write(iout,*) 'Aggregator object type: ',ag%fmt() + write(iout,*) trim(prefix_),' ','NewMatch Aggregator' + write(iout,*) trim(prefix_),' ',' Number of Matching sweeps: ',ag%n_sweeps + write(iout,*) trim(prefix_),' ',' Matching algorithm : ',ag%matching_alg + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index 1ca0e9cb..c8c122ec 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -259,7 +259,7 @@ module amg_d_onelev_mod end interface interface - subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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,6 +270,7 @@ 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 diff --git a/amgprec/amg_d_parmatch_aggregator_mod.F90 b/amgprec/amg_d_parmatch_aggregator_mod.F90 index cfe5e874..525bb0c3 100644 --- a/amgprec/amg_d_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_d_parmatch_aggregator_mod.F90 @@ -132,8 +132,6 @@ module amg_d_parmatch_aggregator_mod type(psb_dspmat_type), allocatable :: prol, restr type(psb_dspmat_type), allocatable :: ac, base_a, rwa type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc - integer(psb_ipk_) :: max_csize - integer(psb_ipk_) :: max_nlevels logical :: reproducible_matching = .false. logical :: need_symmetrize = .false. logical :: unsmoothed_hierarchy = .true. @@ -392,18 +390,25 @@ contains end function amg_d_parmatch_aggregator_sizeof - subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix) 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,*) '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) + 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) return end subroutine amg_d_parmatch_aggregator_descr @@ -452,10 +457,10 @@ contains & agnext%matching_alg = ag%matching_alg if (.not.is_legal_nsweeps(agnext%n_sweeps))& & agnext%n_sweeps = ag%n_sweeps - if (.not.is_legal_csize(agnext%max_csize))& - & agnext%max_csize = ag%max_csize - if (.not.is_legal_nlevels(agnext%max_nlevels))& - & agnext%max_nlevels = ag%max_nlevels +!!$ if (.not.is_legal_csize(agnext%max_csize))& +!!$ & agnext%max_csize = ag%max_csize +!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))& +!!$ & agnext%max_nlevels = ag%max_nlevels ! Is this going to generate shallow copies/memory leaks/double frees? ! To be investigated further. call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info) @@ -540,10 +545,6 @@ contains case('AGGR_SIZE') ag%orig_aggr_size = val ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0))) - case('PRMC_MAX_CSIZE') - ag%max_csize=val - case('PRMC_MAX_NLEVELS') - ag%max_nlevels=val case('PRMC_W_SIZE') call ag%bld_default_w(val) case('PRMC_REPRODUCIBLE_MATCHING') @@ -569,8 +570,8 @@ contains ag%matching_alg = 0 ag%n_sweeps = 1 ag%jacobi_sweeps = 0 - ag%max_nlevels = 36 - ag%max_csize = -1 +!!$ ag%max_nlevels = 36 +!!$ ag%max_csize = -1 ! ! Apparently BootCMatch works better ! by keeping all entries diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index b41243ec..0774d0ad 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -155,15 +155,16 @@ module amg_d_prec_type interface amg_precdescr - subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix) 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 diff --git a/amgprec/amg_d_slu_solver.F90 b/amgprec/amg_d_slu_solver.F90 index 35f1f8c5..69983efe 100644 --- a/amgprec/amg_d_slu_solver.F90 +++ b/amgprec/amg_d_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine d_slu_solver_finalize - subroutine d_slu_solver_descr(sv,info,iout,coarse) + subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_sludist_solver.F90 b/amgprec/amg_d_sludist_solver.F90 index a196bbfa..c962b248 100644 --- a/amgprec/amg_d_sludist_solver.F90 +++ b/amgprec/amg_d_sludist_solver.F90 @@ -52,7 +52,7 @@ module amg_d_sludist_solver use iso_c_binding use amg_d_base_solver_mod -#if defined(LPK8) +#if (!defined(HAVE_SLUDIST_)) || defined(IPK8) type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type @@ -270,10 +270,12 @@ contains ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat) :: acsr - integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc - integer :: ifrst, ibcheck type(psb_ctxt_type) :: ctxt - integer :: np,me,i, err_act, debug_unit, debug_level + integer(psb_lpk_), allocatable :: gia(:), gja(:) + 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 info=psb_success_ @@ -293,19 +295,36 @@ contains n_col = desc_a%get_local_cols() nglob = desc_a%get_global_rows() - call a%cscnv(atmp,info,type='coo') + ! + ! Strategy here is as follows: because a call to SLUDIST + ! as a gobal solver is mostly done at the coarsest level, + ! even if we start from a problem requiring 8 bytes, chances + ! are that the global size will be suitable for 4 bytes + ! anyway, so we hope for the best, and throw an error + ! if something goes wrong. + ! + if (nglob > huge(1_psb_ipk_)) then + write(0,*) me,' ',trim(name),': Error: overflow of local indices ' + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%cscnv(atmp,info,type='csr') + ! This in case we are dealing with AS call psb_rwextd(n_row,atmp,info,b=b) - call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_) call atmp%mv_to(acsr) nrow_a = acsr%get_nrows() nztota = acsr%get_nzeros() + call psb_loc_to_glob(ione,lfrst,desc_a,info) + ! Fix the entries to call C-base SuperLU - call psb_loc_to_glob(1,ifrst,desc_a,info) - call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info) - call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I') + call psb_realloc(nztota,gja,info) + call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I') + acsr%ja(1:nztota) = gja(1:nztota) acsr%ja(:) = acsr%ja(:) - 1 acsr%irp(:) = acsr%irp(:) - 1 - ifrst = ifrst - 1 + ifrst = lfrst - 1 info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,& & acsr%val,acsr%irp,acsr%ja,sv%lufactors,& & npr,npc) @@ -318,7 +337,6 @@ contains end if call acsr%free() - call atmp%free() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' end' @@ -403,15 +421,16 @@ contains end subroutine d_sludist_solver_finalize - subroutine d_sludist_solver_descr(sv,info,iout,coarse) + subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act @@ -419,6 +438,7 @@ 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_ @@ -427,8 +447,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_d_symdec_aggregator_mod.f90 b/amgprec/amg_d_symdec_aggregator_mod.f90 index e5a2c89f..c74a6053 100644 --- a/amgprec/amg_d_symdec_aggregator_mod.f90 +++ b/amgprec/amg_d_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_d_symdec_aggregator_fmt - subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix) 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 - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + 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) return end subroutine amg_d_symdec_aggregator_descr diff --git a/amgprec/amg_d_umf_solver.F90 b/amgprec/amg_d_umf_solver.F90 index 586447e3..7a34ff3f 100644 --- a/amgprec/amg_d_umf_solver.F90 +++ b/amgprec/amg_d_umf_solver.F90 @@ -390,20 +390,22 @@ contains end subroutine d_umf_solver_finalize - subroutine d_umf_solver_descr(sv,info,iout,coarse) + subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -412,8 +414,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' UMFPACK Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_ainv_solver.F90 b/amgprec/amg_s_ainv_solver.F90 index f1a23716..8bf41b9a 100644 --- a/amgprec/amg_s_ainv_solver.F90 +++ b/amgprec/amg_s_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_s_ainv_solver !!$ end interface interface - subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_ Implicit None @@ -208,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 diff --git a/amgprec/amg_s_as_smoother.f90 b/amgprec/amg_s_as_smoother.f90 index 7ddaead6..84a7ba8c 100644 --- a/amgprec/amg_s_as_smoother.f90 +++ b/amgprec/amg_s_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine s_as_smoother_default - subroutine s_as_smoother_descr(sm,info,iout,coarse) + subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_s_base_aggregator_mod.f90 b/amgprec/amg_s_base_aggregator_mod.f90 index 2c07fc4a..4d97c06d 100644 --- a/amgprec/amg_s_base_aggregator_mod.f90 +++ b/amgprec/amg_s_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_s_base_aggregator_xt_desc - subroutine amg_s_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_base_aggregator_descr diff --git a/amgprec/amg_s_base_smoother_mod.f90 b/amgprec/amg_s_base_smoother_mod.f90 index d4493f32..39d367f8 100644 --- a/amgprec/amg_s_base_smoother_mod.f90 +++ b/amgprec/amg_s_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_s_base_smoother_mod end interface interface - subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix) 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,6 +281,7 @@ 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 diff --git a/amgprec/amg_s_base_solver_mod.f90 b/amgprec/amg_s_base_solver_mod.f90 index 07c8ee08..ad701e41 100644 --- a/amgprec/amg_s_base_solver_mod.f90 +++ b/amgprec/amg_s_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_s_base_solver_mod end interface interface - subroutine amg_s_base_solver_descr(sv,info,iout,coarse) + subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix) 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 diff --git a/amgprec/amg_s_dec_aggregator_mod.f90 b/amgprec/amg_s_dec_aggregator_mod.f90 index 240dfaa8..2b5592c6 100644 --- a/amgprec/amg_s_dec_aggregator_mod.f90 +++ b/amgprec/amg_s_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_s_dec_aggregator_fmt - subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_s_dec_aggregator_descr diff --git a/amgprec/amg_s_diag_solver.f90 b/amgprec/amg_s_diag_solver.f90 index 39f8dbdb..ae0f9aef 100644 --- a/amgprec/amg_s_diag_solver.f90 +++ b/amgprec/amg_s_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine s_diag_solver_free - subroutine s_diag_solver_descr(sv,info,iout,coarse) + subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ 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 @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_s_l1_diag_solver contains - subroutine s_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ 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 @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_s_gs_solver.f90 b/amgprec/amg_s_gs_solver.f90 index 10950382..80ee821e 100644 --- a/amgprec/amg_s_gs_solver.f90 +++ b/amgprec/amg_s_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine s_gs_solver_free - subroutine s_gs_solver_descr(sv,info,iout,coarse) + subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function s_gs_solver_is_iterative - subroutine s_bwgs_solver_descr(sv,info,iout,coarse) + subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_s_id_solver.f90 b/amgprec/amg_s_id_solver.f90 index 2d565e09..d88aebca 100644 --- a/amgprec/amg_s_id_solver.f90 +++ b/amgprec/amg_s_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine s_id_solver_free - subroutine s_id_solver_descr(sv,info,iout,coarse) + subroutine s_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ 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 + 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_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_s_ilu_solver.f90 b/amgprec/amg_s_ilu_solver.f90 index 45e848c5..dd642746 100644 --- a/amgprec/amg_s_ilu_solver.f90 +++ b/amgprec/amg_s_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine s_ilu_solver_free - subroutine s_ilu_solver_descr(sv,info,iout,coarse) + subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ 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 - + 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_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_s_invk_solver.f90 b/amgprec/amg_s_invk_solver.f90 index c99b2184..bf288dda 100644 --- a/amgprec/amg_s_invk_solver.f90 +++ b/amgprec/amg_s_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_s_invk_solver end interface interface - subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_ Implicit None @@ -133,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 diff --git a/amgprec/amg_s_invt_solver.f90 b/amgprec/amg_s_invt_solver.f90 index b54e738f..1096335e 100644 --- a/amgprec/amg_s_invt_solver.f90 +++ b/amgprec/amg_s_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_s_invt_solver end interface interface - subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_invt_solver_descr end interface diff --git a/amgprec/amg_s_jac_smoother.f90 b/amgprec/amg_s_jac_smoother.f90 index adeeb853..6d4ded83 100644 --- a/amgprec/amg_s_jac_smoother.f90 +++ b/amgprec/amg_s_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_s_jac_smoother end interface interface - subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_s_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_s_jac_smoother end interface interface - subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_s_krm_solver.f90 b/amgprec/amg_s_krm_solver.f90 index 06ab0649..fcabfd13 100644 --- a/amgprec/amg_s_krm_solver.f90 +++ b/amgprec/amg_s_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function s_krm_solver_get_fmt - subroutine s_krm_solver_descr(sv,info,iout,coarse) + subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ 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 + 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_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,23 +460,22 @@ contains else iout_ = psb_out_unit endif - - if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) ' Krylov solver (local) ' + prefix_ = "" end if - 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) + + if (sv%global) then + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' sub_solve: ',sv%sub_solve + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps - write(iout_,*) ' fillin: ',sv%fillin - + 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 call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_matchboxp_mod.f90 b/amgprec/amg_s_matchboxp_mod.f90 index 9061344f..a7f41c24 100644 --- a/amgprec/amg_s_matchboxp_mod.f90 +++ b/amgprec/amg_s_matchboxp_mod.f90 @@ -143,9 +143,10 @@ 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_ilaggr=.false., debug_sync=.false., debug_mate=.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) @@ -187,7 +188,7 @@ contains call desc_a%l2gip(ilv,info,owned=.false.) call psb_geall(ilaggr,desc_a,info) - ilaggr = -1 + ilaggr = ilaggr_neginit call psb_geasb(ilaggr,desc_a,info) nr = a%get_nrows() nc = a%get_ncols() @@ -213,7 +214,20 @@ 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 @@ -259,7 +273,7 @@ contains cycle else - if (ilaggr(k) == -1) then + if (ilaggr(k) == ilaggr_neginit) then wk = w(k) widx = w(idx) @@ -267,7 +281,7 @@ contains nrmagg = wmax*sqrt((wk/wmax)**2+(widx/wmax)**2) if (nrmagg > epsilon(nrmagg)) then if (idx <= nr) then - if (ilaggr(idx) == -1) then + if (ilaggr(idx) == ilaggr_neginit) then ! Now, if both vertices are local, the aggregate is local ! (kinda obvious). nlaggr(iam) = nlaggr(iam) + 1 @@ -275,6 +289,9 @@ 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 @@ -294,7 +311,7 @@ contains ilaggr(k) = nlaggr(iam) nlpairs = nlpairs+1 else - ilaggr(k) = -2 + ilaggr(k) = ilaggr_nonlocal end if else ! Use a statistically unbiased tie-breaking rule, @@ -309,7 +326,7 @@ contains ilaggr(k) = nlaggr(iam) nlpairs = nlpairs+1 else - ilaggr(k) = -2 + ilaggr(k) = ilaggr_nonlocal end if end if end if @@ -325,6 +342,12 @@ 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 @@ -332,7 +355,7 @@ contains if (do_timings) call psb_tic(idx_phase3) ! Ok, now compute offsets, gather halo and fix non-local - ! aggregates (those where ilaggr == -2) + ! aggregates (those where ilaggr == ilaggr_nonlocal) call psb_sum(ictxt,nlaggr) ntaggr = sum(nlaggr(0:np-1)) naggrm1 = sum(nlaggr(0:iam-1)) @@ -347,7 +370,7 @@ contains call psb_halo(wtemp,desc_a,info) ! Cleanup as yet unmarked entries do k=1,nr - if (ilaggr(k) == -2) then + if (ilaggr(k) == ilaggr_nonlocal) then idx = mate(k) if (idx > nr) then i = ilaggr(idx) @@ -359,9 +382,14 @@ contains else write(0,*) 'Error : unresolved (paired) index ',k,idx,i,nr,nc, ilv(k),ilv(idx) end if - end if - if (ilaggr(k) <0) then - write(0,*) 'Matchboxp: Funny number: ',k,ilv(k),ilaggr(k),wtemp(k) + 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 end do if (debug_sync) then @@ -414,7 +442,7 @@ contains end block if (iam == 0) then - write(0,*) 'Matching statistics: Unmatched nodes ',& + write(0,*) iam,'Matching statistics: Unmatched nodes ',& & nunmatched,' Singletons:',nlsingl,' Pairs:',nlpairs end if diff --git a/amgprec/amg_s_mumps_solver.F90 b/amgprec/amg_s_mumps_solver.F90 index b8363b4a..af918fcf 100644 --- a/amgprec/amg_s_mumps_solver.F90 +++ b/amgprec/amg_s_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine s_mumps_solver_finalize(sv) end subroutine s_mumps_solver_finalize -subroutine s_mumps_solver_descr(sv,info,iout,coarse) +subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix) 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 - + 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 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_ @@ -337,8 +339,13 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index 4f6d293b..bd02b83b 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -258,7 +258,7 @@ module amg_s_onelev_mod end interface interface - subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -269,6 +269,7 @@ 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 diff --git a/amgprec/amg_s_parmatch_aggregator_mod.F90 b/amgprec/amg_s_parmatch_aggregator_mod.F90 index 90c76bd9..d58bd750 100644 --- a/amgprec/amg_s_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_s_parmatch_aggregator_mod.F90 @@ -132,8 +132,6 @@ module amg_s_parmatch_aggregator_mod type(psb_sspmat_type), allocatable :: prol, restr type(psb_sspmat_type), allocatable :: ac, base_a, rwa type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc - integer(psb_ipk_) :: max_csize - integer(psb_ipk_) :: max_nlevels logical :: reproducible_matching = .false. logical :: need_symmetrize = .false. logical :: unsmoothed_hierarchy = .true. @@ -392,18 +390,25 @@ contains end function amg_s_parmatch_aggregator_sizeof - subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix) 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,*) '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) + 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) return end subroutine amg_s_parmatch_aggregator_descr @@ -452,10 +457,10 @@ contains & agnext%matching_alg = ag%matching_alg if (.not.is_legal_nsweeps(agnext%n_sweeps))& & agnext%n_sweeps = ag%n_sweeps - if (.not.is_legal_csize(agnext%max_csize))& - & agnext%max_csize = ag%max_csize - if (.not.is_legal_nlevels(agnext%max_nlevels))& - & agnext%max_nlevels = ag%max_nlevels +!!$ if (.not.is_legal_csize(agnext%max_csize))& +!!$ & agnext%max_csize = ag%max_csize +!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))& +!!$ & agnext%max_nlevels = ag%max_nlevels ! Is this going to generate shallow copies/memory leaks/double frees? ! To be investigated further. call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info) @@ -540,10 +545,6 @@ contains case('AGGR_SIZE') ag%orig_aggr_size = val ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0))) - case('PRMC_MAX_CSIZE') - ag%max_csize=val - case('PRMC_MAX_NLEVELS') - ag%max_nlevels=val case('PRMC_W_SIZE') call ag%bld_default_w(val) case('PRMC_REPRODUCIBLE_MATCHING') @@ -569,8 +570,8 @@ contains ag%matching_alg = 0 ag%n_sweeps = 1 ag%jacobi_sweeps = 0 - ag%max_nlevels = 36 - ag%max_csize = -1 +!!$ ag%max_nlevels = 36 +!!$ ag%max_csize = -1 ! ! Apparently BootCMatch works better ! by keeping all entries diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index e8dfeae4..11a789b1 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -155,15 +155,16 @@ module amg_s_prec_type interface amg_precdescr - subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix) 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 diff --git a/amgprec/amg_s_slu_solver.F90 b/amgprec/amg_s_slu_solver.F90 index 3c062fd6..89cbfc5a 100644 --- a/amgprec/amg_s_slu_solver.F90 +++ b/amgprec/amg_s_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine s_slu_solver_finalize - subroutine s_slu_solver_descr(sv,info,iout,coarse) + subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_s_symdec_aggregator_mod.f90 b/amgprec/amg_s_symdec_aggregator_mod.f90 index fc5553ec..6adba836 100644 --- a/amgprec/amg_s_symdec_aggregator_mod.f90 +++ b/amgprec/amg_s_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_s_symdec_aggregator_fmt - subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix) 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 - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + 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) return end subroutine amg_s_symdec_aggregator_descr diff --git a/amgprec/amg_z_ainv_solver.F90 b/amgprec/amg_z_ainv_solver.F90 index 9b3a22a0..cdb9a784 100644 --- a/amgprec/amg_z_ainv_solver.F90 +++ b/amgprec/amg_z_ainv_solver.F90 @@ -198,7 +198,7 @@ module amg_z_ainv_solver !!$ end interface interface - subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) + subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_ Implicit None @@ -208,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 diff --git a/amgprec/amg_z_as_smoother.f90 b/amgprec/amg_z_as_smoother.f90 index d79a75f0..619ee2a9 100644 --- a/amgprec/amg_z_as_smoother.f90 +++ b/amgprec/amg_z_as_smoother.f90 @@ -396,21 +396,23 @@ contains end subroutine z_as_smoother_default - subroutine z_as_smoother_descr(sm,info,iout,coarse) + subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_as_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -424,16 +426,21 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then - write(iout_,*) ' Additive Schwarz with ',& + write(iout_,*) trim(prefix_), ' Additive Schwarz with ',& & sm%novr, ' overlap layers.' - write(iout_,*) ' Restrictor: ',restrict_names(sm%restr) - write(iout_,*) ' Prolongator: ',prolong_names(sm%prol) - write(iout_,*) ' Local solver:' + write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr) + write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol) + write(iout_,*) trim(prefix_), ' Local solver:' endif if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if call psb_erractionrestore(err_act) diff --git a/amgprec/amg_z_base_aggregator_mod.f90 b/amgprec/amg_z_base_aggregator_mod.f90 index 81858fb7..6b6a33be 100644 --- a/amgprec/amg_z_base_aggregator_mod.f90 +++ b/amgprec/amg_z_base_aggregator_mod.f90 @@ -275,15 +275,22 @@ contains val = .false. end function amg_z_base_aggregator_xt_desc - subroutine amg_z_base_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_z_base_aggregator_descr diff --git a/amgprec/amg_z_base_smoother_mod.f90 b/amgprec/amg_z_base_smoother_mod.f90 index d697275a..548571c9 100644 --- a/amgprec/amg_z_base_smoother_mod.f90 +++ b/amgprec/amg_z_base_smoother_mod.f90 @@ -272,7 +272,7 @@ module amg_z_base_smoother_mod end interface interface - subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix) 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,6 +281,7 @@ 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 diff --git a/amgprec/amg_z_base_solver_mod.f90 b/amgprec/amg_z_base_solver_mod.f90 index 549aa0e5..7c017459 100644 --- a/amgprec/amg_z_base_solver_mod.f90 +++ b/amgprec/amg_z_base_solver_mod.f90 @@ -270,7 +270,7 @@ module amg_z_base_solver_mod end interface interface - subroutine amg_z_base_solver_descr(sv,info,iout,coarse) + subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix) 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 diff --git a/amgprec/amg_z_dec_aggregator_mod.f90 b/amgprec/amg_z_dec_aggregator_mod.f90 index 90339f11..c42f220c 100644 --- a/amgprec/amg_z_dec_aggregator_mod.f90 +++ b/amgprec/amg_z_dec_aggregator_mod.f90 @@ -184,16 +184,23 @@ contains val = "Decoupled aggregation" end function amg_z_dec_aggregator_fmt - subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_dec_aggregator_descr(ag,parms,iout,info,prefix) 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,*) 'Decoupled Aggregator' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + write(iout,*) trim(prefix_),' ','Decoupled Aggregator' + write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info,prefix=prefix) return end subroutine amg_z_dec_aggregator_descr diff --git a/amgprec/amg_z_diag_solver.f90 b/amgprec/amg_z_diag_solver.f90 index a24b48b7..4d3746d9 100644 --- a/amgprec/amg_z_diag_solver.f90 +++ b/amgprec/amg_z_diag_solver.f90 @@ -219,7 +219,7 @@ contains end subroutine z_diag_solver_free - subroutine z_diag_solver_descr(sv,info,iout,coarse) + subroutine z_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -228,11 +228,13 @@ 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 @@ -240,8 +242,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' Diagonal local solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' Diagonal local solver ' return @@ -352,7 +359,7 @@ module amg_z_l1_diag_solver contains - subroutine z_l1_diag_solver_descr(sv,info,iout,coarse) + subroutine z_l1_diag_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -361,11 +368,13 @@ 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 @@ -373,8 +382,13 @@ contains else iout_ = psb_out_unit endif - - write(iout_,*) ' L1 Diagonal solver ' + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if + + write(iout_,*) trim(prefix_), ' L1 Diagonal solver ' return diff --git a/amgprec/amg_z_gs_solver.f90 b/amgprec/amg_z_gs_solver.f90 index 7e32d258..1ac665b3 100644 --- a/amgprec/amg_z_gs_solver.f90 +++ b/amgprec/amg_z_gs_solver.f90 @@ -433,20 +433,22 @@ contains return end subroutine z_gs_solver_free - subroutine z_gs_solver_descr(sv,info,iout,coarse) + subroutine z_gs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_gs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -455,12 +457,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if @@ -526,20 +533,22 @@ contains val = .true. end function z_gs_solver_is_iterative - subroutine z_bwgs_solver_descr(sv,info,iout,coarse) + subroutine z_bwgs_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_bwgs_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -548,12 +557,17 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (sv%eps<=dzero) then - write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',& & sv%sweeps,' sweeps' else - write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',& + write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',& & sv%eps,' and maxit', sv%sweeps end if diff --git a/amgprec/amg_z_id_solver.f90 b/amgprec/amg_z_id_solver.f90 index 0712061c..6a1a3afb 100644 --- a/amgprec/amg_z_id_solver.f90 +++ b/amgprec/amg_z_id_solver.f90 @@ -157,7 +157,7 @@ contains return end subroutine z_id_solver_free - subroutine z_id_solver_descr(sv,info,iout,coarse) + subroutine z_id_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -165,12 +165,14 @@ 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 + 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_id_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -178,8 +180,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Identity local solver ' + write(iout_,*) trim(prefix_), ' Identity local solver ' return diff --git a/amgprec/amg_z_ilu_solver.f90 b/amgprec/amg_z_ilu_solver.f90 index f6f97c21..48b5ff1f 100644 --- a/amgprec/amg_z_ilu_solver.f90 +++ b/amgprec/amg_z_ilu_solver.f90 @@ -406,7 +406,7 @@ contains return end subroutine z_ilu_solver_free - subroutine z_ilu_solver_descr(sv,info,iout,coarse) + subroutine z_ilu_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -414,12 +414,14 @@ 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 - + 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_ilu_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -428,15 +430,20 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' Incomplete factorization solver: ',& + write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',& & amg_fact_names(sv%fact_type) select case(sv%fact_type) case(psb_ilu_n_,psb_milu_n_) - write(iout_,*) ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in case(psb_ilu_t_) - write(iout_,*) ' Fill level:',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh end select call psb_erractionrestore(err_act) diff --git a/amgprec/amg_z_invk_solver.f90 b/amgprec/amg_z_invk_solver.f90 index 2348d7a6..6f9e8c20 100644 --- a/amgprec/amg_z_invk_solver.f90 +++ b/amgprec/amg_z_invk_solver.f90 @@ -123,7 +123,7 @@ module amg_z_invk_solver end interface interface - subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) + subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix) import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_ Implicit None @@ -133,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 diff --git a/amgprec/amg_z_invt_solver.f90 b/amgprec/amg_z_invt_solver.f90 index c9ec2549..f6a4c808 100644 --- a/amgprec/amg_z_invt_solver.f90 +++ b/amgprec/amg_z_invt_solver.f90 @@ -134,16 +134,17 @@ module amg_z_invt_solver end interface interface - subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) + subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix) 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 + 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_invt_solver_descr end interface diff --git a/amgprec/amg_z_jac_smoother.f90 b/amgprec/amg_z_jac_smoother.f90 index 9420fce3..bfe83949 100644 --- a/amgprec/amg_z_jac_smoother.f90 +++ b/amgprec/amg_z_jac_smoother.f90 @@ -219,12 +219,13 @@ module amg_z_jac_smoother end interface interface - subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix end subroutine amg_z_jac_smoother_descr end interface @@ -313,12 +314,13 @@ module amg_z_jac_smoother end interface interface - subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) + subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) 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 + 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_l1_jac_smoother_descr end interface diff --git a/amgprec/amg_z_krm_solver.f90 b/amgprec/amg_z_krm_solver.f90 index da17dac4..da539732 100644 --- a/amgprec/amg_z_krm_solver.f90 +++ b/amgprec/amg_z_krm_solver.f90 @@ -436,7 +436,7 @@ contains val = "KRM solver" end function z_krm_solver_get_fmt - subroutine z_krm_solver_descr(sv,info,iout,coarse) + subroutine z_krm_solver_descr(sv,info,iout,coarse,prefix) Implicit None @@ -444,12 +444,14 @@ 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 + 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_krm_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -458,23 +460,22 @@ contains else iout_ = psb_out_unit endif - - if (sv%global) then - write(iout_,*) ' Krylov solver (global)' + if (present(prefix)) then + prefix_ = prefix else - write(iout_,*) ' Krylov solver (local) ' + prefix_ = "" end if - 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) + + if (sv%global) then + write(iout_,*) trim(prefix_), ' Krylov solver (global)' else - write(iout_,*) ' sub_solve: ',sv%sub_solve + write(iout_,*) trim(prefix_), ' Krylov solver (local) ' end if - write(iout_,*) ' itmax: ',sv%itmax - write(iout_,*) ' eps: ',sv%eps - write(iout_,*) ' fillin: ',sv%fillin - + 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 call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_mumps_solver.F90 b/amgprec/amg_z_mumps_solver.F90 index 2b0b8c0d..3ab54345 100644 --- a/amgprec/amg_z_mumps_solver.F90 +++ b/amgprec/amg_z_mumps_solver.F90 @@ -313,22 +313,24 @@ subroutine z_mumps_solver_finalize(sv) end subroutine z_mumps_solver_finalize -subroutine z_mumps_solver_descr(sv,info,iout,coarse) +subroutine z_mumps_solver_descr(sv,info,iout,coarse,prefix) 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 - + 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 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_ @@ -337,8 +339,13 @@ subroutine z_mumps_solver_descr(sv,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' MUMPS Solver. ' + write(iout_,*) trim(prefix_), ' MUMPS Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index 0105f358..648ede75 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -257,7 +257,7 @@ module amg_z_onelev_mod end interface interface - subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity) + subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) 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 @@ -268,6 +268,7 @@ 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 diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index 98a7aa1f..33c9324a 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -155,15 +155,16 @@ module amg_z_prec_type interface amg_precdescr - subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity) + subroutine amg_zfile_prec_descr(prec,info,iout,root,verbosity,prefix) 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 diff --git a/amgprec/amg_z_slu_solver.F90 b/amgprec/amg_z_slu_solver.F90 index 7be34e44..54957513 100644 --- a/amgprec/amg_z_slu_solver.F90 +++ b/amgprec/amg_z_slu_solver.F90 @@ -385,20 +385,22 @@ contains end subroutine z_slu_solver_finalize - subroutine z_slu_solver_descr(sv,info,iout,coarse) + subroutine z_slu_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -407,8 +409,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_sludist_solver.F90 b/amgprec/amg_z_sludist_solver.F90 index 50cd39b4..d78356a3 100644 --- a/amgprec/amg_z_sludist_solver.F90 +++ b/amgprec/amg_z_sludist_solver.F90 @@ -52,7 +52,7 @@ module amg_z_sludist_solver use iso_c_binding use amg_z_base_solver_mod -#if defined(LPK8) +#if (!defined(HAVE_SLUDIST_)) || defined(IPK8) type, extends(amg_z_base_solver_type) :: amg_z_sludist_solver_type @@ -270,10 +270,12 @@ contains ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csr_sparse_mat) :: acsr - integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc - integer :: ifrst, ibcheck type(psb_ctxt_type) :: ctxt - integer :: np,me,i, err_act, debug_unit, debug_level + integer(psb_lpk_), allocatable :: gia(:), gja(:) + 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 info=psb_success_ @@ -293,19 +295,36 @@ contains n_col = desc_a%get_local_cols() nglob = desc_a%get_global_rows() - call a%cscnv(atmp,info,type='coo') + ! + ! Strategy here is as follows: because a call to SLUDIST + ! as a gobal solver is mostly done at the coarsest level, + ! even if we start from a problem requiring 8 bytes, chances + ! are that the global size will be suitable for 4 bytes + ! anyway, so we hope for the best, and throw an error + ! if something goes wrong. + ! + if (nglob > huge(1_psb_ipk_)) then + write(0,*) me,' ',trim(name),': Error: overflow of local indices ' + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if + + call a%cscnv(atmp,info,type='csr') + ! This in case we are dealing with AS call psb_rwextd(n_row,atmp,info,b=b) - call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_) call atmp%mv_to(acsr) nrow_a = acsr%get_nrows() nztota = acsr%get_nzeros() + call psb_loc_to_glob(ione,lfrst,desc_a,info) + ! Fix the entries to call C-base SuperLU - call psb_loc_to_glob(1,ifrst,desc_a,info) - call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info) - call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I') + call psb_realloc(nztota,gja,info) + call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I') + acsr%ja(1:nztota) = gja(1:nztota) acsr%ja(:) = acsr%ja(:) - 1 acsr%irp(:) = acsr%irp(:) - 1 - ifrst = ifrst - 1 + ifrst = lfrst - 1 info = amg_zsludist_fact(nglob,nrow_a,nztota,ifrst,& & acsr%val,acsr%irp,acsr%ja,sv%lufactors,& & npr,npc) @@ -318,7 +337,6 @@ contains end if call acsr%free() - call atmp%free() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' end' @@ -403,15 +421,16 @@ contains end subroutine z_sludist_solver_finalize - subroutine z_sludist_solver_descr(sv,info,iout,coarse) + subroutine z_sludist_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! Local variables integer :: err_act @@ -419,6 +438,7 @@ 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_ @@ -427,8 +447,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/amg_z_symdec_aggregator_mod.f90 b/amgprec/amg_z_symdec_aggregator_mod.f90 index 820367a8..bad271d9 100644 --- a/amgprec/amg_z_symdec_aggregator_mod.f90 +++ b/amgprec/amg_z_symdec_aggregator_mod.f90 @@ -88,16 +88,25 @@ contains val = "Symmetric Decoupled aggregation" end function amg_z_symdec_aggregator_fmt - subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info) + subroutine amg_z_symdec_aggregator_descr(ag,parms,iout,info,prefix) 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 - write(iout,*) 'Decoupled Aggregator locally-symmetrized' - write(iout,*) 'Aggregator object type: ',ag%fmt() - call parms%mldescr(iout,info) + 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) return end subroutine amg_z_symdec_aggregator_descr diff --git a/amgprec/amg_z_umf_solver.F90 b/amgprec/amg_z_umf_solver.F90 index 88641a97..549da100 100644 --- a/amgprec/amg_z_umf_solver.F90 +++ b/amgprec/amg_z_umf_solver.F90 @@ -390,20 +390,22 @@ contains end subroutine z_umf_solver_finalize - subroutine z_umf_solver_descr(sv,info,iout,coarse) + subroutine z_umf_solver_descr(sv,info,iout,coarse,prefix) 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 + integer, intent(out) :: info + integer, intent(in), optional :: iout + logical, intent(in), optional :: coarse + character(len=*), intent(in), optional :: prefix ! 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_ @@ -412,8 +414,13 @@ contains else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' UMFPACK Sparse Factorization Solver. ' + write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. ' call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/Makefile b/amgprec/impl/Makefile index 811ec7ea..826c7dd1 100644 --- a/amgprec/impl/Makefile +++ b/amgprec/impl/Makefile @@ -67,22 +67,25 @@ 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: - $(MAKE) -C aggregator + cd aggregator && $(MAKE) objs levd: - $(MAKE) -C level + cd level && $(MAKE) objs smoothd: - $(MAKE) -C smoother + cd smoother && $(MAKE) objs solvd: - $(MAKE) -C solver + cd solver && $(MAKE) objs -mpobjs: - (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)") - (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") veryclean: clean /bin/rm -f $(LIBNAME) @@ -91,10 +94,10 @@ clean: solvclean smoothclean levclean aggrclean /bin/rm -f $(OBJS) $(LOCAL_MODS) aggrclean: - $(MAKE) -C aggregator clean + cd aggregator && $(MAKE) clean levclean: - $(MAKE) -C level clean + cd level && $(MAKE) clean smoothclean: - $(MAKE) -C smoother clean + cd smoother && $(MAKE) clean solvclean: - $(MAKE) -C solver clean + cd solver && $(MAKE) clean diff --git a/amgprec/impl/aggregator/Makefile b/amgprec/impl/aggregator/Makefile index 3d0532ad..0ef0ab75 100644 --- a/amgprec/impl/aggregator/Makefile +++ b/amgprec/impl/aggregator/Makefile @@ -70,13 +70,31 @@ amg_d_newmatch_spmm_bld_ov.o MPCXXOBJS=MatchBoxPC.o \ algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o \ -newmatch_interface.o +newmatch_interface.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 \ +algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o \ +MatchingAlgorithms.o OBJS = $(FOBJS) $(MPCOBJS) $(MPCXXOBJS) LIBNAME=libamg_prec.a -lib: $(OBJS) +objs: $(OBJS) + +lib: objs $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) diff --git a/amgprec/impl/aggregator/MatchBoxPC.cpp b/amgprec/impl/aggregator/MatchBoxPC.cpp index c1ec0976..90b448dc 100644 --- a/amgprec/impl/aggregator/MatchBoxPC.cpp +++ b/amgprec/impl/aggregator/MatchBoxPC.cpp @@ -60,17 +60,43 @@ 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 - dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC(NLVer, NLEdge, + + +#define TIME_TRACKER + #ifdef TIME_TRACKER + double tmr = MPI_Wtime(); + #endif + +#define OMP +#ifdef OMP + dalgoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP(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 } diff --git a/amgprec/impl/aggregator/MatchBoxPC.h b/amgprec/impl/aggregator/MatchBoxPC.h index 21d0a181..a1fddb59 100644 --- a/amgprec/impl/aggregator/MatchBoxPC.h +++ b/amgprec/impl/aggregator/MatchBoxPC.h @@ -52,145 +52,412 @@ #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 #include #include #include #include -// #include "matchboxp.h" +#include "omp.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 DEFAULT_VECTOR; + +// MPI type map +template +MPI_Datatype TypeMap(); +template <> +inline MPI_Datatype TypeMap() { return MPI_LONG_LONG; } +template <> +inline MPI_Datatype TypeMap() { return MPI_INT; } +template <> +inline MPI_Datatype TypeMap() { return MPI_DOUBLE; } +template <> +inline MPI_Datatype TypeMap() { 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 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 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 - - //// 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 - - #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 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 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 + +#ifdef BIT64 +#define MilanLongIntMax INT64_MAX +#define MilanLongIntMin -INT64_MAX +#else +#define MilanLongIntMax INT32_MAX +#define MilanLongIntMin -INT32_MAX +#endif + +#endif // +INFINITY const double PLUS_INFINITY = numeric_limits::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: -inline MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance, - MilanInt myRank, MilanInt numProcs); - - 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 ); + // Function of find the owner of a ghost vertex using binary search: + MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance, + MilanInt myRank, MilanInt numProcs); + + MilanLongInt firstComputeCandidateMate(MilanLongInt adj1, + MilanLongInt adj2, + MilanLongInt *verLocInd, + MilanReal *edgeLocWeight); + + void queuesTransfer(vector &U, + vector &privateU, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner); + + bool isAlreadyMatched(MilanLongInt node, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap); + + MilanLongInt computeCandidateMate(MilanLongInt adj1, + MilanLongInt adj2, + MilanReal *edgeLocWeight, + MilanLongInt k, + MilanLongInt *verLocInd, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap); + + void initialize(MilanLongInt NLVer, MilanLongInt NLEdge, + MilanLongInt StartIndex, MilanLongInt EndIndex, + MilanLongInt *numGhostEdgesPtr, + MilanLongInt *numGhostVerticesPtr, + MilanLongInt *S, + MilanLongInt *verLocInd, + MilanLongInt *verLocPtr, + map &Ghost2LocalMap, + vector &Counter, + vector &verGhostPtr, + vector &verGhostInd, + vector &tempCounter, + vector &GMate, + vector &Message, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + MilanLongInt *&candidateMate, + vector &U, + vector &privateU, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner); + + void clean(MilanLongInt NLVer, + MilanInt myRank, + MilanLongInt MessageIndex, + vector &SRequest, + vector &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 &GMate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + MilanLongInt *myCardPtr, + MilanLongInt *msgIndPtr, + MilanLongInt *NumMessagesBundledPtr, + MilanLongInt *SPtr, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + vector &U, + vector &privateU, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner); + + void PROCESS_CROSS_EDGE(MilanLongInt *edge, + MilanLongInt *SPtr); + + void processMatchedVertices( + MilanLongInt NLVer, + vector &UChunkBeingProcessed, + vector &U, + vector &privateU, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *myCardPtr, + MilanLongInt *msgIndPtr, + MilanLongInt *NumMessagesBundledPtr, + MilanLongInt *SPtr, + MilanLongInt *verLocPtr, + MilanLongInt *verLocInd, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + MilanLongInt *candidateMate, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner); + + void processMatchedVerticesAndSendMessages( + MilanLongInt NLVer, + vector &UChunkBeingProcessed, + vector &U, + vector &privateU, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *myCardPtr, + MilanLongInt *msgIndPtr, + MilanLongInt *NumMessagesBundledPtr, + MilanLongInt *SPtr, + MilanLongInt *verLocPtr, + MilanLongInt *verLocInd, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + MilanLongInt *candidateMate, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner, + MPI_Comm comm, + MilanLongInt *msgActual, + vector &Message); + + void sendBundledMessages(MilanLongInt *numGhostEdgesPtr, + MilanInt *BufferSizePtr, + MilanLongInt *Buffer, + vector &PCumulative, + vector &PMessageBundle, + vector &PSizeInfoMessages, + MilanLongInt *PCounter, + MilanLongInt NumMessagesBundled, + MilanLongInt *msgActualPtr, + MilanLongInt *MessageIndexPtr, + MilanInt numProcs, + MilanInt myRank, + MPI_Comm comm, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &SRequest, + vector &SStatus); + + void processMessages( + MilanLongInt NLVer, + MilanLongInt *Mate, + MilanLongInt *candidateMate, + map &Ghost2LocalMap, + vector &GMate, + vector &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 &Message, + MilanLongInt numGhostEdges, + MilanLongInt u, + MilanLongInt v, + MilanLongInt *SPtr, + vector &U); + + void extractUChunk( + vector &UChunkBeingProcessed, + vector &U, + vector &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); #endif #ifdef __cplusplus diff --git a/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp b/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp index 8be438b6..f03f726f 100644 --- a/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp +++ b/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp @@ -72,12 +72,6 @@ #ifdef SERIAL_MPI #else -//MPI type map -template MPI_Datatype TypeMap(); -template<> inline MPI_Datatype TypeMap() { return MPI_LONG_LONG; } -template<> inline MPI_Datatype TypeMap() { return MPI_INT; } -template<> inline MPI_Datatype TypeMap() { return MPI_DOUBLE; } -template<> inline MPI_Datatype TypeMap() { return MPI_FLOAT; } // DOUBLE PRECISION VERSION //WARNING: The vertex block on a given rank is contiguous diff --git a/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp b/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp new file mode 100644 index 00000000..49b366a6 --- /dev/null +++ b/amgprec/impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp @@ -0,0 +1,554 @@ +#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 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 QLocalVtx, QGhostVtx, QMsgType; + vector 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 Ghost2LocalMap; // Map each ghost vertex to a local vertex + vector 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 verGhostPtr, verGhostInd, tempCounter; + // Mate array for ghost vertices: + vector GMate; // Proportional to the number of ghost vertices + MilanLongInt S; + MilanLongInt privateMyCard = 0; + vector PCumulative, PMessageBundle, PSizeInfoMessages; + vector SRequest; // Requests that are used for each send message + vector SStatus; // Status of sent messages, used in MPI_Wait + MilanLongInt MessageIndex = 0; // Pointer for current message + MilanInt BufferSize; + MilanLongInt *Buffer; + + vector privateQLocalVtx, privateQGhostVtx, privateQMsgType; + vector privateQOwner; + vector 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 " < 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 " <= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' @@ -292,7 +318,7 @@ subroutine amg_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call op_prol%mv_from(coo_prol) call op_restr%mv_from(coo_restr) - + if (do_timings) call psb_toc(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' diff --git a/amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90 index 2edcca6c..26edbb0a 100644 --- a/amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_d_dec_aggregator_tprol.f90 @@ -97,6 +97,8 @@ subroutine amg_d_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_d_dec_aggregator_tprol' call psb_erractionsave(err_act) @@ -108,6 +110,10 @@ subroutine amg_d_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) @@ -121,10 +127,14 @@ subroutine amg_d_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') diff --git a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 index 5ae47718..f23869b7 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90 @@ -68,7 +68,8 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& real(psb_dpk_), allocatable :: tmpw(:), tmpwnxt(:) integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:) type(psb_dspmat_type) :: a_tmp - integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels + integer(psb_ipk_) :: match_algorithm, n_sweeps + integer(psb_lpk_) :: target_csize character(len=40) :: name, ch_err character(len=80) :: fname, prefix_ type(psb_ctxt_type) :: ictxt @@ -128,27 +129,22 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps end if end if - if (ag%max_csize > 0) then - max_csize = ag%max_csize + if (ag_data%target_coarse_size > 0) then + target_csize = ag_data%target_coarse_size else - max_csize = ag_data%min_coarse_size - end if - if (ag%max_nlevels > 0) then - max_nlevels = ag%max_nlevels - else - max_nlevels = ag_data%max_levs + target_csize = ag_data%min_coarse_size end if if (.true.) then block integer(psb_ipk_) :: ipv(2) - ipv(1) = max_csize + ipv(1) = target_csize ipv(2) = n_sweeps call psb_bcast(ictxt,ipv) - max_csize = ipv(1) + target_csize = ipv(1) n_sweeps = ipv(2) end block else - call psb_bcast(ictxt,max_csize) + call psb_bcast(ictxt,target_csize) call psb_bcast(ictxt,n_sweeps) end if if (n_sweeps /= ag%n_sweeps) then @@ -156,7 +152,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& end if !!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps n_sweeps = max(1,n_sweeps) - if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize + if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then call ag%base_a%cp_to(acsr) if (ag%do_clean_zeros) call acsr%clean_zeros(info) @@ -242,7 +238,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& if (debug) then call psb_barrier(ictxt) - if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize + if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize end if ! @@ -300,11 +296,11 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& if (debug) then call psb_barrier(ictxt) - if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info + if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info csz = sum(nxaggr) call psb_bcast(ictxt,csz) if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',& - & csz,sum(nxaggr),max_csize + & csz,sum(nxaggr),target_csize end if if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2' @@ -342,10 +338,10 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& call move_alloc(tmpwnxt,tmpw) if (debug) then if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',& - & csz,sum(nlaggr),max_csize, info + & csz,sum(nlaggr),target_csize, info end if call acv(i-1)%free() - if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then + if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then x_sweeps = i exit sweeps_loop end if diff --git a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 index 82da3fc7..d365bf27 100644 --- a/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 +++ b/amgprec/impl/aggregator/amg_daggrmat_smth_bld.f90 @@ -140,6 +140,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& real(psb_dpk_) :: anorm, omega, tmp, dg, theta logical, parameter :: debug_new=.false. character(len=80) :: filename + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1 + integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1 name='amg_aggrmat_smth_bld' info=psb_success_ @@ -153,6 +156,23 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ctxt = desc_a%get_context() call psb_info(ctxt, me, np) + if ((do_timings).and.(idx_spspmm==-1)) & + & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm") + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2 ") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3 ") + if ((do_timings).and.(idx_gtrans==-1)) & + & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans ") + if ((do_timings).and.(idx_refine==-1)) & + & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine ") + if ((do_timings).and.(idx_cdasb==-1)) & + & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb ") + if ((do_timings).and.(idx_ptap==-1)) & + & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld ") + nglob = desc_a%get_global_rows() nrow = desc_a%get_local_rows() @@ -171,6 +191,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! naggr: number of local aggregates ! nrow: local rows. ! + if (do_timings) call psb_tic(idx_phase1) ! Get the diagonal D adiag = a%get_diag(info) @@ -196,7 +217,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! ! Build the filtered matrix Af from A ! - + !$OMP parallel do private(i,j,tmp,jd) schedule(static) do i=1, nrow tmp = dzero jd = -1 @@ -214,11 +235,13 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& acsrf%val(jd)=acsrf%val(jd)-tmp end if enddo + !$OMP end parallel do ! Take out zeroed terms call acsrf%clean_zeros(info) end if + !$OMP parallel do private(i) schedule(static) do i=1,size(adiag) if (adiag(i) /= dzero) then adiag(i) = done / adiag(i) @@ -226,7 +249,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& adiag(i) = done end if end do - + !$OMP end parallel do if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_eig == amg_max_norm_) then @@ -252,8 +275,9 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_') goto 9999 end if + if (do_timings) call psb_toc(idx_phase1) - + if (do_timings) call psb_tic(idx_phase2) call acsrf%scal(adiag,info) if (info /= psb_success_) goto 9999 @@ -267,6 +291,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_cdasb(desc_ac,info) call psb_cd_reinit(desc_ac,info) + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! ! Build the smoothed prolongator using either A or Af ! acsr1 = (I-w*D*A) Prol acsr1 = (I-w*D*Af) Prol @@ -279,8 +305,8 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1') goto 9999 end if - - + if (do_timings) call psb_toc(idx_phase3) + if (do_timings) call psb_tic(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' @@ -292,7 +318,7 @@ subroutine amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call op_prol%mv_from(coo_prol) call op_restr%mv_from(coo_restr) - + if (do_timings) call psb_toc(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' diff --git a/amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90 index c52c04f7..9529d141 100644 --- a/amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_s_dec_aggregator_tprol.f90 @@ -97,6 +97,8 @@ subroutine amg_s_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_s_dec_aggregator_tprol' call psb_erractionsave(err_act) @@ -108,6 +110,10 @@ subroutine amg_s_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) @@ -121,10 +127,14 @@ subroutine amg_s_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') diff --git a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90 b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90 index 28b63272..b68531d3 100644 --- a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90 +++ b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90 @@ -68,7 +68,8 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& real(psb_spk_), allocatable :: tmpw(:), tmpwnxt(:) integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:) type(psb_sspmat_type) :: a_tmp - integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels + integer(psb_ipk_) :: match_algorithm, n_sweeps + integer(psb_lpk_) :: target_csize character(len=40) :: name, ch_err character(len=80) :: fname, prefix_ type(psb_ctxt_type) :: ictxt @@ -128,27 +129,22 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps end if end if - if (ag%max_csize > 0) then - max_csize = ag%max_csize + if (ag_data%target_coarse_size > 0) then + target_csize = ag_data%target_coarse_size else - max_csize = ag_data%min_coarse_size - end if - if (ag%max_nlevels > 0) then - max_nlevels = ag%max_nlevels - else - max_nlevels = ag_data%max_levs + target_csize = ag_data%min_coarse_size end if if (.true.) then block integer(psb_ipk_) :: ipv(2) - ipv(1) = max_csize + ipv(1) = target_csize ipv(2) = n_sweeps call psb_bcast(ictxt,ipv) - max_csize = ipv(1) + target_csize = ipv(1) n_sweeps = ipv(2) end block else - call psb_bcast(ictxt,max_csize) + call psb_bcast(ictxt,target_csize) call psb_bcast(ictxt,n_sweeps) end if if (n_sweeps /= ag%n_sweeps) then @@ -156,7 +152,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& end if !!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps n_sweeps = max(1,n_sweeps) - if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize + if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then call ag%base_a%cp_to(acsr) if (ag%do_clean_zeros) call acsr%clean_zeros(info) @@ -242,7 +238,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& if (debug) then call psb_barrier(ictxt) - if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize + if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize end if ! @@ -300,11 +296,11 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& if (debug) then call psb_barrier(ictxt) - if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info + if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info csz = sum(nxaggr) call psb_bcast(ictxt,csz) if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',& - & csz,sum(nxaggr),max_csize + & csz,sum(nxaggr),target_csize end if if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2' @@ -342,10 +338,10 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& call move_alloc(tmpwnxt,tmpw) if (debug) then if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',& - & csz,sum(nlaggr),max_csize, info + & csz,sum(nlaggr),target_csize, info end if call acv(i-1)%free() - if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then + if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then x_sweeps = i exit sweeps_loop end if diff --git a/amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90 b/amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90 index d96176b2..c2eae3a4 100644 --- a/amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90 +++ b/amgprec/impl/aggregator/amg_saggrmat_smth_bld.f90 @@ -140,6 +140,9 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& real(psb_spk_) :: anorm, omega, tmp, dg, theta logical, parameter :: debug_new=.false. character(len=80) :: filename + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1 + integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1 name='amg_aggrmat_smth_bld' info=psb_success_ @@ -153,6 +156,23 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ctxt = desc_a%get_context() call psb_info(ctxt, me, np) + if ((do_timings).and.(idx_spspmm==-1)) & + & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm") + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2 ") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3 ") + if ((do_timings).and.(idx_gtrans==-1)) & + & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans ") + if ((do_timings).and.(idx_refine==-1)) & + & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine ") + if ((do_timings).and.(idx_cdasb==-1)) & + & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb ") + if ((do_timings).and.(idx_ptap==-1)) & + & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld ") + nglob = desc_a%get_global_rows() nrow = desc_a%get_local_rows() @@ -171,6 +191,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! naggr: number of local aggregates ! nrow: local rows. ! + if (do_timings) call psb_tic(idx_phase1) ! Get the diagonal D adiag = a%get_diag(info) @@ -196,7 +217,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! ! Build the filtered matrix Af from A ! - + !$OMP parallel do private(i,j,tmp,jd) schedule(static) do i=1, nrow tmp = szero jd = -1 @@ -214,11 +235,13 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& acsrf%val(jd)=acsrf%val(jd)-tmp end if enddo + !$OMP end parallel do ! Take out zeroed terms call acsrf%clean_zeros(info) end if + !$OMP parallel do private(i) schedule(static) do i=1,size(adiag) if (adiag(i) /= szero) then adiag(i) = sone / adiag(i) @@ -226,7 +249,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& adiag(i) = sone end if end do - + !$OMP end parallel do if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_eig == amg_max_norm_) then @@ -252,8 +275,9 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_') goto 9999 end if + if (do_timings) call psb_toc(idx_phase1) - + if (do_timings) call psb_tic(idx_phase2) call acsrf%scal(adiag,info) if (info /= psb_success_) goto 9999 @@ -267,6 +291,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_cdasb(desc_ac,info) call psb_cd_reinit(desc_ac,info) + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! ! Build the smoothed prolongator using either A or Af ! acsr1 = (I-w*D*A) Prol acsr1 = (I-w*D*Af) Prol @@ -279,8 +305,8 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1') goto 9999 end if - - + if (do_timings) call psb_toc(idx_phase3) + if (do_timings) call psb_tic(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' @@ -292,7 +318,7 @@ subroutine amg_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call op_prol%mv_from(coo_prol) call op_restr%mv_from(coo_restr) - + if (do_timings) call psb_toc(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' diff --git a/amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90 index a64e3ebb..a6a7856e 100644 --- a/amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_z_dec_aggregator_tprol.f90 @@ -97,6 +97,8 @@ subroutine amg_z_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_z_dec_aggregator_tprol' call psb_erractionsave(err_act) @@ -108,6 +110,10 @@ subroutine amg_z_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) @@ -121,10 +127,14 @@ subroutine amg_z_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') diff --git a/amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90 b/amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90 index 2f944699..7b8ed075 100644 --- a/amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90 +++ b/amgprec/impl/aggregator/amg_zaggrmat_smth_bld.f90 @@ -140,6 +140,9 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& real(psb_dpk_) :: anorm, omega, tmp, dg, theta logical, parameter :: debug_new=.false. character(len=80) :: filename + logical, parameter :: do_timings=.false. + integer(psb_ipk_), save :: idx_spspmm=-1, idx_phase1=-1, idx_gtrans=-1, idx_phase2=-1, idx_refine=-1 + integer(psb_ipk_), save :: idx_phase3=-1, idx_cdasb=-1, idx_ptap=-1 name='amg_aggrmat_smth_bld' info=psb_success_ @@ -153,6 +156,23 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ctxt = desc_a%get_context() call psb_info(ctxt, me, np) + if ((do_timings).and.(idx_spspmm==-1)) & + & idx_spspmm = psb_get_timer_idx("DEC_SMTH_BLD: par_spspmm") + if ((do_timings).and.(idx_phase1==-1)) & + & idx_phase1 = psb_get_timer_idx("DEC_SMTH_BLD: phase1 ") + if ((do_timings).and.(idx_phase2==-1)) & + & idx_phase2 = psb_get_timer_idx("DEC_SMTH_BLD: phase2 ") + if ((do_timings).and.(idx_phase3==-1)) & + & idx_phase3 = psb_get_timer_idx("DEC_SMTH_BLD: phase3 ") + if ((do_timings).and.(idx_gtrans==-1)) & + & idx_gtrans = psb_get_timer_idx("DEC_SMTH_BLD: gtrans ") + if ((do_timings).and.(idx_refine==-1)) & + & idx_refine = psb_get_timer_idx("DEC_SMTH_BLD: refine ") + if ((do_timings).and.(idx_cdasb==-1)) & + & idx_cdasb = psb_get_timer_idx("DEC_SMTH_BLD: cdasb ") + if ((do_timings).and.(idx_ptap==-1)) & + & idx_ptap = psb_get_timer_idx("DEC_SMTH_BLD: ptap_bld ") + nglob = desc_a%get_global_rows() nrow = desc_a%get_local_rows() @@ -171,6 +191,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! naggr: number of local aggregates ! nrow: local rows. ! + if (do_timings) call psb_tic(idx_phase1) ! Get the diagonal D adiag = a%get_diag(info) @@ -196,7 +217,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! ! Build the filtered matrix Af from A ! - + !$OMP parallel do private(i,j,tmp,jd) schedule(static) do i=1, nrow tmp = zzero jd = -1 @@ -214,11 +235,13 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& acsrf%val(jd)=acsrf%val(jd)-tmp end if enddo + !$OMP end parallel do ! Take out zeroed terms call acsrf%clean_zeros(info) end if + !$OMP parallel do private(i) schedule(static) do i=1,size(adiag) if (adiag(i) /= zzero) then adiag(i) = zone / adiag(i) @@ -226,7 +249,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& adiag(i) = zone end if end do - + !$OMP end parallel do if (parms%aggr_omega_alg == amg_eig_est_) then if (parms%aggr_eig == amg_max_norm_) then @@ -252,8 +275,9 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(info,name,a_err='invalid amg_aggr_omega_alg_') goto 9999 end if + if (do_timings) call psb_toc(idx_phase1) - + if (do_timings) call psb_tic(idx_phase2) call acsrf%scal(adiag,info) if (info /= psb_success_) goto 9999 @@ -267,6 +291,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_cdasb(desc_ac,info) call psb_cd_reinit(desc_ac,info) + if (do_timings) call psb_toc(idx_phase2) + if (do_timings) call psb_tic(idx_phase3) ! ! Build the smoothed prolongator using either A or Af ! acsr1 = (I-w*D*A) Prol acsr1 = (I-w*D*Af) Prol @@ -279,8 +305,8 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1') goto 9999 end if - - + if (do_timings) call psb_toc(idx_phase3) + if (do_timings) call psb_tic(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' @@ -292,7 +318,7 @@ subroutine amg_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& call op_prol%mv_from(coo_prol) call op_restr%mv_from(coo_restr) - + if (do_timings) call psb_toc(idx_ptap) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done smooth_aggregate ' diff --git a/amgprec/impl/aggregator/clean.cpp b/amgprec/impl/aggregator/clean.cpp new file mode 100644 index 00000000..f316aee7 --- /dev/null +++ b/amgprec/impl/aggregator/clean.cpp @@ -0,0 +1,91 @@ +#include "MatchBoxPC.h" + +// TODO comment + +void clean(MilanLongInt NLVer, + MilanInt myRank, + MilanLongInt MessageIndex, + vector &SRequest, + vector &SStatus, + MilanInt BufferSize, + MilanLongInt *Buffer, + MilanLongInt msgActual, + MilanLongInt *msgActualSent, + MilanLongInt msgInd, + MilanLongInt *msgIndSent, + MilanLongInt NumMessagesBundled, + MilanReal *msgPercent) +{ + // Cleanup Phase + +#pragma omp parallel + { +#pragma omp master + { +#pragma omp task + { + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ") Waitall= " << endl; + fflush(stdout); +#endif +#ifdef DEBUG_HANG_ + cout << "\n(" << myRank << ") Waitall " << endl; + fflush(stdout); +#endif + //return; + + MPI_Waitall(MessageIndex, &SRequest[0], &SStatus[0]); + + // MPI_Buffer_attach(&Buffer, BufferSize); //Attach the Buffer + if (BufferSize > 0) + { + MPI_Buffer_detach(&Buffer, &BufferSize); // Detach the Buffer + free(Buffer); // Free the memory that was allocated + } + } + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")End of function to compute matching: " << endl; + fflush(stdout); + cout << "\n(" << myRank << ")myCardinality: " << myCard << endl; + fflush(stdout); + cout << "\n(" << myRank << ")Matching took " << finishTime - startTime << "seconds" << endl; + fflush(stdout); + cout << "\n(" << myRank << ")** Getting out of the matching function **" << endl; + fflush(stdout); +#endif +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ") Number of Ghost edges = " << numGhostEdges; + cout << "\n(" << myRank << ") Total number of potential message X 2 = " << numGhostEdges * 2; + cout << "\n(" << myRank << ") Number messages bundled = " << NumMessagesBundled; + cout << "\n(" << myRank << ") Total Individual Messages sent = " << msgInd; + if (msgInd > 0) + { + cout << "\n(" << myRank << ") Percentage of messages bundled = " << ((double)NumMessagesBundled / (double)(msgInd)) * 100.0 << "% \n"; + } + fflush(stdout); +#endif + +#pragma omp task + { + *msgActualSent = msgActual; + *msgIndSent = msgInd; + if (msgInd > 0) + { + *msgPercent = ((double)NumMessagesBundled / (double)(msgInd)) * 100.0; + } + else + { + *msgPercent = 0; + } + } + +#ifdef DEBUG_HANG_ + if (myRank == 0) + cout << "\n(" << myRank << ") Done" << endl; + fflush(stdout); +#endif + } + } +} diff --git a/amgprec/impl/aggregator/computeCandidateMate.cpp b/amgprec/impl/aggregator/computeCandidateMate.cpp new file mode 100644 index 00000000..7d4e7ce8 --- /dev/null +++ b/amgprec/impl/aggregator/computeCandidateMate.cpp @@ -0,0 +1,73 @@ +#include "MatchBoxPC.h" + +/** + * Execute the research fr the Candidate Mate without controlling if the vertices are already matched. + * Returns the vertices with the highest weight + * @param adj1 + * @param adj2 + * @param verLocInd + * @param edgeLocWeight + * @return + */ +MilanLongInt firstComputeCandidateMate(MilanLongInt adj1, + MilanLongInt adj2, + MilanLongInt *verLocInd, + MilanReal *edgeLocWeight) +{ + MilanInt w = -1; + MilanReal heaviestEdgeWt = MilanRealMin; // Assign the smallest Value possible first LDBL_MIN + int finalK; + for (int k = adj1; k < adj2; k++) { + if ((edgeLocWeight[k] > heaviestEdgeWt) || + ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k]))) { + heaviestEdgeWt = edgeLocWeight[k]; + w = verLocInd[k]; + finalK = k; + } + } // End of for loop + return finalK; +} + +/** + * //TODO documentation + * @param adj1 + * @param adj2 + * @param edgeLocWeight + * @param k + * @param verLocInd + * @param StartIndex + * @param EndIndex + * @param GMate + * @param Mate + * @param Ghost2LocalMap + * @return + */ +MilanLongInt computeCandidateMate(MilanLongInt adj1, + MilanLongInt adj2, + MilanReal *edgeLocWeight, + MilanLongInt k, + MilanLongInt *verLocInd, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap) +{ + // Start: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v) + + MilanInt w = -1; + MilanReal heaviestEdgeWt = MilanRealMin; // Assign the smallest Value possible first LDBL_MIN + for (k = adj1; k < adj2; k++) { + if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap)) + continue; + + if ((edgeLocWeight[k] > heaviestEdgeWt) || + ((edgeLocWeight[k] == heaviestEdgeWt) && (w < verLocInd[k]))) { + heaviestEdgeWt = edgeLocWeight[k]; + w = verLocInd[k]; + } + } // End of for loop + // End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v) + + return w; +} diff --git a/amgprec/impl/aggregator/dataStrStaticQueue.h b/amgprec/impl/aggregator/dataStrStaticQueue.h index eecbffeb..c6e6882a 100755 --- a/amgprec/impl/aggregator/dataStrStaticQueue.h +++ b/amgprec/impl/aggregator/dataStrStaticQueue.h @@ -80,9 +80,11 @@ class staticQueue MilanLongInt squeueTail; MilanLongInt NumNodes; + //FIXME I had to comment this piece of code in order to make everything work. + // why? //Prevent Assignment and Pass by Value: - staticQueue(const staticQueue& src); - staticQueue& operator=(const staticQueue& rhs); + //staticQueue(const staticQueue& src); + //staticQueue& operator=(const staticQueue& rhs); public: //Constructors and Destructors diff --git a/amgprec/impl/aggregator/extractUChunk.cpp b/amgprec/impl/aggregator/extractUChunk.cpp new file mode 100644 index 00000000..923a0b51 --- /dev/null +++ b/amgprec/impl/aggregator/extractUChunk.cpp @@ -0,0 +1,31 @@ +#include "MatchBoxPC.h" + +void extractUChunk( + vector &UChunkBeingProcessed, + vector &U, + vector &privateU) +{ + + UChunkBeingProcessed.clear(); +#pragma omp critical(U) + { + + if (U.empty() && !privateU.empty()) // If U is empty but there are nodes in private U + { + while (!privateU.empty()) + UChunkBeingProcessed.push_back(privateU.back()); + privateU.pop_back(); + } + else + { + for (int i = 0; i < UCHUNK; i++) + { // Pop the new nodes + if (U.empty()) + break; + UChunkBeingProcessed.push_back(U.back()); + U.pop_back(); + } + } + + } // End of critical U // End of critical U +} \ No newline at end of file diff --git a/amgprec/impl/aggregator/findOwnerOfGhost.cpp b/amgprec/impl/aggregator/findOwnerOfGhost.cpp new file mode 100644 index 00000000..b9d60614 --- /dev/null +++ b/amgprec/impl/aggregator/findOwnerOfGhost.cpp @@ -0,0 +1,29 @@ +#include "MatchBoxPC.h" + +/// Find the owner of a ghost node: +MilanInt findOwnerOfGhost(MilanLongInt vtxIndex, MilanLongInt *mVerDistance, + MilanInt myRank, MilanInt numProcs) +{ + + MilanLongInt mStartInd = mVerDistance[myRank]; + MilanInt Start = 0; + MilanInt End = numProcs; + MilanInt Current = 0; + + while (Start <= End) + { + Current = (End + Start) / 2; + // CASE-1: + if (mVerDistance[Current] == vtxIndex) return Current; + else // CASE 2: + if (mVerDistance[Current] > vtxIndex) + End = Current - 1; + else // CASE 3: + Start = Current + 1; + } // End of While() + + if (mVerDistance[Current] > vtxIndex) + return (Current - 1); + + return Current; +} // End of findOwnerOfGhost() diff --git a/amgprec/impl/aggregator/initialize.cpp b/amgprec/impl/aggregator/initialize.cpp new file mode 100644 index 00000000..17a4169e --- /dev/null +++ b/amgprec/impl/aggregator/initialize.cpp @@ -0,0 +1,304 @@ +#include "MatchBoxPC.h" + +void initialize(MilanLongInt NLVer, MilanLongInt NLEdge, + MilanLongInt StartIndex, MilanLongInt EndIndex, + MilanLongInt *numGhostEdges, + MilanLongInt *numGhostVertices, + MilanLongInt *S, + MilanLongInt *verLocInd, + MilanLongInt *verLocPtr, + map &Ghost2LocalMap, + vector &Counter, + vector &verGhostPtr, + vector &verGhostInd, + vector &tempCounter, + vector &GMate, + vector &Message, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + MilanLongInt *&candidateMate, + vector &U, + vector &privateU, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner) +{ + + MilanLongInt insertMe = 0; + MilanLongInt adj1, adj2; + int i, v, k, w; + // index that starts with zero to |Vg| - 1 + map::iterator storedAlready; + +#pragma omp parallel private(insertMe, k, w, v, adj1, adj2) firstprivate(StartIndex, EndIndex) default(shared) num_threads(NUM_THREAD) + { + +#pragma omp single + { + +#ifdef TIME_TRACKER + double Ghost2LocalInitialization = MPI_Wtime(); +#endif + + /* + * OMP Ghost2LocalInitialization + * This loop analyzes all the edges and when finds a ghost edge + * puts it in the Ghost2LocalMap. + * A critical region is needed when inserting data in the map. + * + * Despite the critical region it is still productive to + * parallelize this cycle because the critical region is exeuted + * only when a ghost edge is found and ghost edges are a minority, + * circa 3.5% during the tests. + */ +#pragma omp task depend(out \ + : *numGhostEdges, Counter, Ghost2LocalMap, insertMe, storedAlready, *numGhostVertices) + { +#pragma omp taskloop num_tasks(NUM_THREAD) reduction(+ \ + : numGhostEdges[:1]) + for (i = 0; i < NLEdge; i++) + { // O(m) - Each edge stored twice + insertMe = verLocInd[i]; + if ((insertMe < StartIndex) || (insertMe > EndIndex)) + { // Find a ghost + (*numGhostEdges)++; +#pragma omp critical + { + storedAlready = Ghost2LocalMap.find(insertMe); + if (storedAlready != Ghost2LocalMap.end()) + { // Has already been added + Counter[storedAlready->second]++; // Increment the counter + } + else + { // Insert an entry for the ghost: + Ghost2LocalMap[insertMe] = *numGhostVertices; // Add a map entry + Counter.push_back(1); // Initialize the counter + (*numGhostVertices)++; // Increment the number of ghost vertices + } // End of else() + } + } // End of if ( (insertMe < StartIndex) || (insertMe > EndIndex) ) + } // End of for(ghost vertices) + } // end of task depend + + // *numGhostEdges = atomicNumGhostEdges; +#ifdef TIME_TRACKER + Ghost2LocalInitialization = MPI_Wtime() - Ghost2LocalInitialization; + fprintf(stderr, "Ghost2LocalInitialization time: %f\n", Ghost2LocalInitialization); +#endif + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")NGhosts:" << *numGhostVertices << " GhostEdges: " << *numGhostEdges; + if (!Ghost2LocalMap.empty()) + { + cout << "\n(" << myRank << ")Final Map : on process "; + cout << "\n(" << myRank << ")Key \t Value \t Counter \n"; + fflush(stdout); + storedAlready = Ghost2LocalMap.begin(); + do + { + cout << storedAlready->second << " - " << storedAlready->first << " : " << Counter[storedAlready->second] << endl; + fflush(stdout); + storedAlready++; + } while (storedAlready != Ghost2LocalMap.end()); + } +#endif + +#pragma omp task depend(out \ + : verGhostPtr, tempCounter, verGhostInd, GMate) depend(in \ + : *numGhostVertices, *numGhostEdges) + { + + // Initialize adjacency Lists for Ghost Vertices: + try + { + verGhostPtr.reserve(*numGhostVertices + 1); // Pointer Vector + tempCounter.reserve(*numGhostVertices); // Pointer Vector + verGhostInd.reserve(*numGhostEdges); // Index Vector + GMate.reserve(*numGhostVertices); // Ghost Mate Vector + } + catch (length_error) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearch: \n"; + cout << "Not enough memory to allocate the internal variables \n"; + exit(1); + } + // Initialize the Vectors: + verGhostPtr.resize(*numGhostVertices + 1, 0); // Pointer Vector + tempCounter.resize(*numGhostVertices, 0); // Temporary Counter + verGhostInd.resize(*numGhostEdges, -1); // Index Vector + GMate.resize(*numGhostVertices, -1); // Temporary Counter + verGhostPtr[0] = 0; // The first value +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Ghost Vertex Pointer: "; + fflush(stdout); +#endif + + } // End of task + +#pragma omp task depend(out \ + : verGhostPtr) depend(in \ + : Counter, *numGhostVertices) + { + +#ifdef TIME_TRACKER + double verGhostPtrInitialization = MPI_Wtime(); +#endif + for (i = 0; i < *numGhostVertices; i++) + { // O(|Ghost Vertices|) + verGhostPtr[i + 1] = verGhostPtr[i] + Counter[i]; +#ifdef PRINT_DEBUG_INFO_ + cout << verGhostPtr[i] << "\t"; + fflush(stdout); +#endif + } + +#ifdef TIME_TRACKER + verGhostPtrInitialization = MPI_Wtime() - verGhostPtrInitialization; + fprintf(stderr, "verGhostPtrInitialization time: %f\n", verGhostPtrInitialization); +#endif + } // End of task + +#ifdef PRINT_DEBUG_INFO_ + if (*numGhostVertices > 0) + cout << verGhostPtr[*numGhostVertices] << "\n"; + fflush(stdout); +#endif + +#ifdef TIME_TRACKER + double verGhostIndInitialization = MPI_Wtime(); +#endif + + /* + * OMP verGhostIndInitialization + * + * In this cycle the verGhostInd is initialized + * with the datas related to ghost edges. + * The check to see if a node is a ghost node is + * executed in paralle and when a ghost node + * is found a critical region is started. + * + * Despite the critical region it's still useful to + * parallelize the for cause the ghost nodes + * are a minority hence the critical region is executed + * few times, circa 3.5% of the times in the tests. + */ +#pragma omp task depend(in \ + : insertMe, Ghost2LocalMap, tempCounter, verGhostPtr) depend(out \ + : verGhostInd) + { +#pragma omp taskloop num_tasks(NUM_THREAD) + for (v = 0; v < NLVer; v++) + { + adj1 = verLocPtr[v]; // Vertex Pointer + adj2 = verLocPtr[v + 1]; + for (k = adj1; k < adj2; k++) + { + w = verLocInd[k]; // Get the adjacent vertex + if ((w < StartIndex) || (w > EndIndex)) + { // Find a ghost +#pragma omp critical + { + insertMe = verGhostPtr[Ghost2LocalMap[w]] + tempCounter[Ghost2LocalMap[w]]; // Where to insert + tempCounter[Ghost2LocalMap[w]]++; // Increment the counter + } + verGhostInd[insertMe] = v + StartIndex; // Add the adjacency + } // End of if((w < StartIndex) || (w > EndIndex)) + } // End of for(k) + } // End of for (v) + } // end of tasklopp + +#ifdef TIME_TRACKER + verGhostIndInitialization = MPI_Wtime() - verGhostIndInitialization; + fprintf(stderr, "verGhostIndInitialization time: %f\n", verGhostIndInitialization); +#endif + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Ghost Vertex Index: "; + for (v = 0; v < *numGhostEdges; v++) + cout << verGhostInd[v] << "\t"; + cout << endl; + fflush(stdout); +#endif + +#pragma omp task depend(in \ + : *numGhostEdges) depend(out \ + : QLocalVtx, QGhostVtx, QMsgType, QOwner) + { + try + { + QLocalVtx.reserve(*numGhostEdges); // Local Vertex + QGhostVtx.reserve(*numGhostEdges); // Ghost Vertex + QMsgType.reserve(*numGhostEdges); // Message Type (Request/Failure) + QOwner.reserve(*numGhostEdges); // Owner of the ghost: COmpute once and use later + } + catch (length_error) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n"; + cout << "Not enough memory to allocate the internal variables \n"; + exit(1); + } + } // end of task + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Allocating CandidateMate.. "; + fflush(stdout); +#endif + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << "=========================************===============================" << endl; + fflush(stdout); + fflush(stdout); +#endif + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ") Setup Time :" << *ph0_time << endl; + fflush(stdout); + fflush(stdout); +#endif + +#ifdef DEBUG_HANG_ + if (myRank == 0) + cout << "\n(" << myRank << ") Setup Time :" << *ph0_time << endl; + fflush(stdout); +#endif + +#pragma omp task depend(in \ + : *numGhostVertices) depend(out \ + : candidateMate, S, U, privateU, privateQLocalVtx, privateQGhostVtx, privateQMsgType, privateQOwner) + { + + // Allocate Data Structures: + /* + * candidateMate was a vector and has been replaced with an array + * there is no point in using the vector (or maybe there is (???)) + * so I replaced it with an array wich is slightly faster + */ + candidateMate = new MilanLongInt[NLVer + (*numGhostVertices)]; + + *S = (*numGhostVertices); // Initialize S with number of Ghost Vertices + + /* + * Create the Queue Data Structure for the Dominating Set + * + * I had to declare the staticuQueue U before the parallel region + * to have it in the correct scope. Since we can't change the dimension + * of a staticQueue I had to destroy the previous object and instantiate + * a new one of the correct size. + */ + //new (&U) staticQueue(NLVer + (*numGhostVertices)); + U.reserve(NLVer + (*numGhostVertices)); + + // Initialize the private vectors + privateQLocalVtx.reserve(*numGhostVertices); + privateQGhostVtx.reserve(*numGhostVertices); + privateQMsgType.reserve(*numGhostVertices); + privateQOwner.reserve(*numGhostVertices); + privateU.reserve(*numGhostVertices); + } // end of task + + } // End of single region + } // End of parallel region +} diff --git a/amgprec/impl/aggregator/isAlreadyMatched.cpp b/amgprec/impl/aggregator/isAlreadyMatched.cpp new file mode 100644 index 00000000..a7d65c15 --- /dev/null +++ b/amgprec/impl/aggregator/isAlreadyMatched.cpp @@ -0,0 +1,46 @@ +#include "MatchBoxPC.h" + +/** + * //TODO documentation + * @param k + * @param verLocInd + * @param StartIndex + * @param EndIndex + * @param GMate + * @param Mate + * @param Ghost2LocalMap + * @return + */ +bool isAlreadyMatched(MilanLongInt node, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap) +{ + + /* +#pragma omp critical(Mate) + { + if ((node < StartIndex) || (node > EndIndex)) { //Is it a ghost vertex? + result = GMate[Ghost2LocalMap[node]] >= 0;// Already matched + } else { //A local vertex + result = (Mate[node - StartIndex] >= 0); // Already matched + } + + } + */ + MilanLongInt val; + if ((node < StartIndex) || (node > EndIndex)) // if ghost vertex + { +#pragma omp atomic read + val = GMate[Ghost2LocalMap[node]]; + return val >= 0; // Already matched + } + + // If not ghost vertex +#pragma omp atomic read + val = Mate[node - StartIndex]; + + return val >= 0; // Already matched +} \ No newline at end of file diff --git a/amgprec/impl/aggregator/newmatch_interface.cpp b/amgprec/impl/aggregator/newmatch_interface.cpp index aee12aa4..da4cf728 100644 --- a/amgprec/impl/aggregator/newmatch_interface.cpp +++ b/amgprec/impl/aggregator/newmatch_interface.cpp @@ -99,8 +99,8 @@ psb_i_t dnew_Match_If(psb_i_t ipar, psb_i_t matching, psb_d_t lambda, } else if (lambda >= 0 && lambda <= 1.0){ lambda = lambda*eps + (1.0-lambda)*(fmax(maxweight-2.0*minweight,0.0) ); } - fprintf(stderr,"Calling matching: pre %d nt %d lambda %g %g %g\n", - preprocess,nt,lambda,maxweight,minweight); + //fprintf(stderr,"Calling matching: pre %d nt %d lambda %g %g %g\n", + // preprocess,nt,lambda,maxweight,minweight); runRomaWrapper(s,t,weights, nr, mateNode,preprocess,romaInput,lambda ,nt, pstat, timeDiff); /* loop here only makes sense when nr==nz */ diff --git a/amgprec/impl/aggregator/parallelComputeCandidateMateB.cpp b/amgprec/impl/aggregator/parallelComputeCandidateMateB.cpp new file mode 100644 index 00000000..ffb8d2a3 --- /dev/null +++ b/amgprec/impl/aggregator/parallelComputeCandidateMateB.cpp @@ -0,0 +1,27 @@ +#include "MatchBoxPC.h" + +void PARALLEL_COMPUTE_CANDIDATE_MATE_B(MilanLongInt NLVer, + MilanLongInt *verLocPtr, + MilanLongInt *verLocInd, + MilanInt myRank, + MilanReal *edgeLocWeight, + MilanLongInt *candidateMate) +{ + + MilanLongInt v = -1; + +#pragma omp parallel private(v) default(shared) num_threads(NUM_THREAD) + { + +#pragma omp for schedule(static) + for (v = 0; v < NLVer; v++) { +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Processing: " << v + StartIndex << endl; + fflush(stdout); +#endif + // Start: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v) + candidateMate[v] = firstComputeCandidateMate(verLocPtr[v], verLocPtr[v + 1], verLocInd, edgeLocWeight); + // End: PARALLEL_COMPUTE_CANDIDATE_MATE_B(v) + } + } +} diff --git a/amgprec/impl/aggregator/processCrossEdge.cpp b/amgprec/impl/aggregator/processCrossEdge.cpp new file mode 100644 index 00000000..e844f127 --- /dev/null +++ b/amgprec/impl/aggregator/processCrossEdge.cpp @@ -0,0 +1,24 @@ +#include "MatchBoxPC.h" + +void PROCESS_CROSS_EDGE(MilanLongInt *edge, + MilanLongInt *S) +{ + // Start: PARALLEL_PROCESS_CROSS_EDGE_B + MilanLongInt captureCounter; + +#pragma omp atomic capture + captureCounter = --(*edge); // Decrement + + //assert(captureCounter >= 0); + + if (captureCounter == 0) +#pragma omp atomic + (*S)--; // Decrement S + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Decrementing S: Ghost vertex " << edge << " has received all its messages"; + fflush(stdout); +#endif + + // End: PARALLEL_PROCESS_CROSS_EDGE_B +} \ No newline at end of file diff --git a/amgprec/impl/aggregator/processExposedVertex.cpp b/amgprec/impl/aggregator/processExposedVertex.cpp new file mode 100644 index 00000000..2b38ec7a --- /dev/null +++ b/amgprec/impl/aggregator/processExposedVertex.cpp @@ -0,0 +1,195 @@ +#include "MatchBoxPC.h" + +void PARALLEL_PROCESS_EXPOSED_VERTEX_B(MilanLongInt NLVer, + MilanLongInt *candidateMate, + MilanLongInt *verLocInd, + MilanLongInt *verLocPtr, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *Mate, + vector &GMate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + MilanLongInt *myCard, + MilanLongInt *msgInd, + MilanLongInt *NumMessagesBundled, + MilanLongInt *S, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + vector &U, + vector &privateU, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner) +{ + + MilanLongInt v = -1, k = -1, w = -1, adj11 = 0, adj12 = 0, k1 = 0; + MilanInt ghostOwner = 0, option, igw; + +#pragma omp parallel private(option, k, w, v, k1, adj11, adj12, ghostOwner) \ + firstprivate(privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx, privateQMsgType, privateQOwner) \ + default(shared) num_threads(NUM_THREAD) + + { +#pragma omp for reduction(+ \ + : PCounter[:numProcs], myCard \ + [:1], msgInd \ + [:1], NumMessagesBundled \ + [:1]) \ + schedule(static) + for (v = 0; v < NLVer; v++) { + option = -1; + // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + k = candidateMate[v]; + candidateMate[v] = verLocInd[k]; + w = candidateMate[v]; + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Processing: " << v + StartIndex << endl; + fflush(stdout); +#endif + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")" << v + StartIndex << " Points to: " << w; + fflush(stdout); +#endif + // If found a dominating edge: + if (w >= 0) + { + +#pragma omp critical(processExposed) + { + if (isAlreadyMatched(verLocInd[k], StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap)) { + w = computeCandidateMate(verLocPtr[v], + verLocPtr[v + 1], + edgeLocWeight, 0, + verLocInd, + StartIndex, + EndIndex, + GMate, + Mate, + Ghost2LocalMap); + candidateMate[v] = w; + } + + if (w >= 0) { + (*myCard)++; + if ((w < StartIndex) || (w > EndIndex)) { // w is a ghost vertex + option = 2; + if (candidateMate[NLVer + Ghost2LocalMap[w]] == v + StartIndex) { + option = 1; + Mate[v] = w; + GMate[Ghost2LocalMap[w]] = v + StartIndex; // w is a Ghost + + } // End of if CandidateMate[w] = v + + } // End of if a Ghost Vertex + else { // w is a local vertex + + if (candidateMate[w - StartIndex] == (v + StartIndex)) { + option = 3; + Mate[v] = w; // v is local + Mate[w - StartIndex] = v + StartIndex; // w is local + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v + StartIndex << "," << w << ") "; + fflush(stdout); +#endif + + } // End of if ( candidateMate[w-StartIndex] == (v+StartIndex) ) + } // End of Else + + } // End of second if + + } // End critical processExposed + + } // End of if(w >=0) + else { + // This piece of code is executed a really small amount of times + adj11 = verLocPtr[v]; + adj12 = verLocPtr[v + 1]; + for (k1 = adj11; k1 < adj12; k1++) { + w = verLocInd[k1]; + if ((w < StartIndex) || (w > EndIndex)) { // A ghost + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a failure message: "; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs); + fflush(stdout); +#endif + (*msgInd)++; + (*NumMessagesBundled)++; + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + // assert(ghostOwner != -1); + // assert(ghostOwner != myRank); + PCounter[ghostOwner]++; + + privateQLocalVtx.push_back(v + StartIndex); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(FAILURE); + privateQOwner.push_back(ghostOwner); + + } // End of if(GHOST) + } // End of for loop + } + // End: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + + switch (option) + { + case -1: + break; + case 1: + privateU.push_back(v + StartIndex); + privateU.push_back(w); + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v + StartIndex << "," << w << ")"; + fflush(stdout); +#endif + + // Decrement the counter: + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], S); + case 2: +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a request message (291):"; + cout << "\n(" << myRank << ")Local is: " << v + StartIndex << " Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl; + fflush(stdout); +#endif + (*msgInd)++; + (*NumMessagesBundled)++; + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + // assert(ghostOwner != -1); + // assert(ghostOwner != myRank); + PCounter[ghostOwner]++; + + privateQLocalVtx.push_back(v + StartIndex); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(REQUEST); + privateQOwner.push_back(ghostOwner); + break; + case 3: + default: + privateU.push_back(v + StartIndex); + privateU.push_back(w); + break; + } + + } // End of for ( v=0; v < NLVer; v++ ) + + queuesTransfer(U, privateU, QLocalVtx, + QGhostVtx, + QMsgType, QOwner, privateQLocalVtx, + privateQGhostVtx, + privateQMsgType, + privateQOwner); + + } // End of parallel region +} diff --git a/amgprec/impl/aggregator/processMatchedVertices.cpp b/amgprec/impl/aggregator/processMatchedVertices.cpp new file mode 100644 index 00000000..d9363c39 --- /dev/null +++ b/amgprec/impl/aggregator/processMatchedVertices.cpp @@ -0,0 +1,294 @@ +#include "MatchBoxPC.h" + +void processMatchedVertices( + MilanLongInt NLVer, + vector &UChunkBeingProcessed, + vector &U, + vector &privateU, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *myCard, + MilanLongInt *msgInd, + MilanLongInt *NumMessagesBundled, + MilanLongInt *SPtr, + MilanLongInt *verLocPtr, + MilanLongInt *verLocInd, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + MilanLongInt *candidateMate, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner) +{ + + MilanLongInt adj1, adj2, adj11, adj12, k, k1, v = -1, w = -1, ghostOwner; + int option; + MilanLongInt mateVal; + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << "=========================************===============================" << endl; + fflush(stdout); + fflush(stdout); +#endif + +#ifdef COUNT_LOCAL_VERTEX + MilanLongInt localVertices = 0; +#endif + //#pragma omp parallel private(k, w, v, k1, adj1, adj2, adj11, adj12, ghostOwner, option) \ + firstprivate(privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx, \ + privateQMsgType, privateQOwner, UChunkBeingProcessed) \ + default(shared) num_threads(NUM_THREAD) \ + reduction(+ \ + : msgInd[:1], PCounter \ + [:numProcs], myCard \ + [:1], NumMessagesBundled \ + [:1]) + { + + while (!U.empty()) { + + extractUChunk(UChunkBeingProcessed, U, privateU); + + for (MilanLongInt u : UChunkBeingProcessed) { +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")u: " << u; + fflush(stdout); +#endif + if ((u >= StartIndex) && (u <= EndIndex)) { // Process Only the Local Vertices + +#ifdef COUNT_LOCAL_VERTEX + localVertices++; +#endif + + // Get the Adjacency list for u + adj1 = verLocPtr[u - StartIndex]; // Pointer + adj2 = verLocPtr[u - StartIndex + 1]; + for (k = adj1; k < adj2; k++) { + option = -1; + v = verLocInd[k]; + + if ((v >= StartIndex) && (v <= EndIndex)) { // If Local Vertex: + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")v: " << v << " c(v)= " << candidateMate[v - StartIndex] << " Mate[v]: " << Mate[v]; + fflush(stdout); +#endif +#pragma omp atomic read + mateVal = Mate[v - StartIndex]; + // If the current vertex is pointing to a matched vertex and is not matched + if (mateVal < 0) { +#pragma omp critical + { + if (candidateMate[v - StartIndex] == u) { + // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + w = computeCandidateMate(verLocPtr[v - StartIndex], + verLocPtr[v - StartIndex + 1], + edgeLocWeight, 0, + verLocInd, + StartIndex, + EndIndex, + GMate, + Mate, + Ghost2LocalMap); + + candidateMate[v - StartIndex] = w; + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")" << v << " Points to: " << w; + fflush(stdout); +#endif + // If found a dominating edge: + if (w >= 0) { + if ((w < StartIndex) || (w > EndIndex)) { // A ghost +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a request message:"; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs); +#endif + option = 2; + + if (candidateMate[NLVer + Ghost2LocalMap[w]] == v) { + option = 1; + Mate[v - StartIndex] = w; // v is a local vertex + GMate[Ghost2LocalMap[w]] = v; // w is a ghost vertex + + } // End of if CandidateMate[w] = v + } // End of if a Ghost Vertex + else { // w is a local vertex + if (candidateMate[w - StartIndex] == v) { + option = 3; + Mate[v - StartIndex] = w; // v is a local vertex + Mate[w - StartIndex] = v; // w is a local vertex + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") "; + fflush(stdout); +#endif + } // End of if(CandidateMate(w) = v + } // End of Else + } // End of if(w >=0) + else + option = 4; // End of Else: w == -1 + // End: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + } // End of If (candidateMate[v-StartIndex] == u + } // End of task + } // mateval < 0 + } // End of if ( (v >= StartIndex) && (v <= EndIndex) ) //If Local Vertex: + else { // Neighbor is a ghost vertex + +#pragma omp critical + { + if (candidateMate[NLVer + Ghost2LocalMap[v]] == u) + candidateMate[NLVer + Ghost2LocalMap[v]] = -1; + if (v != Mate[u - StartIndex]) + option = 5; // u is local + } // End of critical + } // End of Else //A Ghost Vertex + + switch (option) + { + case -1: + // No things to do + break; + case 1: + // Found a dominating edge, it is a ghost and candidateMate[NLVer + Ghost2LocalMap[w]] == v + privateU.push_back(v); + privateU.push_back(w); + + (*myCard)++; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") "; + fflush(stdout); +#endif + // Decrement the counter: + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], SPtr); + case 2: + + // Found a dominating edge, it is a ghost + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + // assert(ghostOwner != -1); + // assert(ghostOwner != myRank); + PCounter[ghostOwner]++; + (*NumMessagesBundled)++; + (*msgInd)++; + + privateQLocalVtx.push_back(v); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(REQUEST); + privateQOwner.push_back(ghostOwner); + break; + case 3: + privateU.push_back(v); + privateU.push_back(w); + + (*myCard)++; + break; + case 4: + // Could not find a dominating vertex + adj11 = verLocPtr[v - StartIndex]; + adj12 = verLocPtr[v - StartIndex + 1]; + for (k1 = adj11; k1 < adj12; k1++) { + w = verLocInd[k1]; + if ((w < StartIndex) || (w > EndIndex)) { // A ghost + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a failure message: "; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs); + fflush(stdout); +#endif + + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + // assert(ghostOwner != -1); + // assert(ghostOwner != myRank); + + PCounter[ghostOwner]++; + (*NumMessagesBundled)++; + (*msgInd)++; + + privateQLocalVtx.push_back(v); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(FAILURE); + privateQOwner.push_back(ghostOwner); + + } // End of if(GHOST) + } // End of for loop + break; + case 5: + default: + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a success message: "; + cout << "\n(" << myRank << ")Ghost is " << v << " Owner is: " << findOwnerOfGhost(v, verDistance, myRank, numProcs) << "\n"; + fflush(stdout); +#endif + + ghostOwner = findOwnerOfGhost(v, verDistance, myRank, numProcs); + // assert(ghostOwner != -1); + // assert(ghostOwner != myRank); + + (*NumMessagesBundled)++; + PCounter[ghostOwner]++; + (*msgInd)++; + + privateQLocalVtx.push_back(u); + privateQGhostVtx.push_back(v); + privateQMsgType.push_back(SUCCESS); + privateQOwner.push_back(ghostOwner); + + break; + } // End of switch + + } // End of inner for + } + } // End of outer for + + queuesTransfer(U, privateU, QLocalVtx, + QGhostVtx, + QMsgType, QOwner, privateQLocalVtx, + privateQGhostVtx, + privateQMsgType, + privateQOwner); + +#pragma omp critical(U) + { + U.insert(U.end(), privateU.begin(), privateU.end()); + } + + privateU.clear(); + +#pragma omp critical(sendMessageTransfer) + { + + QLocalVtx.insert(QLocalVtx.end(), privateQLocalVtx.begin(), privateQLocalVtx.end()); + QGhostVtx.insert(QGhostVtx.end(), privateQGhostVtx.begin(), privateQGhostVtx.end()); + QMsgType.insert(QMsgType.end(), privateQMsgType.begin(), privateQMsgType.end()); + QOwner.insert(QOwner.end(), privateQOwner.begin(), privateQOwner.end()); + } + + privateQLocalVtx.clear(); + privateQGhostVtx.clear(); + privateQMsgType.clear(); + privateQOwner.clear(); + + } // End of while ( !U.empty() ) + +#ifdef COUNT_LOCAL_VERTEX + printf("Count local vertexes: %ld for thread %d of processor %d\n", + localVertices, + omp_get_thread_num(), + myRank); + +#endif + } // End of parallel region +} diff --git a/amgprec/impl/aggregator/processMatchedVerticesAndSendMessages.cpp b/amgprec/impl/aggregator/processMatchedVerticesAndSendMessages.cpp new file mode 100644 index 00000000..469d7a16 --- /dev/null +++ b/amgprec/impl/aggregator/processMatchedVerticesAndSendMessages.cpp @@ -0,0 +1,308 @@ +#include "MatchBoxPC.h" +//#define DEBUG_HANG_ +void processMatchedVerticesAndSendMessages( + MilanLongInt NLVer, + vector &UChunkBeingProcessed, + vector &U, + vector &privateU, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *myCard, + MilanLongInt *msgInd, + MilanLongInt *NumMessagesBundled, + MilanLongInt *SPtr, + MilanLongInt *verLocPtr, + MilanLongInt *verLocInd, + MilanLongInt *verDistance, + MilanLongInt *PCounter, + vector &Counter, + MilanInt myRank, + MilanInt numProcs, + MilanLongInt *candidateMate, + vector &GMate, + MilanLongInt *Mate, + map &Ghost2LocalMap, + MilanReal *edgeLocWeight, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner, + MPI_Comm comm, + MilanLongInt *msgActual, + vector &Message) +{ + + MilanLongInt initialSize = QLocalVtx.size(); + MilanLongInt adj1, adj2, adj11, adj12, k, k1, v = -1, w = -1, ghostOwner; + int option; + MilanLongInt mateVal; + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << "=========================************===============================" << endl; + fflush(stdout); + fflush(stdout); +#endif + +#ifdef COUNT_LOCAL_VERTEX + MilanLongInt localVertices = 0; +#endif + //#pragma omp parallel private(k, w, v, k1, adj1, adj2, adj11, adj12, ghostOwner, option) \ + firstprivate(Message, privateU, StartIndex, EndIndex, privateQLocalVtx, privateQGhostVtx,\ + privateQMsgType, privateQOwner, UChunkBeingProcessed) default(shared) \ + num_threads(NUM_THREAD) \ + reduction(+ \ + : msgInd[:1], PCounter \ + [:numProcs], myCard \ + [:1], NumMessagesBundled \ + [:1], msgActual \ + [:1]) + { + + while (!U.empty()) { + + extractUChunk(UChunkBeingProcessed, U, privateU); + + for (MilanLongInt u : UChunkBeingProcessed) { +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")u: " << u; + fflush(stdout); +#endif + if ((u >= StartIndex) && (u <= EndIndex)) { // Process Only the Local Vertices + +#ifdef COUNT_LOCAL_VERTEX + localVertices++; +#endif + + // Get the Adjacency list for u + adj1 = verLocPtr[u - StartIndex]; // Pointer + adj2 = verLocPtr[u - StartIndex + 1]; + for (k = adj1; k < adj2; k++) { + option = -1; + v = verLocInd[k]; + + if ((v >= StartIndex) && (v <= EndIndex)) { // If Local Vertex: + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")v: " << v << " c(v)= " << candidateMate[v - StartIndex] << " Mate[v]: " << Mate[v]; + fflush(stdout); +#endif +#pragma omp atomic read + mateVal = Mate[v - StartIndex]; + // If the current vertex is pointing to a matched vertex and is not matched + if (mateVal < 0) { +#pragma omp critical + { + if (candidateMate[v - StartIndex] == u) { + // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + w = computeCandidateMate(verLocPtr[v - StartIndex], + verLocPtr[v - StartIndex + 1], + edgeLocWeight, 0, + verLocInd, + StartIndex, + EndIndex, + GMate, + Mate, + Ghost2LocalMap); + + candidateMate[v - StartIndex] = w; + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")" << v << " Points to: " << w; + fflush(stdout); +#endif + // If found a dominating edge: + if (w >= 0) { + + if ((w < StartIndex) || (w > EndIndex)) { // A ghost +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a request message:"; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs); +#endif + option = 2; + + if (candidateMate[NLVer + Ghost2LocalMap[w]] == v) { + option = 1; + Mate[v - StartIndex] = w; // v is a local vertex + GMate[Ghost2LocalMap[w]] = v; // w is a ghost vertex + + } // End of if CandidateMate[w] = v + } // End of if a Ghost Vertex + else { // w is a local vertex + if (candidateMate[w - StartIndex] == v) { + option = 3; + Mate[v - StartIndex] = w; // v is a local vertex + Mate[w - StartIndex] = v; // w is a local vertex + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") "; + fflush(stdout); +#endif + } // End of if(CandidateMate(w) = v + } // End of Else + } // End of if(w >=0) + else + option = 4; // End of Else: w == -1 + // End: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + } // End of If (candidateMate[v-StartIndex] == u + } // End of task + } // mateval < 0 + } // End of if ( (v >= StartIndex) && (v <= EndIndex) ) //If Local Vertex: + else { // Neighbor is a ghost vertex + +#pragma omp critical + { + if (candidateMate[NLVer + Ghost2LocalMap[v]] == u) + candidateMate[NLVer + Ghost2LocalMap[v]] = -1; + if (v != Mate[u - StartIndex]) + option = 5; // u is local + } // End of critical + } // End of Else //A Ghost Vertex + + switch (option) + { + case -1: + // No things to do + break; + case 1: + // Found a dominating edge, it is a ghost and candidateMate[NLVer + Ghost2LocalMap[w]] == v + privateU.push_back(v); + privateU.push_back(w); + (*myCard)++; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") "; + fflush(stdout); +#endif + // Decrement the counter: + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], SPtr); + case 2: + + // Found a dominating edge, it is a ghost + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + + // Build the Message Packet: + // Message[0] = v; // LOCAL + // Message[1] = w; // GHOST + // Message[2] = REQUEST; // TYPE + // Send a Request (Asynchronous) + // MPI_Bsend(&Message[0], 3, TypeMap(), ghostOwner, ComputeTag, comm); + + (*msgActual)++; + (*msgInd)++; + + privateQLocalVtx.push_back(v); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(REQUEST); + privateQOwner.push_back(ghostOwner); + break; + case 3: + privateU.push_back(v); + privateU.push_back(w); + (*myCard)++; + break; + case 4: + // Could not find a dominating vertex + adj11 = verLocPtr[v - StartIndex]; + adj12 = verLocPtr[v - StartIndex + 1]; + for (k1 = adj11; k1 < adj12; k1++) { + w = verLocInd[k1]; + if ((w < StartIndex) || (w > EndIndex)) { // A ghost + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a failure message: "; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs); + fflush(stdout); +#endif + + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + + // Build the Message Packet: + // Message[0] = v; // LOCAL + // Message[1] = w; // GHOST + // Message[2] = FAILURE; // TYPE + // Send a Request (Asynchronous) + // MPI_Bsend(&Message[0], 3, TypeMap(), ghostOwner, ComputeTag, comm); + + (*msgActual)++; + (*msgInd)++; + + privateQLocalVtx.push_back(v); + privateQGhostVtx.push_back(w); + privateQMsgType.push_back(FAILURE); + privateQOwner.push_back(ghostOwner); + + } // End of if(GHOST) + } // End of for loop + break; + case 5: + default: + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a success message: "; + cout << "\n(" << myRank << ")Ghost is " << v << " Owner is: " << findOwnerOfGhost(v, verDistance, myRank, numProcs) << "\n"; + fflush(stdout); +#endif + + ghostOwner = findOwnerOfGhost(v, verDistance, myRank, numProcs); + + // Build the Message Packet: + // Message[0] = u; // LOCAL + // Message[1] = v; // GHOST + // Message[2] = SUCCESS; // TYPE + // Send a Request (Asynchronous) + // MPI_Bsend(&Message[0], 3, TypeMap(), ghostOwner, ComputeTag, comm); + + (*msgActual)++; + (*msgInd)++; + + privateQLocalVtx.push_back(u); + privateQGhostVtx.push_back(v); + privateQMsgType.push_back(SUCCESS); + privateQOwner.push_back(ghostOwner); + + break; + } // End of switch + } // End of inner for + } + } // End of outer for + + queuesTransfer(U, privateU, QLocalVtx, + QGhostVtx, + QMsgType, QOwner, privateQLocalVtx, + privateQGhostVtx, + privateQMsgType, + privateQOwner); + + } // End of while ( !U.empty() ) + +#ifdef COUNT_LOCAL_VERTEX + printf("Count local vertexes: %ld for thread %d of processor %d\n", + localVertices, + omp_get_thread_num(), + myRank); + +#endif + } // End of parallel region + + // Send the messages +#ifdef DEBUG_HANG_ + cout << myRank<<" Sending: "<(), ghostOwner, ComputeTag, comm); + //cout << myRank<<" Sending to "<(), ghostOwner, ComputeTag, comm); + } +#ifdef DEBUG_HANG_ + cout << myRank<<" Done sending messages"< &Ghost2LocalMap, + vector &GMate, + vector &Counter, + MilanLongInt StartIndex, + MilanLongInt EndIndex, + MilanLongInt *myCard, + MilanLongInt *msgInd, + MilanLongInt *msgActual, + MilanReal *edgeLocWeight, + MilanLongInt *verDistance, + MilanLongInt *verLocPtr, + MilanLongInt k, + MilanLongInt *verLocInd, + MilanInt numProcs, + MilanInt myRank, + MPI_Comm comm, + vector &Message, + MilanLongInt numGhostEdges, + MilanLongInt u, + MilanLongInt v, + MilanLongInt *S, + vector &U) +{ + + //#define PRINT_DEBUG_INFO_ + + MilanInt Sender; + MPI_Status computeStatus; + MilanLongInt bundleSize, w; + MilanLongInt adj11, adj12, k1; + MilanLongInt ghostOwner; + int error_codeC; + error_codeC = MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN); + char error_message[MPI_MAX_ERROR_STRING]; + int message_length; + MilanLongInt message_type = 0; + + // Buffer to receive bundled messages + // Maximum messages that can be received from any processor is + // twice the edge cut: REQUEST; REQUEST+(FAILURE/SUCCESS) + vector ReceiveBuffer; + try + { + ReceiveBuffer.reserve(numGhostEdges * 2 * 3); // Three integers per cross edge + } + catch (length_error) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n"; + cout << "Not enough memory to allocate the internal variables \n"; + exit(1); + } + +#ifdef PRINT_DEBUG_INFO_ + cout + << "\n(" << myRank << "=========================************===============================" << endl; + fflush(stdout); + fflush(stdout); +#endif +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")About to begin Message processing phase ... *S=" << *S << endl; + fflush(stdout); +#endif +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << "=========================************===============================" << endl; + fflush(stdout); + fflush(stdout); +#endif + // BLOCKING RECEIVE: +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << " Waiting for blocking receive..." << endl; + fflush(stdout); + fflush(stdout); +#endif + + //cout << myRank<<" Receiving ..."; + error_codeC = MPI_Recv(&Message[0], 3, TypeMap(), MPI_ANY_SOURCE, ComputeTag, comm, &computeStatus); + if (error_codeC != MPI_SUCCESS) + { + MPI_Error_string(error_codeC, error_message, &message_length); + cout << "\n*Error in call to MPI_Receive on Slave: " << error_message << "\n"; + fflush(stdout); + } + Sender = computeStatus.MPI_SOURCE; + //cout << " ...from "<(), Sender, BundleTag, comm, &computeStatus); + if (error_codeC != MPI_SUCCESS) { + MPI_Error_string(error_codeC, error_message, &message_length); + cout << "\n*Error in call to MPI_Receive on processor " << myRank << " Error: " << error_message << "\n"; + fflush(stdout); + } +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Message Bundle After: " << endl; + for (int i = 0; i < bundleSize; i++) + cout << ReceiveBuffer[i] << ","; + cout << endl; + fflush(stdout); +#endif + } else { // Just a single message: +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Received regular message from Process " << Sender << " u= " << Message[0] << " v= " << Message[1] << endl; + fflush(stdout); +#endif + // Add the current message to Queue: + bundleSize = 3; //#of integers in the message + // Build the Message Buffer: + if (!ReceiveBuffer.empty()) + ReceiveBuffer.clear(); // Empty it out first + ReceiveBuffer.resize(bundleSize, -1); // Initialize + + ReceiveBuffer[0] = Message[0]; // u + ReceiveBuffer[1] = Message[1]; // v + ReceiveBuffer[2] = Message[2]; // message_type + } + +#ifdef DEBUG_GHOST_ + if ((v < StartIndex) || (v > EndIndex)) { + cout << "\n(" << myRank << ") From ReceiveBuffer: This should not happen: u= " << u << " v= " << v << " Type= " << message_type << " StartIndex " << StartIndex << " EndIndex " << EndIndex << endl; + fflush(stdout); + } +#endif +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Processing message: u= " << u << " v= " << v << " Type= " << message_type << endl; + fflush(stdout); +#endif + + // Most of the time bundleSize == 3, thus, it's not worth parallelizing thi loop + for (MilanLongInt bundleCounter = 3; bundleCounter < bundleSize + 3; bundleCounter += 3) { + u = ReceiveBuffer[bundleCounter - 3]; // GHOST + v = ReceiveBuffer[bundleCounter - 2]; // LOCAL + message_type = ReceiveBuffer[bundleCounter - 1]; // TYPE + + // CASE I: REQUEST + if (message_type == REQUEST) { +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Message type is REQUEST" << endl; + fflush(stdout); +#endif +#ifdef DEBUG_GHOST_ + if ((v < 0) || (v < StartIndex) || ((v - StartIndex) > NLVer)) { + cout << "\n(" << myRank << ") case 1 Bad address " << v << " " << StartIndex << " " << v - StartIndex << " " << NLVer << endl; + fflush(stdout); + } + +#endif + + if (Mate[v - StartIndex] == -1) { + // Process only if not already matched (v is local) + candidateMate[NLVer + Ghost2LocalMap[u]] = v; // Set CandidateMate for the ghost + if (candidateMate[v - StartIndex] == u) { + GMate[Ghost2LocalMap[u]] = v; // u is ghost + Mate[v - StartIndex] = u; // v is local + U.push_back(v); + U.push_back(u); + (*myCard)++; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << u << ") " << endl; + fflush(stdout); +#endif + + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S); + } // End of if ( candidateMate[v-StartIndex] == u )e + } // End of if ( Mate[v] == -1 ) + } // End of REQUEST + else { // CASE II: SUCCESS + if (message_type == SUCCESS) { +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Message type is SUCCESS" << endl; + fflush(stdout); +#endif + GMate[Ghost2LocalMap[u]] = EndIndex + 1; // Set a Dummy Mate to make sure that we do not (u is a ghost) process it again + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S); +#ifdef DEBUG_GHOST_ + if ((v < 0) || (v < StartIndex) || ((v - StartIndex) > NLVer)) { + cout << "\n(" << myRank << ") case 2 Bad address " << v << " " << StartIndex << " " << v - StartIndex << " " << NLVer << endl; + fflush(stdout); + } +#endif + if (Mate[v - StartIndex] == -1) { + // Process only if not already matched ( v is local) + if (candidateMate[v - StartIndex] == u) { + // Start: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + w = computeCandidateMate(verLocPtr[v - StartIndex], verLocPtr[v - StartIndex + 1], edgeLocWeight, k, + verLocInd, StartIndex, EndIndex, GMate, Mate, Ghost2LocalMap); + candidateMate[v - StartIndex] = w; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")" << v << " Points to: " << w << endl; + fflush(stdout); +#endif + // If found a dominating edge: + if (w >= 0) { + if ((w < StartIndex) || (w > EndIndex)) { + // w is a ghost + // Build the Message Packet: + Message[0] = v; // LOCAL + Message[1] = w; // GHOST + Message[2] = REQUEST; // TYPE + // Send a Request (Asynchronous) +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a request message: "; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl; + fflush(stdout); +#endif + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + //assert(ghostOwner != -1); + //assert(ghostOwner != myRank); + //cout << myRank<<" Sending to "<(), ghostOwner, ComputeTag, comm); + (*msgInd)++; + (*msgActual)++; + if (candidateMate[NLVer + Ghost2LocalMap[w]] == v) { + Mate[v - StartIndex] = w; // v is local + GMate[Ghost2LocalMap[w]] = v; // w is ghost + U.push_back(v); + U.push_back(w); + (*myCard)++; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") " << endl; + fflush(stdout); +#endif + + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[w]], S); + } // End of if CandidateMate[w] = v + } // End of if a Ghost Vertex + else { // w is a local vertex + if (candidateMate[w - StartIndex] == v) { + Mate[v - StartIndex] = w; // v is local + Mate[w - StartIndex] = v; // w is local + // Q.push_back(u); + U.push_back(v); + U.push_back(w); + (*myCard)++; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")MATCH: (" << v << "," << w << ") " << endl; + fflush(stdout); +#endif + } // End of if(CandidateMate(w) = v + } // End of Else + } // End of if(w >=0) + else { // No dominant edge found + adj11 = verLocPtr[v - StartIndex]; + adj12 = verLocPtr[v - StartIndex + 1]; + for (k1 = adj11; k1 < adj12; k1++) { + w = verLocInd[k1]; + if ((w < StartIndex) || (w > EndIndex)) { + // A ghost + // Build the Message Packet: + Message[0] = v; // LOCAL + Message[1] = w; // GHOST + Message[2] = FAILURE; // TYPE + // Send a Request (Asynchronous) +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending a failure message: "; + cout << "\n(" << myRank << ")Ghost is " << w << " Owner is: " << findOwnerOfGhost(w, verDistance, myRank, numProcs) << endl; + fflush(stdout); +#endif + ghostOwner = findOwnerOfGhost(w, verDistance, myRank, numProcs); + //assert(ghostOwner != -1); + //assert(ghostOwner != myRank); + //cout << myRank<<" Sending to "<(), ghostOwner, ComputeTag, comm); + (*msgInd)++; + (*msgActual)++; + } // End of if(GHOST) + } // End of for loop + } // End of Else: w == -1 + // End: PARALLEL_PROCESS_EXPOSED_VERTEX_B(v) + } // End of if ( candidateMate[v-StartIndex] == u ) + } // End of if ( Mate[v] == -1 ) + } // End of if ( message_type == SUCCESS ) + else { + // CASE III: FAILURE +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Message type is FAILURE" << endl; + fflush(stdout); +#endif + GMate[Ghost2LocalMap[u]] = EndIndex + 1; // Set a Dummy Mate to make sure that we do not (u is a ghost) process this anymore + PROCESS_CROSS_EDGE(&Counter[Ghost2LocalMap[u]], S); // Decrease the counter + } // End of else: CASE III + } // End of else: CASE I + } + + return; +} diff --git a/amgprec/impl/aggregator/queueTransfer.cpp b/amgprec/impl/aggregator/queueTransfer.cpp new file mode 100644 index 00000000..33c65749 --- /dev/null +++ b/amgprec/impl/aggregator/queueTransfer.cpp @@ -0,0 +1,36 @@ +#include "MatchBoxPC.h" + +void queuesTransfer(vector &U, + vector &privateU, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &privateQLocalVtx, + vector &privateQGhostVtx, + vector &privateQMsgType, + vector &privateQOwner) +{ + +#pragma omp critical(U) + { + U.insert(U.end(), privateU.begin(), privateU.end()); + } + + privateU.clear(); + +#pragma omp critical(sendMessageTransfer) + { + + QLocalVtx.insert(QLocalVtx.end(), privateQLocalVtx.begin(), privateQLocalVtx.end()); + QGhostVtx.insert(QGhostVtx.end(), privateQGhostVtx.begin(), privateQGhostVtx.end()); + QMsgType.insert(QMsgType.end(), privateQMsgType.begin(), privateQMsgType.end()); + QOwner.insert(QOwner.end(), privateQOwner.begin(), privateQOwner.end()); + } + + privateQLocalVtx.clear(); + privateQGhostVtx.clear(); + privateQMsgType.clear(); + privateQOwner.clear(); + +} diff --git a/amgprec/impl/aggregator/sendBundledMessages.cpp b/amgprec/impl/aggregator/sendBundledMessages.cpp new file mode 100644 index 00000000..80a88b94 --- /dev/null +++ b/amgprec/impl/aggregator/sendBundledMessages.cpp @@ -0,0 +1,209 @@ +#include "MatchBoxPC.h" + +void sendBundledMessages(MilanLongInt *numGhostEdges, + MilanInt *BufferSize, + MilanLongInt *Buffer, + vector &PCumulative, + vector &PMessageBundle, + vector &PSizeInfoMessages, + MilanLongInt *PCounter, + MilanLongInt NumMessagesBundled, + MilanLongInt *msgActual, + MilanLongInt *msgInd, + MilanInt numProcs, + MilanInt myRank, + MPI_Comm comm, + vector &QLocalVtx, + vector &QGhostVtx, + vector &QMsgType, + vector &QOwner, + vector &SRequest, + vector &SStatus) +{ + + MilanLongInt myIndex = 0, numMessagesToSend; + MilanInt i = 0, OneMessageSize = 0; + +#ifdef DEBUG_HANG_ + if (myRank == 0) + cout << "\n(" << myRank << ") Send Bundles" << endl; + fflush(stdout); +#endif + +#pragma omp parallel private(i) default(shared) num_threads(NUM_THREAD) + { +#pragma omp master + { +// Data structures for Bundled Messages: +#pragma omp task depend(inout \ + : PCumulative, PMessageBundle, PSizeInfoMessages) depend(in \ + : NumMessagesBundled, numProcs) + { + try { + PMessageBundle.reserve(NumMessagesBundled * 3); // Three integers per message + PCumulative.reserve(numProcs + 1); // Similar to Row Pointer vector in CSR data structure + PSizeInfoMessages.reserve(numProcs * 3); // Buffer to hold the Size info message packets + } + catch (length_error) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesMessageBundling: \n"; + cout << "Not enough memory to allocate the internal variables \n"; + exit(1); + } + PMessageBundle.resize(NumMessagesBundled * 3, -1); // Initialize + PCumulative.resize(numProcs + 1, 0); // Only initialize the counter variable + PSizeInfoMessages.resize(numProcs * 3, 0); + } + +#pragma omp task depend(inout \ + : PCumulative) depend(in \ + : PCounter) + { + for (i = 0; i < numProcs; i++) + PCumulative[i + 1] = PCumulative[i] + PCounter[i]; + } + +#pragma omp task depend(inout \ + : PCounter) + { + // Reuse PCounter to keep track of how many messages were inserted: + for (MilanInt i = 0; i < numProcs; i++) // Changed by Fabio to be an integer, addresses needs to be integers! + PCounter[i] = 0; + } + +// Build the Message Bundle packet: +#pragma omp task depend(in \ + : PCounter, QLocalVtx, QGhostVtx, QMsgType, QOwner, PMessageBundle, PCumulative) depend(out \ + : myIndex, PMessageBundle, PCounter) +{ + for (i = 0; i < NumMessagesBundled; i++) { + myIndex = (PCumulative[QOwner[i]] + PCounter[QOwner[i]]) * 3; + PMessageBundle[myIndex + 0] = QLocalVtx[i]; + PMessageBundle[myIndex + 1] = QGhostVtx[i]; + PMessageBundle[myIndex + 2] = QMsgType[i]; + PCounter[QOwner[i]]++; + } + } + +// Send the Bundled Messages: Use ISend +#pragma omp task depend(out \ + : SRequest, SStatus) + { + try + { + SRequest.reserve(numProcs * 2); // At most two messages per processor + SStatus.reserve(numProcs * 2); // At most two messages per processor + } + catch (length_error) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearchImmediateSend: \n"; + cout << "Not enough memory to allocate the internal variables \n"; + exit(1); + } + } + +// Send the Messages +#pragma omp task depend(inout \ + : SRequest, PSizeInfoMessages, PCumulative) depend(out \ + : *msgActual, *msgInd) +{ + for (i = 0; i < numProcs; i++) { // Changed by Fabio to be an integer, addresses needs to be integers! + if (i == myRank) // Do not send anything to yourself + continue; + // Send the Message with information about the size of next message: + // Build the Message Packet: + PSizeInfoMessages[i * 3 + 0] = (PCumulative[i + 1] - PCumulative[i]) * 3; // # of integers in the next message + PSizeInfoMessages[i * 3 + 1] = -1; // Dummy packet + PSizeInfoMessages[i * 3 + 2] = SIZEINFO; // TYPE + // Send a Request (Asynchronous) +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Sending bundled message to process " << i << " size: " << PSizeInfoMessages[i * 3 + 0] << endl; + fflush(stdout); +#endif + if (PSizeInfoMessages[i * 3 + 0] > 0) + { // Send only if it is a nonempty packet + MPI_Isend(&PSizeInfoMessages[i * 3 + 0], 3, TypeMap(), i, ComputeTag, comm, + &SRequest[(*msgInd)]); + (*msgActual)++; + (*msgInd)++; + // Now Send the message with the data packet: +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")SendiFFng Bundle to : " << i << endl; + for (k = (PCumulative[i] * 3); k < (PCumulative[i] * 3 + PSizeInfoMessages[i * 3 + 0]); k++) + cout << PMessageBundle[k] << ","; + cout << endl; + fflush(stdout); +#endif + MPI_Isend(&PMessageBundle[PCumulative[i] * 3], PSizeInfoMessages[i * 3 + 0], + TypeMap(), i, BundleTag, comm, &SRequest[(*msgInd)]); + (*msgInd)++; + } // End of if size > 0 + } +} + +#pragma omp task depend(inout \ + : PCumulative, QLocalVtx, QGhostVtx, QMsgType, QOwner) +{ + + // Free up temporary memory: + PCumulative.clear(); + QLocalVtx.clear(); + QGhostVtx.clear(); + QMsgType.clear(); + QOwner.clear(); +} + +#pragma omp task depend(inout : OneMessageSize, *BufferSize) depend(out : numMessagesToSend) depend(in : *numGhostEdges) +{ + +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Number of Ghost edges = " << *numGhostEdges; + cout << "\n(" << myRank << ")Total number of potential message X 2 = " << *numGhostEdges * 2; + cout << "\n(" << myRank << ")Number messages already sent in bundles = " << NumMessagesBundled; + if (*numGhostEdges > 0) + { + cout << "\n(" << myRank << ")Percentage of total = " << ((double)NumMessagesBundled / (double)(*numGhostEdges * 2)) * 100.0 << "% \n"; + } + fflush(stdout); +#endif + + // Allocate memory for MPI Send messages: + /* WILL COME BACK HERE - NO NEED TO STORE ALL THIS MEMORY !! */ + OneMessageSize = 0; + MPI_Pack_size(3, TypeMap(), comm, &OneMessageSize); // Size of one message packet + // How many messages to send? + // Potentially three kinds of messages will be sent/received: + // Request, Success, Failure. + // But only two will be sent from a given processor. + // Substract the number of messages that have already been sent as bundled messages: + numMessagesToSend = (*numGhostEdges) * 2 - NumMessagesBundled; + *BufferSize = (OneMessageSize + MPI_BSEND_OVERHEAD) * numMessagesToSend; +} + +#pragma omp task depend(out : Buffer) depend(in : *BufferSize) + { + Buffer = 0; +#ifdef PRINT_DEBUG_INFO_ + cout << "\n(" << myRank << ")Size of One Message from PACK= " << OneMessageSize; + cout << "\n(" << myRank << ")Size of Message overhead = " << MPI_BSEND_OVERHEAD; + cout << "\n(" << myRank << ")Number of Ghost edges = " << *numGhostEdges; + cout << "\n(" << myRank << ")Number of remaining message = " << numMessagesToSend; + cout << "\n(" << myRank << ")BufferSize = " << (*BufferSize); + cout << "\n(" << myRank << ")Attaching Buffer on.. "; + fflush(stdout); +#endif + if ((*BufferSize) > 0) + { + Buffer = (MilanLongInt *)malloc((*BufferSize)); // Allocate memory + if (Buffer == 0) + { + cout << "Error in function algoDistEdgeApproxDominatingEdgesLinearSearch: \n"; + cout << "Not enough memory to allocate for send buffer on process " << myRank << "\n"; + exit(1); + } + MPI_Buffer_attach(Buffer, *BufferSize); // Attach the Buffer + } + } +} +} +} diff --git a/amgprec/impl/amg_ccprecset.F90 b/amgprec/impl/amg_ccprecset.F90 index 3fb97bf3..5a917d10 100644 --- a/amgprec/impl/amg_ccprecset.F90 +++ b/amgprec/impl/amg_ccprecset.F90 @@ -571,7 +571,6 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_c_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select @@ -729,7 +728,6 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_c_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select diff --git a/amgprec/impl/amg_cfile_prec_descr.f90 b/amgprec/impl/amg_cfile_prec_descr.f90 index 6ce27bf2..396a9467 100644 --- a/amgprec/impl/amg_cfile_prec_descr.f90 +++ b/amgprec/impl/amg_cfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_descr use amg_c_inner_mod @@ -73,11 +73,12 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) 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 + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' else - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) end if nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) else - call prec%precv(1)%sm%descr(info,iout=iout_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) end if ! ! Print multilevel details ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_dcprecset.F90 b/amgprec/impl/amg_dcprecset.F90 index 4fe1dc0b..ad02a364 100644 --- a/amgprec/impl/amg_dcprecset.F90 +++ b/amgprec/impl/amg_dcprecset.F90 @@ -599,7 +599,6 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_d_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select @@ -773,7 +772,6 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_d_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select diff --git a/amgprec/impl/amg_dfile_prec_descr.f90 b/amgprec/impl/amg_dfile_prec_descr.f90 index ed2fd2fb..3213df29 100644 --- a/amgprec/impl/amg_dfile_prec_descr.f90 +++ b/amgprec/impl/amg_dfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_descr use amg_d_inner_mod @@ -73,11 +73,12 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) 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 + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' else - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) end if nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) else - call prec%precv(1)%sm%descr(info,iout=iout_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) end if ! ! Print multilevel details ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_dslud_interface.c b/amgprec/impl/amg_dslud_interface.c index b3f0138f..2831c6f1 100644 --- a/amgprec/impl/amg_dslud_interface.c +++ b/amgprec/impl/amg_dslud_interface.c @@ -94,7 +94,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define HANDLE_SIZE 8 -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) typedef struct { SuperMatrix *A; dLUstruct_t *LUstruct; @@ -135,7 +135,7 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr, SuperMatrix *A; NRformat_loc *Astore; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) dScalePermstruct_t *ScalePermstruct; dLUstruct_t *LUstruct; dSOLVEstruct_t SOLVEstruct; @@ -148,9 +148,9 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr, int i, panel_size, permc_spec, relax, info; trans_t trans; double drop_tol = 0.0, b[1], berr[1]; -#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -174,7 +174,7 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr, SLU_NR_loc, SLU_D, SLU_GE); /* Initialize ScalePermstruct and LUstruct. */ -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) ScalePermstruct = (dScalePermstruct_t *) SUPERLU_MALLOC(sizeof(dScalePermstruct_t)); LUstruct = (dLUstruct_t *) SUPERLU_MALLOC(sizeof(dLUstruct_t)); dScalePermstructInit(n,n, ScalePermstruct); @@ -183,11 +183,11 @@ int amg_dsludist_fact(int n, int nl, int nnzl, int ffstr, LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t)); ScalePermstructInit(n,n, ScalePermstruct); #endif -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) dLUstructInit(n, LUstruct); -#elif defined(SLUD_VERSION_4) || defined(SLUD_VERSION_5) || defined(SLUD_VERSION_6) +#elif (SLUD_VERSION_>=40) LUstructInit(n, LUstruct); -#elif defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) LUstructInit(n,n, LUstruct); #else choke_on_me; @@ -245,7 +245,7 @@ int amg_dsludist_solve(int itrans, int n, int nrhs, */ #ifdef Have_SLUDist_ SuperMatrix *A; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) dScalePermstruct_t *ScalePermstruct; dLUstruct_t *LUstruct; dSOLVEstruct_t SOLVEstruct; @@ -259,9 +259,9 @@ int amg_dsludist_solve(int itrans, int n, int nrhs, trans_t trans; double drop_tol = 0.0; double *berr; -#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6) ||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)|| defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -331,7 +331,7 @@ int amg_dsludist_free(void *f_factors) */ #ifdef Have_SLUDist_ SuperMatrix *A; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) dScalePermstruct_t *ScalePermstruct; dLUstruct_t *LUstruct; dSOLVEstruct_t SOLVEstruct; @@ -345,9 +345,9 @@ int amg_dsludist_free(void *f_factors) trans_t trans; double drop_tol = 0.0; double *berr; -#if defined(SLUD_VERSION_63)||defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -368,7 +368,7 @@ int amg_dsludist_free(void *f_factors) // we either have a leak or a segfault here. // To be investigated further. //Destroy_CompRowLoc_Matrix_dist(A); -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) dScalePermstructFree(ScalePermstruct); dLUstructFree(LUstruct); #else diff --git a/amgprec/impl/amg_scprecset.F90 b/amgprec/impl/amg_scprecset.F90 index e82df5ba..43aa85db 100644 --- a/amgprec/impl/amg_scprecset.F90 +++ b/amgprec/impl/amg_scprecset.F90 @@ -571,7 +571,6 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_s_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select @@ -729,7 +728,6 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_s_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select diff --git a/amgprec/impl/amg_sfile_prec_descr.f90 b/amgprec/impl/amg_sfile_prec_descr.f90 index 61cc1ae4..5996e2a1 100644 --- a/amgprec/impl/amg_sfile_prec_descr.f90 +++ b/amgprec/impl/amg_sfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_descr use amg_s_inner_mod @@ -73,11 +73,12 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) 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 + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' else - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) end if nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) else - call prec%precv(1)%sm%descr(info,iout=iout_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) end if ! ! Print multilevel details ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_zcprecset.F90 b/amgprec/impl/amg_zcprecset.F90 index 4e27ac15..ab6fde91 100644 --- a/amgprec/impl/amg_zcprecset.F90 +++ b/amgprec/impl/amg_zcprecset.F90 @@ -599,7 +599,6 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_z_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select @@ -773,7 +772,6 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) type(amg_z_krm_solver_type) :: krm_slv call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_krm_,info,pos=pos) call p%precv(nlev_)%set(krm_slv,info) - call p%precv(nlev_)%default() call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos) end block end select diff --git a/amgprec/impl/amg_zfile_prec_descr.f90 b/amgprec/impl/amg_zfile_prec_descr.f90 index fa7afe24..f3002cfd 100644 --- a/amgprec/impl/amg_zfile_prec_descr.f90 +++ b/amgprec/impl/amg_zfile_prec_descr.f90 @@ -65,7 +65,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) +subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) use psb_base_mod use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_descr use amg_z_inner_mod @@ -73,11 +73,12 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) 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 + integer(psb_ipk_), intent(in), optional :: verbosity + character(len=*), intent(in), optional :: prefix ! Local variables @@ -87,6 +88,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + character(1024) :: prefix_ info = psb_success_ if (present(iout)) then @@ -101,6 +103,11 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if ctxt = prec%ctxt @@ -133,7 +140,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) end do write(iout_,*) - write(iout_,'(a)') 'Preconditioner description' + write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' if (nlev == 1) then ! @@ -150,53 +157,53 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity) end select end select if (is_symgs) then - write(iout_,*) ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' + write(iout_,*) trim(prefix_), ' Forward-Backward (symmetrized) Hybrid Gauss-Seidel' else - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_), 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_), 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) end if nswps = max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post) else - call prec%precv(1)%sm%descr(info,iout=iout_) + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) nswps = prec%precv(1)%parms%sweeps_pre end if - if (nswps > 1) write(iout_,*) ' Number of sweeps : ',nswps - write(iout_,*) + write(iout_,*) trim(prefix_), ' Number of sweeps : ',nswps + write(iout_,*) trim(prefix_) else if (nlev > 1) then ! ! Print description of base preconditioner ! - write(iout_,*) 'Multilevel Preconditioner' - write(iout_,*) 'Outer sweeps:',prec%outer_sweeps - write(iout_,*) + write(iout_,*) trim(prefix_),' ', 'Multilevel Preconditioner' + write(iout_,*) trim(prefix_),' ', 'Outer sweeps:',prec%outer_sweeps + write(iout_,*) trim(prefix_) if (allocated(prec%precv(1)%sm2a)) then - write(iout_,*) 'Pre Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) - write(iout_,*) 'Post smoother:' - call prec%precv(1)%sm2a%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Pre Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) + write(iout_,*) trim(prefix_),' ', 'Post smoother:' + call prec%precv(1)%sm2a%descr(info,iout=iout_,prefix=prefix) else - write(iout_,*) 'Smoother: ' - call prec%precv(1)%sm%descr(info,iout=iout_) + write(iout_,*) trim(prefix_),' ', 'Smoother: ' + call prec%precv(1)%sm%descr(info,iout=iout_,prefix=prefix) end if ! ! Print multilevel details ! - write(iout_,*) - write(iout_,*) 'Multilevel hierarchy: ' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() + write(iout_,*) trim(prefix_) + write(iout_,*) trim(prefix_),' ', 'Multilevel hierarchy: ' + write(iout_,*) trim(prefix_),' ', ' Number of levels : ',nlev + write(iout_,*) trim(prefix_),' ', ' Operator complexity: ',prec%get_complexity() + write(iout_,*) trim(prefix_),' ', ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev call prec%precv(ilev)%descr(ilev,nlev,ilmin,info, & - & iout=iout_,verbosity=verbosity) + & iout=iout_,verbosity=verbosity,prefix=prefix) end do - write(iout_,*) + write(iout_,*) trim(prefix_) else write(iout_,*) trim(name), & diff --git a/amgprec/impl/amg_zslud_interface.c b/amgprec/impl/amg_zslud_interface.c index c3120aa6..6170772a 100644 --- a/amgprec/impl/amg_zslud_interface.c +++ b/amgprec/impl/amg_zslud_interface.c @@ -94,7 +94,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define HANDLE_SIZE 8 -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) typedef struct { SuperMatrix *A; zLUstruct_t *LUstruct; @@ -142,7 +142,7 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr, SuperMatrix *A; NRformat_loc *Astore; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) zScalePermstruct_t *ScalePermstruct; zLUstruct_t *LUstruct; zSOLVEstruct_t SOLVEstruct; @@ -155,9 +155,9 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr, int i, panel_size, permc_spec, relax, info; trans_t trans; double drop_tol = 0.0,berr[1]; -#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -181,7 +181,7 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr, SLU_NR_loc, SLU_Z, SLU_GE); /* Initialize ScalePermstruct and LUstruct. */ -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) ScalePermstruct = (zScalePermstruct_t *) SUPERLU_MALLOC(sizeof(zScalePermstruct_t)); LUstruct = (zLUstruct_t *) SUPERLU_MALLOC(sizeof(zLUstruct_t)); zScalePermstructInit(n,n, ScalePermstruct); @@ -190,11 +190,11 @@ int amg_zsludist_fact(int n, int nl, int nnzl, int ffstr, LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t)); ScalePermstructInit(n,n, ScalePermstruct); #endif -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) zLUstructInit(n, LUstruct); -#elif defined(SLUD_VERSION_4) || defined(SLUD_VERSION_5) || defined(SLUD_VERSION_6) +#elif (SLUD_VERSION_>=40) LUstructInit(n, LUstruct); -#elif defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) LUstructInit(n,n, LUstruct); #else choke_on_me; @@ -257,7 +257,7 @@ int amg_zsludist_solve(int itrans, int n, int nrhs, */ #ifdef Have_SLUDist_ SuperMatrix *A; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) zScalePermstruct_t *ScalePermstruct; zLUstruct_t *LUstruct; zSOLVEstruct_t SOLVEstruct; @@ -271,9 +271,9 @@ int amg_zsludist_solve(int itrans, int n, int nrhs, trans_t trans; double drop_tol = 0.0; double *berr; -#if defined(SLUD_VERSION_63) || defined(SLUD_VERSION_6) ||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)|| defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -343,7 +343,7 @@ int amg_zsludist_free(void *f_factors) */ #ifdef Have_SLUDist_ SuperMatrix *A; -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) zScalePermstruct_t *ScalePermstruct; zLUstruct_t *LUstruct; zSOLVEstruct_t SOLVEstruct; @@ -357,9 +357,9 @@ int amg_zsludist_free(void *f_factors) trans_t trans; double drop_tol = 0.0; double *berr; -#if defined(SLUD_VERSION_63)||defined(SLUD_VERSION_6)||defined(SLUD_VERSION_5) +#if (SLUD_VERSION_>=50) superlu_dist_options_t options; -#elif defined(SLUD_VERSION_4)||defined(SLUD_VERSION_3) +#elif (SLUD_VERSION_>=30) superlu_options_t options; #else choke_on_me; @@ -380,7 +380,7 @@ int amg_zsludist_free(void *f_factors) // we either have a leak or a segfault here. // To be investigated further. //Destroy_CompRowLoc_Matrix_dist(A); -#if defined(SLUD_VERSION_63) +#if (SLUD_VERSION_>=63) zScalePermstructFree(ScalePermstruct); zLUstructFree(LUstruct); #else diff --git a/amgprec/impl/level/Makefile b/amgprec/impl/level/Makefile index 80d782da..861769f3 100644 --- a/amgprec/impl/level/Makefile +++ b/amgprec/impl/level/Makefile @@ -72,14 +72,11 @@ amg_z_base_onelev_map_prol.o LIBNAME=libamg_prec.a -lib: $(OBJS) +objs: $(OBJS) +lib: objs $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) -mpobjs: - (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)") - (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") - veryclean: clean /bin/rm -f $(LIBNAME) diff --git a/amgprec/impl/level/amg_c_base_onelev_descr.f90 b/amgprec/impl/level/amg_c_base_onelev_descr.f90 index 6fe7aef3..8c3b1e5b 100644 --- a/amgprec/impl/level/amg_c_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_c_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,54 +81,62 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) + end if + if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_c_base_onelev_mat_asb.f90 b/amgprec/impl/level/amg_c_base_onelev_mat_asb.f90 index e79c90c9..27896806 100644 --- a/amgprec/impl/level/amg_c_base_onelev_mat_asb.f90 +++ b/amgprec/impl/level/amg_c_base_onelev_mat_asb.f90 @@ -109,6 +109,8 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) type(psb_cspmat_type) :: ac, op_restr, op_prol integer(psb_ipk_) :: nzl, inl integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_), save :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1 + logical, parameter :: do_timings=.false. name='amg_c_onelev_mat_asb' call psb_erractionsave(err_act) @@ -120,6 +122,12 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) info = psb_success_ ctxt = desc_a%get_context() call psb_info(ctxt,me,np) + if ((do_timings).and.(idx_matbld==-1)) & + & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb") + if ((do_timings).and.(idx_mapbld==-1)) & + & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld") call amg_check_def(lv%parms%aggr_prol,'Smoother',& & amg_smooth_prol_,is_legal_ml_aggr_prol) @@ -139,9 +147,10 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! the mapping defined by amg_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(amg_aggr_prol_) ! + if (do_timings) call psb_tic(idx_matbld) call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,& & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info) - + if (do_timings) call psb_toc(idx_matbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb') goto 9999 @@ -151,14 +160,17 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! Now build its descriptor and convert global indices for ! ac, op_restr and op_prol ! + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) & & call lv%aggr%mat_asb(lv%parms,a,desc_a,& & lv%ac,lv%desc_ac,op_prol,op_restr,info) - + if (do_timings) call psb_toc(idx_matasb) + if (do_timings) call psb_tic(idx_mapbld) if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,& & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info) + if (do_timings) call psb_toc(idx_mapbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld') goto 9999 diff --git a/amgprec/impl/level/amg_d_base_onelev_descr.f90 b/amgprec/impl/level/amg_d_base_onelev_descr.f90 index 880d5f3d..cefa6ece 100644 --- a/amgprec/impl/level/amg_d_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_d_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,54 +81,62 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) + end if + if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_d_base_onelev_mat_asb.f90 b/amgprec/impl/level/amg_d_base_onelev_mat_asb.f90 index e9e55a9a..6bd4e1ac 100644 --- a/amgprec/impl/level/amg_d_base_onelev_mat_asb.f90 +++ b/amgprec/impl/level/amg_d_base_onelev_mat_asb.f90 @@ -109,6 +109,8 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) type(psb_dspmat_type) :: ac, op_restr, op_prol integer(psb_ipk_) :: nzl, inl integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_), save :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1 + logical, parameter :: do_timings=.false. name='amg_d_onelev_mat_asb' call psb_erractionsave(err_act) @@ -120,6 +122,12 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) info = psb_success_ ctxt = desc_a%get_context() call psb_info(ctxt,me,np) + if ((do_timings).and.(idx_matbld==-1)) & + & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb") + if ((do_timings).and.(idx_mapbld==-1)) & + & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld") call amg_check_def(lv%parms%aggr_prol,'Smoother',& & amg_smooth_prol_,is_legal_ml_aggr_prol) @@ -139,9 +147,10 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! the mapping defined by amg_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(amg_aggr_prol_) ! + if (do_timings) call psb_tic(idx_matbld) call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,& & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info) - + if (do_timings) call psb_toc(idx_matbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb') goto 9999 @@ -151,14 +160,17 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! Now build its descriptor and convert global indices for ! ac, op_restr and op_prol ! + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) & & call lv%aggr%mat_asb(lv%parms,a,desc_a,& & lv%ac,lv%desc_ac,op_prol,op_restr,info) - + if (do_timings) call psb_toc(idx_matasb) + if (do_timings) call psb_tic(idx_mapbld) if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,& & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info) + if (do_timings) call psb_toc(idx_mapbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld') goto 9999 diff --git a/amgprec/impl/level/amg_s_base_onelev_descr.f90 b/amgprec/impl/level/amg_s_base_onelev_descr.f90 index 94b776eb..9de05c6e 100644 --- a/amgprec/impl/level/amg_s_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_s_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,54 +81,62 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) + end if + if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_s_base_onelev_mat_asb.f90 b/amgprec/impl/level/amg_s_base_onelev_mat_asb.f90 index 271b31d0..034151d3 100644 --- a/amgprec/impl/level/amg_s_base_onelev_mat_asb.f90 +++ b/amgprec/impl/level/amg_s_base_onelev_mat_asb.f90 @@ -109,6 +109,8 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) type(psb_sspmat_type) :: ac, op_restr, op_prol integer(psb_ipk_) :: nzl, inl integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_), save :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1 + logical, parameter :: do_timings=.false. name='amg_s_onelev_mat_asb' call psb_erractionsave(err_act) @@ -120,6 +122,12 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) info = psb_success_ ctxt = desc_a%get_context() call psb_info(ctxt,me,np) + if ((do_timings).and.(idx_matbld==-1)) & + & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb") + if ((do_timings).and.(idx_mapbld==-1)) & + & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld") call amg_check_def(lv%parms%aggr_prol,'Smoother',& & amg_smooth_prol_,is_legal_ml_aggr_prol) @@ -139,9 +147,10 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! the mapping defined by amg_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(amg_aggr_prol_) ! + if (do_timings) call psb_tic(idx_matbld) call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,& & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info) - + if (do_timings) call psb_toc(idx_matbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb') goto 9999 @@ -151,14 +160,17 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! Now build its descriptor and convert global indices for ! ac, op_restr and op_prol ! + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) & & call lv%aggr%mat_asb(lv%parms,a,desc_a,& & lv%ac,lv%desc_ac,op_prol,op_restr,info) - + if (do_timings) call psb_toc(idx_matasb) + if (do_timings) call psb_tic(idx_mapbld) if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,& & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info) + if (do_timings) call psb_toc(idx_mapbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld') goto 9999 diff --git a/amgprec/impl/level/amg_z_base_onelev_descr.f90 b/amgprec/impl/level/amg_z_base_onelev_descr.f90 index a92cb79e..99a1e9d7 100644 --- a/amgprec/impl/level/amg_z_base_onelev_descr.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_descr.f90 @@ -42,7 +42,7 @@ ! 0: normal ! >1: increased details ! -subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) +subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity,prefix) use psb_base_mod use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_descr @@ -53,6 +53,7 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) 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 ! Local variables @@ -60,6 +61,7 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) character(len=20), parameter :: name='amg_z_base_onelev_descr' integer(psb_ipk_) :: iout_, verbosity_ logical :: coarse + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -79,54 +81,62 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout,verbosity) verbosity_ = 0 end if if (verbosity_ < 0) goto 9998 + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) + write(iout_,*) trim(prefix_) if (il == ilmin) then call lv%parms%mlcycledsc(iout_,info) + end if + if (((ilmin==1).and.(il==2)).or.((ilmin>1).and.(il==ilmin))) then if (allocated(lv%aggr)) then - call lv%aggr%descr(lv%parms,iout_,info) + call lv%aggr%descr(lv%parms,iout_,info,prefix=prefix) else - write(iout_,*) 'Internal error: unallocated aggregator object' + write(iout_,*) trim(prefix_),' ', 'Internal error: unallocated aggregator object' info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 end if - write(iout_,*) + write(iout_,*) trim(prefix_) end if if (il > 1) then if (coarse) then - write(iout_,*) ' Level ',il,' (coarse)' + write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)' else - write(iout_,*) ' Level ',il + write(iout_,*) trim(prefix_), ' Level ',il end if - call lv%parms%descr(iout_,info,coarse=coarse) + call lv%parms%descr(iout_,info,coarse=coarse,prefix=prefix) if (nl > 1) then if (allocated(lv%linmap%naggr)) then - write(iout_,*) ' Coarse Matrix: Global size: ', & + write(iout_,*) trim(prefix_), ' Coarse Matrix: Global size: ', & & lv%linmap%nagtot - write(iout_,*) ' Nonzeros: ',lv%ac_nz_tot + write(iout_,*) trim(prefix_), ' Nonzeros: ',lv%ac_nz_tot if (verbosity_>0) then - write(iout_,*) ' Local matrix sizes: ', & + write(iout_,*) trim(prefix_), ' Local matrix sizes: ', & & lv%linmap%naggr(:) else - write(iout_,'(2(a,1x,i12))') & + write(iout_,'(a,1x,2(a,1x,i12))') trim(prefix_),& & ' Local matrix sizes: min:', & & lv%linmap%nagmin,' max:', lv%linmap%nagmax - write(iout_,'(a,1x,f14.1)') & + write(iout_,'(a,1x,a,1x,f14.1)') trim(prefix_),& & ' avg:', & & lv%linmap%nagavg end if - write(iout_,'(a,1x,f14.2)') ' Aggregation ratio: ', & + write(iout_,'(a,1xa,1x,f14.2)') trim(prefix_),& + & ' Aggregation ratio: ', & & lv%szratio end if end if if (coarse.and.allocated(lv%sm)) & - & call lv%sm%descr(info,iout=iout_,coarse=coarse) + & call lv%sm%descr(info,iout=iout_,coarse=coarse,prefix=prefix) end if 9998 continue diff --git a/amgprec/impl/level/amg_z_base_onelev_mat_asb.f90 b/amgprec/impl/level/amg_z_base_onelev_mat_asb.f90 index 07ab3e0b..eb11cad2 100644 --- a/amgprec/impl/level/amg_z_base_onelev_mat_asb.f90 +++ b/amgprec/impl/level/amg_z_base_onelev_mat_asb.f90 @@ -109,6 +109,8 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) type(psb_zspmat_type) :: ac, op_restr, op_prol integer(psb_ipk_) :: nzl, inl integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_), save :: idx_matbld=-1, idx_matasb=-1, idx_mapbld=-1 + logical, parameter :: do_timings=.false. name='amg_z_onelev_mat_asb' call psb_erractionsave(err_act) @@ -120,6 +122,12 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) info = psb_success_ ctxt = desc_a%get_context() call psb_info(ctxt,me,np) + if ((do_timings).and.(idx_matbld==-1)) & + & idx_matbld = psb_get_timer_idx("LEV_MASB: mat_bld") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("LEV_MASB: mat_asb") + if ((do_timings).and.(idx_mapbld==-1)) & + & idx_mapbld = psb_get_timer_idx("LEV_MASB: map_bld") call amg_check_def(lv%parms%aggr_prol,'Smoother',& & amg_smooth_prol_,is_legal_ml_aggr_prol) @@ -139,9 +147,10 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! the mapping defined by amg_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(amg_aggr_prol_) ! + if (do_timings) call psb_tic(idx_matbld) call lv%aggr%mat_bld(lv%parms,a,desc_a,ilaggr,nlaggr,& & lv%ac,lv%desc_ac,op_prol,op_restr,t_prol,info) - + if (do_timings) call psb_toc(idx_matbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_aggrmat_asb') goto 9999 @@ -151,14 +160,17 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) ! Now build its descriptor and convert global indices for ! ac, op_restr and op_prol ! + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) & & call lv%aggr%mat_asb(lv%parms,a,desc_a,& & lv%ac,lv%desc_ac,op_prol,op_restr,info) - + if (do_timings) call psb_toc(idx_matasb) + if (do_timings) call psb_tic(idx_mapbld) if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,& & ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info) + if (do_timings) call psb_toc(idx_mapbld) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld') goto 9999 diff --git a/amgprec/impl/smoother/Makefile b/amgprec/impl/smoother/Makefile index 9004f395..f26b8f00 100644 --- a/amgprec/impl/smoother/Makefile +++ b/amgprec/impl/smoother/Makefile @@ -190,14 +190,12 @@ amg_z_l1_jac_smoother_clone.o \ LIBNAME=libamg_prec.a -lib: $(OBJS) +objs: $(OBJS) + +lib: objs $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) -mpobjs: - (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)") - (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") - veryclean: clean /bin/rm -f $(LIBNAME) diff --git a/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 index 1b3839f1..4ed7798c 100644 --- a/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_base_smoother_mod, amg_protect_name => amg_c_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) 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_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_c_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_c_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 index 522954f8..f0f670cc 100644 --- a/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_diag_solver @@ -50,12 +50,14 @@ subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_c_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_c_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_c_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 index 3b8507b4..fb053d86 100644 --- a/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_c_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_c_diag_solver @@ -50,12 +50,14 @@ subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_c_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_c_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_c_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 index b6251836..2c59b7d2 100644 --- a/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_base_smoother_mod, amg_protect_name => amg_d_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) 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_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_d_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_d_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 index b2cf9896..11d6bbad 100644 --- a/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_diag_solver @@ -50,12 +50,14 @@ subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_d_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_d_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_d_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 index d4588efb..015a1256 100644 --- a/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_d_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_d_diag_solver @@ -50,12 +50,14 @@ subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_d_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_d_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_d_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 index efa282b2..f81f9c95 100644 --- a/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_base_smoother_mod, amg_protect_name => amg_s_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) 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_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_s_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_s_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 index 9b5f21ae..08836ea2 100644 --- a/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_diag_solver @@ -50,12 +50,14 @@ subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_s_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_s_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_s_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 index 838344ae..ea458a0f 100644 --- a/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_s_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_s_diag_solver @@ -50,12 +50,14 @@ subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_s_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_s_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_s_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 index d77f0292..42d9cbb9 100644 --- a/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_base_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_base_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_base_smoother_mod, amg_protect_name => amg_z_base_smoother_descr @@ -47,12 +47,14 @@ subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) 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_base_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) @@ -68,20 +70,25 @@ subroutine amg_z_base_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit end if + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (coarse_) then - if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse) + if (allocated(sm%sv)) call sm%sv%descr(info,iout,coarse,prefix=prefix) else if (allocated(sm%sv)) then select type (sv => sm%sv) class is (amg_z_id_solver_type) - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' class default - write(iout_,*) 'Decoupled preconditioner/smoother with local solver' - call sm%sv%descr(info,iout,coarse) + write(iout_,*) trim(prefix_), 'Decoupled preconditioner/smoother with local solver' + call sm%sv%descr(info,iout,coarse,prefix=prefix) end select else - write(iout_,*) 'No preconditioner/smoother' + write(iout_,*) trim(prefix_), 'No preconditioner/smoother' end if end if diff --git a/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 index 7d4bb9cf..79f85d23 100644 --- a/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_diag_solver @@ -50,12 +50,14 @@ subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_z_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_z_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_z_bwgs_solver_type) - write(iout_,*) ' Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Backward Gauss-Seidel ' class is (amg_z_gs_solver_type) - write(iout_,*) ' Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' Block Jacobi ' + write(iout_,*) trim(prefix_), ' Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 b/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 index e050c864..63ebf9ee 100644 --- a/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 +++ b/amgprec/impl/smoother/amg_z_l1_jac_smoother_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) +subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse,prefix) use psb_base_mod use amg_z_diag_solver @@ -50,12 +50,14 @@ subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) 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_jac_smoother_descr' integer(psb_ipk_) :: iout_ logical :: coarse_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -69,30 +71,35 @@ subroutine amg_z_l1_jac_smoother_descr(sm,info,iout,coarse) else iout_ = psb_out_unit endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if if (.not.coarse_) then if (allocated(sm%sv)) then select type(smv=>sm%sv) class is (amg_z_diag_solver_type) - write(iout_,*) ' Point Jacobi ' - write(iout_,*) ' Local diagonal:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' Point Jacobi ' + write(iout_,*) trim(prefix_), ' Local diagonal:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) class is (amg_z_bwgs_solver_type) - write(iout_,*) ' L1-Hybrid Backward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Backward Gauss-Seidel ' class is (amg_z_gs_solver_type) - write(iout_,*) ' L1-Hybrid Forward Gauss-Seidel ' + write(iout_,*) trim(prefix_), ' L1-Hybrid Forward Gauss-Seidel ' class default - write(iout_,*) ' L1-Block Jacobi ' - write(iout_,*) ' Local solver details:' - call smv%descr(info,iout_,coarse=coarse) + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' Local solver details:' + call smv%descr(info,iout_,coarse=coarse,prefix=prefix) end select else - write(iout_,*) ' L1-Block Jacobi ' + write(iout_,*) trim(prefix_), ' L1-Block Jacobi ' end if else if (allocated(sm%sv)) then - call sm%sv%descr(info,iout_,coarse=coarse) + call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix) end if end if call psb_erractionrestore(err_act) diff --git a/amgprec/impl/solver/Makefile b/amgprec/impl/solver/Makefile index 8a3a3570..f5d5b3c7 100644 --- a/amgprec/impl/solver/Makefile +++ b/amgprec/impl/solver/Makefile @@ -294,14 +294,12 @@ amg_z_krm_solver_impl.o LIBNAME=libamg_prec.a -lib: $(OBJS) +objs: $(OBJS) + +lib: objs $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) -mpobjs: - (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)") - (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") - veryclean: clean /bin/rm -f $(LIBNAME) diff --git a/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 index 9a25435f..8bbdf666 100644 --- a/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) 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_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_c_base_solver_descr.f90 b/amgprec/impl/solver/amg_c_base_solver_descr.f90 index 2d6d0e1a..b768d52b 100644 --- a/amgprec/impl/solver/amg_c_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_base_solver_descr(sv,info,iout,coarse) +subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_c_base_solver_mod, amg_protect_name => amg_c_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_c_base_solver_descr(sv,info,iout,coarse) 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 diff --git a/amgprec/impl/solver/amg_c_invk_solver_descr.f90 b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 index 50b97117..46b79813 100644 --- a/amgprec/impl/solver/amg_c_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) 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_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_c_invt_solver_descr.f90 b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 index cc3b90dc..5a8508c5 100644 --- a/amgprec/impl/solver/amg_c_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) 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_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 index 4205f75b..cca5d2f9 100644 --- a/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) 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_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_base_solver_descr.f90 b/amgprec/impl/solver/amg_d_base_solver_descr.f90 index 5d54523d..46f94c38 100644 --- a/amgprec/impl/solver/amg_d_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_base_solver_descr(sv,info,iout,coarse) +subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_d_base_solver_mod, amg_protect_name => amg_d_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_d_base_solver_descr(sv,info,iout,coarse) 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 diff --git a/amgprec/impl/solver/amg_d_invk_solver_descr.f90 b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 index b8658e8c..3a0633c2 100644 --- a/amgprec/impl/solver/amg_d_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) 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_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_d_invt_solver_descr.f90 b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 index f2f4fba4..33d7b32f 100644 --- a/amgprec/impl/solver/amg_d_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) 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_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 index d6cd87b7..5f39a070 100644 --- a/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) 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_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_base_solver_descr.f90 b/amgprec/impl/solver/amg_s_base_solver_descr.f90 index 25eccf82..ee6f0922 100644 --- a/amgprec/impl/solver/amg_s_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_base_solver_descr(sv,info,iout,coarse) +subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_s_base_solver_mod, amg_protect_name => amg_s_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_s_base_solver_descr(sv,info,iout,coarse) 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 diff --git a/amgprec/impl/solver/amg_s_invk_solver_descr.f90 b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 index 7b38d124..b793b98b 100644 --- a/amgprec/impl/solver/amg_s_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) 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_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_s_invt_solver_descr.f90 b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 index 822c7a3b..d706096c 100644 --- a/amgprec/impl/solver/amg_s_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) 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_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 index 9bc96160..c208e68d 100644 --- a/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) +subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) 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_ainv_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,11 +63,16 @@ subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' - write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) - write(iout_,*) ' Fill level : ',sv%fill_in - write(iout_,*) ' Fill threshold : ',sv%thresh + write(iout_,*) trim(prefix_), ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) trim(prefix_), ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) trim(prefix_), ' Fill level : ',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold : ',sv%thresh call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_base_solver_descr.f90 b/amgprec/impl/solver/amg_z_base_solver_descr.f90 index 3a666273..a2035b02 100644 --- a/amgprec/impl/solver/amg_z_base_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_base_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_base_solver_descr(sv,info,iout,coarse) +subroutine amg_z_base_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_z_base_solver_mod, amg_protect_name => amg_z_base_solver_descr @@ -45,6 +45,7 @@ subroutine amg_z_base_solver_descr(sv,info,iout,coarse) 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 diff --git a/amgprec/impl/solver/amg_z_invk_solver_descr.f90 b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 index 0920e570..9bbd88ac 100644 --- a/amgprec/impl/solver/amg_z_invk_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) +subroutine amg_z_invk_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod @@ -48,11 +48,13 @@ subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) 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_invk_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,10 +63,15 @@ subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/solver/amg_z_invt_solver_descr.f90 b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 index 653f90b1..50f73de2 100644 --- a/amgprec/impl/solver/amg_z_invt_solver_descr.f90 +++ b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 @@ -35,8 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) - +subroutine amg_z_invt_solver_descr(sv,info,iout,coarse,prefix) use psb_base_mod use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_descr @@ -48,11 +47,13 @@ subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) 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_invt_solver_descr' integer(psb_ipk_) :: iout_ + character(1024) :: prefix_ call psb_erractionsave(err_act) info = psb_success_ @@ -61,12 +62,17 @@ subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) else iout_ = 6 endif + if (present(prefix)) then + prefix_ = prefix + else + prefix_ = "" + end if - write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' - write(iout_,*) ' Fill level :',sv%fill_in - write(iout_,*) ' Fill threshold :',sv%thresh - write(iout_,*) ' Inverse fill level :',sv%inv_fill - write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + write(iout_,*) trim(prefix_), ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) trim(prefix_), ' Fill level :',sv%fill_in + write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh + write(iout_,*) trim(prefix_), ' Inverse fill level :',sv%inv_fill + write(iout_,*) trim(prefix_), ' Inverse fill threshold :',sv%inv_thresh call psb_erractionrestore(err_act) return diff --git a/cbind/Makefile b/cbind/Makefile index 377eb5c2..1ae60ded 100644 --- a/cbind/Makefile +++ b/cbind/Makefile @@ -8,19 +8,19 @@ MODDIR=../modules/ LIBNAME=$(CBINDLIBNAME) LIBNAME=libamg_cbind.a -all: lib -lib: amgprecd +objs: amgprecd + +lib: objs + cd amgprec && $(MAKE) lib LIBNAME=$(LIBNAME) /bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR) - /bin/cp -p $(CPUPDFLAG) *.h $(INCDIR) - /bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR) amgprecd: - $(MAKE) -C amgprec lib LIBNAME=$(LIBNAME) + cd amgprec && $(MAKE) objs clean: - $(MAKE) -C amgprec clean + cd amgprec &&$(MAKE) clean veryclean: clean diff --git a/cbind/amgprec/Makefile b/cbind/amgprec/Makefile index 80df067c..1be73280 100644 --- a/cbind/amgprec/Makefile +++ b/cbind/amgprec/Makefile @@ -6,7 +6,7 @@ MODDIR=$(TOP)/modules HERE=. DEST=../ -CINCLUDES=-I. -I$(LIBDIR) -I$(PSBLAS_INCDIR) +CINCLUDES=-I. -I$(INCDIR) -I$(PSBLAS_INCDIR) FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(FMFLAG)$(MODDIR) $(PSBLAS_INCLUDES) @@ -18,12 +18,14 @@ LIBMOD=amg_prec_cbind_mod$(.mod) amg_dprec_cbind_mod$(.mod) amg_zprec_cbind_mod$ LOCAL_MODS=$(LIBMOD) #LIBNAME=$(CPRECLIBNAME) +objs: $(OBJS) + /bin/cp -p $(LIBMOD) $(MODDIR) + /bin/cp -p $(CMOD) $(INCDIR) -lib: $(OBJS) $(CMOD) +lib: objs $(CMOD) $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) /bin/cp -p $(HERE)/$(LIBNAME) $(DEST) - /bin/cp -p $(LIBMOD) $(CMOD) $(DEST) amg_prec_cbind_mod.o: amg_dprec_cbind_mod.o amg_zprec_cbind_mod.o #amg_prec_cbind_mod.o: psb_prec_cbind_mod.o diff --git a/config/pac.m4 b/config/pac.m4 index c26ec2a4..1aca5b77 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -68,8 +68,8 @@ dnl Warning : square brackets are EVIL! [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -106,8 +106,8 @@ dnl Warning : square brackets are EVIL! [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -143,8 +143,8 @@ AC_DEFUN(PAC_CHECK_HAVE_GFORTRAN, [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -178,8 +178,8 @@ AC_DEFUN(PAC_HAVE_MODERN_GFORTRAN, ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) AC_MSG_NOTICE([Sorry, we require GNU Fortran version 4.8.4 or later.]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -213,7 +213,7 @@ AC_DEFUN([PAC_ARG_WITH_FLAGS], AC_MSG_CHECKING([whether additional [$2] flags should be added (should be invoked only once)]) dnl AC_MSG_CHECKING([whether additional [$2] flags should be added]) AC_ARG_WITH($1, -AC_HELP_STRING([--with-$1], +AS_HELP_STRING([--with-$1], [additional [$2] flags to be added: will prepend to [$2]]), [ $2="${withval} ${$2}" @@ -245,7 +245,7 @@ AC_DEFUN([PAC_ARG_WITH_LIBS], [ AC_MSG_CHECKING([whether additional libraries are needed]) AC_ARG_WITH(libs, -AC_HELP_STRING([--with-libs], +AS_HELP_STRING([--with-libs], [List additional link flags here. For example, --with-libs=-lspecial_system_lib or --with-libs=-L/path/to/libs]), [ @@ -279,7 +279,7 @@ AC_DEFUN([PAC_ARG_WITH_EXTRA_LIBS], [ AC_MSG_CHECKING([whether additional libraries are needed]) AC_ARG_WITH(extra-libs, -AC_HELP_STRING([--with-extra-libs], +AS_HELP_STRING([--with-extra-libs], [List additional link flags here. For example, --with-extra-libs=-lspecial_system_lib or --with-extra-libs=-L/path/to/libs]), [ @@ -310,17 +310,17 @@ dnl AC_DEFUN([PAC_ARG_WITH_PSBLAS], [ AC_ARG_WITH(psblas, -AC_HELP_STRING([--with-psblas=DIR], [The install directory for PSBLAS, for example, +AS_HELP_STRING([--with-psblas=DIR], [The install directory for PSBLAS, for example, --with-psblas=/opt/packages/psblas-3.5]), [pac_cv_psblas_dir=$withval], [pac_cv_psblas_dir='']) -AC_ARG_WITH(psblas-incdir, AC_HELP_STRING([--with-psblas-incdir=DIR], [Specify the directory for PSBLAS C includes.]), +AC_ARG_WITH(psblas-incdir, AS_HELP_STRING([--with-psblas-incdir=DIR], [Specify the directory for PSBLAS C includes.]), [pac_cv_psblas_incdir=$withval], [pac_cv_psblas_incdir='']) -AC_ARG_WITH(psblas-moddir, AC_HELP_STRING([--with-psblas-moddir=DIR], [Specify the directory for PSBLAS Fortran modules.]), +AC_ARG_WITH(psblas-moddir, AS_HELP_STRING([--with-psblas-moddir=DIR], [Specify the directory for PSBLAS Fortran modules.]), [pac_cv_psblas_moddir=$withval], [pac_cv_psblas_moddir='']) -AC_ARG_WITH(psblas-libdir, AC_HELP_STRING([--with-psblas-libdir=DIR], [Specify the directory for PSBLAS library.]), +AC_ARG_WITH(psblas-libdir, AS_HELP_STRING([--with-psblas-libdir=DIR], [Specify the directory for PSBLAS library.]), [pac_cv_psblas_libdir=$withval], [pac_cv_psblas_libdir='']) if test x"$pac_cv_psblas_incdir" == "x" ; then @@ -543,17 +543,17 @@ dnl dnl @author Salvatore Filippone dnl AC_DEFUN(PAC_CHECK_UMFPACK, -[AC_ARG_WITH(umfpack, AC_HELP_STRING([--with-umfpack=LIBNAME], [Specify the library name for UMFPACK and its support libraries. +[AC_ARG_WITH(umfpack, AS_HELP_STRING([--with-umfpack=LIBNAME], [Specify the library name for UMFPACK and its support libraries. Default: "-lumfpack -lamd"]), [amg4psblas_cv_umfpack=$withval], [amg4psblas_cv_umfpack='-lumfpack -lamd']) -AC_ARG_WITH(umfpackdir, AC_HELP_STRING([--with-umfpackdir=DIR], [Specify the directory for UMFPACK library and includes.]), +AC_ARG_WITH(umfpackdir, AS_HELP_STRING([--with-umfpackdir=DIR], [Specify the directory for UMFPACK library and includes.]), [amg4psblas_cv_umfpackdir=$withval], [amg4psblas_cv_umfpackdir='']) -AC_ARG_WITH(umfpackincdir, AC_HELP_STRING([--with-umfpackincdir=DIR], [Specify the directory for UMFPACK includes.]), +AC_ARG_WITH(umfpackincdir, AS_HELP_STRING([--with-umfpackincdir=DIR], [Specify the directory for UMFPACK includes.]), [amg4psblas_cv_umfpackincdir=$withval], [amg4psblas_cv_umfpackincdir='']) -AC_ARG_WITH(umfpacklibdir, AC_HELP_STRING([--with-umfpacklibdir=DIR], [Specify the directory for UMFPACK library.]), +AC_ARG_WITH(umfpacklibdir, AS_HELP_STRING([--with-umfpacklibdir=DIR], [Specify the directory for UMFPACK library.]), [amg4psblas_cv_umfpacklibdir=$withval], [amg4psblas_cv_umfpacklibdir='']) @@ -660,17 +660,17 @@ dnl dnl @author Salvatore Filippone dnl AC_DEFUN(PAC_CHECK_SUPERLU, -[AC_ARG_WITH(superlu, AC_HELP_STRING([--with-superlu=LIBNAME], [Specify the library name for SUPERLU library. +[AC_ARG_WITH(superlu, AS_HELP_STRING([--with-superlu=LIBNAME], [Specify the library name for SUPERLU library. Default: "-lsuperlu"]), [amg4psblas_cv_superlu=$withval], [amg4psblas_cv_superlu='-lsuperlu']) -AC_ARG_WITH(superludir, AC_HELP_STRING([--with-superludir=DIR], [Specify the directory for SUPERLU library and includes.]), +AC_ARG_WITH(superludir, AS_HELP_STRING([--with-superludir=DIR], [Specify the directory for SUPERLU library and includes.]), [amg4psblas_cv_superludir=$withval], [amg4psblas_cv_superludir='']) -AC_ARG_WITH(superluincdir, AC_HELP_STRING([--with-superluincdir=DIR], [Specify the directory for SUPERLU includes.]), +AC_ARG_WITH(superluincdir, AS_HELP_STRING([--with-superluincdir=DIR], [Specify the directory for SUPERLU includes.]), [amg4psblas_cv_superluincdir=$withval], [amg4psblas_cv_superluincdir='']) -AC_ARG_WITH(superlulibdir, AC_HELP_STRING([--with-superlulibdir=DIR], [Specify the directory for SUPERLU library.]), +AC_ARG_WITH(superlulibdir, AS_HELP_STRING([--with-superlulibdir=DIR], [Specify the directory for SUPERLU library.]), [amg4psblas_cv_superlulibdir=$withval], [amg4psblas_cv_superlulibdir='']) AC_LANG_PUSH([C]) @@ -779,18 +779,18 @@ dnl dnl @author Salvatore Filippone dnl AC_DEFUN(PAC_CHECK_SUPERLUDIST, -[AC_ARG_WITH(superludist, AC_HELP_STRING([--with-superludist=LIBNAME], [Specify the libname for SUPERLUDIST library. Requires you also specify SuperLU. Default: "-lsuperlu_dist"]), +[AC_ARG_WITH(superludist, AS_HELP_STRING([--with-superludist=LIBNAME], [Specify the libname for SUPERLUDIST library. Requires you also specify SuperLU. Default: "-lsuperlu_dist"]), [amg4psblas_cv_superludist=$withval], [amg4psblas_cv_superludist='-lsuperlu_dist']) -AC_ARG_WITH(superludistdir, AC_HELP_STRING([--with-superludistdir=DIR], [Specify the directory for SUPERLUDIST library and includes.]), +AC_ARG_WITH(superludistdir, AS_HELP_STRING([--with-superludistdir=DIR], [Specify the directory for SUPERLUDIST library and includes.]), [amg4psblas_cv_superludistdir=$withval], [amg4psblas_cv_superludistdir='']) -AC_ARG_WITH(superludistincdir, AC_HELP_STRING([--with-superludistincdir=DIR], [Specify the directory for SUPERLUDIST includes.]), +AC_ARG_WITH(superludistincdir, AS_HELP_STRING([--with-superludistincdir=DIR], [Specify the directory for SUPERLUDIST includes.]), [amg4psblas_cv_superludistincdir=$withval], [amg4psblas_cv_superludistincdir='']) -AC_ARG_WITH(superludistlibdir, AC_HELP_STRING([--with-superludistlibdir=DIR], [Specify the directory for SUPERLUDIST library.]), +AC_ARG_WITH(superludistlibdir, AS_HELP_STRING([--with-superludistlibdir=DIR], [Specify the directory for SUPERLUDIST library.]), [amg4psblas_cv_superludistlibdir=$withval], [amg4psblas_cv_superludistlibdir='']) @@ -852,6 +852,7 @@ if test "x$pac_sludist_header_ok" == "xyes" ; then dnl Maybe lib? SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + AC_MSG_CHECKING([for superlu_malloc_dist in $SLUDIST_LIBS]) AC_TRY_LINK_FUNC(superlu_malloc_dist, [amg4psblas_cv_have_superludist=yes;pac_sludist_lib_ok=yes;], [amg4psblas_cv_have_superludist=no;pac_sludist_lib_ok=no; @@ -861,12 +862,13 @@ if test "x$pac_sludist_header_ok" == "xyes" ; then dnl Maybe lib64? SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib64"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + AC_MSG_CHECKING([for superlu_malloc_dist in $SLUDIST_LIBS]) AC_TRY_LINK_FUNC(superlu_malloc_dist, [amg4psblas_cv_have_superludist=yes;pac_sludist_lib_ok=yes;], [amg4psblas_cv_have_superludist=no;pac_sludist_lib_ok=no; SLUDIST_LIBS="";SLUDIST_INCLUDES=""]) fi - AC_MSG_RESULT($pac_sludist_lib_ok) + AC_MSG_RESULT([$pac_sludist_lib_ok $SLUDIST_LIBS]) fi if test "x$pac_sludist_lib_ok" == "xyes" ; then @@ -954,22 +956,22 @@ dnl dnl @author Salvatore Filippone dnl AC_DEFUN(PAC_CHECK_MUMPS, -[AC_ARG_WITH(mumps, AC_HELP_STRING([--with-mumps=LIBNAME], [Specify the libname for MUMPS. Default: autodetect with minimum "-lmumps_common -lpord"]), +[AC_ARG_WITH(mumps, AS_HELP_STRING([--with-mumps=LIBNAME], [Specify the libname for MUMPS. Default: autodetect with minimum "-lmumps_common -lpord"]), [amg4psblas_cv_mumps=$withval], [amg4psblas_cv_mumps='-lsmumps -ldmumps -lcmumps -lzmumps -lmumps_common -lpord']) - AC_ARG_WITH(mumpsdir, AC_HELP_STRING([--with-mumpsdir=DIR], [Specify the directory for MUMPS library and includes. Note: you will need to add auxiliary libraries with --extra-libs; this depends on how MUMPS was configured and installed, at a minimum you will need SCALAPACK and BLAS]), + AC_ARG_WITH(mumpsdir, AS_HELP_STRING([--with-mumpsdir=DIR], [Specify the directory for MUMPS library and includes. Note: you will need to add auxiliary libraries with --extra-libs; this depends on how MUMPS was configured and installed, at a minimum you will need SCALAPACK and BLAS]), [amg4psblas_cv_mumpsdir=$withval], [amg4psblas_cv_mumpsdir='']) -AC_ARG_WITH(mumpsincdir, AC_HELP_STRING([--with-mumpsincdir=DIR], [Specify the directory for MUMPS includes.]), +AC_ARG_WITH(mumpsincdir, AS_HELP_STRING([--with-mumpsincdir=DIR], [Specify the directory for MUMPS includes.]), [amg4psblas_cv_mumpsincdir=$withval], [amg4psblas_cv_mumpsincdir='']) -AC_ARG_WITH(mumpsmoddir, AC_HELP_STRING([--with-mumpsmoddir=DIR], [Specify the directory for MUMPS Fortran modules.]), +AC_ARG_WITH(mumpsmoddir, AS_HELP_STRING([--with-mumpsmoddir=DIR], [Specify the directory for MUMPS Fortran modules.]), [amg4psblas_cv_mumpsmoddir=$withval], [amg4psblas_cv_mumpsmoddir='']) -AC_ARG_WITH(mumpslibdir, AC_HELP_STRING([--with-mumpslibdir=DIR], [Specify the directory for MUMPS library.]), +AC_ARG_WITH(mumpslibdir, AS_HELP_STRING([--with-mumpslibdir=DIR], [Specify the directory for MUMPS library.]), [amg4psblas_cv_mumpslibdir=$withval], [amg4psblas_cv_mumpslibdir='']) @@ -1190,7 +1192,7 @@ dnl AC_DEFUN([PAC_ARG_SERIAL_MPI], [AC_MSG_CHECKING([whether we want serial mpi stubs]) AC_ARG_ENABLE(serial, -AC_HELP_STRING([--enable-serial], +AS_HELP_STRING([--enable-serial], [Specify whether to enable a fake mpi library to run in serial mode. ]), [ pac_cv_serial_mpi="yes"; @@ -1231,8 +1233,8 @@ AC_DEFUN(PAC_FORTRAN_CHECK_HAVE_MPI_MOD, [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1274,8 +1276,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1296,7 +1298,7 @@ AC_DEFUN([PAC_ARG_LONG_INTEGERS], [ AC_MSG_CHECKING([whether we want long (8 bytes) integers]) AC_ARG_ENABLE(long-integers, -AC_HELP_STRING([--enable-long-integers], +AS_HELP_STRING([--enable-long-integers], [Specify usage of 64 bits integers. ]), [ pac_cv_long_integers="yes"; @@ -1366,8 +1368,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1411,8 +1413,8 @@ end program xtt], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1442,8 +1444,8 @@ dnl Warning : square brackets are EVIL! [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1478,8 +1480,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1515,8 +1517,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1578,8 +1580,8 @@ end module conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1617,8 +1619,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1647,8 +1649,8 @@ AC_DEFUN(PAC_FORTRAN_TEST_ISO_FORTRAN_ENV, [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1697,8 +1699,8 @@ end program conftest], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1742,8 +1744,8 @@ end program stt], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1785,8 +1787,8 @@ end program xtt], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1830,8 +1832,8 @@ end program xtt], [ AC_MSG_RESULT([yes]) ifelse([$1], , :, [ $1])], [ AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD ifelse([$2], , , [ $2])]) AC_LANG_POP([Fortran]) ]) @@ -1889,7 +1891,7 @@ dnl AC_REQUIRE([AC_FC_LIBRARY_LDFLAGS]) pac_blas_ok=no AC_ARG_WITH(blas, - [AC_HELP_STRING([--with-blas=], [use BLAS library ])]) + [AS_HELP_STRING([--with-blas=], [use BLAS library ])]) case $with_blas in yes | "") ;; no) pac_blas_ok=disable ;; @@ -1897,7 +1899,7 @@ case $with_blas in *) BLAS_LIBS="-l$with_blas" ;; esac AC_ARG_WITH(blasdir, - [AC_HELP_STRING([--with-blasdir=], [search for BLAS library in ])]) + [AS_HELP_STRING([--with-blasdir=], [search for BLAS library in ])]) case $with_blasdir in "") ;; *) if test -d $with_blasdir; then @@ -2090,7 +2092,7 @@ AC_REQUIRE([PAC_BLAS]) pac_lapack_ok=no AC_ARG_WITH(lapack, - [AC_HELP_STRING([--with-lapack=], [use LAPACK library ])]) + [AS_HELP_STRING([--with-lapack=], [use LAPACK library ])]) case $with_lapack in yes | "") ;; no) pac_lapack_ok=disable ;; @@ -2122,8 +2124,8 @@ EOF AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD fi rm -f conftest* LIBS="$save_LIBS" @@ -2149,8 +2151,8 @@ EOF AC_MSG_RESULT([yes]) else AC_MSG_RESULT([no]) - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC + echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD + cat conftest.$ac_ext >&AS_MESSAGE_LOG_FD fi rm -f conftest* LIBS="$save_LIBS" @@ -2197,7 +2199,7 @@ AC_DEFUN([PAC_ARG_WITH_IPK], [ AC_MSG_CHECKING([what size in bytes we want for local indices and data]) AC_ARG_WITH(ipk, - AC_HELP_STRING([--with-ipk=], + AS_HELP_STRING([--with-ipk=], [Specify the size in bytes for local indices and data, default 4 bytes. ]), [pac_cv_ipk_size=$withval;], [pac_cv_ipk_size=4;] @@ -2226,7 +2228,7 @@ AC_DEFUN([PAC_ARG_WITH_LPK], [ AC_MSG_CHECKING([what size in bytes we want for global indices and data]) AC_ARG_WITH(lpk, - AC_HELP_STRING([--with-lpk=], + AS_HELP_STRING([--with-lpk=], [Specify the size in bytes for global indices and data, default 8 bytes. ]), [pac_cv_lpk_size=$withval;], [pac_cv_lpk_size=8;] @@ -2256,20 +2258,20 @@ dnl dnl @author Salvatore Filippone dnl AC_DEFUN(PAC_CHECK_METIS, -[AC_ARG_WITH(metis, AC_HELP_STRING([--with-metis=LIBNAME], [Specify the library name for METIS library. +[AC_ARG_WITH(metis, AS_HELP_STRING([--with-metis=LIBNAME], [Specify the library name for METIS library. Default: "-lmetis"]), [psblas_cv_metis=$withval], [psblas_cv_metis='-lmetis']) -AC_ARG_WITH(metisincfile, AC_HELP_STRING([--with-metisincfile=DIR], [Specify the name for METIS include file.]), +AC_ARG_WITH(metisincfile, AS_HELP_STRING([--with-metisincfile=DIR], [Specify the name for METIS include file.]), [psblas_cv_metisincfile=$withval], [psblas_cv_metisincfile='metis.h']) -AC_ARG_WITH(metisdir, AC_HELP_STRING([--with-metisdir=DIR], [Specify the directory for METIS library and includes.]), +AC_ARG_WITH(metisdir, AS_HELP_STRING([--with-metisdir=DIR], [Specify the directory for METIS library and includes.]), [psblas_cv_metisdir=$withval], [psblas_cv_metisdir='']) -AC_ARG_WITH(metisincdir, AC_HELP_STRING([--with-metisincdir=DIR], [Specify the directory for METIS includes.]), +AC_ARG_WITH(metisincdir, AS_HELP_STRING([--with-metisincdir=DIR], [Specify the directory for METIS includes.]), [psblas_cv_metisincdir=$withval], [psblas_cv_metisincdir='']) -AC_ARG_WITH(metislibdir, AC_HELP_STRING([--with-metislibdir=DIR], [Specify the directory for METIS library.]), +AC_ARG_WITH(metislibdir, AS_HELP_STRING([--with-metislibdir=DIR], [Specify the directory for METIS library.]), [psblas_cv_metislibdir=$withval], [psblas_cv_metislibdir='']) diff --git a/configure b/configure index cedf2c1e..4d7ac45a 100755 --- a/configure +++ b/configure @@ -658,9 +658,16 @@ LAPACK_LIBS EGREP GREP CPP +MPICXX MPIFC MPILIBS MPICC +am__fastdepCXX_FALSE +am__fastdepCXX_TRUE +CXXDEPMODE +ac_ct_CXX +CXXFLAGS +CXX am__fastdepCC_FALSE am__fastdepCC_TRUE CCDEPMODE @@ -726,6 +733,7 @@ infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -757,10 +765,12 @@ enable_silent_rules enable_dependency_tracking enable_serial with_ccopt +with_cxxopt with_fcopt with_libs with_clibs with_flibs +with_cxxlibs with_library_path with_include_path with_module_path @@ -796,8 +806,12 @@ LIBS CC CFLAGS CPPFLAGS +CXX +CXXFLAGS +CCC MPICC MPIFC +MPICXX CPP' @@ -837,6 +851,7 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -1089,6 +1104,15 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1226,7 +1250,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1379,6 +1403,7 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] @@ -1435,6 +1460,8 @@ Optional Packages: Specify the directory for PSBLAS library. --with-ccopt additional [CCOPT] flags to be added: will prepend to [CCOPT] + --with-cxxopt additional [CXXOPT] flags to be added: will prepend + to [CXXOPT] --with-fcopt additional [FCOPT] flags to be added: will prepend to [FCOPT] --with-libs List additional link flags here. For example, @@ -1444,6 +1471,8 @@ Optional Packages: to [CLIBS] --with-flibs additional [FLIBS] flags to be added: will prepend to [FLIBS] + --with-cxxlibs additional [CXXLIBS] flags to be added: will prepend + to [CXXLIBS] --with-library-path additional [LIBRARYPATH] flags to be added: will prepend to [LIBRARYPATH] --with-include-path additional [INCLUDEPATH] flags to be added: will @@ -1504,8 +1533,11 @@ Some influential environment variables: CFLAGS C compiler flags CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory + CXX C++ compiler command + CXXFLAGS C++ compiler flags MPICC MPI C compiler command MPIFC MPI Fortran compiler command + MPICXX MPI C++ compiler command CPP C preprocessor Use these variables to override the choices made by `configure' or to help @@ -1664,6 +1696,44 @@ fi } # ac_fn_c_try_compile +# ac_fn_cxx_try_compile LINENO +# ---------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_compile + # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. @@ -1823,6 +1893,119 @@ fi } # ac_fn_fc_try_link +# ac_fn_cxx_try_link LINENO +# ------------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_cxx_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_cxx_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_cxx_try_link + +# ac_fn_cxx_check_func LINENO FUNC VAR +# ------------------------------------ +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_cxx_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_cxx_check_func + # ac_fn_c_try_run LINENO # ---------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. Assumes @@ -4354,82 +4537,28 @@ fi CFLAGS="$save_CFLAGS"; - - -# Sanity checks, although redundant (useful when debugging this configure.ac)! -if test "X$FC" == "X" ; then - as_fn_error $? "Problem : No Fortran compiler specified nor found!" "$LINENO" 5 -fi - -if test "X$CC" == "X" ; then - as_fn_error $? "Problem : No C compiler specified nor found!" "$LINENO" 5 -fi -if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then - # Some configurations of the XLF want "-WF," prepended to -D.. flags. - # TODO : discover the exact conditions when the usage of -WF is needed. - amg_cv_define_prepend="-WF," - if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then - FDEFINES="$amg_cv_define_prepend-DXLF_10 $FDEFINES" - fi - - # Note : there could be problems with old xlf compiler versions ( <10.1 ) - # since (as far as it is known to us) -WF, is not used in earlier versions. - # More problems could be undocumented yet. -fi -############################################################################### -# Suitable MPI compilers detection -############################################################################### -# Note: Someday we will contemplate a fake MPI - configured version of PSBLAS -############################################################################### -# First check whether the user required our serial (fake) mpi. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we want serial mpi stubs" >&5 -$as_echo_n "checking whether we want serial mpi stubs... " >&6; } -# Check whether --enable-serial was given. -if test "${enable_serial+set}" = set; then : - enableval=$enable_serial; -pac_cv_serial_mpi="yes"; - - -fi - -if test x"$pac_cv_serial_mpi" == x"yes" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes." >&5 -$as_echo "yes." >&6; } -else - pac_cv_serial_mpi="no"; - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no." >&5 -$as_echo "no." >&6; } -fi - - - -#Note : we miss the name of the Intel C compiler -if test x"$pac_cv_serial_mpi" == x"yes" ; then - FAKEMPI="fakempi.o"; - MPIFC="$FC"; - MPICC="$CC"; - CXXDEFINES="-DSERIAL_MPI $CXXDEFINES"; - -else -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - -if test "X$MPICC" = "X" ; then - # This is our MPICC compiler preference: it will override ACX_MPI's first try. - for ac_prog in mpxlc mpiicc mpcc mpicc cc -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 +save_CXXFLAGS="$CXXFLAGS"; +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu +if test -z "$CXX"; then + if test -n "$CCC"; then + CXX=$CCC + else + if test -n "$ac_tool_prefix"; then + for ac_prog in CC xlc++ icpc g++ + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_MPICC+:} false; then : +if ${ac_cv_prog_CXX+:} false; then : $as_echo_n "(cached) " >&6 else - if test -n "$MPICC"; then - ac_cv_prog_MPICC="$MPICC" # Let the user override the test. + if test -n "$CXX"; then + ac_cv_prog_CXX="$CXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH @@ -4438,7 +4567,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_MPICC="$ac_prog" + ac_cv_prog_CXX="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -4448,37 +4577,32 @@ IFS=$as_save_IFS fi fi -MPICC=$ac_cv_prog_MPICC -if test -n "$MPICC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICC" >&5 -$as_echo "$MPICC" >&6; } +CXX=$ac_cv_prog_CXX +if test -n "$CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CXX" >&5 +$as_echo "$CXX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi - test -n "$MPICC" && break -done - + test -n "$CXX" && break + done fi - - - - - - - for ac_prog in mpicc hcc mpxlc_r mpxlc mpcc cmpicc +if test -z "$CXX"; then + ac_ct_CXX=$CXX + for ac_prog in CC xlc++ icpc g++ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_MPICC+:} false; then : +if ${ac_cv_prog_ac_ct_CXX+:} false; then : $as_echo_n "(cached) " >&6 else - if test -n "$MPICC"; then - ac_cv_prog_MPICC="$MPICC" # Let the user override the test. + if test -n "$ac_ct_CXX"; then + ac_cv_prog_ac_ct_CXX="$ac_ct_CXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH @@ -4487,7 +4611,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_MPICC="$ac_prog" + ac_cv_prog_ac_ct_CXX="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -4497,33 +4621,1093 @@ IFS=$as_save_IFS fi fi -MPICC=$ac_cv_prog_MPICC -if test -n "$MPICC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICC" >&5 -$as_echo "$MPICC" >&6; } +ac_ct_CXX=$ac_cv_prog_ac_ct_CXX +if test -n "$ac_ct_CXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CXX" >&5 +$as_echo "$ac_ct_CXX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi - test -n "$MPICC" && break + test -n "$ac_ct_CXX" && break done -test -n "$MPICC" || MPICC="$CC" - - acx_mpi_save_CC="$CC" - CC="$MPICC" - - -if test x = x"$MPILIBS"; then - ac_fn_c_check_func "$LINENO" "MPI_Init" "ac_cv_func_MPI_Init" -if test "x$ac_cv_func_MPI_Init" = xyes; then : - MPILIBS=" " + if test "x$ac_ct_CXX" = x; then + CXX="g++" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CXX=$ac_ct_CXX + fi fi + fi +fi +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C++ compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C++ compiler" >&5 +$as_echo_n "checking whether we are using the GNU C++ compiler... " >&6; } +if ${ac_cv_cxx_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_cxx_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cxx_compiler_gnu" >&5 +$as_echo "$ac_cv_cxx_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GXX=yes +else + GXX= +fi +ac_test_CXXFLAGS=${CXXFLAGS+set} +ac_save_CXXFLAGS=$CXXFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CXX accepts -g" >&5 +$as_echo_n "checking whether $CXX accepts -g... " >&6; } +if ${ac_cv_prog_cxx_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_cxx_werror_flag=$ac_cxx_werror_flag + ac_cxx_werror_flag=yes + ac_cv_prog_cxx_g=no + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +else + CXXFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + +else + ac_cxx_werror_flag=$ac_save_cxx_werror_flag + CXXFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_compile "$LINENO"; then : + ac_cv_prog_cxx_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cxx_werror_flag=$ac_save_cxx_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cxx_g" >&5 +$as_echo "$ac_cv_prog_cxx_g" >&6; } +if test "$ac_test_CXXFLAGS" = set; then + CXXFLAGS=$ac_save_CXXFLAGS +elif test $ac_cv_prog_cxx_g = yes; then + if test "$GXX" = yes; then + CXXFLAGS="-g -O2" + else + CXXFLAGS="-g" + fi +else + if test "$GXX" = yes; then + CXXFLAGS="-O2" + else + CXXFLAGS= + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +depcc="$CXX" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CXX_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CXX_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CXX_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CXX_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CXX_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CXX_dependencies_compiler_type" >&6; } +CXXDEPMODE=depmode=$am_cv_CXX_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CXX_dependencies_compiler_type" = gcc3; then + am__fastdepCXX_TRUE= + am__fastdepCXX_FALSE='#' +else + am__fastdepCXX_TRUE='#' + am__fastdepCXX_FALSE= +fi + + +CXXFLAGS="$save_CXXFLAGS"; + + +# Sanity checks, although redundant (useful when debugging this configure.ac)! +if test "X$FC" == "X" ; then + as_fn_error $? "Problem : No Fortran compiler specified nor found!" "$LINENO" 5 +fi + +if test "X$CC" == "X" ; then + as_fn_error $? "Problem : No C compiler specified nor found!" "$LINENO" 5 +fi +if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then + # Some configurations of the XLF want "-WF," prepended to -D.. flags. + # TODO : discover the exact conditions when the usage of -WF is needed. + amg_cv_define_prepend="-WF," + if eval "$MPIFC -qversion 2>&1 | grep -e\"Version: 10\.\" 2>/dev/null"; then + FDEFINES="$amg_cv_define_prepend-DXLF_10 $FDEFINES" + fi + + # Note : there could be problems with old xlf compiler versions ( <10.1 ) + # since (as far as it is known to us) -WF, is not used in earlier versions. + # More problems could be undocumented yet. +fi + +if test "X$CC" == "X" ; then + as_fn_error $? "Problem : No C compiler specified nor found!" "$LINENO" 5 +fi + case $ac_cv_prog_cc_stdc in #( + no) : + ac_cv_prog_cc_c99=no; ac_cv_prog_cc_c89=no ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C99" >&5 +$as_echo_n "checking for $CC option to accept ISO C99... " >&6; } +if ${ac_cv_prog_cc_c99+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include +#include + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +#define debug(...) fprintf (stderr, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + your preprocessor is broken; +#endif +#if BIG_OK +#else + your preprocessor is broken; +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\0'; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static void +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str; + int number; + float fnumber; + + while (*format) + { + switch (*format++) + { + case 's': // string + str = va_arg (args_copy, const char *); + break; + case 'd': // int + number = va_arg (args_copy, int); + break; + case 'f': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); +} + +int +main () +{ + + // Check bool. + _Bool success = false; + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + test_varargs ("s, d' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + return (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == 'x' + || dynamic_array[ni.number - 1] != 543); + + ; + return 0; +} +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc99 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c99" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c99" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +$as_echo "$ac_cv_prog_cc_c99" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c99" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 +else + ac_cv_prog_cc_stdc=no +fi + +fi + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO Standard C" >&5 +$as_echo_n "checking for $CC option to accept ISO Standard C... " >&6; } + if ${ac_cv_prog_cc_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +fi + + case $ac_cv_prog_cc_stdc in #( + no) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; #( + '') : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_stdc" >&5 +$as_echo "$ac_cv_prog_cc_stdc" >&6; } ;; +esac + +if test "x$ac_cv_prog_cc_stdc" == "xno" ; then + as_fn_error $? "Problem : Need a C99 compiler ! " "$LINENO" 5 +else + C99OPT="$ac_cv_prog_cc_stdc"; +fi +############################################################################### +# Suitable MPI compilers detection +############################################################################### +# Note: Someday we will contemplate a fake MPI - configured version of PSBLAS +############################################################################### +# First check whether the user required our serial (fake) mpi. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we want serial mpi stubs" >&5 +$as_echo_n "checking whether we want serial mpi stubs... " >&6; } +# Check whether --enable-serial was given. +if test "${enable_serial+set}" = set; then : + enableval=$enable_serial; +pac_cv_serial_mpi="yes"; + + +fi + +if test x"$pac_cv_serial_mpi" == x"yes" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes." >&5 +$as_echo "yes." >&6; } +else + pac_cv_serial_mpi="no"; + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no." >&5 +$as_echo "no." >&6; } +fi + + + +#Note : we miss the name of the Intel C compiler +if test x"$pac_cv_serial_mpi" == x"yes" ; then + FAKEMPI="fakempi.o"; + MPIFC="$FC"; + MPICC="$CC"; + MPICXX="$CXX"; + CXXDEFINES="-DSERIAL_MPI $CXXDEFINES"; + +else +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test "X$MPICC" = "X" ; then + # This is our MPICC compiler preference: it will override ACX_MPI's first try. + for ac_prog in mpxlc mpiicc mpcc mpicc cc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MPICC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MPICC"; then + ac_cv_prog_MPICC="$MPICC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MPICC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MPICC=$ac_cv_prog_MPICC +if test -n "$MPICC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICC" >&5 +$as_echo "$MPICC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MPICC" && break +done + +fi + + + + + + + for ac_prog in mpicc hcc mpxlc_r mpxlc mpcc cmpicc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MPICC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MPICC"; then + ac_cv_prog_MPICC="$MPICC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MPICC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MPICC=$ac_cv_prog_MPICC +if test -n "$MPICC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICC" >&5 +$as_echo "$MPICC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MPICC" && break +done +test -n "$MPICC" || MPICC="$CC" + + acx_mpi_save_CC="$CC" + CC="$MPICC" + + + +if test x = x"$MPILIBS"; then + ac_fn_c_check_func "$LINENO" "MPI_Init" "ac_cv_func_MPI_Init" +if test "x$ac_cv_func_MPI_Init" = xyes; then : + MPILIBS=" " +fi + +fi + +if test x = x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpi" >&5 +$as_echo_n "checking for MPI_Init in -lmpi... " >&6; } +if ${ac_cv_lib_mpi_MPI_Init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lmpi $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char MPI_Init (); +int +main () +{ +return MPI_Init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_mpi_MPI_Init=yes +else + ac_cv_lib_mpi_MPI_Init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpi_MPI_Init" >&5 +$as_echo "$ac_cv_lib_mpi_MPI_Init" >&6; } +if test "x$ac_cv_lib_mpi_MPI_Init" = xyes; then : + MPILIBS="-lmpi" +fi + +fi +if test x = x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpich" >&5 +$as_echo_n "checking for MPI_Init in -lmpich... " >&6; } +if ${ac_cv_lib_mpich_MPI_Init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lmpich $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char MPI_Init (); +int +main () +{ +return MPI_Init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_mpich_MPI_Init=yes +else + ac_cv_lib_mpich_MPI_Init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpich_MPI_Init" >&5 +$as_echo "$ac_cv_lib_mpich_MPI_Init" >&6; } +if test "x$ac_cv_lib_mpich_MPI_Init" = xyes; then : + MPILIBS="-lmpich" +fi + +fi + +if test x != x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpi.h" >&5 +$as_echo_n "checking for mpi.h... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + MPILIBS="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +CC="$acx_mpi_save_CC" + + + +# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: +if test x = x"$MPILIBS"; then + as_fn_error $? "Cannot find any suitable MPI implementation for C" "$LINENO" 5 + : +else + +$as_echo "#define HAVE_MPI 1" >>confdefs.h + + : +fi + + + +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + +if test "X$MPIFC" = "X" ; then + # This is our MPIFC compiler preference: it will override ACX_MPI's first try. + for ac_prog in mpxlf2003_r mpxlf2003 mpxlf95_r mpxlf90 mpiifort mpf95 mpf90 mpifort mpif95 mpif90 ftn +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MPIFC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MPIFC"; then + ac_cv_prog_MPIFC="$MPIFC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MPIFC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MPIFC=$ac_cv_prog_MPIFC +if test -n "$MPIFC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIFC" >&5 +$as_echo "$MPIFC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MPIFC" && break +done + +fi + + + + + + + + for ac_prog in mpif90 hf90 mpxlf90 mpxlf95 mpf90 cmpifc cmpif90c +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_MPIFC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$MPIFC"; then + ac_cv_prog_MPIFC="$MPIFC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_MPIFC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +MPIFC=$ac_cv_prog_MPIFC +if test -n "$MPIFC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIFC" >&5 +$as_echo "$MPIFC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$MPIFC" && break +done +test -n "$MPIFC" || MPIFC="$FC" + + acx_mpi_save_FC="$FC" + FC="$MPIFC" + + + +if test x = x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init" >&5 +$as_echo_n "checking for MPI_Init... " >&6; } + cat > conftest.$ac_ext <<_ACEOF + program main + call MPI_Init + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + MPILIBS=" " + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi + + if test x = x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lfmpi" >&5 +$as_echo_n "checking for MPI_Init in -lfmpi... " >&6; } +if ${ac_cv_lib_fmpi_MPI_Init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lfmpi $LIBS" +cat > conftest.$ac_ext <<_ACEOF + program main + call MPI_Init + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + ac_cv_lib_fmpi_MPI_Init=yes +else + ac_cv_lib_fmpi_MPI_Init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fmpi_MPI_Init" >&5 +$as_echo "$ac_cv_lib_fmpi_MPI_Init" >&6; } +if test "x$ac_cv_lib_fmpi_MPI_Init" = xyes; then : + MPILIBS="-lfmpi" +fi + + fi + if test x = x"$MPILIBS"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpichf90" >&5 +$as_echo_n "checking for MPI_Init in -lmpichf90... " >&6; } +if ${ac_cv_lib_mpichf90_MPI_Init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lmpichf90 $LIBS" +cat > conftest.$ac_ext <<_ACEOF + program main + call MPI_Init + end +_ACEOF +if ac_fn_fc_try_link "$LINENO"; then : + ac_cv_lib_mpichf90_MPI_Init=yes +else + ac_cv_lib_mpichf90_MPI_Init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpichf90_MPI_Init" >&5 +$as_echo "$ac_cv_lib_mpichf90_MPI_Init" >&6; } +if test "x$ac_cv_lib_mpichf90_MPI_Init" = xyes; then : + MPILIBS="-lmpichf90" fi + fi + if test x = x"$MPILIBS"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpi" >&5 $as_echo_n "checking for MPI_Init in -lmpi... " >&6; } @@ -4532,25 +5716,12 @@ if ${ac_cv_lib_mpi_MPI_Init+:} false; then : else ac_check_lib_save_LIBS=$LIBS LIBS="-lmpi $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char MPI_Init (); -int -main () -{ -return MPI_Init (); - ; - return 0; -} +cat > conftest.$ac_ext <<_ACEOF + program main + call MPI_Init + end _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +if ac_fn_fc_try_link "$LINENO"; then : ac_cv_lib_mpi_MPI_Init=yes else ac_cv_lib_mpi_MPI_Init=no @@ -4574,25 +5745,12 @@ if ${ac_cv_lib_mpich_MPI_Init+:} false; then : else ac_check_lib_save_LIBS=$LIBS LIBS="-lmpich $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char MPI_Init (); -int -main () -{ -return MPI_Init (); - ; - return 0; -} +cat > conftest.$ac_ext <<_ACEOF + program main + call MPI_Init + end _ACEOF -if ac_fn_c_try_link "$LINENO"; then : +if ac_fn_fc_try_link "$LINENO"; then : ac_cv_lib_mpich_MPI_Init=yes else ac_cv_lib_mpich_MPI_Init=no @@ -4610,20 +5768,14 @@ fi fi if test x != x"$MPILIBS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpi.h" >&5 -$as_echo_n "checking for mpi.h... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - - ; - return 0; -} + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpif.h" >&5 +$as_echo_n "checking for mpif.h... " >&6; } + cat > conftest.$ac_ext <<_ACEOF + program main + include 'mpif.h' + end _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : +if ac_fn_fc_try_compile "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else @@ -4634,13 +5786,13 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -CC="$acx_mpi_save_CC" +FC="$acx_mpi_save_FC" # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test x = x"$MPILIBS"; then - as_fn_error $? "Cannot find any suitable MPI implementation for C" "$LINENO" 5 + as_fn_error $? "Cannot find any suitable MPI implementation for Fortran" "$LINENO" 5 : else @@ -4649,27 +5801,25 @@ $as_echo "#define HAVE_MPI 1" >>confdefs.h : fi +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu - -ac_ext=${ac_fc_srcext-f} -ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' -ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_fc_compiler_gnu - - -if test "X$MPIFC" = "X" ; then - # This is our MPIFC compiler preference: it will override ACX_MPI's first try. - for ac_prog in mpxlf2003_r mpxlf2003 mpxlf95_r mpxlf90 mpiifort mpf95 mpf90 mpifort mpif95 mpif90 ftn +if test "X$MPICXX" = "X" ; then + # This is our MPICC compiler preference: it will override ACX_MPI's first try. + for ac_prog in mpxlc++ mpiicpc mpicxx do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_MPIFC+:} false; then : +if ${ac_cv_prog_MPICXX+:} false; then : $as_echo_n "(cached) " >&6 else - if test -n "$MPIFC"; then - ac_cv_prog_MPIFC="$MPIFC" # Let the user override the test. + if test -n "$MPICXX"; then + ac_cv_prog_MPICXX="$MPICXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH @@ -4678,7 +5828,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_MPIFC="$ac_prog" + ac_cv_prog_MPICXX="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -4687,18 +5837,18 @@ done IFS=$as_save_IFS fi -fi -MPIFC=$ac_cv_prog_MPIFC -if test -n "$MPIFC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIFC" >&5 -$as_echo "$MPIFC" >&6; } +fi +MPICXX=$ac_cv_prog_MPICXX +if test -n "$MPICXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICXX" >&5 +$as_echo "$MPICXX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi - test -n "$MPIFC" && break + test -n "$MPICXX" && break done fi @@ -4708,18 +5858,17 @@ fi - - for ac_prog in mpif90 hf90 mpxlf90 mpxlf95 mpf90 cmpifc cmpif90c + for ac_prog in mpic++ mpicxx mpiCC hcp mpxlC_r mpxlC mpCC cmpic++ do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_MPIFC+:} false; then : +if ${ac_cv_prog_MPICXX+:} false; then : $as_echo_n "(cached) " >&6 else - if test -n "$MPIFC"; then - ac_cv_prog_MPIFC="$MPIFC" # Let the user override the test. + if test -n "$MPICXX"; then + ac_cv_prog_MPICXX="$MPICXX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH @@ -4728,7 +5877,7 @@ do test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_MPIFC="$ac_prog" + ac_cv_prog_MPICXX="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi @@ -4738,104 +5887,33 @@ IFS=$as_save_IFS fi fi -MPIFC=$ac_cv_prog_MPIFC -if test -n "$MPIFC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIFC" >&5 -$as_echo "$MPIFC" >&6; } +MPICXX=$ac_cv_prog_MPICXX +if test -n "$MPICXX"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPICXX" >&5 +$as_echo "$MPICXX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi - test -n "$MPIFC" && break + test -n "$MPICXX" && break done -test -n "$MPIFC" || MPIFC="$FC" +test -n "$MPICXX" || MPICXX="$CXX" - acx_mpi_save_FC="$FC" - FC="$MPIFC" + acx_mpi_save_CXX="$CXX" + CXX="$MPICXX" if test x = x"$MPILIBS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init" >&5 -$as_echo_n "checking for MPI_Init... " >&6; } - cat > conftest.$ac_ext <<_ACEOF - program main - call MPI_Init - end -_ACEOF -if ac_fn_fc_try_link "$LINENO"; then : + ac_fn_cxx_check_func "$LINENO" "MPI_Init" "ac_cv_func_MPI_Init" +if test "x$ac_cv_func_MPI_Init" = xyes; then : MPILIBS=" " - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - if test x = x"$MPILIBS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lfmpi" >&5 -$as_echo_n "checking for MPI_Init in -lfmpi... " >&6; } -if ${ac_cv_lib_fmpi_MPI_Init+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lfmpi $LIBS" -cat > conftest.$ac_ext <<_ACEOF - program main - call MPI_Init - end -_ACEOF -if ac_fn_fc_try_link "$LINENO"; then : - ac_cv_lib_fmpi_MPI_Init=yes -else - ac_cv_lib_fmpi_MPI_Init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fmpi_MPI_Init" >&5 -$as_echo "$ac_cv_lib_fmpi_MPI_Init" >&6; } -if test "x$ac_cv_lib_fmpi_MPI_Init" = xyes; then : - MPILIBS="-lfmpi" fi - fi - if test x = x"$MPILIBS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpichf90" >&5 -$as_echo_n "checking for MPI_Init in -lmpichf90... " >&6; } -if ${ac_cv_lib_mpichf90_MPI_Init+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lmpichf90 $LIBS" -cat > conftest.$ac_ext <<_ACEOF - program main - call MPI_Init - end -_ACEOF -if ac_fn_fc_try_link "$LINENO"; then : - ac_cv_lib_mpichf90_MPI_Init=yes -else - ac_cv_lib_mpichf90_MPI_Init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpichf90_MPI_Init" >&5 -$as_echo "$ac_cv_lib_mpichf90_MPI_Init" >&6; } -if test "x$ac_cv_lib_mpichf90_MPI_Init" = xyes; then : - MPILIBS="-lmpichf90" fi - fi - if test x = x"$MPILIBS"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpi" >&5 $as_echo_n "checking for MPI_Init in -lmpi... " >&6; } @@ -4844,12 +5922,25 @@ if ${ac_cv_lib_mpi_MPI_Init+:} false; then : else ac_check_lib_save_LIBS=$LIBS LIBS="-lmpi $LIBS" -cat > conftest.$ac_ext <<_ACEOF - program main - call MPI_Init - end +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char MPI_Init (); +int +main () +{ +return MPI_Init (); + ; + return 0; +} _ACEOF -if ac_fn_fc_try_link "$LINENO"; then : +if ac_fn_cxx_try_link "$LINENO"; then : ac_cv_lib_mpi_MPI_Init=yes else ac_cv_lib_mpi_MPI_Init=no @@ -4873,12 +5964,25 @@ if ${ac_cv_lib_mpich_MPI_Init+:} false; then : else ac_check_lib_save_LIBS=$LIBS LIBS="-lmpich $LIBS" -cat > conftest.$ac_ext <<_ACEOF - program main - call MPI_Init - end +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char MPI_Init (); +int +main () +{ +return MPI_Init (); + ; + return 0; +} _ACEOF -if ac_fn_fc_try_link "$LINENO"; then : +if ac_fn_cxx_try_link "$LINENO"; then : ac_cv_lib_mpich_MPI_Init=yes else ac_cv_lib_mpich_MPI_Init=no @@ -4896,14 +6000,20 @@ fi fi if test x != x"$MPILIBS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpif.h" >&5 -$as_echo_n "checking for mpif.h... " >&6; } - cat > conftest.$ac_ext <<_ACEOF - program main - include 'mpif.h' - end + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpi.h" >&5 +$as_echo_n "checking for mpi.h... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ + + ; + return 0; +} _ACEOF -if ac_fn_fc_try_compile "$LINENO"; then : +if ac_fn_cxx_try_compile "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else @@ -4914,13 +6024,13 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -FC="$acx_mpi_save_FC" +CXX="$acx_mpi_save_CXX" # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test x = x"$MPILIBS"; then - as_fn_error $? "Cannot find any suitable MPI implementation for Fortran" "$LINENO" 5 + as_fn_error $? "Cannot find any suitable MPI implementation for C++" "$LINENO" 5 : else @@ -4929,9 +6039,15 @@ $as_echo "#define HAVE_MPI 1" >>confdefs.h : fi +ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + FC="$MPIFC" ; CC="$MPICC"; +CXX="$MPICXX"; fi ac_ext=c @@ -4977,6 +6093,24 @@ fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether additional CXXOPT flags should be added (should be invoked only once)" >&5 +$as_echo_n "checking whether additional CXXOPT flags should be added (should be invoked only once)... " >&6; } + +# Check whether --with-cxxopt was given. +if test "${with_cxxopt+set}" = set; then : + withval=$with_cxxopt; +CXXOPT="${withval} ${CXXOPT}" +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: CXXOPT = ${CXXOPT}" >&5 +$as_echo "CXXOPT = ${CXXOPT}" >&6; } + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether additional FCOPT flags should be added (should be invoked only once)" >&5 $as_echo_n "checking whether additional FCOPT flags should be added (should be invoked only once)... " >&6; } @@ -5050,6 +6184,24 @@ fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether additional CXXLIBS flags should be added (should be invoked only once)" >&5 +$as_echo_n "checking whether additional CXXLIBS flags should be added (should be invoked only once)... " >&6; } + +# Check whether --with-cxxlibs was given. +if test "${with_cxxlibs+set}" = set; then : + withval=$with_cxxlibs; +CXXLIBS="${withval} ${CXXLIBS}" +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: CXXLIBS = ${CXXLIBS}" >&5 +$as_echo "CXXLIBS = ${CXXLIBS}" >&6; } + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether additional LIBRARYPATH flags should be added (should be invoked only once)" >&5 $as_echo_n "checking whether additional LIBRARYPATH flags should be added (should be invoked only once)... " >&6; } @@ -5126,6 +6278,23 @@ fi +# Check if we need extra libs (e.g. for OpenMPI) +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Extra mpicxx libs?" >&5 +$as_echo_n "checking Extra mpicxx libs?... " >&6; } +xtrlibs=`mpicxx --showme:link 2>/dev/null`; +if (( $? == 0 )) +then + EXTRA_LIBS="$EXTRA_LIBS $xtrlibs"; + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $xtrlibs" >&5 +$as_echo "$xtrlibs" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } +fi + + + + ############################################################################### # Sanity checks, although redundant (useful when debugging this configure.ac)! ############################################################################### @@ -5978,6 +7147,36 @@ if test "X$CCOPT" == "X" ; then fi fi #CFLAGS="${CCOPT}" +if test "X$CXXOPT" == "X" ; then + CXXOPT="$CXXFLAGS"; +fi +if test "X$CXXOPT" == "X" ; then + if test "X$psblas_cv_fc" == "Xgcc" ; then + # note that no space should be placed around the equality symbol in assignements + # Note : 'native' is valid _only_ on GCC/x86 (32/64 bits) + CXXOPT="-g -O3 $CXXOPT" + + elif test "X$psblas_cv_fc" == X"xlf" ; then + # XL compiler : consider using -qarch=auto + CXXOPT="-O3 -qarch=auto $CXXOPT" + elif test "X$psblas_cv_fc" == X"ifc" ; then + # other compilers .. + CXXOPT="-O3 $CXXOPT" + elif test "X$psblas_cv_fc" == X"pg" ; then + # other compilers .. + CXXCOPT="-fast $CXXOPT" + # NOTE : PG & Sun use -fast instead -O3 + elif test "X$psblas_cv_fc" == X"sun" ; then + # other compilers .. + CXXOPT="-fast $CXXOPT" + elif test "X$psblas_cv_fc" == X"cray" ; then + CXXOPT="-O3 $CXXOPT" + MPICXX="CC" + else + CXXOPT="-g -O3 $CXXOPT" + fi +fi + # Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence if test "X$FCOPT" == "X" ; then @@ -6026,7 +7225,8 @@ fi ############################################################################## FC=${FC} CC=${CC} -MPCC=${MPICC} +CXX=${CXX} +CCOPT="$CCOPT $C99OPT" ############################################################################## @@ -6178,6 +7378,61 @@ fi if test "X$FLINK" == "X" ; then FLINK=${MPF90} fi +# Custom test : do we have a module or include for MPI Fortran interface? +if test x"$pac_cv_serial_mpi" == x"yes" ; then + FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES"; +else + PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08() + if test x"$pac_cv_mpi_f08" == x"yes" ; then + FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"; + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran MPI mod" >&5 +$as_echo_n "checking for Fortran MPI mod... " >&6; } + ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + ac_exeext='' + ac_ext='F90' + ac_fc=${MPIFC-$FC}; + cat > conftest.$ac_ext <<_ACEOF + + program test + use mpi + end program test +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + fi +fi + +FLINK="$MPIFC" +PAC_ARG_OPENMP() +if test x"$pac_cv_openmp" == x"yes" ; then + FDEFINES="$psblas_cv_define_prepend-DOPENMP $FDEFINES"; + CDEFINES="-DOPENMP $CDEFINES"; + FCOPT="$FCOPT $pac_cv_openmp_fcopt"; + CCOPT="$CCOPT $pac_cv_openmp_ccopt"; + FLINK="$FLINK $pac_cv_openmp_fcopt"; +fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working installation of PSBLAS" >&5 $as_echo_n "checking for working installation of PSBLAS... " >&6; } @@ -9078,6 +10333,8 @@ rm -f core conftest.err conftest.$ac_objext \ if test "x$pac_sludist_lib_ok" == "xno" ; then SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for superlu_malloc_dist in $SLUDIST_LIBS" >&5 +$as_echo_n "checking for superlu_malloc_dist in $SLUDIST_LIBS... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9108,6 +10365,8 @@ rm -f core conftest.err conftest.$ac_objext \ if test "x$pac_sludist_lib_ok" == "xno" ; then SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib64"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for superlu_malloc_dist in $SLUDIST_LIBS" >&5 +$as_echo_n "checking for superlu_malloc_dist in $SLUDIST_LIBS... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9135,8 +10394,8 @@ fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $pac_sludist_lib_ok" >&5 -$as_echo "$pac_sludist_lib_ok" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $pac_sludist_lib_ok $SLUDIST_LIBS" >&5 +$as_echo "$pac_sludist_lib_ok $SLUDIST_LIBS" >&6; } fi if test "x$pac_sludist_lib_ok" == "xyes" ; then @@ -9278,14 +10537,11 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then - pac_sludist_version="$amg4psblas_cv_superludist_major"; - if (($amg4psblas_cv_superludist_major==6)); then - if (($amg4psblas_cv_superludist_minor>=3)); then - pac_sludist_version="63"; - fi - fi + pac_sludist_version="$amg4psblas_cv_superludist_major$amg4psblas_cv_superludist_minor"; + { $as_echo "$as_me:${as_lineno-$LINENO}: Configuring with SuperLU_DIST version flag $pac_sludist_version" >&5 +$as_echo "$as_me: Configuring with SuperLU_DIST version flag $pac_sludist_version" >&6;} SLUDIST_FLAGS="" - SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_$pac_sludist_version $SLUDIST_INCLUDES" + SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_="$pac_sludist_version" $SLUDIST_INCLUDES" FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES" else SLUDIST_FLAGS="" @@ -9513,6 +10769,10 @@ if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then as_fn_error $? "conditional \"am__fastdepCC\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${am__fastdepCXX_TRUE}" && test -z "${am__fastdepCXX_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCXX\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 @@ -10598,7 +11858,9 @@ $as_echo X/"$am_mf" | { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "Something went wrong bootstrapping makefile fragments - for automatic dependency tracking. Try re-running configure with the + for automatic dependency tracking. If GNU make was not used, consider + re-running the configure script with MAKE=\"gmake\" (or whatever is + necessary). You can also try re-running configure with the '--disable-dependency-tracking' option to at least be able to build the package (albeit without support for automatic dependency tracking). See \`config.log' for more details" "$LINENO" 5; } diff --git a/configure.ac b/configure.ac index 8cd0797b..f179a7d2 100755 --- a/configure.ac +++ b/configure.ac @@ -34,11 +34,11 @@ dnl NOTE : odd configurations like ifc + gcc still await in the mist of the unkn ############################################################################### # NOTE: the literal for version (the second argument to AC_INIT should be a literal!) -AC_INIT([AMG4PSBLAS],1.0.0, [https://github.com/sfilippone/amg4psblas/issues]) +AC_INIT([AMG4PSBLAS],1.1.0, [https://github.com/sfilippone/amg4psblas/issues]) # VERSION is the file containing the PSBLAS version code # FIXME -amg4psblas_cv_version="1.0.0" +amg4psblas_cv_version="1.1.0" # A sample source file AC_CONFIG_SRCDIR([amgprec/amg_prec_type.f90]) @@ -132,7 +132,15 @@ AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifort ifc FCFLAGS="$save_FCFLAGS"; save_CFLAGS="$CFLAGS"; AC_PROG_CC([cc xlc pgcc icc gcc ]) +if test "x$ac_cv_prog_cc_stdc" == "xno" ; then + AC_MSG_ERROR([Problem : Need a C99 compiler ! ]) +else + C99OPT="$ac_cv_prog_cc_stdc"; +fi CFLAGS="$save_CFLAGS"; +save_CXXFLAGS="$CXXFLAGS"; +AC_PROG_CXX([CC xlc++ icpc g++]) +CXXFLAGS="$save_CXXFLAGS"; dnl AC_PROG_CXX dnl AC_PROG_F90 doesn't exist, at the time of writing this ! @@ -158,6 +166,10 @@ if eval "$FC -qversion 2>&1 | grep XL 2>/dev/null" ; then # since (as far as it is known to us) -WF, is not used in earlier versions. # More problems could be undocumented yet. fi + +if test "X$CC" == "X" ; then + AC_MSG_ERROR([Problem : No C compiler specified nor found!]) +fi ############################################################################### # Suitable MPI compilers detection ############################################################################### @@ -171,6 +183,7 @@ if test x"$pac_cv_serial_mpi" == x"yes" ; then FAKEMPI="fakempi.o"; MPIFC="$FC"; MPICC="$CC"; + MPICXX="$CXX"; CXXDEFINES="-DSERIAL_MPI $CXXDEFINES"; else @@ -190,9 +203,17 @@ if test "X$MPIFC" = "X" ; then fi ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])]) +AC_LANG([C++]) +if test "X$MPICXX" = "X" ; then + # This is our MPICC compiler preference: it will override ACX_MPI's first try. + AC_CHECK_PROGS([MPICXX],[mpxlc++ mpiicpc mpicxx]) +fi +ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for C++]])]) +AC_LANG([Fortran]) FC="$MPIFC" ; CC="$MPICC"; +CXX="$MPICXX"; fi AC_LANG([C]) @@ -217,10 +238,12 @@ fi dnl NOTE : no spaces before the comma, and no brackets before the second argument! PAC_ARG_WITH_FLAGS(ccopt,CCOPT) +PAC_ARG_WITH_FLAGS(cxxopt,CXXOPT) PAC_ARG_WITH_FLAGS(fcopt,FCOPT) PAC_ARG_WITH_LIBS PAC_ARG_WITH_FLAGS(clibs,CLIBS) PAC_ARG_WITH_FLAGS(flibs,FLIBS) +PAC_ARG_WITH_FLAGS(cxxlibs,CXXLIBS) dnl candidates for removal: PAC_ARG_WITH_FLAGS(library-path,LIBRARYPATH) @@ -230,6 +253,20 @@ PAC_ARG_WITH_FLAGS(module-path,MODULE_PATH) # we just gave the user the chance to append values to these variables PAC_ARG_WITH_EXTRA_LIBS +# Check if we need extra libs (e.g. for OpenMPI) +AC_MSG_CHECKING([Extra mpicxx libs?]) +xtrlibs=`mpicxx --showme:link 2>/dev/null`; +if (( $? == 0 )) +then + EXTRA_LIBS="$EXTRA_LIBS $xtrlibs"; + AC_MSG_RESULT([$xtrlibs]) +else + AC_MSG_RESULT([none]) +fi + + + + ############################################################################### # Sanity checks, although redundant (useful when debugging this configure.ac)! ############################################################################### @@ -395,6 +432,36 @@ if test "X$CCOPT" == "X" ; then fi fi #CFLAGS="${CCOPT}" +if test "X$CXXOPT" == "X" ; then + CXXOPT="$CXXFLAGS"; +fi +if test "X$CXXOPT" == "X" ; then + if test "X$psblas_cv_fc" == "Xgcc" ; then + # note that no space should be placed around the equality symbol in assignements + # Note : 'native' is valid _only_ on GCC/x86 (32/64 bits) + CXXOPT="-g -O3 $CXXOPT" + + elif test "X$psblas_cv_fc" == X"xlf" ; then + # XL compiler : consider using -qarch=auto + CXXOPT="-O3 -qarch=auto $CXXOPT" + elif test "X$psblas_cv_fc" == X"ifc" ; then + # other compilers .. + CXXOPT="-O3 $CXXOPT" + elif test "X$psblas_cv_fc" == X"pg" ; then + # other compilers .. + CXXCOPT="-fast $CXXOPT" + # NOTE : PG & Sun use -fast instead -O3 + elif test "X$psblas_cv_fc" == X"sun" ; then + # other compilers .. + CXXOPT="-fast $CXXOPT" + elif test "X$psblas_cv_fc" == X"cray" ; then + CXXOPT="-O3 $CXXOPT" + MPICXX="CC" + else + CXXOPT="-g -O3 $CXXOPT" + fi +fi + # Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence if test "X$FCOPT" == "X" ; then @@ -443,7 +510,8 @@ fi ############################################################################## FC=${FC} CC=${CC} -MPCC=${MPICC} +CXX=${CXX} +CCOPT="$CCOPT $C99OPT" ############################################################################## @@ -478,6 +546,30 @@ fi if test "X$FLINK" == "X" ; then FLINK=${MPF90} fi +# Custom test : do we have a module or include for MPI Fortran interface? +if test x"$pac_cv_serial_mpi" == x"yes" ; then + FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES"; +else + PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08() + if test x"$pac_cv_mpi_f08" == x"yes" ; then +dnl FDEFINES="$psblas_cv_define_prepend-DMPI_MOD_F08 $FDEFINES"; + FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"; + else + PAC_FORTRAN_CHECK_HAVE_MPI_MOD( + [FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"], + [FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"]) + fi +fi + +FLINK="$MPIFC" +PAC_ARG_OPENMP() +if test x"$pac_cv_openmp" == x"yes" ; then + FDEFINES="$psblas_cv_define_prepend-DOPENMP $FDEFINES"; + CDEFINES="-DOPENMP $CDEFINES"; + FCOPT="$FCOPT $pac_cv_openmp_fcopt"; + CCOPT="$CCOPT $pac_cv_openmp_ccopt"; + FLINK="$FLINK $pac_cv_openmp_fcopt"; +fi PAC_FORTRAN_HAVE_PSBLAS([AC_MSG_RESULT([yes.])], [AC_MSG_ERROR([no. Could not find working version of PSBLAS.])]) @@ -494,8 +586,8 @@ if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".]) fi if (( $pac_cv_psblas_major < 3 )) || - ( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 7 ))) ; then - AC_MSG_ERROR([I need at least PSBLAS version 3.7.]) + ( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 8 ))) ; then + AC_MSG_ERROR([I need at least PSBLAS version 3.8.0]) else AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.]) fi @@ -693,14 +785,10 @@ fi PAC_CHECK_SUPERLUDIST() if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then - pac_sludist_version="$amg4psblas_cv_superludist_major"; - if (($amg4psblas_cv_superludist_major==6)); then - if (($amg4psblas_cv_superludist_minor>=3)); then - pac_sludist_version="63"; - fi - fi + pac_sludist_version="$amg4psblas_cv_superludist_major$amg4psblas_cv_superludist_minor"; + AC_MSG_NOTICE([Configuring with SuperLU_DIST version flag $pac_sludist_version]) SLUDIST_FLAGS="" - SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_$pac_sludist_version $SLUDIST_INCLUDES" + SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_="$pac_sludist_version" $SLUDIST_INCLUDES" FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES" else SLUDIST_FLAGS="" diff --git a/configure_n b/configure_n index 42999ca0..08c0b135 100755 --- a/configure_n +++ b/configure_n @@ -753,6 +753,7 @@ infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -877,6 +878,7 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -1129,6 +1131,15 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1266,7 +1277,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1419,6 +1430,7 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] @@ -8087,6 +8099,44 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran ISO_C_BINDING module" >&5 +$as_echo_n "checking support for Fortran ISO_C_BINDING module... " >&6; } + ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + ac_exeext='' + ac_ext='f90' + ac_fc=${MPIFC-$FC}; + cat > conftest.$ac_ext <<_ACEOF + +program conftest + use iso_c_binding +end program conftest +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + : +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + as_fn_error $? "Sorry, cannot build PSBLAS without support for ISO_C_BINDING. + Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8." "$LINENO" 5 + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for ISO_FORTRAN_ENV" >&5 $as_echo_n "checking support for ISO_FORTRAN_ENV... " >&6; } ac_ext=${ac_fc_srcext-f} @@ -10706,6 +10756,8 @@ rm -f core conftest.err conftest.$ac_objext \ if test "x$pac_sludist_lib_ok" == "xno" ; then SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for superlu_malloc_dist in $SLUDIST_LIBS" >&5 +$as_echo_n "checking for superlu_malloc_dist in $SLUDIST_LIBS... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10736,6 +10788,8 @@ rm -f core conftest.err conftest.$ac_objext \ if test "x$pac_sludist_lib_ok" == "xno" ; then SLUDIST_LIBS="$amg4psblas_cv_superludist -L$amg4psblas_cv_superludistdir/lib64"; LIBS="$SLUDIST_LIBS -lm $save_LIBS"; + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for superlu_malloc_dist in $SLUDIST_LIBS" >&5 +$as_echo_n "checking for superlu_malloc_dist in $SLUDIST_LIBS... " >&6; } cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10763,8 +10817,8 @@ fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $pac_sludist_lib_ok" >&5 -$as_echo "$pac_sludist_lib_ok" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $pac_sludist_lib_ok $SLUDIST_LIBS" >&5 +$as_echo "$pac_sludist_lib_ok $SLUDIST_LIBS" >&6; } fi if test "x$pac_sludist_lib_ok" == "xyes" ; then @@ -10906,14 +10960,11 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then - pac_sludist_version="$amg4psblas_cv_superludist_major"; - if (($amg4psblas_cv_superludist_major==6)); then - if (($amg4psblas_cv_superludist_minor>=3)); then - pac_sludist_version="63"; - fi - fi + pac_sludist_version="$amg4psblas_cv_superludist_major$amg4psblas_cv_superludist_minor"; + { $as_echo "$as_me:${as_lineno-$LINENO}: Configuring with SuperLU_DIST version flag $pac_sludist_version" >&5 +$as_echo "$as_me: Configuring with SuperLU_DIST version flag $pac_sludist_version" >&6;} SLUDIST_FLAGS="" - SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_$pac_sludist_version $SLUDIST_INCLUDES" + SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_="$pac_sludist_version" $SLUDIST_INCLUDES" FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES" else SLUDIST_FLAGS="" @@ -12275,7 +12326,9 @@ $as_echo X/"$am_mf" | { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "Something went wrong bootstrapping makefile fragments - for automatic dependency tracking. Try re-running configure with the + for automatic dependency tracking. If GNU make was not used, consider + re-running the configure script with MAKE=\"gmake\" (or whatever is + necessary). You can also try re-running configure with the '--disable-dependency-tracking' option to at least be able to build the package (albeit without support for automatic dependency tracking). See \`config.log' for more details" "$LINENO" 5; } diff --git a/configure_n.ac b/configure_n.ac index bdf31b21..ccebf414 100755 --- a/configure_n.ac +++ b/configure_n.ac @@ -34,11 +34,11 @@ dnl NOTE : odd configurations like ifc + gcc still await in the mist of the unkn ############################################################################### # NOTE: the literal for version (the second argument to AC_INIT should be a literal!) -AC_INIT([AMG4PSBLAS],1.0.0, [https://github.com/sfilippone/amg4psblas/issues]) +AC_INIT([AMG4PSBLAS],1.1.0, [https://github.com/sfilippone/amg4psblas/issues]) # VERSION is the file containing the PSBLAS version code # FIXME -amg4psblas_cv_version="1.0.0" +amg4psblas_cv_version="1.1.0" # A sample source file AC_CONFIG_SRCDIR([amgprec/amg_prec_type.f90]) @@ -559,31 +559,14 @@ if test "x$pac_cv_psblas_patchlevel" == "xunknown"; then AC_MSG_ERROR([PSBLAS patchlevel "$pac_cv_psblas_patchlevel".]) fi if (( $pac_cv_psblas_major < 3 )) || - ( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 7 ))) ; then - AC_MSG_ERROR([I need at least PSBLAS version 3.7.]) + ( (( $pac_cv_psblas_major == 3 )) && (( $pac_cv_psblas_minor < 8 ))) ; then + AC_MSG_ERROR([I need at least PSBLAS version 3.8.0]) else AC_MSG_NOTICE([Am configuring with PSBLAS version $pac_cv_psblas_major.$pac_cv_psblas_minor.$pac_cv_psblas_patchlevel.]) fi - -PAC_ARG_WITH_IPK -PAC_ARG_WITH_LPK -# Defaults for IPK/LPK -if test x"$pac_cv_ipk_size" == x"" ; then - pac_cv_ipk_size=4 -fi -if test x"$pac_cv_lpk_size" == x"" ; then - pac_cv_lpk_size=8 -fi -# Enforce sensible combination -if (( $pac_cv_lpk_size < $pac_cv_ipk_size )); then - AC_MSG_NOTICE([[Invalid combination of size specs IPK ${pac_cv_ipk_size} LPK ${pac_cv_lpk_size}. ]]); - AC_MSG_NOTICE([[Forcing equal values]]) - pac_cv_lpk_size=$pac_cv_ipk_size; -fi -FDEFINES="$psblas_cv_define_prepend-DIPK${pac_cv_ipk_size} $FDEFINES"; -FDEFINES="$psblas_cv_define_prepend-DLPK${pac_cv_lpk_size} $FDEFINES"; -CDEFINES="-DIPK${pac_cv_ipk_size} -DLPK${pac_cv_lpk_size} $CDEFINES"; -if test x"$pac_cv_lpk_size" == x8"" ; then +PAC_FORTRAN_PSBLAS_INTEGER_SIZES() +AC_MSG_NOTICE([PSBLAS size of LPK "$pac_cv_psblas_lpk".]) +if test x"$pac_cv_psblas_lpk" == x8"" ; then CXXDEFINES="-DBIT64 $CXXDEFINES"; fi @@ -673,6 +656,12 @@ PAC_FORTRAN_TEST_VOLATILE( [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for VOLATILE])] ) +PAC_FORTRAN_TEST_ISO_C_BIND( + [], + [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_C_BINDING. + Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])] +) + PAC_FORTRAN_TEST_ISO_FORTRAN_ENV( [], [AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for ISO_FORTRAN_ENV])] @@ -856,14 +845,10 @@ fi PAC_CHECK_SUPERLUDIST() if test "x$amg4psblas_cv_have_superludist" == "xyes" ; then - pac_sludist_version="$amg4psblas_cv_superludist_major"; - if (($amg4psblas_cv_superludist_major==6)); then - if (($amg4psblas_cv_superludist_minor>=3)); then - pac_sludist_version="63"; - fi - fi + pac_sludist_version="$amg4psblas_cv_superludist_major$amg4psblas_cv_superludist_minor"; + AC_MSG_NOTICE([Configuring with SuperLU_DIST version flag $pac_sludist_version]) SLUDIST_FLAGS="" - SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_$pac_sludist_version $SLUDIST_INCLUDES" + SLUDIST_FLAGS="-DHave_SLUDist_ -DSLUD_VERSION_="$pac_sludist_version" $SLUDIST_INCLUDES" FDEFINES="$amg_cv_define_prepend-DHAVE_SLUDIST_ $FDEFINES" else SLUDIST_FLAGS="" diff --git a/exec.sh b/exec.sh new file mode 100755 index 00000000..1181f776 --- /dev/null +++ b/exec.sh @@ -0,0 +1,25 @@ +cd amgprec/impl/aggregator/ +rm MatchBoxPC.o +rm sendBundledMessages.o +rm initialize.o +rm extractUChunk.o +rm isAlreadyMatched.o +rm findOwnerOfGhost.o +rm computeCandidateMate.o +rm parallelComputeCandidateMateB.o +rm processMatchedVertices.o +rm processCrossEdge.o +rm queueTransfer.o +rm processMessages.o +rm processExposedVertex.o +rm algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o +rm algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.o +cd ../../../ +make all +cd samples/advanced/pdegen +make amg_d_pde3d +cd runs +mpirun -np 4 amg_d_pde3d amg_pde3d.inp + + + diff --git a/samples/advanced/fileread/amg_cf_sample.f90 b/samples/advanced/fileread/amg_cf_sample.f90 index c881fb40..e18079ae 100644 --- a/samples/advanced/fileread/amg_cf_sample.f90 +++ b/samples/advanced/fileread/amg_cf_sample.f90 @@ -676,8 +676,9 @@ contains call read_data(prec%aggr_prol,inp_unit) ! aggregation type call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -685,7 +686,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/fileread/amg_df_sample.f90 b/samples/advanced/fileread/amg_df_sample.f90 index a43a654e..8c29eff8 100644 --- a/samples/advanced/fileread/amg_df_sample.f90 +++ b/samples/advanced/fileread/amg_df_sample.f90 @@ -676,8 +676,9 @@ contains call read_data(prec%aggr_prol,inp_unit) ! aggregation type call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -685,7 +686,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/fileread/amg_sf_sample.f90 b/samples/advanced/fileread/amg_sf_sample.f90 index 650ca0ea..e195d4ff 100644 --- a/samples/advanced/fileread/amg_sf_sample.f90 +++ b/samples/advanced/fileread/amg_sf_sample.f90 @@ -676,8 +676,9 @@ contains call read_data(prec%aggr_prol,inp_unit) ! aggregation type call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -685,7 +686,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/fileread/amg_zf_sample.f90 b/samples/advanced/fileread/amg_zf_sample.f90 index 7ea18464..6d7e6f9c 100644 --- a/samples/advanced/fileread/amg_zf_sample.f90 +++ b/samples/advanced/fileread/amg_zf_sample.f90 @@ -676,8 +676,9 @@ contains call read_data(prec%aggr_prol,inp_unit) ! aggregation type call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -685,7 +686,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/fileread/runs/amg_cfs.inp b/samples/advanced/fileread/runs/amg_cfs.inp index 195be4a4..44ca86bf 100644 --- a/samples/advanced/fileread/runs/amg_cfs.inp +++ b/samples/advanced/fileread/runs/amg_cfs.inp @@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE -FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% SLU ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC SLU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/fileread/runs/amg_dfs.inp b/samples/advanced/fileread/runs/amg_dfs.inp index 221dfecd..9e0606b2 100644 --- a/samples/advanced/fileread/runs/amg_dfs.inp +++ b/samples/advanced/fileread/runs/amg_dfs.inp @@ -1,8 +1,8 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. -mld_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or -mld_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html +amg_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or +amg_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html NONE ! Initial guess -mld_sol.mtx ! Reference solution +amg_sol.mtx ! Reference solution MM ! File format: MatrixMarket or Harwell-Boeing CSR ! Storage format: CSR COO JAD GRAPH ! PART (partition method): BLOCK GRAPH @@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE -FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/fileread/runs/amg_sfs.inp b/samples/advanced/fileread/runs/amg_sfs.inp index d7388521..a73415ab 100644 --- a/samples/advanced/fileread/runs/amg_sfs.inp +++ b/samples/advanced/fileread/runs/amg_sfs.inp @@ -1,8 +1,8 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. -mld_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or -mld_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html +amg_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or +amg_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html NONE ! Initial guess -mld_sol.mtx ! Reference solution +amg_sol.mtx ! Reference solution MM ! File format: MatrixMarket or Harwell-Boeing CSR ! Storage format: CSR COO JAD GRAPH ! PART (partition method): BLOCK GRAPH @@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE -FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% SLU ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC SLU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/fileread/runs/amg_zfs.inp b/samples/advanced/fileread/runs/amg_zfs.inp index d0c48861..1868d64c 100644 --- a/samples/advanced/fileread/runs/amg_zfs.inp +++ b/samples/advanced/fileread/runs/amg_zfs.inp @@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE -FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/pdegen/Makefile b/samples/advanced/pdegen/Makefile index 913f5bb2..c6588f05 100644 --- a/samples/advanced/pdegen/Makefile +++ b/samples/advanced/pdegen/Makefile @@ -3,11 +3,11 @@ AMGINCDIR=$(AMGDIR)/include include $(AMGINCDIR)/Make.inc.amg4psblas AMGMODDIR=$(AMGDIR)/modules AMGLIBDIR=$(AMGDIR)/lib -AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec +AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). LINKOPT= -XTRALINK=-lstdc++ -lroma -L../../../../ParallelRomaF-main/lib/ -fopenmp +XTRALINK=-lstdc++ -lroma -fopenmp EXEDIR=./runs all: amg_s_pde3d amg_d_pde3d amg_s_pde2d amg_d_pde2d @@ -45,7 +45,7 @@ check: all clean: /bin/rm -f data_input.o *.o *$(.mod)\ - $(EXEDIR)/mld_d_pde3d $(EXEDIR)/mld_s_pde3d $(EXEDIR)/mld_d_pde2d $(EXEDIR)/mld_s_pde2d + $(EXEDIR)/amg_d_pde3d $(EXEDIR)/amg_s_pde3d $(EXEDIR)/amg_d_pde2d $(EXEDIR)/amg_s_pde2d verycleanlib: (cd ../..; make veryclean) diff --git a/samples/advanced/pdegen/amg_d_genpde_mod.F90 b/samples/advanced/pdegen/amg_d_genpde_mod.F90 index 31748121..ec3affc5 100644 --- a/samples/advanced/pdegen/amg_d_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_d_genpde_mod.F90 @@ -93,6 +93,9 @@ contains & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv) use psb_base_mod use psb_util_mod +#if defined(OPENMP) + use omp_lib +#endif ! ! Discretizes the partial differential equation ! @@ -128,7 +131,6 @@ contains type(psb_d_csc_sparse_mat) :: acsc type(psb_d_coo_sparse_mat) :: acoo type(psb_d_csr_sparse_mat) :: acsr - real(psb_dpk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner @@ -141,8 +143,7 @@ contains ! Process grid integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_dpk_), allocatable :: val(:) + integer(psb_lpk_), allocatable :: myidx(:) ! deltah dimension of each grid cell ! deltat discretization time real(psb_dpk_) :: deltah, sqdeltah, deltah2 @@ -368,119 +369,128 @@ contains call psb_barrier(ctxt) talc = psb_wtime()-t0 - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - call psb_barrier(ctxt) t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) - ! x, y, z coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - z = (iz-1)*deltah - zt(k) = f_(x,y,z) - ! internal point: build discretization - ! - ! term depending on (x-1,y,z) - ! - val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 - if (ix == 1) then - zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1,z) - val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 - if (iy == 1) then - zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y,z-1) - val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 - if (iz == 1) then - zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y,z) - val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & - & + c(x,y,z) - call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y,z+1) - val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 - if (iz == idim) then - zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y+1,z) - val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 - if (iy == idim) then - zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y,z) - val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 - if (ix==idim) then - zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + !$omp parallel shared(deltah,myidx,a,desc_a) + ! + block + integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth + integer(psb_lpk_) :: glob_row + integer(psb_lpk_), allocatable :: irow(:),icol(:) + real(psb_dpk_), allocatable :: val(:) + real(psb_dpk_) :: x,y,z, zt(nb) +#if defined(OPENMP) + nth = omp_get_num_threads() + ith = omp_get_thread_num() +#else + nth = 1 + ith = 0 +#endif + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + !goto 9999 + endif + + !$omp do schedule(dynamic) + ! + do ii=1, nlr, nb + if (info /= psb_success_) cycle + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + z = (iz-1)*deltah + zt(k) = f_(x,y,z) + ! internal point: build discretization + ! + ! term depending on (x-1,y,z) + ! + val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 + if (ix == 1) then + zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1,z) + val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 + if (iy == 1) then + zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y,z-1) + val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 + if (iz == 1) then + zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y,z) + val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & + & + c(x,y,z) + call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 - endif + ! term depending on (x,y,z+1) + val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 + if (iz == idim) then + zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y+1,z) + val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 + if (iy == idim) then + zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y,z) + val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 + if (ix==idim) then + zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + end do + !write(0,*) ' Outer in_parallel ',omp_in_parallel() + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) cycle + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) cycle + zt(:)=dzero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) cycle end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=dzero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do + !$omp end do + + deallocate(val,irow,icol) + end block + !$omp end parallel tgen = psb_wtime()-t1 if(info /= psb_success_) then @@ -490,7 +500,6 @@ contains goto 9999 end if - deallocate(val,irow,icol) call psb_barrier(ctxt) t1 = psb_wtime() @@ -500,9 +509,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt) @@ -557,6 +566,9 @@ contains & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) use psb_base_mod use psb_util_mod +#if defined(OPENMP) + use omp_lib +#endif ! ! Discretizes the partial differential equation ! @@ -591,7 +603,6 @@ contains type(psb_d_csc_sparse_mat) :: acsc type(psb_d_coo_sparse_mat) :: acoo type(psb_d_csr_sparse_mat) :: acsr - real(psb_dpk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner @@ -604,8 +615,7 @@ contains ! Process grid integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_dpk_), allocatable :: val(:) + integer(psb_lpk_), allocatable :: myidx(:) ! deltah dimension of each grid cell ! deltat discretization time real(psb_dpk_) :: deltah, sqdeltah, deltah2, dd @@ -791,7 +801,7 @@ contains !write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy() end if end block - + case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 @@ -816,93 +826,109 @@ contains goto 9999 end if - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - call psb_barrier(ctxt) t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,glob_row,idim,idim) - ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - - zt(k) = f_(x,y) - ! internal point: build discretization - ! - ! term depending on (x-1,y) - ! - val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 - if (ix == 1) then - zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1) - val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 - if (iy == 1) then - zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y) - val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) - call ijk2idx(icol(icoeff),ix,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y+1) - val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 - if (iy == idim) then - zt(k) = g(x,done)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y) - val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 - if (ix==idim) then - zt(k) = g(done,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + !$omp parallel shared(deltah,myidx,a,desc_a) + ! + block + integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth + integer(psb_lpk_) :: glob_row + integer(psb_lpk_), allocatable :: irow(:),icol(:) + real(psb_dpk_), allocatable :: val(:) + real(psb_dpk_) :: x,y,z, zt(nb) +#if defined(OPENMP) + nth = omp_get_num_threads() + ith = omp_get_thread_num() +#else + nth = 1 + ith = 0 +#endif + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + !goto 9999 + endif + + ! loop over rows belonging to current process in a block + ! distribution. + !$omp do schedule(dynamic) + ! + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,glob_row,idim,idim) + ! x, y coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + + zt(k) = f_(x,y) + ! internal point: build discretization + ! + ! term depending on (x-1,y) + ! + val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 + if (ix == 1) then + zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1) + val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 + if (iy == 1) then + zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y) + val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) + call ijk2idx(icol(icoeff),ix,iy,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 - endif + ! term depending on (x,y+1) + val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 + if (iy == idim) then + zt(k) = g(x,done)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y) + val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 + if (ix==idim) then + zt(k) = g(done,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) cycle + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) cycle + zt(:)=dzero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) cycle end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=dzero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do + !$omp end do + + deallocate(val,irow,icol) + end block + !$omp end parallel tgen = psb_wtime()-t1 if(info /= psb_success_) then @@ -912,8 +938,6 @@ contains goto 9999 end if - deallocate(val,irow,icol) - call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info) @@ -922,9 +946,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt) diff --git a/samples/advanced/pdegen/amg_d_pde2d.f90 b/samples/advanced/pdegen/amg_d_pde2d.f90 index 4e72981f..c036aa6d 100644 --- a/samples/advanced/pdegen/amg_d_pde2d.f90 +++ b/samples/advanced/pdegen/amg_d_pde2d.f90 @@ -581,8 +581,9 @@ contains call read_data(prec%aggr_type,inp_unit) ! type of aggregation call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -590,7 +591,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/pdegen/amg_d_pde3d.f90 b/samples/advanced/pdegen/amg_d_pde3d.F90 similarity index 98% rename from samples/advanced/pdegen/amg_d_pde3d.f90 rename to samples/advanced/pdegen/amg_d_pde3d.F90 index a31dce23..433c4c2e 100644 --- a/samples/advanced/pdegen/amg_d_pde3d.f90 +++ b/samples/advanced/pdegen/amg_d_pde3d.F90 @@ -74,6 +74,9 @@ program amg_d_pde3d use amg_d_pde3d_exp_mod use amg_d_pde3d_gauss_mod use amg_d_genpde_mod +#if defined(OPENMP) + use omp_lib +#endif implicit none ! input parameters @@ -94,7 +97,7 @@ program amg_d_pde3d type(psb_d_vect_type) :: x,b,r ! parallel environment type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: iam, np + integer(psb_ipk_) :: iam, np, nth ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nlv @@ -201,6 +204,15 @@ program amg_d_pde3d call psb_init(ctxt) call psb_info(ctxt,iam,np) +#if defined(OPENMP) + !$OMP parallel shared(nth) + !$OMP master + nth = omp_get_num_threads() + !$OMP end master + !$OMP end parallel +#else + nth = 1 +#endif if (iam < 0) then ! This should not happen, but just in case @@ -464,6 +476,8 @@ program amg_d_pde3d call prec%descr(info,iout=psb_out_unit) if (iam == psb_root_) then write(psb_out_unit,'("Computed solution on ",i8," processors")') np + write(psb_out_unit,'("Number of threads : ",i12)') nth + write(psb_out_unit,'("Total number of tasks : ",i12)') nth*np write(psb_out_unit,'("Linear system size : ",i12)') system_size write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff) write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd) diff --git a/samples/advanced/pdegen/amg_s_genpde_mod.F90 b/samples/advanced/pdegen/amg_s_genpde_mod.F90 index d75bb333..dfa79ab3 100644 --- a/samples/advanced/pdegen/amg_s_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_s_genpde_mod.F90 @@ -93,6 +93,9 @@ contains & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv) use psb_base_mod use psb_util_mod +#if defined(OPENMP) + use omp_lib +#endif ! ! Discretizes the partial differential equation ! @@ -128,7 +131,6 @@ contains type(psb_s_csc_sparse_mat) :: acsc type(psb_s_coo_sparse_mat) :: acoo type(psb_s_csr_sparse_mat) :: acsr - real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner @@ -141,8 +143,7 @@ contains ! Process grid integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_spk_), allocatable :: val(:) + integer(psb_lpk_), allocatable :: myidx(:) ! deltah dimension of each grid cell ! deltat discretization time real(psb_spk_) :: deltah, sqdeltah, deltah2 @@ -368,119 +369,128 @@ contains call psb_barrier(ctxt) talc = psb_wtime()-t0 - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - call psb_barrier(ctxt) t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) - ! x, y, z coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - z = (iz-1)*deltah - zt(k) = f_(x,y,z) - ! internal point: build discretization - ! - ! term depending on (x-1,y,z) - ! - val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 - if (ix == 1) then - zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1,z) - val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 - if (iy == 1) then - zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y,z-1) - val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 - if (iz == 1) then - zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y,z) - val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & - & + c(x,y,z) - call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y,z+1) - val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 - if (iz == idim) then - zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y+1,z) - val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 - if (iy == idim) then - zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y,z) - val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 - if (ix==idim) then - zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + !$omp parallel shared(deltah,myidx,a,desc_a) + ! + block + integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth + integer(psb_lpk_) :: glob_row + integer(psb_lpk_), allocatable :: irow(:),icol(:) + real(psb_spk_), allocatable :: val(:) + real(psb_spk_) :: x,y,z, zt(nb) +#if defined(OPENMP) + nth = omp_get_num_threads() + ith = omp_get_thread_num() +#else + nth = 1 + ith = 0 +#endif + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + !goto 9999 + endif + + !$omp do schedule(dynamic) + ! + do ii=1, nlr, nb + if (info /= psb_success_) cycle + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + z = (iz-1)*deltah + zt(k) = f_(x,y,z) + ! internal point: build discretization + ! + ! term depending on (x-1,y,z) + ! + val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 + if (ix == 1) then + zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1,z) + val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 + if (iy == 1) then + zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y,z-1) + val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 + if (iz == 1) then + zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y,z) + val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & + & + c(x,y,z) + call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 - endif + ! term depending on (x,y,z+1) + val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 + if (iz == idim) then + zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y+1,z) + val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 + if (iy == idim) then + zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y,z) + val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 + if (ix==idim) then + zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + end do + !write(0,*) ' Outer in_parallel ',omp_in_parallel() + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) cycle + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) cycle + zt(:)=szero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) cycle end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=szero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do + !$omp end do + + deallocate(val,irow,icol) + end block + !$omp end parallel tgen = psb_wtime()-t1 if(info /= psb_success_) then @@ -490,7 +500,6 @@ contains goto 9999 end if - deallocate(val,irow,icol) call psb_barrier(ctxt) t1 = psb_wtime() @@ -500,9 +509,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt) @@ -557,6 +566,9 @@ contains & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) use psb_base_mod use psb_util_mod +#if defined(OPENMP) + use omp_lib +#endif ! ! Discretizes the partial differential equation ! @@ -591,7 +603,6 @@ contains type(psb_s_csc_sparse_mat) :: acsc type(psb_s_coo_sparse_mat) :: acoo type(psb_s_csr_sparse_mat) :: acsr - real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner @@ -604,8 +615,7 @@ contains ! Process grid integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_spk_), allocatable :: val(:) + integer(psb_lpk_), allocatable :: myidx(:) ! deltah dimension of each grid cell ! deltat discretization time real(psb_spk_) :: deltah, sqdeltah, deltah2, dd @@ -791,7 +801,7 @@ contains !write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy() end if end block - + case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 @@ -816,93 +826,109 @@ contains goto 9999 end if - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - call psb_barrier(ctxt) t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,glob_row,idim,idim) - ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - - zt(k) = f_(x,y) - ! internal point: build discretization - ! - ! term depending on (x-1,y) - ! - val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 - if (ix == 1) then - zt(k) = g(szero,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1) - val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 - if (iy == 1) then - zt(k) = g(x,szero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y) - val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) - call ijk2idx(icol(icoeff),ix,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y+1) - val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 - if (iy == idim) then - zt(k) = g(x,sone)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y) - val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 - if (ix==idim) then - zt(k) = g(sone,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + !$omp parallel shared(deltah,myidx,a,desc_a) + ! + block + integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth + integer(psb_lpk_) :: glob_row + integer(psb_lpk_), allocatable :: irow(:),icol(:) + real(psb_spk_), allocatable :: val(:) + real(psb_spk_) :: x,y,z, zt(nb) +#if defined(OPENMP) + nth = omp_get_num_threads() + ith = omp_get_thread_num() +#else + nth = 1 + ith = 0 +#endif + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + !goto 9999 + endif + + ! loop over rows belonging to current process in a block + ! distribution. + !$omp do schedule(dynamic) + ! + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,glob_row,idim,idim) + ! x, y coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + + zt(k) = f_(x,y) + ! internal point: build discretization + ! + ! term depending on (x-1,y) + ! + val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 + if (ix == 1) then + zt(k) = g(szero,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1) + val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 + if (iy == 1) then + zt(k) = g(x,szero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y) + val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) + call ijk2idx(icol(icoeff),ix,iy,idim,idim) irow(icoeff) = glob_row icoeff = icoeff+1 - endif + ! term depending on (x,y+1) + val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 + if (iy == idim) then + zt(k) = g(x,sone)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y) + val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 + if (ix==idim) then + zt(k) = g(sone,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) cycle + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) cycle + zt(:)=szero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) cycle end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=szero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do + !$omp end do + + deallocate(val,irow,icol) + end block + !$omp end parallel tgen = psb_wtime()-t1 if(info /= psb_success_) then @@ -912,8 +938,6 @@ contains goto 9999 end if - deallocate(val,irow,icol) - call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info) @@ -922,9 +946,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt) diff --git a/samples/advanced/pdegen/amg_s_pde2d.f90 b/samples/advanced/pdegen/amg_s_pde2d.f90 index 5fbd1864..a81d16ff 100644 --- a/samples/advanced/pdegen/amg_s_pde2d.f90 +++ b/samples/advanced/pdegen/amg_s_pde2d.f90 @@ -581,8 +581,9 @@ contains call read_data(prec%aggr_type,inp_unit) ! type of aggregation call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -590,7 +591,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/pdegen/amg_s_pde3d.f90 b/samples/advanced/pdegen/amg_s_pde3d.f90 index 949371f4..7542c3a2 100644 --- a/samples/advanced/pdegen/amg_s_pde3d.f90 +++ b/samples/advanced/pdegen/amg_s_pde3d.f90 @@ -585,8 +585,9 @@ contains call read_data(prec%aggr_type,inp_unit) ! type of aggregation call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation - call read_data(prec%aggr_filter,inp_unit) ! filtering call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio + call read_data(prec%aggr_filter,inp_unit) ! filtering + call read_data(prec%athres,inp_unit) ! smoothed aggr thresh call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector if (prec%thrvsz > 0) then call psb_realloc(prec%thrvsz,prec%athresv,info) @@ -594,7 +595,6 @@ contains else read(inp_unit,*) ! dummy read to skip a record end if - call read_data(prec%athres,inp_unit) ! smoothed aggr thresh ! coasest-level solver call read_data(prec%csolve,inp_unit) ! coarsest-lev solver call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver diff --git a/samples/advanced/pdegen/runs/amg_pde2d.inp b/samples/advanced/pdegen/runs/amg_pde2d.inp index 8e538001..c3fc58e1 100644 --- a/samples/advanced/pdegen/runs/amg_pde2d.inp +++ b/samples/advanced/pdegen/runs/amg_pde2d.inp @@ -43,11 +43,11 @@ COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED MATCHBOXP ! aggregation measure SOC1, MATCHBOXP 8 ! Requested size of the aggregates for MATCHBOXP NATURAL ! Ordering of aggregation NATURAL DEGREE -FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/pdegen/runs/amg_pde3d.inp b/samples/advanced/pdegen/runs/amg_pde3d.inp index f9ff0d5d..0cd5d6c5 100644 --- a/samples/advanced/pdegen/runs/amg_pde3d.inp +++ b/samples/advanced/pdegen/runs/amg_pde3d.inp @@ -1,6 +1,6 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. CSR ! Storage format CSR COO JAD -0080 ! IDIM; domain size. Linear system size is IDIM**3 +0200 ! IDIM; domain size. Linear system size is IDIM**3 CONST ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC @@ -43,11 +43,11 @@ COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED MATCHBOXP ! aggregation measure SOC1, MATCHBOXP 8 ! Requested size of the aggregates for MATCHBOXP NATURAL ! Ordering of aggregation NATURAL DEGREE -NOFILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default +FILTER ! Filtering of matrix: FILTER NOFILTER +-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 -2 ! Number of thresholds in vector, next line ignored if <= 0 0.05 0.025 ! Thresholds --0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU diff --git a/samples/advanced/pdegen/runs/tnewmtc.inp b/samples/advanced/pdegen/runs/tnewmtc.inp index f59d49ec..5be2a39d 100644 --- a/samples/advanced/pdegen/runs/tnewmtc.inp +++ b/samples/advanced/pdegen/runs/tnewmtc.inp @@ -1,6 +1,6 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. CSR ! Storage format CSR COO JAD -0080 ! IDIM; domain size. Linear system size is IDIM**3 +0140 ! IDIM; domain size. Linear system size is IDIM**3 CONST ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC @@ -40,7 +40,7 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL -3 ! Target coarse matrix size per process; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED NEWMTC ! Parallel aggregation: DEC, SYMDEC, COUPLED NEWMTC -MATCHBOXP ! aggregation measure SOC1, MATCHBOXP NEWMTC +NEWMTC ! aggregation measure SOC1, MATCHBOXP NEWMTC 8 ! Requested size of the aggregates for MATCHBOXP NATURAL ! Ordering of aggregation NATURAL DEGREE NOFILTER ! Filtering of matrix: FILTER NOFILTER diff --git a/samples/simple/pdegen/amg_dpde_mod.f90 b/samples/simple/pdegen/amg_dpde_mod.f90 index 5bbc4ff9..821d57f0 100644 --- a/samples/simple/pdegen/amg_dpde_mod.f90 +++ b/samples/simple/pdegen/amg_dpde_mod.f90 @@ -465,9 +465,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt) diff --git a/samples/simple/pdegen/amg_spde_mod.f90 b/samples/simple/pdegen/amg_spde_mod.f90 index 366da1d3..505e1e96 100644 --- a/samples/simple/pdegen/amg_spde_mod.f90 +++ b/samples/simple/pdegen/amg_spde_mod.f90 @@ -465,9 +465,9 @@ contains t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + call psb_spasb(a,desc_a,info,mold=amold) else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + call psb_spasb(a,desc_a,info,afmt=afmt) end if end if call psb_barrier(ctxt)