From d45fffe4820f421800d4e87481e925734a88bf60 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 19 Apr 2026 12:49:11 +0200 Subject: [PATCH] Merged MUMPS fixes --- .../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