Commit 6bed5ec6 authored by Thomas Jahns's avatar Thomas Jahns 🤸
Browse files

Rename irand routines to PPM-prefix conformant symbols.

* This also fixes a race condition.
parent 6162e262
......@@ -32,6 +32,7 @@ if FC_MOD_UPPERCASE
PPM_MOD_NAME=SCALES_PPM
PPM_GRAPH_PARTITION_MPI_MOD_NAME=PPM_GRAPH_PARTITION_MPI
PPM_BASE_MOD_NAME=PPM_BASE
PPM_IRAND_INTERNAL_MOD_NAME=PPM_IRAND_INTERNAL
PPM_EXTENTS_MOD_NAME=PPM_EXTENTS
PPM_POSIX_MOD_NAME=PPM_POSIX
PPM_STD_TYPE_KINDS_MOD_NAME=PPM_STD_TYPE_KINDS
......@@ -51,6 +52,7 @@ else
PPM_MOD_NAME=scales_ppm
PPM_GRAPH_PARTITION_MPI_MOD_NAME=ppm_graph_partition_mpi
PPM_BASE_MOD_NAME=ppm_base
PPM_IRAND_INTERNAL_MOD_NAME=ppm_irand_internal
PPM_EXTENTS_MOD_NAME=ppm_extents
PPM_POSIX_MOD_NAME=ppm_posix
PPM_STD_TYPE_KINDS_MOD_NAME=ppm_std_type_kinds
......@@ -84,6 +86,10 @@ $(PPM_BASE_MOD_NAME).$(FCMODEXT): \
../../src/$(PPM_BASE_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(PPM_BASE_MOD_NAME).$(FCMODEXT) .
$(PPM_IRAND_INTERNAL_MOD_NAME).$(FCMODEXT): \
../../src/$(PPM_IRAND_INTERNAL_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(PPM_IRAND_INTERNAL_MOD_NAME).$(FCMODEXT) .
$(PPM_EXTENTS_MOD_NAME).$(FCMODEXT): \
../../src/$(PPM_EXTENTS_MOD_NAME).$(FCMODEXT)
$(LN_S) ../../src/$(PPM_EXTENTS_MOD_NAME).$(FCMODEXT) .
......@@ -137,6 +143,7 @@ $(SOLVER_ALL_MOD_NAME).$(FCMODEXT): ../../src/$(SOLVER_ALL_MOD_NAME).$(FCMODEXT)
include_HEADERS=$(PPM_MOD_NAME).$(FCMODEXT) \
$(PPM_BASE_MOD_NAME).$(FCMODEXT) \
$(PPM_IRAND_INTERNAL_MOD_NAME).$(FCMODEXT) \
$(PPM_EXTENTS_MOD_NAME).$(FCMODEXT) \
$(PPM_POSIX_MOD_NAME).$(FCMODEXT) \
$(PPM_STD_TYPE_KINDS_MOD_NAME).$(FCMODEXT) \
......
......@@ -53,7 +53,8 @@ libscalesppm_a_SOURCES=ppm/scales_ppm.f90 \
\
core/core.c core/core.h \
core/yarandom.c core/yarandom.h \
core/ppm_base.f90 core/ppm_set_default_comm.f90 \
core/ppm_base.f90 core/ppm_irand_internal.f90 \
core/ppm_set_default_comm.f90 \
core/ppm_posix.f90 core/ppm_posix_c.c \
core/ppm_extents.f90 core/ppm_extents_c.c \
core/ppm_strided_extents.f90 core/ppm_strided_extents_c.c \
......
......@@ -69,7 +69,7 @@ MPI_COMM_WORLD
#endif
;
void
static void
PPM_set_default_comm_f(MPI_Fint *comm_f)
{
#if defined(USE_MPI) && defined(HAVE_MPI_COMM_F2C)
......@@ -99,7 +99,7 @@ FCALLSCSUB1(PPM_set_default_comm_f, PPM_SET_DEFAULT_COMM,
ppm_set_default_comm, PVOID)
void
static void
PPM_abort_f(MPI_Fint *comm_f, const char *msg, const char *source, int line)
{
MPI_Comm comm_c;
......@@ -134,26 +134,26 @@ PPM_abort_default(MPI_Comm *comm, const char *msg, const char *source, int line)
PPM_abort_func PPM_abort = PPM_abort_default;
int
IRand()
PPM_irand()
{
uint32_t i = ppm_ya_random();
if (i == (uint32_t)-2147483648UL) i = (uint32_t)0U;
return (int)i;
}
FCALLSCFUN0(INT,IRand,IRAND,irand)
FCALLSCFUN0(INT,PPM_irand,PPM_IRAND,ppm_irand)
void
aIRand(int *a, int n)
PPM_irand_a(int *a, int n)
{
int i;
for (i = 0; i < n; ++i)
a[i] = IRand();
a[i] = PPM_irand();
}
FCALLSCSUB2(aIRand,A_RAND_I,a_rand_i,PINT,INT)
FCALLSCSUB2(PPM_irand_a,PPM_IRAND_A,ppm_irand_a,PINT,INT)
void
static void
initIRand_f(MPI_Fint *comm_f, int random_seed)
{
MPI_Comm comm_c;
......@@ -167,7 +167,7 @@ initIRand_f(MPI_Fint *comm_f, int random_seed)
ppm_ya_rand_init(&comm_c, random_seed);
}
FCALLSCSUB2(initIRand_f,INITIALIZE_IRAND,initialize_irand,PVOID,INT)
FCALLSCSUB2(initIRand_f,PPM_INITIALIZE_IRAND,ppm_initialize_irand,PVOID,INT)
/*
......
......@@ -43,6 +43,9 @@
! Code:
!
MODULE ppm_base
USE ppm_irand_internal, ONLY: irand => ppm_irand, &
initialize_irand => ppm_initialize_irand, &
a_rand
IMPLICIT NONE
PRIVATE
#ifdef USE_MPI
......@@ -60,31 +63,6 @@ MODULE ppm_base
CHARACTER(*), INTENT(in) :: msg, source
END SUBROUTINE ppm_abort
END INTERFACE
!> irand returns integers in the range irand_min..irand_max
INTEGER, PARAMETER :: irand_min=-2147483647, irand_max=2147483647
!> this function shall be implemented in an OpenMP-thread-safe means,
!! currently it's not
INTERFACE
FUNCTION irand()
INTEGER :: irand
END FUNCTION irand
END INTERFACE
INTERFACE
SUBROUTINE initialize_irand(comm, random_seed)
INTEGER, INTENT(inout) :: comm
INTEGER, INTENT(in) :: random_seed
END SUBROUTINE initialize_irand
END INTERFACE
!> unfortunately, Fortrans random number generator is only prepared
!! to produce REAL-type results, this add similar capabilities for
!! INTEGER results
INTERFACE a_rand
SUBROUTINE a_rand_i(a, n)
INTEGER, INTENT(out) :: a(*)
INTEGER, INTENT(in) :: n
END SUBROUTINE a_rand_i
MODULE PROCEDURE a_rand_i_1d
END INTERFACE a_rand
PUBLIC :: ppm_default_comm, set_default_comm
PUBLIC :: abort_ppm, assertion
PUBLIC :: irand, initialize_irand, a_rand
......@@ -134,11 +112,6 @@ CONTAINS
END IF
END SUBROUTINE assertion
SUBROUTINE a_rand_i_1d(a)
INTEGER, INTENT(out) :: a(:)
CALL a_rand(a(1:SIZE(a)), SIZE(a))
END SUBROUTINE a_rand_i_1d
END MODULE ppm_base
!
! Local Variables:
......
MODULE ppm_irand_internal
IMPLICIT NONE
PRIVATE
!> irand returns integers in the range irand_min..irand_max
INTEGER, PARAMETER :: irand_min=-2147483647, irand_max=2147483647
!> this function shall be implemented in an OpenMP-thread-safe means,
!! currently it's not
!! returns integers within range [irand_min,irand_max]
INTERFACE
FUNCTION ppm_irand()
INTEGER :: ppm_irand
END FUNCTION ppm_irand
END INTERFACE
!> unfortunately, Fortrans random number generator is only prepared
!! to produce REAL-type results, this add similar capabilities for
!! INTEGER results
INTERFACE a_rand
SUBROUTINE ppm_irand_a(a, n)
INTEGER, INTENT(out) :: a(*)
INTEGER, INTENT(in) :: n
END SUBROUTINE ppm_irand_a
MODULE PROCEDURE irand_a_1d
END INTERFACE a_rand
INTERFACE
SUBROUTINE ppm_initialize_irand(comm, random_seed)
INTEGER, INTENT(inout) :: comm
INTEGER, INTENT(in) :: random_seed
END SUBROUTINE ppm_initialize_irand
END INTERFACE
PUBLIC :: ppm_irand, ppm_initialize_irand, irand_min, irand_max, a_rand
CONTAINS
SUBROUTINE irand_a_1d(a)
INTEGER, INTENT(out) :: a(:)
CALL a_rand(a(1:SIZE(a)), SIZE(a))
END SUBROUTINE irand_a_1d
END MODULE ppm_irand_internal
!
! Local Variables:
! license-project-url: "https://www.dkrz.de/redmine/projects/show/scales-ppm"
! license-markup: "doxygen"
! license-default: "bsd"
! End:
......@@ -134,19 +134,22 @@ ppm_ya_rand_init(MPI_Comm *comm, int seed_arg)
seed = (999*tp.tv_sec) + (1001*tp.tv_usec) + (1003 * getpid()) + tid;
}
#ifdef _OPENMP
#pragma omp single
#pragma omp master
{
int n = omp_get_num_threads();
if (vidx) free(vidx);
if (a) free(a);
vidx = malloc(n * sizeof(*vidx));
a = malloc(n * sizeof(*a));
void *temp;
if (!(temp = realloc(vidx, n * sizeof(*vidx))))
free(vidx);
vidx = temp;
if (!(temp = realloc(a, n * sizeof(*a))))
free(a);
a = temp;
if (!vidx || !a)
PPM_abort(comm, "error in ppm_ya_rand_init", __FILE__, __LINE__);
}
#pragma omp barrier
#endif
/* allow to call gt_ya_rand_init() multiple times */
/* allow to call ppm_ya_rand_init() multiple times */
for (i = 0; i < VectorSize; i++)
a[tid][i] = a_source[i];
......
......@@ -22,6 +22,7 @@ PROGRAM test_irand
num_rands = MOD(IAND(irand(), 2147483647), 10000)
ALLOCATE(irand_res(num_rands, 0:num_threads-1))
!$omp end master
!$omp barrier
CALL initialize_irand(ppm_default_comm, 9)
DO i = 1, num_rands
irand_res(i, tid) = irand()
......@@ -30,6 +31,7 @@ PROGRAM test_irand
ref = MOD(tid + 1, num_threads)
inequality_found = inequality_found &
.OR. ANY(irand_res(:, tid) /= irand_res(:, ref))
!$omp barrier
CALL a_rand(irand_res(:, tid))
!$omp barrier
inequality_found = inequality_found &
......
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