Skip to content

Commit 5a0a008

Browse files
jvdp1awvwgk
jvdp1
authored and
awvwgk
committed
Add test_mean_f03 + update makefile
1 parent dec1f12 commit 5a0a008

File tree

4 files changed

+304
-55
lines changed

4 files changed

+304
-55
lines changed

‎src/tests/stats/CMakeLists.txt

+1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
# Create a list of the files to be preprocessed
44
set(fppFiles
55
test_mean.fypp
6+
test_mean_f03.fypp
67
test_median.fypp
78
)
89

‎src/tests/stats/Makefile.manual

+1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
SRCFYPP =\
2+
test_mean.fypp \
23
test_median.fypp
34

45
SRCGEN = $(SRCFYPP:.fypp=.f90)

‎src/tests/stats/test_mean_f03.f90

-55
This file was deleted.

‎src/tests/stats/test_mean_f03.fypp

+302
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,302 @@
1+
#:include "common.fypp"
2+
#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
3+
4+
#:set NRANK = 4
5+
6+
module test_stats_meanf03
7+
use stdlib_test, only : new_unittest, unittest_type, error_type, check
8+
use stdlib_stats, only: mean
9+
use stdlib_kinds, only : int8, int16, int32, int64, sp, dp, qp
10+
use, intrinsic :: ieee_arithmetic, only : ieee_is_nan
11+
implicit none
12+
private
13+
14+
public :: collect_stats_meanf03
15+
16+
real(sp), parameter :: sptol = 1000 * epsilon(1._sp)
17+
real(dp), parameter :: dptol = 2000 * epsilon(1._dp)
18+
real(qp), parameter :: qptol = 2000 * epsilon(1._qp)
19+
20+
#:for k1,t1 in IR_KINDS_TYPES
21+
${t1}$ , parameter :: d1_${k1}$(18) = [-10, 2, 3, 4, -6, 6, -7, 8, 9, 4, 1, -20, 9, 10, 14, 15, 40, 30]
22+
${t1}$ :: d8_${k1}$(2, 3, 4, 2, 3, 4, 2, 3) = reshape(d1_${k1}$, [2, 3, 4, 2, 3, 4, 2, 3], [${t1}$:: 3])
23+
#:endfor
24+
25+
#:for k1,t1 in CMPLX_KINDS_TYPES
26+
${t1}$ , parameter :: d1_c${k1}$(18) = d1_${k1}$
27+
${t1}$ :: d8_c${k1}$(2, 3, 4, 2, 3, 4, 2, 3) = reshape(d1_c${k1}$, [2, 3, 4, 2, 3, 4, 2, 3], [${t1}$:: 3])
28+
#:endfor
29+
30+
contains
31+
32+
!> Collect all exported unit tests
33+
subroutine collect_stats_meanf03(testsuite)
34+
!> Collection of tests
35+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
36+
37+
testsuite = [ &
38+
new_unittest("test_stats_meanf03_all_int8", test_stats_meanf03_all_int8) &
39+
#:for k1,t1 in IR_KINDS_TYPES
40+
,new_unittest("test_stats_meanf03_all_${k1}$", test_stats_meanf03_all_${k1}$) &
41+
, new_unittest("test_stats_meanf03_all_optmask_${k1}$", test_stats_meanf03_all_optmask_${k1}$) &
42+
, new_unittest("test_stats_meanf03_${k1}$", test_stats_meanf03_${k1}$) &
43+
, new_unittest("test_stats_meanf03_optmask_${k1}$", test_stats_meanf03_optmask_${k1}$) &
44+
, new_unittest("test_stats_meanf03_mask_all_${k1}$", test_stats_meanf03_mask_all_${k1}$) &
45+
, new_unittest("test_stats_meanf03_mask_${k1}$", test_stats_meanf03_mask_${k1}$) &
46+
#:endfor
47+
#:for k1,t1 in CMPLX_KINDS_TYPES
48+
,new_unittest("test_stats_meanf03_all_c${k1}$", test_stats_meanf03_all_c${k1}$) &
49+
, new_unittest("test_stats_meanf03_all_optmask_c${k1}$", test_stats_meanf03_all_optmask_c${k1}$) &
50+
, new_unittest("test_stats_meanf03_c${k1}$", test_stats_meanf03_c${k1}$) &
51+
, new_unittest("test_stats_meanf03_optmask_c${k1}$", test_stats_meanf03_optmask_c${k1}$) &
52+
, new_unittest("test_stats_meanf03_mask_all_c${k1}$", test_stats_meanf03_mask_all_c${k1}$) &
53+
, new_unittest("test_stats_meanf03_mask_c${k1}$", test_stats_meanf03_mask_c${k1}$) &
54+
#:endfor
55+
]
56+
end subroutine collect_stats_meanf03
57+
58+
#:for k1,t1 in INT_KINDS_TYPES
59+
subroutine test_stats_meanf03_all_${k1}$(error)
60+
!> Error handling
61+
type(error_type), allocatable, intent(out) :: error
62+
63+
call check(error, mean(d8_${k1}$), sum(real(d8_${k1}$, dp))/real(size(d8_${k1}$), dp)&
64+
, 'mean(d8_${k1}$): uncorrect answer'&
65+
, thr = dptol)
66+
if (allocated(error)) return
67+
end subroutine
68+
69+
subroutine test_stats_meanf03_all_optmask_${k1}$(error)
70+
!> Error handling
71+
type(error_type), allocatable, intent(out) :: error
72+
73+
call check(error, ieee_is_nan(mean(d8_${k1}$, .false.))&
74+
, 'mean(d8_${k1}$, .false.): uncorrect answer')
75+
if (allocated(error)) return
76+
end subroutine
77+
78+
subroutine test_stats_meanf03_${k1}$(error)
79+
!> Error handling
80+
type(error_type), allocatable, intent(out) :: error
81+
82+
#:for dim in range(1, 9)
83+
call check(error&
84+
, sum(abs(mean(d8_${k1}$, ${dim}$) -&
85+
sum(real(d8_${k1}$, dp), ${dim}$)/real(size(d8_${k1}$, ${dim}$), dp))) < dptol&
86+
, 'mean(d8_${k1}$, ${dim}$): uncorrect answer'&
87+
)
88+
if (allocated(error)) return
89+
#:endfor
90+
end subroutine
91+
92+
subroutine test_stats_meanf03_optmask_${k1}$(error)
93+
!> Error handling
94+
type(error_type), allocatable, intent(out) :: error
95+
96+
call check(error, ieee_is_nan(mean(d1_${k1}$, 1, .false.))&
97+
, 'mean(d1_${k1}$, 1, .false.): uncorrect answer'&
98+
)
99+
if (allocated(error)) return
100+
101+
#:for dim in range(1, 9)
102+
call check(error, any(ieee_is_nan(mean(d8_${k1}$, ${dim}$, .false.)))&
103+
, 'mean(d8_${k1}$, ${dim}$, .false.): uncorrect answer')
104+
if (allocated(error)) return
105+
#:endfor
106+
end subroutine
107+
108+
subroutine test_stats_meanf03_mask_all_${k1}$(error)
109+
!> Error handling
110+
type(error_type), allocatable, intent(out) :: error
111+
112+
call check(error, mean(d8_${k1}$, d8_${k1}$ > 0)&
113+
, sum(real(d8_${k1}$, dp), d8_${k1}$ > 0)/real(count(d8_${k1}$ > 0), dp)&
114+
, 'mean(d8_${k1}$, d8_${k1}$ > 0): uncorrect answer'&
115+
, thr = dptol)
116+
if (allocated(error)) return
117+
end subroutine
118+
119+
subroutine test_stats_meanf03_mask_${k1}$(error)
120+
!> Error handling
121+
type(error_type), allocatable, intent(out) :: error
122+
123+
#:for dim in range(1, 9)
124+
call check(error&
125+
, sum(abs(mean(d8_${k1}$, ${dim}$, d8_${k1}$ > 0) -&
126+
sum(real(d8_${k1}$, dp), ${dim}$, d8_${k1}$ > 0)/real(count(d8_${k1}$ > 0, ${dim}$), dp))) < dptol&
127+
, 'mean(d8_${k1}$, ${dim}$, d8_${k1}$ > 0): uncorrect answer'&
128+
)
129+
if (allocated(error)) return
130+
#:endfor
131+
end subroutine
132+
#:endfor
133+
134+
#:for k1,t1 in REAL_KINDS_TYPES
135+
subroutine test_stats_meanf03_all_${k1}$(error)
136+
!> Error handling
137+
type(error_type), allocatable, intent(out) :: error
138+
139+
call check(error, mean(d8_${k1}$), sum(d8_${k1}$)/real(size(d8_${k1}$), ${k1}$)&
140+
, 'mean(d8_${k1}$): uncorrect answer'&
141+
, thr = ${k1}$tol)
142+
if (allocated(error)) return
143+
end subroutine
144+
145+
subroutine test_stats_meanf03_all_optmask_${k1}$(error)
146+
!> Error handling
147+
type(error_type), allocatable, intent(out) :: error
148+
149+
call check(error, ieee_is_nan(mean(d8_${k1}$, .false.))&
150+
, 'mean(d8_${k1}$, .false.): uncorrect answer')
151+
if (allocated(error)) return
152+
end subroutine
153+
154+
subroutine test_stats_meanf03_${k1}$(error)
155+
!> Error handling
156+
type(error_type), allocatable, intent(out) :: error
157+
158+
#:for dim in range(1, 9)
159+
call check(error&
160+
, sum(abs(mean(d8_${k1}$, ${dim}$) -&
161+
sum(d8_${k1}$, ${dim}$)/real(size(d8_${k1}$, ${dim}$), ${k1}$))) < ${k1}$tol&
162+
, 'mean(d8_${k1}$, ${dim}$): uncorrect answer'&
163+
)
164+
if (allocated(error)) return
165+
#:endfor
166+
end subroutine
167+
168+
subroutine test_stats_meanf03_optmask_${k1}$(error)
169+
!> Error handling
170+
type(error_type), allocatable, intent(out) :: error
171+
172+
#:for dim in range(1, 9)
173+
call check(error, any(ieee_is_nan(mean(d8_${k1}$, ${dim}$, .false.)))&
174+
, 'mean(d8_${k1}$, ${dim}$, .false.): uncorrect answer')
175+
if (allocated(error)) return
176+
#:endfor
177+
end subroutine
178+
179+
subroutine test_stats_meanf03_mask_all_${k1}$(error)
180+
!> Error handling
181+
type(error_type), allocatable, intent(out) :: error
182+
183+
call check(error, mean(d8_${k1}$, d8_${k1}$ > 0)&
184+
, sum(d8_${k1}$, d8_${k1}$ > 0)/real(count(d8_${k1}$ > 0), ${k1}$)&
185+
, 'mean(d8_${k1}$, d8_${k1}$ > 0): uncorrect answer'&
186+
, thr = ${k1}$tol)
187+
if (allocated(error)) return
188+
end subroutine
189+
190+
subroutine test_stats_meanf03_mask_${k1}$(error)
191+
!> Error handling
192+
type(error_type), allocatable, intent(out) :: error
193+
194+
#:for dim in range(1, 9)
195+
call check(error&
196+
, sum(abs(mean(d8_${k1}$, ${dim}$, d8_${k1}$ > 0) -&
197+
sum(d8_${k1}$, ${dim}$, d8_${k1}$ > 0)/real(count(d8_${k1}$ > 0, ${dim}$), ${k1}$))) < ${k1}$tol&
198+
, 'mean(d8_${k1}$, ${dim}$, d8_${k1}$ > 0): uncorrect answer'&
199+
)
200+
if (allocated(error)) return
201+
#:endfor
202+
end subroutine
203+
#:endfor
204+
205+
#:for k1,t1 in CMPLX_KINDS_TYPES
206+
subroutine test_stats_meanf03_all_c${k1}$(error)
207+
!> Error handling
208+
type(error_type), allocatable, intent(out) :: error
209+
210+
call check(error, mean(d8_c${k1}$), sum(d8_c${k1}$)/real(size(d8_c${k1}$), ${k1}$)&
211+
, 'mean(d8_c${k1}$): uncorrect answer'&
212+
, thr = ${k1}$tol)
213+
if (allocated(error)) return
214+
end subroutine
215+
216+
subroutine test_stats_meanf03_all_optmask_c${k1}$(error)
217+
!> Error handling
218+
type(error_type), allocatable, intent(out) :: error
219+
220+
call check(error, ieee_is_nan(real(mean(d8_c${k1}$, .false.)))&
221+
, 'mean(d8_c${k1}$, .false.): uncorrect answer')
222+
if (allocated(error)) return
223+
end subroutine
224+
225+
subroutine test_stats_meanf03_c${k1}$(error)
226+
!> Error handling
227+
type(error_type), allocatable, intent(out) :: error
228+
229+
#:for dim in range(1, 9)
230+
call check(error&
231+
, sum(abs(mean(d8_c${k1}$, ${dim}$) -&
232+
sum(d8_c${k1}$, ${dim}$)/real(size(d8_c${k1}$, ${dim}$), ${k1}$))) < ${k1}$tol&
233+
, 'mean(d8_c${k1}$, ${dim}$): uncorrect answer'&
234+
)
235+
if (allocated(error)) return
236+
#:endfor
237+
end subroutine
238+
239+
subroutine test_stats_meanf03_optmask_c${k1}$(error)
240+
!> Error handling
241+
type(error_type), allocatable, intent(out) :: error
242+
243+
#:for dim in range(1, 9)
244+
call check(error, any(ieee_is_nan(real(mean(d8_c${k1}$, ${dim}$, .false.))))&
245+
, 'mean(d8_c${k1}$, ${dim}$, .false.): uncorrect answer')
246+
if (allocated(error)) return
247+
#:endfor
248+
end subroutine
249+
250+
subroutine test_stats_meanf03_mask_all_c${k1}$(error)
251+
!> Error handling
252+
type(error_type), allocatable, intent(out) :: error
253+
254+
call check(error, mean(d8_c${k1}$, d8_c${k1}$%re > 0)&
255+
, sum(d8_c${k1}$, d8_c${k1}$%re > 0)/real(count(d8_c${k1}$%re > 0), ${k1}$)&
256+
, 'mean(d8_c${k1}$, d8_c${k1}$%re > 0): uncorrect answer'&
257+
, thr = ${k1}$tol)
258+
if (allocated(error)) return
259+
end subroutine
260+
261+
subroutine test_stats_meanf03_mask_c${k1}$(error)
262+
!> Error handling
263+
type(error_type), allocatable, intent(out) :: error
264+
265+
#:for dim in range(1, 9)
266+
call check(error&
267+
, sum(abs(mean(d8_c${k1}$, ${dim}$, d8_c${k1}$%re > 0) -&
268+
sum(d8_c${k1}$, ${dim}$, d8_c${k1}$%re > 0)/real(count(d8_c${k1}$%re > 0, ${dim}$), ${k1}$))) < ${k1}$tol&
269+
, 'mean(d8_c${k1}$, ${dim}$, d8_c${k1}$%re > 0): uncorrect answer'&
270+
)
271+
if (allocated(error)) return
272+
#:endfor
273+
end subroutine
274+
#:endfor
275+
276+
end module test_stats_meanf03
277+
278+
program tester
279+
use, intrinsic :: iso_fortran_env, only : error_unit
280+
use stdlib_test, only : run_testsuite, new_testsuite, testsuite_type
281+
use test_stats_meanf03, only : collect_stats_meanf03
282+
implicit none
283+
integer :: stat, is
284+
type(testsuite_type), allocatable :: testsuites(:)
285+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
286+
287+
stat = 0
288+
289+
testsuites = [ &
290+
new_testsuite("stats_meanf03", collect_stats_meanf03) &
291+
]
292+
293+
do is = 1, size(testsuites)
294+
write(error_unit, fmt) "Testing:", testsuites(is)%name
295+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
296+
end do
297+
298+
if (stat > 0) then
299+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
300+
error stop
301+
end if
302+
end program

0 commit comments

Comments
 (0)