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

Also add mt 64bit integer PRNG functions to Fortran API.

parent ca441f50
......@@ -74,6 +74,15 @@ MODULE ppm_irand_internal
END FUNCTION ppm_irandp
END INTERFACE
!> this function is implemented in an OpenMP-thread-safe means,
!! returns integers within range [0,irand8_max]
INTERFACE
FUNCTION ppm_irandp8()
USE ppm_std_type_kinds, ONLY: i8
INTEGER(i8) :: ppm_irandp8
END FUNCTION ppm_irandp8
END INTERFACE
!> these functions are implemented in an OpenMP-thread-safe means,
!! return integers within the specified range, which must be non-empty
INTERFACE ppm_irandr
......@@ -138,8 +147,9 @@ MODULE ppm_irand_internal
!> unfortunately, Fortrans random number generator is only prepared
!! to produce REAL-type results, this add similar capabilities for
!! INTEGER results in range [irand_min,irand_max]
!! and REALs in the range (-1.0,1.0)
!! INTEGER results in range [irand_min,irand_max] and
!! [irand8_min,irand8_max] respectively and REALs in the range
!! (-1.0,1.0)
INTERFACE a_rand
SUBROUTINE ppm_irand_a(a, n)
USE ppm_std_type_kinds, ONLY: i4
......@@ -307,6 +317,21 @@ MODULE ppm_irand_internal
INTEGER(i4), INTENT(out) :: a(n,1,*)
INTEGER, INTENT(in) :: n
END SUBROUTINE ppm_irand_mt_a_3d
SUBROUTINE ppm_irand8_mt_a(a, n)
USE ppm_std_type_kinds, ONLY: i8
INTEGER(i8), INTENT(out) :: a(*)
INTEGER, INTENT(in) :: n
END SUBROUTINE ppm_irand8_mt_a
SUBROUTINE ppm_irand8_mt_a_2d(a, n)
USE ppm_std_type_kinds, ONLY: i8
INTEGER(i8), INTENT(out) :: a(n,*)
INTEGER, INTENT(in) :: n
END SUBROUTINE ppm_irand8_mt_a_2d
SUBROUTINE ppm_irand8_mt_a_3d(a, n)
USE ppm_std_type_kinds, ONLY: i8
INTEGER(i8), INTENT(out) :: a(n,1,*)
INTEGER, INTENT(in) :: n
END SUBROUTINE ppm_irand8_mt_a_3d
SUBROUTINE ppm_drand_mt_a(a, n)
USE ppm_std_type_kinds, ONLY: dp
REAL(dp), INTENT(out) :: a(*)
......@@ -340,6 +365,9 @@ MODULE ppm_irand_internal
MODULE PROCEDURE irand_mt_a_1d
MODULE PROCEDURE irand_mt_a_2d
MODULE PROCEDURE irand_mt_a_3d
MODULE PROCEDURE irand8_mt_a_1d
MODULE PROCEDURE irand8_mt_a_2d
MODULE PROCEDURE irand8_mt_a_3d
MODULE PROCEDURE drand_mt_a_1d
MODULE PROCEDURE drand_mt_a_2d
MODULE PROCEDURE drand_mt_a_3d
......@@ -575,7 +603,7 @@ MODULE ppm_irand_internal
PUBLIC :: ppm_irandr, ppm_drandr, ppm_frandr
PUBLIC :: initialize_irand, finalize_irand
PUBLIC :: irand_min, irand_max
PUBLIC :: ppm_irand8, irand8_min, irand8_max, ppm_irandr8
PUBLIC :: ppm_irand8, irand8_min, irand8_max, ppm_irandp8, ppm_irandr8
PUBLIC :: a_rand, a_randp, a_randr, a_rand_mt, a_randp_mt, a_randr_mt
CONTAINS
SUBROUTINE irand_a_1d(a)
......@@ -683,6 +711,21 @@ CONTAINS
CALL a_rand_mt(a, SIZE(a))
END SUBROUTINE irand_mt_a_3d
SUBROUTINE irand8_mt_a_1d(a)
INTEGER(i8), INTENT(out) :: a(:)
CALL a_rand_mt(a, SIZE(a))
END SUBROUTINE irand8_mt_a_1d
SUBROUTINE irand8_mt_a_2d(a)
INTEGER(i8), INTENT(out) :: a(:, :)
CALL a_rand_mt(a, SIZE(a))
END SUBROUTINE irand8_mt_a_2d
SUBROUTINE irand8_mt_a_3d(a)
INTEGER(i8), INTENT(out) :: a(:, :, :)
CALL a_rand_mt(a, SIZE(a))
END SUBROUTINE irand8_mt_a_3d
SUBROUTINE drand_mt_a_1d(a)
REAL(dp), INTENT(out) :: a(:)
CALL a_rand_mt(a, SIZE(a))
......
......@@ -41,7 +41,8 @@ MODULE ppm_random
USE ppm_math_extensions, ONLY: m_pi_dp, m_pi_sp
USE ppm_irand_internal, ONLY: irand => ppm_irand, irandp => ppm_irandp, &
irandr => ppm_irandr, &
irand8 => ppm_irand8, irand8_min, irand8_max, &
irand8 => ppm_irand8, irandp8 => ppm_irandp8, irand8_min, irand8_max, &
irandr8 => ppm_irandr8, &
drand => ppm_drand, drandp => ppm_drandp, drandr => ppm_drandr, &
frand => ppm_frand, frandp => ppm_frandp, frandr => ppm_frandr, &
irand_min, irand_max, &
......@@ -56,7 +57,7 @@ MODULE ppm_random
PUBLIC :: a_rand, a_randp, a_randr, a_rand_mt, a_randp_mt
PUBLIC :: a_randr_mt, drand_normal, frand_normal
PUBLIC :: irand_min, irand_max
PUBLIC :: irand8, irand8_min, irand8_max
PUBLIC :: irand8, irand8_min, irand8_max, irandp8, irandr8
CONTAINS
!> return evenly distributed random logical value
FUNCTION lrand() RESULT(p)
......
......@@ -157,7 +157,8 @@ FCALLSCSUB2(PPM_frandp_mt_a_f,PPM_FRANDP_MT_A_3D,ppm_frandp_mt_a_3d,
FLOATVVV,INT)
static inline void
PPM_frandr_mt_a_f(float *restrict a, int n, struct PPM_iinterval_sp *restrict range)
PPM_frandr_mt_a_f(float *restrict a, int n,
struct PPM_iinterval_sp *restrict range)
{
assert(n >= 0);
PPM_frandr_mt_a(a, (size_t)n, *range);
......@@ -169,6 +170,49 @@ FCALLSCSUB3(PPM_frandr_mt_a_f,PPM_FRANDR_MT_A_2D,ppm_frandr_mt_a_2d,
FCALLSCSUB3(PPM_frandr_mt_a_f,PPM_FRANDR_MT_A_3D,ppm_frandr_mt_a_3d,
FLOATVVV,INT,PVOID)
static inline void
PPM_irand8_mt_a_f(int64_t *restrict a, int n)
{
assert(n >= 0);
PPM_irand8_mt_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irand8_mt_a_f,PPM_IRAND8_MT_A,ppm_irand8_mt_a,
INT64V,INT)
FCALLSCSUB2(PPM_irand8_mt_a_f,PPM_IRAND8_MT_A_2D,ppm_irand8_mt_a_2d,
INT64VV,INT)
FCALLSCSUB2(PPM_irand8_mt_a_f,PPM_IRAND8_MT_A_3D,ppm_irand8_mt_a_3d,
INT64VVV,INT)
static inline void
PPM_irandp8_mt_a_f(int64_t *restrict a, int n)
{
assert(n >= 0);
PPM_irandp8_mt_a(a, (size_t)n);
}
FCALLSCSUB2(PPM_irandp8_mt_a_f,PPM_IRANDP8_MT_A,ppm_irandp8_mt_a,
INT64V,INT)
FCALLSCSUB2(PPM_irandp8_mt_a_f,PPM_IRANDP8_MT_A_2D,ppm_irandp8_mt_a_2d,
INT64VV,INT)
FCALLSCSUB2(PPM_irandp8_mt_a_f,PPM_IRANDP8_MT_A_3D,ppm_irandp8_mt_a_3d,
INT64VVV,INT)
static inline void
PPM_irandr8_mt_a_f(int64_t *restrict a, int n,
struct PPM_iinterval64 *restrict range)
{
assert(n >= 0);
PPM_irandr8_mt_a(a, (size_t)n, *range);
}
FCALLSCSUB3(PPM_irandr8_mt_a_f,PPM_IRANDR8_MT_A,ppm_irandr8_mt_a,
INT64V,INT,PVOID)
FCALLSCSUB3(PPM_irandr8_mt_a_f,PPM_IRANDR8_MT_A_2D,ppm_irandr8_mt_a_2d,
INT64VV,INT,PVOID)
FCALLSCSUB3(PPM_irandr8_mt_a_f,PPM_IRANDR8_MT_A_3D,ppm_irandr8_mt_a_3d,
INT64VVV,INT,PVOID)
/*
* Local Variables:
* license-project-url: "https://www.dkrz.de/redmine/projects/scales-ppm"
......
Markdown is supported
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