Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains procedure implementations of the tests of [pm_cosmology](@ref pm_cosmology).
19 : !>
20 : !> \fintest
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, 12:27 AM Tuesday, February 22, 2022, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !%%%%%%%%%%%%%%%%%%%%%%%%
28 : #if getSizeUnivNormed_ENABLED
29 : !%%%%%%%%%%%%%%%%%%%%%%%%
30 :
31 : integer(IK) :: i
32 : real(RKC) , parameter :: TOL = epsilon(0._RKC)*100
33 : real(RKC) :: zplus1, omegaM, omegaL, omegaR, omegaK
34 : real(RKC) :: hubbleParamNormedSq_ref
35 : real(RKC) :: hubbleParamNormedSq
36 : real(RKC) :: diff
37 :
38 4 : assertion = .true._LK
39 2004 : do i = 1_IK, 500_IK
40 :
41 2000 : omegaM = real(OMEGA_M, RKC)
42 2000 : omegaL = real(OMEGA_L, RKC)
43 2000 : omegaR = real(OMEGA_R, RKC)
44 2000 : omegaK = real(OMEGA_K, RKC)
45 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
46 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1)
47 2000 : call report(int(__LINE__, IK))
48 :
49 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
50 2000 : omegaL = 1._RKC - omegaM
51 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
52 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL)
53 2000 : call report(int(__LINE__, IK))
54 :
55 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
56 2000 : omegaL = merge(getUnifRand(0._RKC, 1._RKC - omegaM), 0._RKC, 1._RKC - omegaM > 0._RKC)
57 2000 : omegaR = 1._RKC - omegaM - omegaL
58 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
59 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)
60 2000 : call report(int(__LINE__, IK))
61 :
62 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
63 2000 : omegaL = merge(getUnifRand(0._RKC, 1._RKC - omegaM), 0._RKC, 1._RKC - omegaM > 0._RKC)
64 2000 : omegaR = merge(getUnifRand(0._RKC, 1._RKC - omegaM - omegaL), 0._RKC, 1._RKC - omegaM - omegaL > 0._RKC)
65 2000 : omegaK = 1._RKC - omegaM - omegaL - omegaR
66 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)
67 2004 : call report(int(__LINE__, IK))
68 :
69 : end do
70 :
71 : contains
72 :
73 : function getHubbleParamNormedSq_ref(zplus1, omegaM, omegaL, omegaR, omegaK) result(hubbleParamNormedSq_ref)
74 : real(RKC), intent(in) :: zplus1, omegaM, omegaL, omegaR, omegaK
75 : real(RKC) :: hubbleParamNormedSq_ref
76 8000 : hubbleParamNormedSq_ref = omegaL + zplus1**2 * (omegaK + zplus1 * (omegaM + zplus1 * omegaR))
77 : end function
78 :
79 8000 : subroutine report(line)
80 : integer(IK), intent(in) :: line
81 8000 : hubbleParamNormedSq_ref = getHubbleParamNormedSq_ref(zplus1, omegaM, omegaL, omegaR, omegaK)
82 8000 : diff = abs(hubbleParamNormedSq - hubbleParamNormedSq_ref) / hubbleParamNormedSq_ref
83 8000 : assertion = assertion .and. logical(diff < TOL, LK)
84 8000 : if (test%traceable .and. .not. assertion) then
85 : ! LCOV_EXCL_START
86 : write(test%disp%unit,"(*(g0,:,', '))")
87 : write(test%disp%unit,"(*(g0,:,', '))") "hubbleParamNormedSq_ref", hubbleParamNormedSq_ref
88 : write(test%disp%unit,"(*(g0,:,', '))") "hubbleParamNormedSq ", hubbleParamNormedSq
89 : write(test%disp%unit,"(*(g0,:,', '))") "zplus1 ", zplus1
90 : write(test%disp%unit,"(*(g0,:,', '))") "omegaM ", omegaM
91 : write(test%disp%unit,"(*(g0,:,', '))") "omegaL ", omegaL
92 : write(test%disp%unit,"(*(g0,:,', '))") "omegaR ", omegaR
93 : write(test%disp%unit,"(*(g0,:,', '))") "omegaK ", omegaK
94 : write(test%disp%unit,"(*(g0,:,', '))") "diff ", diff
95 : write(test%disp%unit,"(*(g0,:,', '))") "TOL ", TOL
96 : write(test%disp%unit,"(*(g0,:,', '))")
97 : ! LCOV_EXCL_STOP
98 : end if
99 8000 : call test%assert(assertion, desc = "The dimensionless Hubble Parameter must be computed correctly for the specified cosmological parameters.", line = line)
100 8000 : end subroutine
101 :
102 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
103 : #elif getDisLookbackNormed_ENABLED || getDisComNormed_ENABLED || getDisComTransNormed_ENABLED || \
104 : getDisAngNormed_ENABLED || getDisLumNormed_ENABLED || getDisComTransNormedWU10_ENABLED
105 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
106 :
107 : integer(IK) :: neval, err
108 : real(RKC) , parameter :: reltol = epsilon(0._RKC) * 10000!sqrt(epsilon(0._RKC))
109 : real(RKC) , parameter :: MPC2LY_RKC = real(MPC2LY, RKC)
110 : real(RKC) , parameter :: LIGHT_SPEED_RKC = real(LIGHT_SPEED, RKC)
111 : real(RKC) , parameter :: HUBBLE_CONST_RKC = real(HUBBLE_CONST, RKC)
112 : real(RKC) , parameter :: HUBBLE_DISTANCE_MPC_RKC = real(HUBBLE_DISTANCE_MPC, RKC)
113 : real(RKC) :: zplus1, omegaM, omegaL, omegaR, omegaK
114 : real(RKC) :: distance_ref
115 : real(RKC) :: distance
116 : real(RKC) :: diff
117 : real(RKC) :: tol
118 :
119 24 : tol = epsilon(0._RKC) * 10000
120 24 : assertion = .true._LK
121 :
122 24 : call runTestsWith()
123 24 : call runTestsWith(neval)
124 24 : call runTestsWith(err = err)
125 24 : call runTestsWith(neval, err)
126 :
127 : contains
128 :
129 96 : subroutine runTestsWith(neval, err)
130 : integer(IK), intent(out), optional :: neval, err
131 :
132 : #if getSizeUnivNormed_ENABLED
133 :
134 : zplus1 = 1._RKC
135 : omegaM = real(OMEGA_M, RKC)
136 : omegaL = real(OMEGA_L, RKC)
137 : omegaR = real(OMEGA_R, RKC)
138 : omegaK = real(OMEGA_K, RKC)
139 : distance_ref = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) ! 0.955239468086737240441960122539593084_RKC
140 :
141 : distance = getSizeUnivNormed(zplus1, reltol, neval, err)
142 : call report()
143 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
144 :
145 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, reltol, neval, err)
146 : call report(omegaM, omegaL)
147 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
148 :
149 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
150 : call report(omegaM, omegaL, omegaR)
151 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
152 :
153 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
154 : call report(omegaM, omegaL, omegaR, omegaK)
155 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
156 :
157 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
158 :
159 : zplus1 = huge(0._RKC)
160 : distance_ref = 0._RKC
161 :
162 : distance = getSizeUnivNormed(zplus1, reltol, neval, err)
163 : call report()
164 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
165 :
166 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, reltol, neval, err)
167 : call report(omegaM, omegaL)
168 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
169 :
170 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
171 : call report(omegaM, omegaL, omegaR)
172 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
173 :
174 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
175 : call report(omegaM, omegaL, omegaR, omegaK)
176 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
177 :
178 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
179 :
180 : zplus1 = 3.5_RKC
181 : omegaM = 0.2_RKC
182 : omegaL = 0.5_RKC
183 : omegaR = 0.5_RKC
184 : omegaK = 1._RKC - omegaM - omegaL - omegaR
185 : distance_ref = 0.560176566313766147208125382717677278E-1_RKC
186 :
187 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
188 : call report(omegaM, omegaL, omegaR, omegaK)
189 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
190 :
191 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
192 :
193 : zplus1 = +4._RKC
194 : omegaM = +0.2_RKC
195 : omegaL = -0.5_RKC
196 : omegaR = +0.5_RKC
197 : omegaK = +1._RKC - omegaM - omegaL - omegaR
198 : distance_ref = 0.418795901922915638929080324595150918E-1_RKC
199 :
200 : distance = getSizeUnivNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
201 : call report(omegaM, omegaL, omegaR, omegaK)
202 : call test%assert(assertion, SK_"The Universe Size must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
203 :
204 : #elif getDisLookbackNormed_ENABLED
205 :
206 16 : zplus1 = 1001._RKC
207 16 : omegaM = real(OMEGA_M, RKC)
208 16 : omegaL = real(OMEGA_L, RKC)
209 16 : omegaR = real(OMEGA_R, RKC)
210 16 : omegaK = real(OMEGA_K, RKC)
211 16 : distance_ref = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) ! 0.955239468086737240441960122539593084_RKC
212 :
213 16 : distance = getDisLookbackNormed(zplus1, reltol, neval, err)
214 16 : call report()
215 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
216 :
217 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, reltol, neval, err)
218 16 : call report(omegaM, omegaL)
219 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
220 :
221 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
222 16 : call report(omegaM, omegaL, omegaR)
223 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
224 :
225 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
226 16 : call report(omegaM, omegaL, omegaR, omegaK)
227 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
228 :
229 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
230 :
231 16 : zplus1 = 0._RKC
232 16 : distance_ref = 0._RKC
233 :
234 16 : distance = getDisLookbackNormed(zplus1, reltol, neval, err)
235 16 : call report()
236 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
237 :
238 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, reltol, neval, err)
239 16 : call report(omegaM, omegaL)
240 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
241 :
242 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
243 16 : call report(omegaM, omegaL, omegaR)
244 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
245 :
246 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
247 16 : call report(omegaM, omegaL, omegaR, omegaK)
248 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
249 :
250 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
251 :
252 16 : zplus1 = 6._RKC
253 16 : omegaM = 0.2_RKC
254 16 : omegaL = 0.5_RKC
255 16 : omegaR = 0.5_RKC
256 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
257 16 : distance_ref = 0.586437343702725508511169269833928737_RKC
258 :
259 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
260 16 : call report(omegaM, omegaL, omegaR, omegaK)
261 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
262 :
263 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
264 :
265 16 : zplus1 = +4._RKC
266 16 : omegaM = +0.2_RKC
267 16 : omegaL = -0.5_RKC
268 16 : omegaR = +0.5_RKC
269 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
270 16 : distance_ref = 0.501459151132179770407237268671874632_RKC
271 :
272 16 : distance = getDisLookbackNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
273 16 : call report(omegaM, omegaL, omegaR, omegaK)
274 48 : call test%assert(assertion, SK_"The Lookback Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
275 :
276 : #elif getDisComNormed_ENABLED
277 :
278 16 : zplus1 = 2._RKC
279 16 : omegaM = real(OMEGA_M, RKC)
280 16 : omegaL = real(OMEGA_L, RKC)
281 16 : omegaR = real(OMEGA_R, RKC)
282 16 : omegaK = real(OMEGA_K, RKC)
283 16 : distance_ref = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) ! 3396.03639669472458732702995144103428_RKC
284 :
285 16 : distance = getDisComNormed(zplus1, reltol, neval, err)
286 16 : call report()
287 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
288 :
289 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, reltol, neval, err)
290 16 : call report(omegaM, omegaL)
291 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
292 :
293 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
294 16 : call report(omegaM, omegaL, omegaR)
295 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
296 :
297 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
298 16 : call report(omegaM, omegaL, omegaR, omegaK)
299 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
300 :
301 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
302 :
303 16 : zplus1 = 0._RKC
304 16 : distance_ref = 0._RKC
305 :
306 16 : distance = getDisComNormed(zplus1, reltol, neval, err)
307 16 : call report()
308 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
309 :
310 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, reltol, neval, err)
311 16 : call report(omegaM, omegaL)
312 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
313 :
314 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
315 16 : call report(omegaM, omegaL, omegaR)
316 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
317 :
318 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
319 16 : call report(omegaM, omegaL, omegaR, omegaK)
320 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
321 :
322 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
323 :
324 16 : zplus1 = 6._RKC
325 16 : omegaM = 0.2_RKC
326 16 : omegaL = 0.5_RKC
327 16 : omegaR = 0.5_RKC
328 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
329 16 : distance_ref = 4608.74661107738061825469278425187163_RKC / HUBBLE_DISTANCE_MPC_RKC
330 :
331 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
332 16 : call report(omegaM, omegaL, omegaR, omegaK)
333 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
334 :
335 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
336 :
337 16 : zplus1 = 6._RKC
338 16 : omegaM = 0.2_RKC
339 16 : omegaL = 0.5_RKC
340 16 : omegaR = 0.5_RKC
341 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
342 16 : distance_ref = 4608.74661107738061825469278425187163_RKC / HUBBLE_DISTANCE_MPC_RKC
343 :
344 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
345 16 : call report(omegaM, omegaL, omegaR, omegaK)
346 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
347 :
348 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
349 :
350 16 : zplus1 = +4._RKC
351 16 : omegaM = +0.2_RKC
352 16 : omegaL = -0.5_RKC
353 16 : omegaR = +0.5_RKC
354 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
355 16 : distance_ref = 3656.22113700199274111901199467371355_RKC / HUBBLE_DISTANCE_MPC_RKC
356 :
357 16 : distance = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
358 16 : call report(omegaM, omegaL, omegaR, omegaK)
359 48 : call test%assert(assertion, SK_"The Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
360 :
361 : #elif getDisComTransNormed_ENABLED
362 :
363 16 : zplus1 = 2._RKC
364 16 : omegaM = real(OMEGA_M, RKC)
365 16 : omegaL = real(OMEGA_L, RKC)
366 16 : omegaR = real(OMEGA_R, RKC)
367 16 : omegaK = real(OMEGA_K, RKC)
368 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
369 :
370 16 : distance = getDisComTransNormed(zplus1, reltol, neval, err)
371 16 : call report()
372 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
373 :
374 16 : distance = getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err)
375 16 : call report(omegaM, omegaL)
376 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
377 :
378 16 : distance = getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
379 16 : call report(omegaM, omegaL, omegaR)
380 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
381 :
382 16 : distance = getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
383 16 : call report(omegaM, omegaL, omegaR, omegaK)
384 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
385 :
386 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
387 :
388 16 : zplus1 = +4._RKC
389 16 : omegaM = +0.2_RKC
390 16 : omegaL = -0.5_RKC
391 16 : omegaR = +0.5_RKC
392 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
393 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
394 :
395 16 : distance = getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
396 16 : call report(omegaM, omegaL, omegaR, omegaK)
397 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
398 :
399 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
400 :
401 16 : zplus1 = 6._RKC
402 16 : omegaM = 0.2_RKC
403 16 : omegaL = 0.5_RKC
404 16 : omegaR = 0.5_RKC
405 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
406 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
407 :
408 16 : distance = getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
409 16 : call report(omegaM, omegaL, omegaR, omegaK)
410 48 : call test%assert(assertion, SK_"The Transverse Comoving Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
411 :
412 : #elif getDisAngNormed_ENABLED
413 :
414 16 : zplus1 = 2._RKC
415 16 : omegaM = real(OMEGA_M, RKC)
416 16 : omegaL = real(OMEGA_L, RKC)
417 16 : omegaR = real(OMEGA_R, RKC)
418 16 : omegaK = real(OMEGA_K, RKC)
419 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) / zplus1
420 :
421 16 : distance = getDisAngNormed(zplus1, reltol, neval, err)
422 16 : call report()
423 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
424 :
425 16 : distance = getDisAngNormed(zplus1, omegaM, omegaL, reltol, neval, err)
426 16 : call report(omegaM, omegaL)
427 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
428 :
429 16 : distance = getDisAngNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
430 16 : call report(omegaM, omegaL, omegaR)
431 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
432 :
433 16 : distance = getDisAngNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
434 16 : call report(omegaM, omegaL, omegaR, omegaK)
435 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
436 :
437 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
438 :
439 16 : zplus1 = +4._RKC
440 16 : omegaM = +0.2_RKC
441 16 : omegaL = -0.5_RKC
442 16 : omegaR = +0.5_RKC
443 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
444 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) / zplus1
445 :
446 16 : distance = getDisAngNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
447 16 : call report(omegaM, omegaL, omegaR, omegaK)
448 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
449 :
450 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
451 :
452 16 : zplus1 = 6._RKC
453 16 : omegaM = 0.2_RKC
454 16 : omegaL = 0.5_RKC
455 16 : omegaR = 0.5_RKC
456 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
457 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) / zplus1
458 :
459 16 : distance = getDisAngNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
460 16 : call report(omegaM, omegaL, omegaR, omegaK)
461 48 : call test%assert(assertion, SK_"The Angular Diameter Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
462 :
463 : #elif getDisLumNormed_ENABLED
464 :
465 16 : zplus1 = 2._RKC
466 16 : omegaM = real(OMEGA_M, RKC)
467 16 : omegaL = real(OMEGA_L, RKC)
468 16 : omegaR = real(OMEGA_R, RKC)
469 16 : omegaK = real(OMEGA_K, RKC)
470 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) * zplus1
471 :
472 16 : distance = getDisLumNormed(zplus1, reltol, neval, err)
473 16 : call report()
474 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
475 :
476 16 : distance = getDisLumNormed(zplus1, omegaM, omegaL, reltol, neval, err)
477 16 : call report(omegaM, omegaL)
478 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
479 :
480 16 : distance = getDisLumNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
481 16 : call report(omegaM, omegaL, omegaR)
482 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
483 :
484 16 : distance = getDisLumNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
485 16 : call report(omegaM, omegaL, omegaR, omegaK)
486 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
487 :
488 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
489 :
490 16 : zplus1 = +4._RKC
491 16 : omegaM = +0.2_RKC
492 16 : omegaL = -0.5_RKC
493 16 : omegaR = +0.5_RKC
494 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
495 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) * zplus1
496 :
497 16 : distance = getDisLumNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
498 16 : call report(omegaM, omegaL, omegaR, omegaK)
499 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
500 :
501 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
502 :
503 16 : zplus1 = 6._RKC
504 16 : omegaM = 0.2_RKC
505 16 : omegaL = 0.5_RKC
506 16 : omegaR = 0.5_RKC
507 16 : omegaK = 1._RKC - omegaM - omegaL - omegaR
508 16 : distance_ref = getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) * zplus1
509 :
510 16 : distance = getDisLumNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
511 16 : call report(omegaM, omegaL, omegaR, omegaK)
512 48 : call test%assert(assertion, SK_"The Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
513 :
514 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
515 :
516 : #elif getDisComTransNormedWU10_ENABLED
517 :
518 16 : tol = 0.002_RKC
519 : block
520 : integer :: i
521 96 : do i = 1, 5
522 80 : zplus1 = 1.1_RKC * i
523 80 : omegaM = real(OMEGA_M, RKC)
524 80 : omegaL = real(OMEGA_L, RKC)
525 80 : omegaR = 0._RKC
526 80 : omegaK = 0._RKC
527 80 : distance_ref = getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
528 :
529 80 : distance = getDisComTransNormedWU10(zplus1)
530 80 : call report()
531 240 : call test%assert(assertion, SK_"The WU10 Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
532 :
533 80 : distance = getDisComTransNormedWU10(zplus1, omegaM, omegaL)
534 80 : call report(omegaM, omegaL)
535 256 : call test%assert(assertion, SK_"The WU10 Luminosity Distance must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
536 : end do
537 : end block
538 :
539 : #else
540 : #error "Unrecognized interface."
541 : #endif
542 96 : end subroutine
543 :
544 : #if getDisComTransNormed_ENABLED || getDisAngNormed_ENABLED || getDisLumNormed_ENABLED
545 144 : function getDisComTransNormed_def(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err) result(disComTransNormed)
546 : real(RKC), intent(in), optional :: omegaM, omegaL, omegaR, omegaK, reltol
547 : integer(IK), intent(out) :: neval, err
548 : real(RKC), intent(in) :: zplus1
549 : real(RKC):: disComTransNormed
550 : real(RKC):: sqrtOmegaK
551 144 : if (present(omegaM) .and. present(omegaL) .and. present(omegaR) .and. present(omegaK)) then
552 144 : disComTransNormed = getDisComNormed(zplus1, omegaM, omegaL, omegaR, omegaK, reltol, neval, err)
553 0 : elseif (present(omegaM) .and. present(omegaL) .and. present(omegaR)) then
554 0 : disComTransNormed = getDisComNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
555 0 : elseif (present(omegaM) .and. present(omegaL)) then
556 0 : disComTransNormed = getDisComNormed(zplus1, omegaM, omegaL, reltol, neval, err)
557 : else
558 0 : disComTransNormed = getDisComNormed(zplus1, reltol, neval, err)
559 : end if
560 144 : if (present(omegaK)) then
561 144 : if (omegaK > epsilon(0._RKC)) then
562 48 : sqrtOmegaK = sqrt(omegaK)
563 48 : disComTransNormed = sinh(disComTransNormed * sqrtOmegaK) / sqrtOmegaK
564 96 : elseif (omegaK < -epsilon(0._RKC)) then
565 48 : sqrtOmegaK = sqrt(-omegaK)
566 48 : disComTransNormed = sin(disComTransNormed * sqrtOmegaK) / sqrtOmegaK
567 : end if
568 : end if
569 144 : end function
570 : #endif
571 784 : subroutine report(omegaM, omegaL, omegaR, omegaK)
572 : real(RKC), intent(in), optional :: omegaM, omegaL, omegaR, omegaK
573 784 : if (abs(distance_ref) <= epsilon(0._RKC)) then
574 128 : diff = abs(distance - distance_ref)
575 : else
576 656 : diff = abs(distance - distance_ref) / distance_ref
577 : end if
578 784 : assertion = assertion .and. logical(diff < TOL, LK)
579 784 : if (test%traceable .and. .not. assertion) then
580 : ! LCOV_EXCL_START
581 : write(test%disp%unit,"(*(g0,:,', '))")
582 : write(test%disp%unit,"(*(g0,:,', '))") "distance_ref", distance_ref
583 : write(test%disp%unit,"(*(g0,:,', '))") "distance", distance
584 : write(test%disp%unit,"(*(g0,:,', '))") "zplus1", zplus1
585 : if (present(omegaM)) write(test%disp%unit,"(*(g0,:,', '))") "omegaM", omegaM
586 : if (present(omegaL)) write(test%disp%unit,"(*(g0,:,', '))") "omegaL", omegaL
587 : if (present(omegaR)) write(test%disp%unit,"(*(g0,:,', '))") "omegaR", omegaR
588 : if (present(omegaK)) write(test%disp%unit,"(*(g0,:,', '))") "omegaK", omegaK
589 : write(test%disp%unit,"(*(g0,:,', '))") "diff", diff
590 : write(test%disp%unit,"(*(g0,:,', '))") "TOL", TOL
591 : write(test%disp%unit,"(*(g0,:,', '))")
592 : ! LCOV_EXCL_STOP
593 : end if
594 784 : end subroutine
595 :
596 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
597 : #elif getHubbleParamNormedSq_ENABLED
598 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
599 :
600 : integer(IK) :: i
601 : real(RKC) , parameter :: TOL = epsilon(0._RKC)*100
602 : real(RKC) :: zplus1, omegaM, omegaL, omegaR, omegaK
603 : real(RKC) :: hubbleParamNormedSq_ref
604 : real(RKC) :: hubbleParamNormedSq
605 : real(RKC) :: diff
606 4 : assertion = .true._LK
607 :
608 2004 : do i = 1_IK, 500_IK
609 :
610 2000 : omegaM = real(OMEGA_M, RKC)
611 2000 : omegaL = real(OMEGA_L, RKC)
612 2000 : omegaR = real(OMEGA_R, RKC)
613 2000 : omegaK = real(OMEGA_K, RKC)
614 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
615 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1)
616 2000 : call report(int(__LINE__, IK))
617 :
618 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
619 2000 : omegaL = 1._RKC - omegaM
620 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
621 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL)
622 2000 : call report(int(__LINE__, IK))
623 :
624 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
625 2000 : omegaL = merge(getUnifRand(0._RKC, 1._RKC - omegaM), 0._RKC, 1._RKC - omegaM > 0._RKC)
626 2000 : omegaR = 1._RKC - omegaM - omegaL
627 2000 : zplus1 = getUnifRand(1._RKC, 100._RKC)
628 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)
629 2000 : call report(int(__LINE__, IK))
630 :
631 2000 : omegaM = getUnifRand(0._RKC, 1._RKC)
632 2000 : omegaL = merge(getUnifRand(0._RKC, 1._RKC - omegaM), 0._RKC, 1._RKC - omegaM > 0._RKC)
633 2000 : omegaR = merge(getUnifRand(0._RKC, 1._RKC - omegaM - omegaL), 0._RKC, 1._RKC - omegaM - omegaL > 0._RKC)
634 2000 : omegaK = 1._RKC - omegaM - omegaL - omegaR
635 2000 : hubbleParamNormedSq = getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)
636 2004 : call report(int(__LINE__, IK))
637 :
638 : end do
639 :
640 : contains
641 :
642 : function getHubbleParamNormedSq_ref(zplus1, omegaM, omegaL, omegaR, omegaK) result(hubbleParamNormedSq_ref)
643 : real(RKC), intent(in) :: zplus1, omegaM, omegaL, omegaR, omegaK
644 : real(RKC) :: hubbleParamNormedSq_ref
645 8000 : hubbleParamNormedSq_ref = omegaL + zplus1**2 * (omegaK + zplus1 * (omegaM + zplus1 * omegaR))
646 : end function
647 :
648 8000 : subroutine report(line)
649 : integer(IK), intent(in) :: line
650 8000 : hubbleParamNormedSq_ref = getHubbleParamNormedSq_ref(zplus1, omegaM, omegaL, omegaR, omegaK)
651 8000 : diff = abs(hubbleParamNormedSq - hubbleParamNormedSq_ref) / hubbleParamNormedSq_ref
652 8000 : assertion = assertion .and. logical(diff < TOL, LK)
653 8000 : if (test%traceable .and. .not. assertion) then
654 : ! LCOV_EXCL_START
655 : write(test%disp%unit,"(*(g0,:,', '))")
656 : write(test%disp%unit,"(*(g0,:,', '))") "hubbleParamNormedSq_ref", hubbleParamNormedSq_ref
657 : write(test%disp%unit,"(*(g0,:,', '))") "hubbleParamNormedSq ", hubbleParamNormedSq
658 : write(test%disp%unit,"(*(g0,:,', '))") "zplus1 ", zplus1
659 : write(test%disp%unit,"(*(g0,:,', '))") "omegaM ", omegaM
660 : write(test%disp%unit,"(*(g0,:,', '))") "omegaL ", omegaL
661 : write(test%disp%unit,"(*(g0,:,', '))") "omegaR ", omegaR
662 : write(test%disp%unit,"(*(g0,:,', '))") "omegaK ", omegaK
663 : write(test%disp%unit,"(*(g0,:,', '))") "diff ", diff
664 : write(test%disp%unit,"(*(g0,:,', '))") "TOL ", TOL
665 : write(test%disp%unit,"(*(g0,:,', '))")
666 : ! LCOV_EXCL_STOP
667 : end if
668 8000 : call test%assert(assertion, desc = "The dimensionless Hubble Parameter must be computed correctly for the specified cosmological parameters.", line = line)
669 8000 : end subroutine
670 :
671 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
672 : #elif getVolComDiffNormed_ENABLED || setVolComDiffNormed_ENABLED || getVolComNormed_ENABLED
673 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
674 :
675 : integer(IK) :: neval, err
676 : real(RKC) , parameter :: reltol = epsilon(0._RKC) * 10000!sqrt(epsilon(0._RKC))
677 : real(RKC) , parameter :: MPC2LY_RKC = real(MPC2LY, RKC)
678 : real(RKC) , parameter :: LIGHT_SPEED_RKC = real(LIGHT_SPEED, RKC)
679 : real(RKC) , parameter :: HUBBLE_CONST_RKC = real(HUBBLE_CONST, RKC)
680 : real(RKC) , parameter :: HUBBLE_DISTANCE_MPC_RKC = real(HUBBLE_DISTANCE_MPC, RKC)
681 : real(RKC) :: zplus1, omegaM, omegaL, omegaR, omegaK
682 : real(RKC) :: volComNormed
683 : real(RKC) :: volComNormed_ref
684 : real(RKC) :: diff
685 : real(RKC) :: tol
686 :
687 12 : tol = epsilon(0._RKC) * 10000
688 12 : assertion = .true._LK
689 :
690 12 : call runTestsWith()
691 12 : call runTestsWith(neval)
692 12 : call runTestsWith(err = err)
693 12 : call runTestsWith(neval, err)
694 :
695 : contains
696 :
697 48 : subroutine runTestsWith(neval, err)
698 : use pm_distUnif, only: setUnifRand
699 : integer(IK), intent(out), optional :: neval, err
700 :
701 : #if getVolComDiffNormed_ENABLED
702 :
703 : integer(IK) :: i
704 176 : do i = 1, 10
705 :
706 160 : omegaM = real(OMEGA_M, RKC)
707 160 : omegaL = real(OMEGA_L, RKC)
708 160 : omegaR = real(OMEGA_R, RKC)
709 160 : omegaK = real(OMEGA_K, RKC)
710 160 : call setUnifRand(zplus1, 1._RKC, 10._RKC)
711 160 : volComNormed = getVolComDiffNormed(zplus1, reltol, neval, err)
712 160 : call setVolComDiffNormed(volComNormed_ref, getDisComTransNormed(zplus1, reltol)**2, sqrt(getHubbleParamNormedSq(zplus1)))
713 160 : call report(omegaM, omegaL, omegaR, omegaK)
714 480 : call test%assert(assertion, SK_"@getVolComDiffNormed(): The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
715 :
716 160 : call setUnifRand(omegaM, 0._RKC, 1._RKC)
717 160 : omegaL = 1._RKC - omegaM
718 160 : omegaR = real(OMEGA_R, RKC)
719 160 : omegaK = real(OMEGA_K, RKC)
720 160 : call setUnifRand(zplus1, 1._RKC, 10._RKC)
721 160 : volComNormed = getVolComDiffNormed(zplus1, omegaM, omegaL, reltol, neval, err)
722 160 : call setVolComDiffNormed(volComNormed_ref, getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL)))
723 160 : call report(omegaM, omegaL, omegaR, omegaK)
724 480 : call test%assert(assertion, SK_"@getVolComDiffNormed(): The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
725 :
726 160 : call setUnifRand(omegaM, 0._RKC, 1._RKC)
727 160 : call setUnifRand(omegaL, 0._RKC, 1._RKC - omegaM)
728 160 : omegaR = 1._RKC - omegaM - omegaL
729 160 : omegaK = real(OMEGA_K, RKC)
730 160 : call setUnifRand(zplus1, 1._RKC, 10._RKC)
731 160 : volComNormed = getVolComDiffNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)
732 160 : call setVolComDiffNormed(volComNormed_ref, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)))
733 160 : call report(omegaM, omegaL, omegaR, omegaK)
734 480 : call test%assert(assertion, SK_"@getVolComDiffNormed(): The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
735 :
736 160 : call setUnifRand(omegaM, 0._RKC, 1._RKC)
737 160 : call setUnifRand(omegaL, 0._RKC, omegaM)
738 160 : call setUnifRand(omegaR, 0._RKC, omegaM + omegaL)
739 160 : omegaK = 1._RKC - omegaM - omegaL - omegaR
740 160 : call setUnifRand(zplus1, 1._RKC, 10._RKC)
741 160 : volComNormed = getVolComDiffNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)
742 160 : call setVolComDiffNormed(volComNormed_ref, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
743 160 : call report(omegaM, omegaL, omegaR, omegaK)
744 496 : call test%assert(assertion, SK_"@getVolComDiffNormed(): The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
745 :
746 : end do
747 :
748 : #elif setVolComDiffNormed_ENABLED
749 :
750 16 : omegaM = 0.2_RKC
751 16 : omegaL = 0.4_RKC
752 16 : omegaR = 0.0_RKC
753 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
754 :
755 16 : zplus1 = 1._RKC
756 16 : volComNormed_ref = 0._RKC
757 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
758 16 : call report(omegaM, omegaL, omegaR, omegaK)
759 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
760 :
761 16 : zplus1 = 2.5_RKC
762 16 : volComNormed_ref = 0.424491473544200570744727780980436799_RKC
763 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
764 16 : call report(omegaM, omegaL, omegaR, omegaK)
765 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
766 :
767 16 : zplus1 = 6._RKC
768 16 : volComNormed_ref = 0.601981403654138797418469447630789515_RKC
769 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
770 16 : call report(omegaM, omegaL, omegaR, omegaK)
771 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
772 :
773 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
774 :
775 16 : zplus1 = 1._RKC
776 16 : omegaM = real(OMEGA_M, RKC)
777 16 : omegaL = real(OMEGA_L, RKC)
778 16 : omegaR = real(OMEGA_R, RKC)
779 16 : omegaK = real(OMEGA_K, RKC)
780 16 : volComNormed_ref = 0._RKC
781 :
782 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1)))
783 16 : call report()
784 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
785 :
786 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL)))
787 16 : call report(omegaM, omegaL)
788 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
789 :
790 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)))
791 16 : call report(omegaM, omegaL, omegaR)
792 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
793 :
794 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
795 16 : call report(omegaM, omegaL, omegaR, omegaK)
796 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
797 :
798 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
799 :
800 16 : zplus1 = 2._RKC
801 16 : omegaM = real(OMEGA_M, RKC)
802 16 : omegaL = real(OMEGA_L, RKC)
803 16 : omegaR = real(OMEGA_R, RKC)
804 16 : omegaK = real(OMEGA_K, RKC)
805 16 : call setVolComDiffNormed_def(volComNormed_ref, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
806 :
807 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1)))
808 16 : call report()
809 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
810 :
811 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL)))
812 16 : call report(omegaM, omegaL)
813 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
814 :
815 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)))
816 16 : call report(omegaM, omegaL, omegaR)
817 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
818 :
819 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
820 16 : call report(omegaM, omegaL, omegaR, omegaK)
821 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
822 :
823 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
824 :
825 16 : zplus1 = 3._RKC
826 16 : omegaM = real(OMEGA_M, RKC)
827 16 : omegaL = real(OMEGA_L, RKC)
828 16 : omegaR = real(OMEGA_R, RKC)
829 16 : omegaK = real(OMEGA_K, RKC)
830 16 : call setVolComDiffNormed_def(volComNormed_ref, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
831 :
832 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1)))
833 16 : call report()
834 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
835 :
836 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL)))
837 16 : call report(omegaM, omegaL)
838 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
839 :
840 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR)))
841 16 : call report(omegaM, omegaL, omegaR)
842 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
843 :
844 16 : call setVolComDiffNormed(volComNormed, getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err)**2, sqrt(getHubbleParamNormedSq(zplus1, omegaM, omegaL, omegaR, omegaK)))
845 16 : call report(omegaM, omegaL, omegaR, omegaK)
846 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
847 :
848 : #elif getVolComNormed_ENABLED
849 :
850 16 : omegaM = 0.2_RKC
851 16 : omegaL = 0.4_RKC
852 16 : omegaR = 0.0_RKC
853 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
854 :
855 16 : zplus1 = 1._RKC
856 16 : volComNormed_ref = 0._RKC
857 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
858 16 : call report(omegaM, omegaL, omegaR, omegaK)
859 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
860 :
861 16 : zplus1 = 2.5_RKC
862 16 : volComNormed_ref = 3.99648746549472192582313390774500827_RKC
863 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
864 16 : call report(omegaM, omegaL, omegaR, omegaK)
865 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
866 :
867 16 : zplus1 = 6._RKC
868 16 : volComNormed_ref = 29.0231597572974447624597993854436293_RKC
869 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
870 16 : call report(omegaM, omegaL, omegaR, omegaK)
871 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
872 :
873 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
874 :
875 16 : omegaM = 0.2_RKC
876 16 : omegaL = 0.4_RKC
877 16 : omegaR = 0.5_RKC
878 16 : omegaK = +1._RKC - omegaM - omegaL - omegaR
879 :
880 16 : zplus1 = 1._RKC
881 16 : volComNormed_ref = 0._RKC
882 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
883 16 : call report(omegaM, omegaL, omegaR, omegaK)
884 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
885 :
886 16 : zplus1 = 2.5_RKC
887 16 : volComNormed_ref = 1.50955035302854263049196839502469953_RKC
888 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
889 16 : call report(omegaM, omegaL, omegaR, omegaK)
890 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
891 :
892 16 : zplus1 = 6._RKC
893 16 : volComNormed_ref = 4.45878362364779446349477242289460663_RKC
894 16 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
895 16 : call report(omegaM, omegaL, omegaR, omegaK)
896 48 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
897 :
898 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
899 :
900 : block
901 : integer(IK) :: i
902 64 : do i = 1, 3
903 48 : zplus1 = real(i, RKC)
904 48 : omegaM = real(OMEGA_M, RKC)
905 48 : omegaL = real(OMEGA_L, RKC)
906 48 : omegaR = real(OMEGA_R, RKC)
907 48 : omegaK = real(OMEGA_K, RKC)
908 48 : volComNormed_ref = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
909 :
910 48 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, reltol, neval, err))
911 48 : call report()
912 144 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
913 :
914 48 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, reltol, neval, err))
915 48 : call report(omegaM, omegaL)
916 144 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
917 :
918 48 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, reltol, neval, err))
919 48 : call report(omegaM, omegaL, omegaR)
920 144 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
921 :
922 48 : volComNormed = getVolComNormed(getDisComTransNormed(zplus1, omegaM, omegaL, omegaR, omegaK, sqrt(abs(omegaK)), reltol, neval, err), omegaK, sqrt(abs(omegaK)))
923 48 : call report(omegaM, omegaL, omegaR, omegaK)
924 160 : call test%assert(assertion, SK_"The Comoving Volume Element must be computed correctly for the specified cosmological parameters with present(neval), present(err) = "//getStr([present(neval), present(err)]), int(__LINE__, IK))
925 : end do
926 : end block
927 : #else
928 : #error "Unrecognized interface."
929 : #endif
930 48 : end subroutine
931 :
932 : #if setVolComDiffNormed_ENABLED
933 : pure elemental subroutine setVolComDiffNormed_def(volComNormed, disComTransNormedSq, hubbleParamNormed)
934 : real(RKC), intent(in) :: disComTransNormedSq, hubbleParamNormed
935 : real(RKC), intent(out) :: volComNormed
936 32 : volComNormed = disComTransNormedSq / hubbleParamNormed
937 : end subroutine
938 : #endif
939 1168 : subroutine report(omegaM, omegaL, omegaR, omegaK)
940 : real(RKC), intent(in), optional :: omegaM, omegaL, omegaR, omegaK
941 1168 : if (abs(volComNormed_ref) <= epsilon(0._RKC)) then
942 176 : diff = abs(volComNormed - volComNormed_ref)
943 : else
944 992 : diff = abs(volComNormed - volComNormed_ref) / volComNormed_ref
945 : end if
946 1168 : assertion = assertion .and. logical(diff < TOL, LK)
947 1168 : if (test%traceable .and. .not. assertion) then
948 : ! LCOV_EXCL_START
949 : write(test%disp%unit,"(*(g0,:,', '))")
950 : write(test%disp%unit,"(*(g0,:,', '))") "volComNormed_ref", volComNormed_ref
951 : write(test%disp%unit,"(*(g0,:,', '))") "volComNormed", volComNormed
952 : write(test%disp%unit,"(*(g0,:,', '))") "zplus1", zplus1
953 : if (present(omegaM)) write(test%disp%unit,"(*(g0,:,', '))") "omegaM", omegaM
954 : if (present(omegaL)) write(test%disp%unit,"(*(g0,:,', '))") "omegaL", omegaL
955 : if (present(omegaR)) write(test%disp%unit,"(*(g0,:,', '))") "omegaR", omegaR
956 : if (present(omegaK)) write(test%disp%unit,"(*(g0,:,', '))") "omegaK", omegaK
957 : write(test%disp%unit,"(*(g0,:,', '))") "diff", diff
958 : write(test%disp%unit,"(*(g0,:,', '))") "TOL", TOL
959 : write(test%disp%unit,"(*(g0,:,', '))")
960 : ! LCOV_EXCL_STOP
961 : end if
962 1168 : end subroutine
963 :
964 : #else
965 : !%%%%%%%%%%%%%%%%%%%%%%%%
966 : #error "Unrecognized interface."
967 : !%%%%%%%%%%%%%%%%%%%%%%%%
968 : #endif
|
