mirror/MUSIC
1
0
Fork 0
mirror of https://github.com/cosmo-sims/MUSIC.git synced 2024-09-12 08:53:45 +02:00
Code Releases Activity

Merged in panphasia (pull request #3)

Browse source 
Panphasia
This commit is contained in:
Oliver Hahn 2023-02-14 00:12:25 +00:00
commit 5304b8141a
19 changed files with 7268 additions and 2831 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
CMakeLists.txt
View file

@ -71,6 +71,22 @@ file( GLOB PLUGINS
${PROJECT_SOURCE_DIR}/src/plugins/*.cc
)
# PANPHASIA
option(ENABLE_PANPHASIA "Enable PANPHASIA random number generator" ON)
if(ENABLE_PANPHASIA)
enable_language(Fortran)
if ("${CMAKE_Fortran_COMPILER_ID}" MATCHES "Intel")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -132 -implicit-none")
elseif("${CMAKE_Fortran_COMPILER_ID}" MATCHES "GNU")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffixed-line-length-132 -fimplicit-none")
endif()
list (APPEND SOURCES
${PROJECT_SOURCE_DIR}/ext/panphasia/panphasia_routines.f
${PROJECT_SOURCE_DIR}/ext/panphasia/generic_lecuyer.f90
)
# target_include_directories(${PRGNAME} PRIVATE ${PROJECT_SOURCE_DIR}/external/panphasia_ho)
endif(ENABLE_PANPHASIA)
add_executable(${PRGNAME} ${SOURCES} ${PLUGINS})
set_target_properties(${PRGNAME} PROPERTIES CXX_STANDARD 11)
@ -116,6 +132,10 @@ if(TIRPC_FOUND)
target_compile_options(${PRGNAME} PRIVATE "-DHAVE_TIRPC")
endif(TIRPC_FOUND)
if(ENABLE_PANPHASIA)
target_compile_options(${PRGNAME} PRIVATE "-DHAVE_PANPHASIA")
endif(ENABLE_PANPHASIA)
target_link_libraries(${PRGNAME} ${FFTW3_LIBRARIES})
target_include_directories(${PRGNAME} PRIVATE ${FFTW3_INCLUDE_DIRS})

683
ext/panphasia/generic_lecuyer.f90 Normal file
View file

@ -0,0 +1,683 @@
!=====================================================================================c
!
! The code below was written by: Stephen Booth
! Edinburgh Parallel Computing Centre
! The University of Edinburgh
! JCMB
! Mayfield Road
! Edinburgh EH9 3JZ
! United Kingdom
!
! This file is part of the software made public in
! Jenkins and Booth 2013 - arXiv:1306.XXXX
!
! The software computes the Panphasia Gaussian white noise field
! realisation described in detail in Jenkins 2013 - arXiv:1306.XXXX
!
!
!
! This software is free, subject to a agreeing licence conditions:
!
!
! (i) you will publish the phase descriptors and reference Jenkins (13)
! for any new simulations that use Panphasia phases. You will pass on this
! condition to others for any software or data you make available publically
! or privately that makes use of Panphasia.
!
! (ii) that you will ensure any publications using results derived from Panphasia
! will be submitted as a final version to arXiv prior to or coincident with
! publication in a journal.
!
!
! (iii) that you report any bugs in this software as soon as confirmed to
! A.R.Jenkins@durham.ac.uk
!
! (iv) that you understand that this software comes with no warranty and that is
! your responsibility to ensure that it is suitable for the purpose that
! you intend.
!
!=====================================================================================c
!{{{Rand_base (define kind types)
MODULE Rand_base
! This module just declares the base types
! we may have to edit this to match to the target machine
! we really need a power of 2 selected int kind in fortran-95 we could
! do this with a PURE function I think.
!
! 10 decimal digits will hold 2^31
!
INTEGER, PARAMETER :: Sint = SELECTED_INT_KIND(9)
! INTEGER, PARAMETER :: Sint = SELECTED_INT_KIND(10)
! INTEGER, PARAMETER :: Sint = 4
!
! 18-19 decimal digits will hold 2^63
! but all 19 digit numbers require 2^65 :-(
!
INTEGER, PARAMETER :: Dint = SELECTED_INT_KIND(17)
! INTEGER, PARAMETER :: Dint = SELECTED_INT_KIND(18)
! INTEGER, PARAMETER :: Dint = 8
! type for index counters must hold Nstore
INTEGER, PARAMETER :: Ctype = SELECTED_INT_KIND(3)
END MODULE Rand_base
!}}}
!{{{Rand_int (random integers mod 2^31-1)
MODULE Rand_int
USE Rand_base
IMPLICIT NONE
! The general approach of this module is two have
! two types Sint and Dint
!
! Sint should have at least 31 bits
! dint shouldhave at least 63
!{{{constants
INTEGER(KIND=Ctype), PARAMETER :: Nstate=5_Ctype
INTEGER(KIND=Ctype), PRIVATE, PARAMETER :: Nbatch=128_Ctype
INTEGER(KIND=Ctype), PRIVATE, PARAMETER :: Nstore=Nstate+Nbatch
INTEGER(KIND=Sint), PRIVATE, PARAMETER :: M = 2147483647_Sint
INTEGER(KIND=Dint), PRIVATE, PARAMETER :: Mask = 2147483647_Dint
INTEGER(KIND=Dint), PRIVATE, PARAMETER :: A1 = 107374182_Dint
INTEGER(KIND=Dint), PRIVATE, PARAMETER :: A5 = 104480_Dint
LOGICAL, PARAMETER :: Can_step_int=.TRUE.
LOGICAL, PARAMETER :: Can_reverse_int=.TRUE.
!}}}
!{{{Types
!
! This type holds the state of the generator
!
!{{{TYPE RAND_state
TYPE RAND_state
PRIVATE
INTEGER(KIND=Sint) :: state(Nstore)
! do we need to re-fill state table this is reset when we initialise state.
LOGICAL :: need_fill
! position of the next state variable to output
INTEGER(KIND=Ctype) :: pos
END TYPE RAND_state
!}}}
!
! This type defines the offset type used for stepping.
!
!{{{TYPE RAND_offset
TYPE RAND_offset
PRIVATE
INTEGER(KIND=Sint) :: poly(Nstate)
END TYPE RAND_offset
!}}}
!}}}
!{{{interface and overloads
!
! Allow automatic conversion between integers and offsets
!
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE Rand_set_offset
MODULE PROCEDURE Rand_load
MODULE PROCEDURE Rand_save
MODULE PROCEDURE Rand_seed
END INTERFACE
INTERFACE OPERATOR(+)
MODULE PROCEDURE Rand_add_offset
END INTERFACE
INTERFACE OPERATOR(*)
MODULE PROCEDURE Rand_mul_offset
END INTERFACE
!
! overload + as the boost/stepping operator
!
INTERFACE OPERATOR(+)
MODULE PROCEDURE Rand_step
MODULE PROCEDURE Rand_boost
END INTERFACE
!}}}
!{{{PUBLIC/PRIVATE
PRIVATE reduce,mod_saxpy,mod_sdot,p_saxpy,p_sdot,poly_mult
PRIVATE poly_square, poly_power
PRIVATE fill_state, repack_state
PUBLIC Rand_sint, Rand_sint_vec
PUBLIC Rand_save, Rand_load
PUBLIC Rand_set_offset, Rand_add_offset, Rand_mul_offset
PUBLIC Rand_step, Rand_boost, Rand_seed
!}}}
CONTAINS
!{{{Internals
!{{{RECURSIVE FUNCTION reduce(A)
RECURSIVE FUNCTION reduce(A)
!
! Take A Dint and reduce to Sint MOD M
!
INTEGER(KIND=Dint), INTENT(IN) :: A
INTEGER(KIND=Sint) reduce
INTEGER(KIND=Dint) tmp
tmp = A
DO WHILE( ISHFT(tmp, -31) .GT. 0 )
tmp = IAND(tmp,Mask) + ISHFT(tmp, -31)
END DO
IF( tmp .GE. M ) THEN
reduce = tmp - M
ELSE
reduce = tmp
END IF
END FUNCTION reduce
!}}}
!{{{RECURSIVE SUBROUTINE fill_state(x)
RECURSIVE SUBROUTINE fill_state(x)
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER(KIND=Ctype) i
INTRINSIC IAND, ISHFT
INTEGER(KIND=Dint) tmp
DO i=Nstate+1,Nstore
tmp = (x%state(i-5) * A5) + (x%state(i-1)*A1)
!
! now reduce down to mod M efficiently
! really hope the compiler in-lines this
!
! x%state(i) = reduce(tmp)
DO WHILE( ISHFT(tmp, -31) .GT. 0 )
tmp = IAND(tmp,Mask) + ISHFT(tmp, -31)
END DO
IF( tmp .GE. M ) THEN
x%state(i) = tmp - M
ELSE
x%state(i) = tmp
END IF
END DO
x%need_fill = .FALSE.
END SUBROUTINE fill_state
!}}}
!{{{RECURSIVE SUBROUTINE repack_state(x)
RECURSIVE SUBROUTINE repack_state(x)
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER(KIND=Ctype) i
DO i=1,Nstate
x%state(i) = x%state(i+x%pos-(Nstate+1))
END DO
x%pos = Nstate + 1
x%need_fill = .TRUE.
END SUBROUTINE repack_state
!}}}
!{{{RECURSIVE SUBROUTINE mod_saxpy(y,a,x)
RECURSIVE SUBROUTINE mod_saxpy(y,a,x)
INTEGER(KIND=Ctype) i
INTEGER(KIND=Sint) y(Nstate)
INTEGER(KIND=Sint) a
INTEGER(KIND=Sint) x(Nstate)
INTEGER(KIND=Dint) tx,ty,ta
IF( a .EQ. 0_Sint ) RETURN
! We use KIND=Dint temporaries here to ensure
! that we don't overflow in the expression
ta = a
DO i=1,Nstate
ty=y(i)
tx=x(i)
y(i) = reduce(ty + ta * tx)
END DO
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE mod_sdot(res,x,y)
RECURSIVE SUBROUTINE mod_sdot(res,x,y)
INTEGER(KIND=Sint), INTENT(OUT) :: res
INTEGER(KIND=Sint), INTENT(IN) :: x(Nstate) , y(Nstate)
INTEGER(KIND=Dint) dx, dy, dtmp
INTEGER(KIND=Sint) tmp
INTEGER(KIND=Ctype) i
tmp = 0
DO i=1,Nstate
dx = x(i)
dy = y(i)
dtmp = tmp
tmp = reduce(dtmp + dx * dy)
END DO
res = tmp
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE p_saxpy(y,a)
RECURSIVE SUBROUTINE p_saxpy(y,a)
! Calculates mod_saxpy(y,a,P)
INTEGER(KIND=Sint), INTENT(INOUT) :: y(Nstate)
INTEGER(KIND=Sint), INTENT(IN) :: a
INTEGER(KIND=Dint) tmp, dy, da
dy = y(1)
da = a
tmp = dy + da*A5
y(1) = reduce(tmp)
dy = y(5)
da = a
tmp = dy + da*A1
y(5) = reduce(tmp)
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE p_sdot(res,n,x)
RECURSIVE SUBROUTINE p_sdot(res,x)
INTEGER(KIND=Sint), INTENT(OUT) :: res
INTEGER(KIND=Sint), INTENT(IN) :: x(Nstate)
INTEGER(KIND=Dint) dx1, dx5, dtmp
dx1 = x(1)
dx5 = x(5)
dtmp = A1*dx5 + A5*dx1
res = reduce(dtmp)
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE poly_mult(a,b)
RECURSIVE SUBROUTINE poly_mult(a,b)
INTEGER(KIND=Sint), INTENT(INOUT) :: a(Nstate)
INTEGER(KIND=Sint), INTENT(IN) :: b(Nstate)
INTEGER(KIND=Sint) tmp((2*Nstate) - 1)
INTEGER(KIND=Ctype) i
tmp = 0_Sint
DO i=1,Nstate
CALL mod_saxpy(tmp(i:Nstate+i-1),a(i), b)
END DO
DO i=(2*Nstate)-1, Nstate+1, -1
CALL P_SAXPY(tmp(i-Nstate:i-1),tmp(i))
END DO
a = tmp(1:Nstate)
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE poly_square(a)
RECURSIVE SUBROUTINE poly_square(a)
INTEGER(KIND=Sint), INTENT(INOUT) :: a(Nstate)
INTEGER(KIND=Sint) tmp((2*Nstate) - 1)
INTEGER(KIND=Ctype) i
tmp = 0_Sint
DO i=1,Nstate
CALL mod_saxpy(tmp(i:Nstate+i-1),a(i), a)
END DO
DO i=(2*Nstate)-1, Nstate+1, -1
CALL P_SAXPY(tmp(i-Nstate:i-1),tmp(i))
END DO
a = tmp(1:Nstate)
END SUBROUTINE
!}}}
!{{{RECURSIVE SUBROUTINE poly_power(poly,n)
RECURSIVE SUBROUTINE poly_power(poly,n)
INTEGER(KIND=Sint), INTENT(INOUT) :: poly(Nstate)
INTEGER, INTENT(IN) :: n
INTEGER nn
INTEGER(KIND=Sint) x(Nstate), out(Nstate)
IF( n .EQ. 0 )THEN
poly = 0_Sint
poly(1) = 1_Sint
RETURN
ELSE IF( n .LT. 0 )THEN
poly = 0_Sint
RETURN
END IF
out = 0_sint
out(1) = 1_Sint
x = poly
nn = n
DO WHILE( nn .GT. 0 )
IF( MOD(nn,2) .EQ. 1 )THEN
call poly_mult(out,x)
END IF
nn = nn/2
IF( nn .GT. 0 )THEN
call poly_square(x)
END IF
END DO
poly = out
END SUBROUTINE poly_power
!}}}
!}}}
!{{{RECURSIVE SUBROUTINE Rand_seed( state, n )
RECURSIVE SUBROUTINE Rand_seed( state, n )
TYPE(Rand_state), INTENT(OUT) :: state
INTEGER, INTENT(IN) :: n
! initialise the genrator using a single integer
! fist initialise to an arbitrary state then boost by a multiple
! of a long distance
!
! state is moved forward by P^n steps
! we want this to be ok for seperating parallel sequences on MPP machines
! P is taken as a prime number as this should prevent strong correlations
! when the generators are operated in tight lockstep.
! equivalent points on different processors will also be related by a
! primative polynomial
! P is 2^48-59
TYPE(Rand_state) tmp
TYPE(Rand_offset), PARAMETER :: P = &
Rand_offset( (/ 1509238949_Sint ,2146167999_Sint ,1539340803_Sint , &
1041407428_Sint ,666274987_Sint /) )
CALL Rand_load( tmp, (/ 5, 4, 3, 2, 1 /) )
state = Rand_boost( tmp, Rand_mul_offset(P, n ))
END SUBROUTINE Rand_seed
!}}}
!{{{RECURSIVE SUBROUTINE Rand_load( state, input )
RECURSIVE SUBROUTINE Rand_load( state, input )
TYPE(RAND_state), INTENT(OUT) :: state
INTEGER, INTENT(IN) :: input(Nstate)
INTEGER(KIND=Ctype) i
state%state = 0_Sint
DO i=1,Nstate
state%state(i) = MOD(INT(input(i),KIND=Sint),M)
END DO
state%need_fill = .TRUE.
state%pos = Nstate + 1
END SUBROUTINE Rand_load
!}}}
!{{{RECURSIVE SUBROUTINE Rand_save( save_vec,state )
RECURSIVE SUBROUTINE Rand_save( save_vec, x )
INTEGER, INTENT(OUT) :: save_vec(Nstate)
TYPE(RAND_state), INTENT(IN) :: x
INTEGER(KIND=Ctype) i
DO i=1,Nstate
save_vec(i) = x%state(x%pos-(Nstate+1) + i)
END DO
END SUBROUTINE Rand_save
!}}}
!{{{RECURSIVE SUBROUTINE Rand_set_offset( offset, n )
RECURSIVE SUBROUTINE Rand_set_offset( offset, n )
TYPE(Rand_offset), INTENT(OUT) :: offset
INTEGER, INTENT(IN) :: n
offset%poly = 0_Sint
IF ( n .GE. 0 ) THEN
offset%poly(2) = 1_Sint
call poly_power(offset%poly,n)
ELSE
!
! This is X^-1
!
offset%poly(4) = 858869107_Sint
offset%poly(5) = 1840344978_Sint
call poly_power(offset%poly,-n)
END IF
END SUBROUTINE Rand_set_offset
!}}}
!{{{TYPE(Rand_offset) RECURSIVE FUNCTION Rand_add_offset( a, b )
TYPE(Rand_offset) RECURSIVE FUNCTION Rand_add_offset( a, b )
TYPE(Rand_offset), INTENT(IN) :: a, b
Rand_add_offset = a
CALL poly_mult(Rand_add_offset%poly,b%poly)
RETURN
END FUNCTION Rand_add_offset
!}}}
!{{{TYPE(Rand_offset) RECURSIVE FUNCTION Rand_mul_offset( a, n )
TYPE(Rand_offset) RECURSIVE FUNCTION Rand_mul_offset( a, n )
TYPE(Rand_offset), INTENT(IN) :: a
INTEGER, INTENT(IN) :: n
Rand_mul_offset = a
CALL poly_power(Rand_mul_offset%poly,n)
RETURN
END FUNCTION Rand_mul_offset
!}}}
!{{{RECURSIVE FUNCTION Rand_boost(x, offset)
RECURSIVE FUNCTION Rand_boost(x, offset)
TYPE(Rand_state) Rand_boost
TYPE(Rand_state), INTENT(IN) :: x
TYPE(Rand_offset), INTENT(IN) :: offset
INTEGER(KIND=Sint) tmp(2*Nstate-1), res(Nstate)
INTEGER(KIND=Ctype) i
DO i=1,Nstate
tmp(i) = x%state(x%pos-(Nstate+1) + i)
END DO
tmp(Nstate+1:) = 0_Sint
DO i=1,Nstate-1
call P_SDOT(tmp(i+Nstate),tmp(i:Nstate+i-1))
END DO
DO i=1,Nstate
call mod_sdot(res(i),offset%poly,tmp(i:Nstate+i-1))
END DO
Rand_boost%state = 0_Sint
DO i=1,Nstate
Rand_boost%state(i) = res(i)
END DO
Rand_boost%need_fill = .TRUE.
Rand_boost%pos = Nstate + 1
END FUNCTION Rand_boost
!}}}
!{{{RECURSIVE FUNCTION Rand_step(x, n)
RECURSIVE FUNCTION Rand_step(x, n)
TYPE(Rand_state) Rand_step
TYPE(RAND_state), INTENT(IN) :: x
INTEGER, INTENT(IN) :: n
TYPE(Rand_offset) tmp
CALL Rand_set_offset(tmp,n)
Rand_step=Rand_boost(x,tmp)
END FUNCTION
!}}}
!{{{RECURSIVE FUNCTION Rand_sint(x)
RECURSIVE FUNCTION Rand_sint(x)
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER(KIND=Sint) Rand_sint
IF( x%pos .GT. Nstore )THEN
CALL repack_state(x)
END IF
IF( x%need_fill ) CALL fill_state(x)
Rand_sint = x%state(x%pos)
x%pos = x%pos + 1
RETURN
END FUNCTION Rand_sint
!}}}
!{{{RECURSIVE SUBROUTINE Rand_sint_vec(iv,x)
RECURSIVE SUBROUTINE Rand_sint_vec(iv,x)
INTEGER(KIND=Sint), INTENT(OUT) :: iv(:)
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER left,start, chunk, i
start=1
left=SIZE(iv)
DO WHILE( left .GT. 0 )
IF( x%pos .GT. Nstore )THEN
CALL repack_state(x)
END IF
IF( x%need_fill ) CALL fill_state(x)
chunk = MIN(left,Nstore-x%pos+1)
DO i=0,chunk-1
iv(start+i) = x%state(x%pos+i)
END DO
start = start + chunk
x%pos = x%pos + chunk
left = left - chunk
END DO
RETURN
END SUBROUTINE Rand_sint_vec
!}}}
END MODULE Rand_int
!}}}
!{{{Rand (use Rand_int to make random reals)
MODULE Rand
USE Rand_int
IMPLICIT NONE
!{{{Parameters
INTEGER, PARAMETER :: RAND_kind1 = SELECTED_REAL_KIND(10)
INTEGER, PARAMETER :: RAND_kind2 = SELECTED_REAL_KIND(6)
INTEGER, PARAMETER, PRIVATE :: Max_block=100
INTEGER(KIND=Sint), PRIVATE, PARAMETER :: M = 2147483647
REAL(KIND=RAND_kind1), PRIVATE, PARAMETER :: INVMP1_1 = ( 1.0_RAND_kind1 / 2147483647.0_RAND_kind1 )
REAL(KIND=RAND_kind2), PRIVATE, PARAMETER :: INVMP1_2 = ( 1.0_RAND_kind2 / 2147483647.0_RAND_kind2 )
LOGICAL, PARAMETER :: Can_step = Can_step_int
LOGICAL, PARAMETER :: Can_reverse = Can_reverse_int
!}}}
PUBLIC Rand_real
INTERFACE Rand_real
MODULE PROCEDURE Rand_real1
MODULE PROCEDURE Rand_real2
MODULE PROCEDURE Rand_real_vec1
MODULE PROCEDURE Rand_real_vec2
END INTERFACE
CONTAINS
!{{{RECURSIVE SUBROUTINE Rand_real1(y,x)
RECURSIVE SUBROUTINE Rand_real1(y,x)
REAL(KIND=RAND_kind1), INTENT(OUT) :: y
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER(KIND=Sint) Z
Z = Rand_sint(x)
IF (Z .EQ. 0) Z = M
y = ((Z-0.5d0)*INVMP1_1)
RETURN
END SUBROUTINE Rand_real1
!}}}
!{{{RECURSIVE SUBROUTINE Rand_real2(y,x)
RECURSIVE SUBROUTINE Rand_real2(y,x)
REAL(KIND=RAND_kind2), INTENT(OUT) :: y
TYPE(RAND_state), INTENT(INOUT) :: x
INTEGER(KIND=Sint) Z
Z = Rand_sint(x)
IF (Z .EQ. 0) Z = M
y = ((Z-0.5d0)*INVMP1_1) ! generate in double and truncate.
RETURN
END SUBROUTINE Rand_real2
!}}}
!{{{RECURSIVE SUBROUTINE Rand_real_vec1(rv,x)
RECURSIVE SUBROUTINE Rand_real_vec1(rv,x)
TYPE(RAND_state), INTENT(INOUT) :: x
REAL(KIND=RAND_kind1) rv(:)
INTEGER left,start, chunk, i
INTEGER(KIND=Sint) Z
INTEGER(KIND=Sint) temp(MIN(SIZE(rv),Max_block))
start=0
left=SIZE(rv)
DO WHILE( left .GT. 0 )
chunk = MIN(left,Max_block)
CALL Rand_sint_vec(temp(1:chunk),x)
DO i=1,chunk
Z = temp(i)
IF (Z .EQ. 0) Z = M
rv(start+i) = (Z-0.5d0)*INVMP1_1
END DO
start = start + chunk
left = left - chunk
END DO
RETURN
END SUBROUTINE Rand_real_vec1
!}}}
!{{{RECURSIVE SUBROUTINE Rand_real_vec2(rv,x)
RECURSIVE SUBROUTINE Rand_real_vec2(rv,x)
TYPE(RAND_state), INTENT(INOUT) :: x
REAL(KIND=RAND_kind2) rv(:)
INTEGER left,start, chunk, i
INTEGER(KIND=Sint) Z
INTEGER(KIND=Sint) temp(MIN(SIZE(rv),Max_block))
start=0
left=SIZE(rv)
DO WHILE( left .GT. 0 )
chunk = MIN(left,Max_block)
CALL Rand_sint_vec(temp(1:chunk),x)
DO i=1,chunk
Z = temp(i)
IF (Z .EQ. 0) Z = M
rv(start+i) = (Z-0.5d0)*INVMP1_2
END DO
start = start + chunk
left = left - chunk
END DO
RETURN
END SUBROUTINE Rand_real_vec2
!}}}
END MODULE Rand
!}}}
!{{{test program
! PROGRAM test_random
! use Rand
! TYPE(RAND_state) x
! REAL y
! CALL Rand_load(x,(/5,4,3,2,1/))
! DO I=0,10
! CALL Rand_real(y,x)
! WRITE(*,10) I,y
! END DO
!
!10 FORMAT(I10,E25.16)
!
! END
! 0 0.5024326127022505E-01
! 1 0.8260946767404675E-01
! 2 0.2123264316469431E-01
! 3 0.6926658791489899E+00
! 4 0.2076155943796039E+00
! 5 0.4327449947595596E-01
! 6 0.2204052871093154E-01
! 7 0.1288446951657534E+00
! 8 0.4859915426932275E+00
! 9 0.5721384193748236E-01
! 10 0.7996825082227588E+00
!
!}}}

3334
ext/panphasia/panphasia_routines.f Normal file
View file

File diff suppressed because it is too large Load diff

3
ics_example.conf
View file

@ -12,8 +12,7 @@ align_top = no
baryons = no
use_2LPT = no
use_LLA = no
periodic_TF = yes
zero_zoom_velocity = no
[cosmology]
Omega_m = 0.276

116
src/convolution_kernel.cc
View file

@ -1,10 +1,9 @@
/*
convolution_kernel.cc - This file is part of MUSIC -
a code to generate multi-scale initial conditions
for cosmological simulations
a code to generate multi-scale initial conditions for cosmological simulations
Copyright (C) 2010-19 Oliver Hahn
Copyright (C) 2010-23 Oliver Hahn
*/
@ -35,7 +34,8 @@ void perform(kernel *pk, void *pd, bool shift, bool fix, bool flip)
double fftnormp = 1.0/sqrt((double)cparam_.nx * (double)cparam_.ny * (double)cparam_.nz);
double fftnorm = pow(2.0 * M_PI, 1.5) / sqrt(cparam_.lx * cparam_.ly * cparam_.lz) * fftnormp;
fftw_complex *cdata, *ckernel;
fftw_complex *cdata;
[[maybe_unused]] fftw_complex *ckernel;
fftw_real *data;
data = reinterpret_cast<fftw_real *>(pd);
@ -96,16 +96,23 @@ void perform(kernel *pk, void *pd, bool shift, bool fix, bool flip)
std::complex<double> dcmode(RE(cdata[0]), IM(cdata[0]));
if (!pk->is_ksampled())
#pragma omp parallel
{
#pragma omp parallel for
const size_t veclen = cparam_.nz / 2 + 1;
double *kvec = new double[veclen];
double *Tkvec = new double[veclen];
double *argvec = new double[veclen];
#pragma omp for
for (int i = 0; i < cparam_.nx; ++i)
for (int j = 0; j < cparam_.ny; ++j)
{
for (int k = 0; k < cparam_.nz / 2 + 1; ++k)
{
size_t ii = (size_t)(i * cparam_.ny + j) * (size_t)(cparam_.nz / 2 + 1) + (size_t)k;
double kx, ky, kz;
kx = (double)i;
@ -117,92 +124,42 @@ void perform(kernel *pk, void *pd, bool shift, bool fix, bool flip)
if (ky > cparam_.ny / 2)
ky -= cparam_.ny;
double arg = (kx + ky + kz) * dstag;
std::complex<double> carg(cos(arg), sin(arg));
kvec[k] = sqrt(kx * kx + ky * ky + kz * kz);
argvec[k] = (kx + ky + kz) * dstag;
}
std::complex<double>
ccdata(RE(cdata[ii]), IM(cdata[ii])),
cckernel(RE(ckernel[ii]), IM(ckernel[ii]));
pk->at_k(veclen, kvec, Tkvec);
for (int k = 0; k < cparam_.nz / 2 + 1; ++k)
{
size_t ii = (size_t)(i * cparam_.ny + j) * (size_t)(cparam_.nz / 2 + 1) + (size_t)k;
std::complex<double> carg(cos(argvec[k]), sin(argvec[k]));
std::complex<double> ccdata(RE(cdata[ii]), IM(cdata[ii]));
if( fix ){
ccdata = ccdata / std::abs(ccdata);
ccdata = ccdata / std::abs(ccdata) / fftnormp;
}
if( flip ){
ccdata = -ccdata;
}
ccdata = ccdata * cckernel * fftnorm * carg;
ccdata = ccdata * Tkvec[k] * fftnorm * carg;
RE(cdata[ii]) = ccdata.real();
IM(cdata[ii]) = ccdata.imag();
}
}
delete[] kvec;
delete[] Tkvec;
delete[] argvec;
}
else
{
#pragma omp parallel
{
// we now set the correct DC mode below...
RE(cdata[0]) = 0.0;
IM(cdata[0]) = 0.0;
const size_t veclen = cparam_.nz / 2 + 1;
double *kvec = new double[veclen];
double *Tkvec = new double[veclen];
double *argvec = new double[veclen];
#pragma omp for
for (int i = 0; i < cparam_.nx; ++i)
for (int j = 0; j < cparam_.ny; ++j)
{
for (int k = 0; k < cparam_.nz / 2 + 1; ++k)
{
double kx, ky, kz;
kx = (double)i;
ky = (double)j;
kz = (double)k;
if (kx > cparam_.nx / 2)
kx -= cparam_.nx;
if (ky > cparam_.ny / 2)
ky -= cparam_.ny;
kvec[k] = sqrt(kx * kx + ky * ky + kz * kz);
argvec[k] = (kx + ky + kz) * dstag;
}
pk->at_k(veclen, kvec, Tkvec);
for (int k = 0; k < cparam_.nz / 2 + 1; ++k)
{
size_t ii = (size_t)(i * cparam_.ny + j) * (size_t)(cparam_.nz / 2 + 1) + (size_t)k;
std::complex<double> carg(cos(argvec[k]), sin(argvec[k]));
std::complex<double> ccdata(RE(cdata[ii]), IM(cdata[ii]));
if( fix ){
ccdata = ccdata / std::abs(ccdata) / fftnormp;
}
if( flip ){
ccdata = -ccdata;
}
ccdata = ccdata * Tkvec[k] * fftnorm * carg;
RE(cdata[ii]) = ccdata.real();
IM(cdata[ii]) = ccdata.imag();
}
}
delete[] kvec;
delete[] Tkvec;
delete[] argvec;
}
// we now set the correct DC mode below...
RE(cdata[0]) = 0.0;
IM(cdata[0]) = 0.0;
}
LOGUSER("Performing backward FFT...");
@ -229,7 +186,6 @@ void perform(kernel *pk, void *pd, bool shift, bool fix, bool flip)
#endif
// set the DC mode here to avoid a possible truncation error in single precision
if (pk->is_ksampled())
{
size_t nelem = (size_t)cparam_.nx * (size_t)cparam_.ny * (size_t)cparam_.nz;
real_t mean = dcmode.real() * fftnorm / (real_t)nelem;

3
src/convolution_kernel.hh
View file

@ -4,7 +4,7 @@
a code to generate multi-scale initial conditions
for cosmological simulations
Copyright (C) 2010-19 Oliver Hahn
Copyright (C) 2010-23 Oliver Hahn
*/
@ -16,6 +16,7 @@
#include "config_file.hh"
#include "densities.hh"
#include "density_grid.hh"
#include "transfer_function.hh"
#define ACC_RF(i, j, k) (((((size_t)(i) + nx) % nx) * ny + (((size_t)(j) + ny) % ny)) * 2 * (nz / 2 + 1) + (((size_t)(k) + nz) % nz))

67
src/densities.cc
View file

@ -11,6 +11,7 @@
#include <cstring>
#include "densities.hh"
#include "random.hh"
#include "convolution_kernel.hh"
//TODO: this should be a larger number by default, just to maintain consistency with old default
@ -113,8 +114,13 @@ void fft_coarsen(m1 &v, m2 &V)
val_fine *= val_phas * fftnorm / 8.0;
RE(ccoarse[qc]) = val_fine.real();
IM(ccoarse[qc]) = val_fine.imag();
if( i!=(int)nxF/2 && j!=(int)nyF/2 && k!=(int)nzF/2 ){
RE(ccoarse[qc]) = val_fine.real();
IM(ccoarse[qc]) = val_fine.imag();
}else{
RE(ccoarse[qc]) = 0.0;//val_fine.real();
IM(ccoarse[qc]) = 0.0;//val_fine.imag();
}
}
delete[] rfine;
@ -335,7 +341,7 @@ void fft_interpolate(m1 &V, m2 &v, bool from_basegrid = false)
/*******************************************************************************************/
void GenerateDensityUnigrid(config_file &cf, transfer_function *ptf, tf_type type,
refinement_hierarchy &refh, rand_gen &rand, grid_hierarchy &delta, bool smooth, bool shift)
refinement_hierarchy &refh, noise_generator &rand, grid_hierarchy &delta, bool smooth, bool shift)
{
unsigned levelmin, levelmax, levelminPoisson;
@ -416,7 +422,7 @@ void GenerateDensityUnigrid(config_file &cf, transfer_function *ptf, tf_type typ
/*******************************************************************************************/
void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type type,
refinement_hierarchy &refh, rand_gen &rand,
refinement_hierarchy &refh, noise_generator &rand,
grid_hierarchy &delta, bool smooth, bool shift)
{
unsigned levelmin, levelmax, levelminPoisson;
@ -439,6 +445,7 @@ void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type t
bool fix = cf.getValueSafe<bool>("setup","fix_mode_amplitude",false);
bool flip = cf.getValueSafe<bool>("setup","flip_mode_amplitude",false);
bool fourier_splicing = cf.getValueSafe<bool>("setup","fourier_splicing",true);
if( fix && levelmin != levelmax ){
LOGWARN("You have chosen mode fixing for a zoom. This is not well tested,\n please proceed at your own risk...");
@ -448,27 +455,14 @@ void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type t
convolution::kernel_creator *the_kernel_creator;
if (kspaceTF)
{
std::cout << " - Using k-space transfer function kernel.\n";
LOGUSER("Using k-space transfer function kernel.");
std::cout << " - Using k-space transfer function kernel.\n";
LOGUSER("Using k-space transfer function kernel.");
#ifdef SINGLE_PRECISION
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_k_float"];
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_k_float"];
#else
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_k_double"];
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_k_double"];
#endif
}
else
{
std::cout << " - Using real-space transfer function kernel.\n";
LOGUSER("Using real-space transfer function kernel.");
#ifdef SINGLE_PRECISION
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_real_float"];
#else
the_kernel_creator = convolution::get_kernel_map()["tf_kernel_real_double"];
#endif
}
convolution::kernel *the_tf_kernel = the_kernel_creator->create(cf, ptf, refh, type);
@ -501,21 +495,13 @@ void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type t
refh.size(levelmin + i, 1), refh.size(levelmin + i, 2));
if( refh.get_margin() > 0 ){
fine = new PaddedDensitySubGrid<real_t>(refh.offset(levelmin + i, 0),
refh.offset(levelmin + i, 1),
refh.offset(levelmin + i, 2),
refh.size(levelmin + i, 0),
refh.size(levelmin + i, 1),
refh.size(levelmin + i, 2),
refh.get_margin(), refh.get_margin(), refh.get_margin() );
fine = new PaddedDensitySubGrid<real_t>( refh.offset(levelmin + i, 0), refh.offset(levelmin + i, 1), refh.offset(levelmin + i, 2),
refh.size(levelmin + i, 0), refh.size(levelmin + i, 1), refh.size(levelmin + i, 2),
refh.get_margin(), refh.get_margin(), refh.get_margin() );
LOGUSER(" margin = %d",refh.get_margin());
}else{
fine = new PaddedDensitySubGrid<real_t>(refh.offset(levelmin + i, 0),
refh.offset(levelmin + i, 1),
refh.offset(levelmin + i, 2),
refh.size(levelmin + i, 0),
refh.size(levelmin + i, 1),
refh.size(levelmin + i, 2));
fine = new PaddedDensitySubGrid<real_t>( refh.offset(levelmin + i, 0), refh.offset(levelmin + i, 1), refh.offset(levelmin + i, 2),
refh.size(levelmin + i, 0), refh.size(levelmin + i, 1), refh.size(levelmin + i, 2));
LOGUSER(" margin = %d",refh.size(levelmin + i, 0)/2);
}
/////////////////////////////////////////////////////////////////////////
@ -526,10 +512,12 @@ void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type t
convolution::perform<real_t>(the_tf_kernel->fetch_kernel(levelmin + i, true),
reinterpret_cast<void *>(fine->get_data_ptr()), shift, fix, flip);
if (i == 1)
fft_interpolate(*top, *fine, true);
else
fft_interpolate(*coarse, *fine, false);
if( fourier_splicing ){
if (i == 1)
fft_interpolate(*top, *fine, true);
else
fft_interpolate(*coarse, *fine, false);
}
delta.add_patch(refh.offset(levelmin + i, 0),
refh.offset(levelmin + i, 1),
@ -563,6 +551,9 @@ void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type t
std::cout << " - Density calculation took " << tend - tstart << "s." << std::endl;
#endif
if( !fourier_splicing ){
coarsen_density(refh,delta,false);
}
LOGUSER("Finished computing the density field in %fs", tend - tstart);
}

284
src/densities.hh
View file

@ -15,298 +15,20 @@
#include "general.hh"
#include "config_file.hh"
// #include "density_grid.hh"
#include "random.hh"
#include "cosmology.hh"
#include "transfer_function.hh"
#include "general.hh"
void GenerateDensityHierarchy(config_file &cf, transfer_function *ptf, tf_type type,
refinement_hierarchy &refh, rand_gen &rand, grid_hierarchy &delta, bool smooth, bool shift);
refinement_hierarchy &refh, noise_generator &rand, grid_hierarchy &delta, bool smooth, bool shift);
void GenerateDensityUnigrid(config_file &cf, transfer_function *ptf, tf_type type,
refinement_hierarchy &refh, rand_gen &rand, grid_hierarchy &delta, bool smooth, bool shift);
refinement_hierarchy &refh, noise_generator &rand, grid_hierarchy &delta, bool smooth, bool shift);
void normalize_density(grid_hierarchy &delta);
/*!
* @class DensityGrid
* @brief provides infrastructure for computing the initial density field
*
* This class provides access and data management member functions that
* are used when computing the initial density field by convolution with
* transfer functions.
*/
template <typename real_t>
class DensityGrid
{
public:
size_t nx_; //!< number of grid cells in x-direction
size_t ny_; //!< number of grid cells in y-direction
size_t nz_; //!< number of grid cells in z-direction
size_t nzp_; //!< number of cells in memory (z-dir), used for Nyquist padding
size_t nv_[3];
int ox_; //!< offset of grid in x-direction
int oy_; //!< offset of grid in y-direction
int oz_; //!< offset of grid in z-direction
size_t ov_[3];
//! the actual data container in the form of a 1D array
std::vector<real_t> data_;
//! constructor
/*! constructs an instance given the dimensions of the density field
* @param nx the number of cells in x
* @param ny the number of cells in y
* @param nz the number of cells in z
*/
DensityGrid(unsigned nx, unsigned ny, unsigned nz)
: nx_(nx), ny_(ny), nz_(nz), nzp_(2 * (nz_ / 2 + 1)), ox_(0), oy_(0), oz_(0)
{
data_.assign((size_t)nx_ * (size_t)ny_ * (size_t)nzp_, 0.0);
nv_[0] = nx_;
nv_[1] = ny_;
nv_[2] = nz_;
ov_[0] = ox_;
ov_[1] = oy_;
ov_[2] = oz_;
}
DensityGrid(unsigned nx, unsigned ny, unsigned nz, int ox, int oy, int oz)
: nx_(nx), ny_(ny), nz_(nz), nzp_(2 * (nz_ / 2 + 1)), ox_(ox), oy_(oy), oz_(oz)
{
data_.assign((size_t)nx_ * (size_t)ny_ * (size_t)nzp_, 0.0);
nv_[0] = nx_;
nv_[1] = ny_;
nv_[2] = nz_;
ov_[0] = ox_;
ov_[1] = oy_;
ov_[2] = oz_;
}
//! copy constructor
explicit DensityGrid(const DensityGrid<real_t> &g)
: nx_(g.nx_), ny_(g.ny_), nz_(g.nz_), nzp_(g.nzp_),
ox_(g.ox_), oy_(g.oy_), oz_(g.oz_)
{
data_ = g.data_;
nv_[0] = nx_;
nv_[1] = ny_;
nv_[2] = nz_;
ov_[0] = ox_;
ov_[1] = oy_;
ov_[2] = oz_;
}
//! destructor
~DensityGrid()
{
}
//! clears the density object
/*! sets all dimensions to zero and frees the memory
*/
void clear(void)
{
nx_ = ny_ = nz_ = nzp_ = 0;
ox_ = oy_ = oz_ = 0;
nv_[0] = nv_[1] = nv_[2] = 0;
ov_[0] = ov_[1] = ov_[2] = 0;
data_.clear();
std::vector<real_t>().swap(data_);
}
//! query the 3D array sizes of the density object
/*! returns the size of the 3D density object along a specified dimension
* @param i the dimension for which size is to be returned
* @returns array size along dimension i
*/
size_t size(int i)
{
return nv_[i];
}
int offset(int i)
{
return ov_[i];
}
//! zeroes the density object
/*! sets all values to 0.0
*/
void zero(void)
{
data_.assign(data_.size(), 0.0);
}
//! assigns the contents of another DensityGrid to this
DensityGrid &operator=(const DensityGrid<real_t> &g)
{
nx_ = g.nx_;
ny_ = g.ny_;
nz_ = g.nz_;
nzp_ = g.nzp_;
ox_ = g.ox_;
oy_ = g.oy_;
oz_ = g.oz_;
data_ = g.data_;
return *this;
}
//! 3D index based data access operator
inline real_t &operator()(size_t i, size_t j, size_t k)
{
return data_[((size_t)i * ny_ + (size_t)j) * nzp_ + (size_t)k];
}
//! 3D index based const data access operator
inline const real_t &operator()(size_t i, size_t j, size_t k) const
{
return data_[((size_t)i * ny_ + (size_t)j) * nzp_ + (size_t)k];
}
//! recover the pointer to the 1D data array
inline real_t *get_data_ptr(void)
{
return &data_[0];
}
//! fills the density field with random number values
/*! given a pointer to a random_numbers object, fills the field with random values
* @param prc pointer to a random_numbers object
* @param variance the variance of the random numbers (the values returned by prc are multiplied by this)
* @param i0 x-offset (shift) in cells of the density field with respect to the random number field
* @param j0 y-offset (shift) in cells of the density field with respect to the random number field
* @param k0 z-offset (shift) in cells of the density field with respect to the random number field
* @param setzero boolean, if true, the global mean will be subtracted
*/
void fill_rand(/*const*/ random_numbers<real_t> *prc, real_t variance, int i0, int j0, int k0, bool setzero = false)
{
long double sum = 0.0;
#pragma omp parallel for reduction(+ \
: sum)
for (int i = 0; i < nx_; ++i)
for (int j = 0; j < ny_; ++j)
for (int k = 0; k < nz_; ++k)
{
(*this)(i, j, k) = (*prc)(i0 + i, j0 + j, k0 + k) * variance;
sum += (*this)(i, j, k);
}
sum /= nx_ * ny_ * nz_;
if (setzero)
{
#pragma omp parallel for
for (int i = 0; i < nx_; ++i)
for (int j = 0; j < ny_; ++j)
for (int k = 0; k < nz_; ++k)
(*this)(i, j, k) -= sum;
}
}
//! copies the data from another field with 3D index-based access operator
template <class array3>
void copy(array3 &v)
{
#pragma omp parallel for
for (int ix = 0; ix < (int)nx_; ++ix)
for (int iy = 0; iy < (int)ny_; ++iy)
for (int iz = 0; iz < (int)nz_; ++iz)
v(ix, iy, iz) = (*this)(ix, iy, iz);
}
//! adds the data from another field with 3D index-based access operator
template <class array3>
void copy_add(array3 &v)
{
#pragma omp parallel for
for (int ix = 0; ix < (int)nx_; ++ix)
for (int iy = 0; iy < (int)ny_; ++iy)
for (int iz = 0; iz < (int)nz_; ++iz)
v(ix, iy, iz) += (*this)(ix, iy, iz);
}
};
template <typename real_t>
class PaddedDensitySubGrid : public DensityGrid<real_t>
{
public:
using DensityGrid<real_t>::nx_;
using DensityGrid<real_t>::ny_;
using DensityGrid<real_t>::nz_;
using DensityGrid<real_t>::ox_;
using DensityGrid<real_t>::oy_;
using DensityGrid<real_t>::oz_;
using DensityGrid<real_t>::data_;
std::array<size_t,3> pad_;
using DensityGrid<real_t>::fill_rand;
using DensityGrid<real_t>::get_data_ptr;
public:
PaddedDensitySubGrid(int ox, int oy, int oz, unsigned nx, unsigned ny, unsigned nz )
: DensityGrid<real_t>(nx*2, ny*2, nz*2, ox, oy, oz),
pad_{{ nx / 2, ny / 2, nz / 2 }}
{ }
PaddedDensitySubGrid(int ox, int oy, int oz, unsigned nx, unsigned ny, unsigned nz, unsigned padx, unsigned pady, unsigned padz )
: DensityGrid<real_t>(nx + 2 * padx, ny + 2 * pady, nz + 2 * padz, ox, oy, oz),
pad_{