fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-24 23:01:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

Improve psb_exit handling of MPI communicators

Browse Source
This commit is contained in:
sfilippone
2026-04-16 14:58:05 +02:00
parent 19ffaaa915
commit 3f83bc2918
1 changed files with 8 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/penv/psi_penv_mod.F90
+8 -8
View File
@@ -1035,6 +1035,8 @@ contains
! !$ call psb_error(ctxt)
! !$ endif
! !$ endif
if (close_) call psb_clear_vect_defaults()
if (close_) call psb_clear_mat_defaults()
#if defined(PSB_SERIAL_MPI)
! Under serial mode, CLOSE has no effect, but reclaim
! the used ctxt number.
@@ -1045,12 +1047,6 @@ contains
else
call psb_close_context(psb_mesg_queue,ctxt)
end if
!if ((ctxt /= mpi_comm_null).and.(ctxt /= mpi_comm_world)) then
if (allocated(ctxt%ctxt)) then
!write(0,*) ctxt%ctxt,mpi_comm_world,mpi_comm_null
if ((ctxt%ctxt /= mpi_comm_world).and.(ctxt%ctxt /= mpi_comm_null)) &
& call mpi_comm_Free(ctxt%ctxt,info)
end if
if (close_) then
if (info == 0) call mpi_op_free(mpi_i2amx_op,info)
if (info == 0) call mpi_op_free(mpi_i2amn_op,info)
@@ -1069,12 +1065,16 @@ contains
if (info == 0) call mpi_op_free(mpi_snrm2_op,info)
if (info == 0) call mpi_op_free(mpi_dnrm2_op,info)
end if
if (allocated(ctxt%ctxt)) then
!!$ write(0,*) ctxt%ctxt,mpi_comm_world,mpi_comm_null,mpi_comm_self
if ((ctxt%ctxt /= mpi_comm_world).and.(ctxt%ctxt /= mpi_comm_null).and.&
& (ctxt%ctxt /= mpi_comm_self)) &
& call mpi_comm_Free(ctxt%ctxt,info)
end if
if (close_) call mpi_finalize(info)
#endif
if (close_) call psb_clear_vect_defaults()
if (close_) call psb_clear_mat_defaults()
end subroutine psb_exit_mpik