Commit 2d7d03d5 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Add default communicator of library.

* Error handling functions and such should now use PPM_default_comm instead
  of MPI_COMM_WORLD.
parent 2a48a879
......@@ -52,7 +52,7 @@ libscalesppm_a_SOURCES=ppm/scales_ppm.f90 \
solver/solver_all.f90 \
\
core/core.c core/core.h \
core/ppm_base.f90 \
core/ppm_base.f90 core/ppm_set_default_comm.f90 \
core/ppm_extents.f90 core/ppm_extents_c.c \
core/ppm_strided_extents.f90 core/ppm_strided_extents_c.c \
core/qsort_r.c core/qsort_fwrap.c core/ppm_std_type_kinds.f90
......
......@@ -57,6 +57,43 @@
#include <cfortran.h>
#include "core.h"
MPI_Comm PPM_default_comm =
#ifdef USE_MPI
MPI_COMM_WORLD
#else
0
#endif
;
void
PPM_set_default_comm_f(MPI_Fint *comm_f)
{
#if defined(USE_MPI) && defined(HAVE_MPI_COMM_F2C)
MPI_Comm comm_c = MPI_Comm_f2c((MPI_Fint)*comm_f);
#else
MPI_Comm comm_c = *comm_f;
#endif
PPM_default_comm = comm_c;
}
PROTOCCALLSFSUB1(PPM_SET_DEFAULT_COMM_F, ppm_set_default_comm_f, INT)
void
PPM_set_default_comm(MPI_Comm comm)
{
MPI_Fint comm_f;
#if defined(USE_MPI) && defined(HAVE_MPI_COMM_F2C)
comm_f = MPI_Comm_c2f(comm);
#else
comm_f = comm;
#endif
PPM_default_comm = comm;
CCALLSFSUB1(PPM_SET_DEFAULT_COMM_F, ppm_set_default_comm_f, INT, comm_f);
}
FCALLSCSUB1(PPM_set_default_comm_f, PPM_SET_DEFAULT_COMM,
ppm_set_default_comm, PVOID)
void
PPM_abort_f(MPI_Fint *comm_f, const char *msg, const char *source, int line)
......
......@@ -63,6 +63,12 @@ typedef int MPI_Fint;
typedef void (*PPM_abort_func)(MPI_Comm *comm, const char *msg,
const char *source, int line);
extern PPM_abort_func PPM_abort;
extern MPI_Comm PPM_default_comm;
extern void
PPM_set_default_comm(MPI_Comm comm);
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
......
......@@ -44,18 +44,23 @@
!
MODULE ppm_base
IMPLICIT NONE
PRIVATE
#ifdef USE_MPI
INCLUDE 'mpif.h'
#else
INTEGER, PARAMETER :: mpi_comm_world = 0
#endif
PRIVATE
INTEGER, SAVE :: ppm_default_comm = mpi_comm_world
INTERFACE
SUBROUTINE ppm_set_default_comm(comm)
INTEGER :: comm
END SUBROUTINE ppm_set_default_comm
SUBROUTINE ppm_abort(comm, msg, source, line)
INTEGER, INTENT(in) :: comm, line
CHARACTER(*), INTENT(in) :: msg, source
END SUBROUTINE ppm_abort
END INTERFACE
PUBLIC :: ppm_default_comm, set_default_comm
PUBLIC :: abort_ppm, assertion
CONTAINS
SUBROUTINE abort_ppm(msg, source, line, comm)
......@@ -66,11 +71,18 @@ CONTAINS
IF (PRESENT(comm)) THEN
comm_dummy = comm
ELSE
comm_dummy = mpi_comm_world
comm_dummy = ppm_default_comm
END IF
CALL ppm_abort(comm_dummy, msg, source, line)
END SUBROUTINE abort_ppm
SUBROUTINE set_default_comm(comm)
INTEGER, INTENT(in) :: comm
ppm_default_comm = comm
CALL ppm_set_default_comm(comm)
END SUBROUTINE set_default_comm
SUBROUTINE assertion(cond, origfile, origline, msg)
LOGICAL, INTENT(in) :: cond
CHARACTER(len=*), OPTIONAL, INTENT(in) :: origfile, msg
......
SUBROUTINE ppm_set_default_comm_f(comm)
USE ppm_base, ONLY: ppm_default_comm
INTEGER :: comm
ppm_default_comm = comm
END SUBROUTINE ppm_set_default_comm_f
......@@ -43,7 +43,7 @@
! Code:
!
MODULE scales_ppm
USE ppm_base, ONLY: abort_ppm
USE ppm_base, ONLY: abort_ppm, ppm_default_comm, set_default_comm
USE ppm_extents, ONLY: extent, extent_size, extent_end, &
extent_start, rebased_extent, &
extent_set_iinterval, extent_from_iinterval, char, iinterval, &
......@@ -74,7 +74,15 @@ MODULE scales_ppm
PUBLIC :: abort_ppm, initialize_scales_ppm
PUBLIC :: char
CONTAINS
SUBROUTINE initialize_scales_ppm
SUBROUTINE initialize_scales_ppm(default_comm)
INTEGER, OPTIONAL, INTENT(in) :: default_comm
INTEGER :: random_seed_arg
IF (PRESENT(default_comm)) THEN
ppm_default_comm = default_comm
CALL set_default_comm(default_comm)
END IF
END SUBROUTINE initialize_scales_ppm
END MODULE scales_ppm
!
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment