From 4642c857d10fb63e1d3df904948cf287e9219b70 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Thu, 16 Apr 2026 14:58:59 +0200 Subject: [PATCH 1/5] Improve MUMPS solver build --- .../impl/solver/amg_c_mumps_solver_bld.F90 | 19 +++++++------------ .../impl/solver/amg_d_mumps_solver_bld.F90 | 19 +++++++------------ .../impl/solver/amg_s_mumps_solver_bld.F90 | 19 +++++++------------ .../impl/solver/amg_z_mumps_solver_bld.F90 | 19 +++++++------------ 4 files changed, 28 insertions(+), 48 deletions(-) diff --git a/amgprec/impl/solver/amg_c_mumps_solver_bld.F90 b/amgprec/impl/solver/amg_c_mumps_solver_bld.F90 index 719861b1..1c22a2ca 100644 --- a/amgprec/impl/solver/amg_c_mumps_solver_bld.F90 +++ b/amgprec/impl/solver/amg_c_mumps_solver_bld.F90 @@ -80,24 +80,19 @@ subroutine c_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call psb_info(ctxt, iam, np) if (sv%ipar(1) == amg_local_solver_ ) then call psb_init(ctxt1,np=1,basectxt=ctxt,ids=(/iam/)) - icomm = psb_get_mpi_comm(ctxt1) - allocate(sv%local_ctxt,stat=info) - sv%local_ctxt = ctxt1 - !write(*,*)iam,'mumps_bld: local +++++>',icomm,sv%local_ctxt - call psb_info(ctxt1, me, np) - npr = np else if (sv%ipar(1) == amg_global_solver_ ) then - icomm = psb_get_mpi_comm(ctxt) - !write(*,*)iam,'mumps_bld: global +++++>',icomm,ctxt - call psb_info(ctxt, iam, np) - me = iam - npr = np + call psb_init(ctxt1,basectxt=ctxt) else info = psb_err_internal_error_ call psb_errpush(info,name,& & a_err='Invalid local/global solver in MUMPS') goto 9999 end if + !allocate(sv%local_ctxt,stat=info) + icomm = ctxt1%get_mpic() + sv%local_ctxt = ctxt1 + !write(*,*)iam,'mumps_bld: local +++++>',icomm!,sv%local_ctxt%ctxt + call psb_info(ctxt1, me, npr) npc = 1 if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' start' @@ -115,8 +110,8 @@ subroutine c_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) end if end if + call mpi_comm_dup(icomm,sv%id%comm,info) - sv%id%comm = icomm sv%id%job = -1 sv%id%par = 1 if (sv%ipar(3) == 2) then diff --git a/amgprec/impl/solver/amg_d_mumps_solver_bld.F90 b/amgprec/impl/solver/amg_d_mumps_solver_bld.F90 index 5ad7e771..98919497 100644 --- a/amgprec/impl/solver/amg_d_mumps_solver_bld.F90 +++ b/amgprec/impl/solver/amg_d_mumps_solver_bld.F90 @@ -80,24 +80,19 @@ subroutine d_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call psb_info(ctxt, iam, np) if (sv%ipar(1) == amg_local_solver_ ) then call psb_init(ctxt1,np=1,basectxt=ctxt,ids=(/iam/)) - icomm = psb_get_mpi_comm(ctxt1) - allocate(sv%local_ctxt,stat=info) - sv%local_ctxt = ctxt1 - !write(*,*)iam,'mumps_bld: local +++++>',icomm,sv%local_ctxt - call psb_info(ctxt1, me, np) - npr = np else if (sv%ipar(1) == amg_global_solver_ ) then - icomm = psb_get_mpi_comm(ctxt) - !write(*,*)iam,'mumps_bld: global +++++>',icomm,ctxt - call psb_info(ctxt, iam, np) - me = iam - npr = np + call psb_init(ctxt1,basectxt=ctxt) else info = psb_err_internal_error_ call psb_errpush(info,name,& & a_err='Invalid local/global solver in MUMPS') goto 9999 end if + !allocate(sv%local_ctxt,stat=info) + icomm = ctxt1%get_mpic() + sv%local_ctxt = ctxt1 + !write(*,*)iam,'mumps_bld: local +++++>',icomm!,sv%local_ctxt%ctxt + call psb_info(ctxt1, me, npr) npc = 1 if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' start' @@ -115,8 +110,8 @@ subroutine d_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) end if end if + call mpi_comm_dup(icomm,sv%id%comm,info) - sv%id%comm = icomm sv%id%job = -1 sv%id%par = 1 if (sv%ipar(3) == 2) then diff --git a/amgprec/impl/solver/amg_s_mumps_solver_bld.F90 b/amgprec/impl/solver/amg_s_mumps_solver_bld.F90 index 28016694..eb077c4b 100644 --- a/amgprec/impl/solver/amg_s_mumps_solver_bld.F90 +++ b/amgprec/impl/solver/amg_s_mumps_solver_bld.F90 @@ -80,24 +80,19 @@ subroutine s_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call psb_info(ctxt, iam, np) if (sv%ipar(1) == amg_local_solver_ ) then call psb_init(ctxt1,np=1,basectxt=ctxt,ids=(/iam/)) - icomm = psb_get_mpi_comm(ctxt1) - allocate(sv%local_ctxt,stat=info) - sv%local_ctxt = ctxt1 - !write(*,*)iam,'mumps_bld: local +++++>',icomm,sv%local_ctxt - call psb_info(ctxt1, me, np) - npr = np else if (sv%ipar(1) == amg_global_solver_ ) then - icomm = psb_get_mpi_comm(ctxt) - !write(*,*)iam,'mumps_bld: global +++++>',icomm,ctxt - call psb_info(ctxt, iam, np) - me = iam - npr = np + call psb_init(ctxt1,basectxt=ctxt) else info = psb_err_internal_error_ call psb_errpush(info,name,& & a_err='Invalid local/global solver in MUMPS') goto 9999 end if + !allocate(sv%local_ctxt,stat=info) + icomm = ctxt1%get_mpic() + sv%local_ctxt = ctxt1 + !write(*,*)iam,'mumps_bld: local +++++>',icomm!,sv%local_ctxt%ctxt + call psb_info(ctxt1, me, npr) npc = 1 if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' start' @@ -115,8 +110,8 @@ subroutine s_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) end if end if + call mpi_comm_dup(icomm,sv%id%comm,info) - sv%id%comm = icomm sv%id%job = -1 sv%id%par = 1 if (sv%ipar(3) == 2) then diff --git a/amgprec/impl/solver/amg_z_mumps_solver_bld.F90 b/amgprec/impl/solver/amg_z_mumps_solver_bld.F90 index da77069a..13e21841 100644 --- a/amgprec/impl/solver/amg_z_mumps_solver_bld.F90 +++ b/amgprec/impl/solver/amg_z_mumps_solver_bld.F90 @@ -80,24 +80,19 @@ subroutine z_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call psb_info(ctxt, iam, np) if (sv%ipar(1) == amg_local_solver_ ) then call psb_init(ctxt1,np=1,basectxt=ctxt,ids=(/iam/)) - icomm = psb_get_mpi_comm(ctxt1) - allocate(sv%local_ctxt,stat=info) - sv%local_ctxt = ctxt1 - !write(*,*)iam,'mumps_bld: local +++++>',icomm,sv%local_ctxt - call psb_info(ctxt1, me, np) - npr = np else if (sv%ipar(1) == amg_global_solver_ ) then - icomm = psb_get_mpi_comm(ctxt) - !write(*,*)iam,'mumps_bld: global +++++>',icomm,ctxt - call psb_info(ctxt, iam, np) - me = iam - npr = np + call psb_init(ctxt1,basectxt=ctxt) else info = psb_err_internal_error_ call psb_errpush(info,name,& & a_err='Invalid local/global solver in MUMPS') goto 9999 end if + !allocate(sv%local_ctxt,stat=info) + icomm = ctxt1%get_mpic() + sv%local_ctxt = ctxt1 + !write(*,*)iam,'mumps_bld: local +++++>',icomm!,sv%local_ctxt%ctxt + call psb_info(ctxt1, me, npr) npc = 1 if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' start' @@ -115,8 +110,8 @@ subroutine z_mumps_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) end if end if + call mpi_comm_dup(icomm,sv%id%comm,info) - sv%id%comm = icomm sv%id%job = -1 sv%id%par = 1 if (sv%ipar(3) == 2) then From 1a2ec161d7915446e4258ebc4fafce29db26c0e5 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Thu, 16 Apr 2026 14:59:11 +0200 Subject: [PATCH 2/5] Improve configry for MUMPS --- configure | 145 +++++++++++++++++++++++++++++++++++++++++++++++++-- configure.ac | 6 ++- 2 files changed, 146 insertions(+), 5 deletions(-) diff --git a/configure b/configure index a85756f8..4cd30488 100755 --- a/configure +++ b/configure @@ -3451,7 +3451,7 @@ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Loaded $pac_cv_status_file $FC $MPIFC $BLACS_LIBS" >&5 printf "%s\n" "$as_me: Loaded $pac_cv_status_file $FC $MPIFC $BLACS_LIBS" >&6;} -am__api_version='1.17' +am__api_version='1.18' @@ -3721,10 +3721,14 @@ am_lf=' ' case `pwd` in *[\\\"\#\$\&\'\`$am_lf]*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; esac case $srcdir in *[\\\"\#\$\&\'\`$am_lf\ \ ]*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; esac @@ -4189,9 +4193,133 @@ AMTAR='$${TAR-tar}' # We'll loop over all known methods to create a tar archive until one works. -_am_tools='gnutar pax cpio none' +_am_tools='gnutar plaintar pax cpio none' + +# The POSIX 1988 'ustar' format is defined with fixed-size fields. + # There is notably a 21 bits limit for the UID and the GID. In fact, + # the 'pax' utility can hang on bigger UID/GID (see automake bug#8343 + # and bug#13588). + am_max_uid=2097151 # 2^21 - 1 + am_max_gid=$am_max_uid + # The $UID and $GID variables are not portable, so we need to resort + # to the POSIX-mandated id(1) utility. Errors in the 'id' calls + # below are definitely unexpected, so allow the users to see them + # (that is, avoid stderr redirection). + am_uid=`id -u || echo unknown` + am_gid=`id -g || echo unknown` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether UID '$am_uid' is supported by ustar format" >&5 +printf %s "checking whether UID '$am_uid' is supported by ustar format... " >&6; } + if test x$am_uid = xunknown; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: ancient id detected; assuming current UID is ok, but dist-ustar might not work" >&5 +printf "%s\n" "$as_me: WARNING: ancient id detected; assuming current UID is ok, but dist-ustar might not work" >&2;} + elif test $am_uid -le $am_max_uid; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + _am_tools=none + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether GID '$am_gid' is supported by ustar format" >&5 +printf %s "checking whether GID '$am_gid' is supported by ustar format... " >&6; } + if test x$gm_gid = xunknown; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: ancient id detected; assuming current GID is ok, but dist-ustar might not work" >&5 +printf "%s\n" "$as_me: WARNING: ancient id detected; assuming current GID is ok, but dist-ustar might not work" >&2;} + elif test $am_gid -le $am_max_gid; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + _am_tools=none + fi -am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to create a ustar tar archive" >&5 +printf %s "checking how to create a ustar tar archive... " >&6; } + + # Go ahead even if we have the value already cached. We do so because we + # need to set the values for the 'am__tar' and 'am__untar' variables. + _am_tools=${am_cv_prog_tar_ustar-$_am_tools} + + for _am_tool in $_am_tools; do + case $_am_tool in + gnutar) + for _am_tar in tar gnutar gtar; do + { echo "$as_me:$LINENO: $_am_tar --version" >&5 + ($_am_tar --version) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && break + done + am__tar="$_am_tar --format=ustar -chf - "'"$$tardir"' + am__tar_="$_am_tar --format=ustar -chf - "'"$tardir"' + am__untar="$_am_tar -xf -" + ;; + plaintar) + # Must skip GNU tar: if it does not support --format= it doesn't create + # ustar tarball either. + (tar --version) >/dev/null 2>&1 && continue + am__tar='tar chf - "$$tardir"' + am__tar_='tar chf - "$tardir"' + am__untar='tar xf -' + ;; + pax) + am__tar='pax -L -x ustar -w "$$tardir"' + am__tar_='pax -L -x ustar -w "$tardir"' + am__untar='pax -r' + ;; + cpio) + am__tar='find "$$tardir" -print | cpio -o -H ustar -L' + am__tar_='find "$tardir" -print | cpio -o -H ustar -L' + am__untar='cpio -i -H ustar -d' + ;; + none) + am__tar=false + am__tar_=false + am__untar=false + ;; + esac + + # If the value was cached, stop now. We just wanted to have am__tar + # and am__untar set. + test -n "${am_cv_prog_tar_ustar}" && break + + # tar/untar a dummy directory, and stop if the command works. + rm -rf conftest.dir + mkdir conftest.dir + echo GrepMe > conftest.dir/file + { echo "$as_me:$LINENO: tardir=conftest.dir && eval $am__tar_ >conftest.tar" >&5 + (tardir=conftest.dir && eval $am__tar_ >conftest.tar) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + rm -rf conftest.dir + if test -s conftest.tar; then + { echo "$as_me:$LINENO: $am__untar &5 + ($am__untar &5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + { echo "$as_me:$LINENO: cat conftest.dir/file" >&5 + (cat conftest.dir/file) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } + grep GrepMe conftest.dir/file >/dev/null 2>&1 && break + fi + done + rm -rf conftest.dir + + if test ${am_cv_prog_tar_ustar+y} +then : + printf %s "(cached) " >&6 +else case e in #( + e) am_cv_prog_tar_ustar=$_am_tool ;; +esac +fi + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_tar_ustar" >&5 +printf "%s\n" "$am_cv_prog_tar_ustar" >&6; } @@ -5210,7 +5338,10 @@ _ACEOF break fi done - rm -f core conftest* + # aligned with autoconf, so not including core; see bug#72225. + rm -f -r a.out a.exe b.out conftest.$ac_ext conftest.$ac_objext \ + conftest.dSYM conftest1.$ac_ext conftest1.$ac_objext conftest1.dSYM \ + conftest2.$ac_ext conftest2.$ac_objext conftest2.dSYM unset am_i ;; esac fi @@ -10651,6 +10782,12 @@ if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. " >&5 printf "%s\n" "$as_me: PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. " >&6;} fi + MUMPS_LIBS="-lsmumps -ldmumps -lcmumps -lzmumps -lmumps_common -lpord" + if test "x$amg4psblas_cv_mumpslibdir" != "x" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: MUMPSLIBDIR $amg4psblas_cv_mumpslibdir .." >&5 +printf "%s\n" "$as_me: MUMPSLIBDIR $amg4psblas_cv_mumpslibdir .." >&6;} + MUMPS_LIBS="${MUMPS_LIBS} -L$amg4psblas_cv_mumpslibdir" + fi if test "x$pac_mumps_fmods_ok" == "xyes" ; then FDEFINES="$amg_cv_define_prepend-DAMG_HAVE_MUMPS $amg_cv_define_prepend-DAMG_HAVE_MUMPS_MODULES $MUMPS_MODULES $FDEFINES" MUMPS_FLAGS="-DAMG_HAVE_MUMPS $MUMPS_MODULES" diff --git a/configure.ac b/configure.ac index 3acf94b8..d92efdf0 100755 --- a/configure.ac +++ b/configure.ac @@ -763,7 +763,11 @@ dnl fi if test "x$amg4psblas_cv_have_mumps" == "xyes" ; then if test "x$pac_cv_psblas_lpk" == "x8" ; then AC_MSG_NOTICE([PSBLAS defines PSB_LPK_ as $pac_cv_psblas_lpk. MUMPS interfacing will fail when called in global mode on very large matrices. ]) - fi + fi + MUMPS_LIBS="-lsmumps -ldmumps -lcmumps -lzmumps -lmumps_common -lpord" + if test "x$amg4psblas_cv_mumpslibdir" != "x" ; then + MUMPS_LIBS="${MUMPS_LIBS} -L$amg4psblas_cv_mumpslibdir" + fi if test "x$pac_mumps_fmods_ok" == "xyes" ; then FDEFINES="$amg_cv_define_prepend-DAMG_HAVE_MUMPS $amg_cv_define_prepend-DAMG_HAVE_MUMPS_MODULES $MUMPS_MODULES $FDEFINES" MUMPS_FLAGS="-DAMG_HAVE_MUMPS $MUMPS_MODULES" From 01cc7ada880b5adfad0086d9d85648c8bda4e2d2 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 27 Apr 2026 13:04:04 +0200 Subject: [PATCH 3/5] Adjust strategy for stopping on aggregation ratio --- amgprec/impl/amg_c_hierarchy_bld.F90 | 12 ++++-------- amgprec/impl/amg_d_hierarchy_bld.F90 | 13 ++++--------- amgprec/impl/amg_s_hierarchy_bld.F90 | 12 ++++-------- amgprec/impl/amg_z_hierarchy_bld.F90 | 12 ++++-------- 4 files changed, 16 insertions(+), 33 deletions(-) diff --git a/amgprec/impl/amg_c_hierarchy_bld.F90 b/amgprec/impl/amg_c_hierarchy_bld.F90 index 37e009ea..42deda4b 100644 --- a/amgprec/impl/amg_c_hierarchy_bld.F90 +++ b/amgprec/impl/amg_c_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then diff --git a/amgprec/impl/amg_d_hierarchy_bld.F90 b/amgprec/impl/amg_d_hierarchy_bld.F90 index 452a404f..d74801ed 100644 --- a/amgprec/impl/amg_d_hierarchy_bld.F90 +++ b/amgprec/impl/amg_d_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then @@ -434,7 +430,6 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat) & ilaggr,nlaggr,op_prol,info) if (do_timings) call psb_toc(idx_matasb) end if - if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i call psb_errpush(psb_err_internal_error_,name,& diff --git a/amgprec/impl/amg_s_hierarchy_bld.F90 b/amgprec/impl/amg_s_hierarchy_bld.F90 index 454847ef..826a1efa 100644 --- a/amgprec/impl/amg_s_hierarchy_bld.F90 +++ b/amgprec/impl/amg_s_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then diff --git a/amgprec/impl/amg_z_hierarchy_bld.F90 b/amgprec/impl/amg_z_hierarchy_bld.F90 index 6678530a..f01d8a1b 100644 --- a/amgprec/impl/amg_z_hierarchy_bld.F90 +++ b/amgprec/impl/amg_z_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then From 246992cb6526f638d0c52e3a26d4271fa7ae1ea1 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 27 Apr 2026 13:04:50 +0200 Subject: [PATCH 4/5] Add base matrix info to prec%descr --- amgprec/impl/amg_cfile_prec_descr.f90 | 13 ++++++++++++- amgprec/impl/amg_dfile_prec_descr.f90 | 13 ++++++++++++- amgprec/impl/amg_sfile_prec_descr.f90 | 13 ++++++++++++- amgprec/impl/amg_zfile_prec_descr.f90 | 13 ++++++++++++- 4 files changed, 48 insertions(+), 4 deletions(-) diff --git a/amgprec/impl/amg_cfile_prec_descr.f90 b/amgprec/impl/amg_cfile_prec_descr.f90 index 399e719b..130c719c 100644 --- a/amgprec/impl/amg_cfile_prec_descr.f90 +++ b/amgprec/impl/amg_cfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_dfile_prec_descr.f90 b/amgprec/impl/amg_dfile_prec_descr.f90 index 8d429643..fd2395d0 100644 --- a/amgprec/impl/amg_dfile_prec_descr.f90 +++ b/amgprec/impl/amg_dfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_sfile_prec_descr.f90 b/amgprec/impl/amg_sfile_prec_descr.f90 index 08a4032e..277b25f0 100644 --- a/amgprec/impl/amg_sfile_prec_descr.f90 +++ b/amgprec/impl/amg_sfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_zfile_prec_descr.f90 b/amgprec/impl/amg_zfile_prec_descr.f90 index 2fd88026..8f4864f2 100644 --- a/amgprec/impl/amg_zfile_prec_descr.f90 +++ b/amgprec/impl/amg_zfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. From 1ae3cc135f00c5406f8f955dc9807a0969c0e86b Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 4 May 2026 20:50:34 +0200 Subject: [PATCH 5/5] Improve error handling for prec%free --- amgprec/amg_c_prec_type.f90 | 5 +++++ amgprec/amg_d_prec_type.f90 | 5 +++++ amgprec/amg_s_prec_type.f90 | 5 +++++ amgprec/amg_z_prec_type.f90 | 5 +++++ 4 files changed, 20 insertions(+) diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index 6cb59939..0359efdd 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index 4ff41d15..1a9a932e 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 68ff409b..ea87bbf3 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index 7bc73992..9d44ca06 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if