1
1
#:include "common.fypp"
2
-
3
2
#:set RANKS = range(1, MAXRANK + 1)
4
-
5
-
3
+ #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
6
4
submodule (stdlib_experimental_stats) stdlib_experimental_stats_var
7
5
8
6
use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan
@@ -12,17 +10,18 @@ submodule (stdlib_experimental_stats) stdlib_experimental_stats_var
12
10
13
11
contains
14
12
15
- #:for k1, t1 in REAL_KINDS_TYPES
13
+ #:for k1, t1 in RC_KINDS_TYPES
16
14
#:for rank in RANKS
17
- module function var_${rank}$_all_${k1}$_${k1}$(x, mask) result(res)
15
+ #:set RName = rname("var_all",rank, t1, k1)
16
+ module function ${RName}$(x, mask) result(res)
18
17
${t1}$, intent(in) :: x${ranksuffix(rank)}$
19
18
logical, intent(in), optional :: mask
20
19
${t1}$ :: res
21
20
22
21
${t1}$ :: n, mean
23
22
24
23
if (.not.optval(mask, .true.)) then
25
- res = ieee_value(res, ieee_quiet_nan)
24
+ res = ieee_value(real( res, kind=${k1}$) , ieee_quiet_nan)
26
25
return
27
26
end if
28
27
@@ -31,14 +30,15 @@ contains
31
30
32
31
res = sum((x - mean)**2) / (n - 1._${k1}$)
33
32
34
- end function var_${rank}$_all_${k1}$_${k1 }$
33
+ end function ${RName }$
35
34
#:endfor
36
35
#:endfor
37
36
38
37
39
38
#:for k1, t1 in INT_KINDS_TYPES
40
39
#:for rank in RANKS
41
- module function var_${rank}$_all_${k1}$_dp(x, mask) result(res)
40
+ #:set RName = rname("var_all",rank, t1, k1, 'dp')
41
+ module function ${RName}$(x, mask) result(res)
42
42
${t1}$, intent(in) :: x${ranksuffix(rank)}$
43
43
logical, intent(in), optional :: mask
44
44
real(dp) :: res
@@ -55,14 +55,15 @@ contains
55
55
56
56
res = sum((real(x, dp) - mean)**2) / (n - 1._dp)
57
57
58
- end function var_${rank}$_all_${k1}$_dp
58
+ end function ${RName}$
59
59
#:endfor
60
60
#:endfor
61
61
62
62
63
- #:for k1, t1 in REAL_KINDS_TYPES
63
+ #:for k1, t1 in RC_KINDS_TYPES
64
64
#:for rank in RANKS
65
- module function var_${rank}$_${k1}$_${k1}$(x, dim, mask) result(res)
65
+ #:set RName = rname("var",rank, t1, k1)
66
+ module function ${RName}$(x, dim, mask) result(res)
66
67
${t1}$, intent(in) :: x${ranksuffix(rank)}$
67
68
integer, intent(in) :: dim
68
69
logical, intent(in), optional :: mask
@@ -73,7 +74,7 @@ contains
73
74
${t1}$ :: mean${reduced_shape('x', rank, 'dim')}$
74
75
75
76
if (.not.optval(mask, .true.)) then
76
- res = ieee_value(res, ieee_quiet_nan)
77
+ res = ieee_value(real( res, kind=${k1}$) , ieee_quiet_nan)
77
78
return
78
79
end if
79
80
@@ -92,14 +93,15 @@ contains
92
93
end select
93
94
res = res / (n - 1._${k1}$)
94
95
95
- end function var_${rank}$_${k1}$_${k1 }$
96
+ end function ${RName }$
96
97
#:endfor
97
98
#:endfor
98
99
99
100
100
101
#:for k1, t1 in INT_KINDS_TYPES
101
102
#:for rank in RANKS
102
- module function var_${rank}$_${k1}$_dp(x, dim, mask) result(res)
103
+ #:set RName = rname("var",rank, t1, k1, 'dp')
104
+ module function ${RName}$(x, dim, mask) result(res)
103
105
${t1}$, intent(in) :: x${ranksuffix(rank)}$
104
106
integer, intent(in) :: dim
105
107
logical, intent(in), optional :: mask
@@ -129,14 +131,15 @@ contains
129
131
end select
130
132
res = res / (n - 1._dp)
131
133
132
- end function var_${rank}$_${k1}$_dp
134
+ end function ${RName}$
133
135
#:endfor
134
136
#:endfor
135
137
136
138
137
- #:for k1, t1 in REAL_KINDS_TYPES
139
+ #:for k1, t1 in RC_KINDS_TYPES
138
140
#:for rank in RANKS
139
- module function var_${rank}$_mask_all_${k1}$_${k1}$(x, mask) result(res)
141
+ #:set RName = rname("var_mask_all",rank, t1, k1)
142
+ module function ${RName}$(x, mask) result(res)
140
143
${t1}$, intent(in) :: x${ranksuffix(rank)}$
141
144
logical, intent(in) :: mask${ranksuffix(rank)}$
142
145
${t1}$ :: res
@@ -148,14 +151,15 @@ contains
148
151
149
152
res = sum((x - mean)**2, mask) / (n - 1._${k1}$)
150
153
151
- end function var_${rank}$_mask_all_${k1}$_${k1 }$
154
+ end function ${RName }$
152
155
#:endfor
153
156
#:endfor
154
157
155
158
156
159
#:for k1, t1 in INT_KINDS_TYPES
157
160
#:for rank in RANKS
158
- module function var_${rank}$_mask_all_${k1}$_dp(x, mask) result(res)
161
+ #:set RName = rname("var_mask_all",rank, t1, k1, 'dp')
162
+ module function ${RName}$(x, mask) result(res)
159
163
${t1}$, intent(in) :: x${ranksuffix(rank)}$
160
164
logical, intent(in) :: mask${ranksuffix(rank)}$
161
165
real(dp) :: res
@@ -167,14 +171,15 @@ contains
167
171
168
172
res = sum((real(x, dp) - mean)**2, mask) / (n - 1._dp)
169
173
170
- end function var_${rank}$_mask_all_${k1}$_dp
174
+ end function ${RName}$
171
175
#:endfor
172
176
#:endfor
173
177
174
178
175
- #:for k1, t1 in REAL_KINDS_TYPES
179
+ #:for k1, t1 in RC_KINDS_TYPES
176
180
#:for rank in RANKS
177
- module function var_${rank}$_mask_${k1}$_${k1}$(x, dim, mask) result(res)
181
+ #:set RName = rname("var_mask",rank, t1, k1)
182
+ module function ${RName}$(x, dim, mask) result(res)
178
183
${t1}$, intent(in) :: x${ranksuffix(rank)}$
179
184
integer, intent(in) :: dim
180
185
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -192,22 +197,28 @@ contains
192
197
mean = sum(x, dim, mask) / n
193
198
do i = 1, size(x, dim)
194
199
res = res + merge( (x${rankindice(':', 'i', rank, fi )}$ - mean)**2,&
195
- 0._${k1}$, mask${rankindice(':', 'i', rank, fi)}$)
200
+ #:if t1[0] == 'r'
201
+ 0._${k1}$,&
202
+ #:else
203
+ cmplx(0._${k1}$, 0._${k1}$, ${k1}$),&
204
+ #:endif
205
+ mask${rankindice(':', 'i', rank, fi)}$)
196
206
end do
197
207
#:endfor
198
208
case default
199
209
call error_stop("ERROR (mean): wrong dimension")
200
210
end select
201
211
res = res / (n - 1._${k1}$)
202
212
203
- end function var_${rank}$_mask_${k1}$_${k1 }$
213
+ end function ${RName }$
204
214
#:endfor
205
215
#:endfor
206
216
207
217
208
218
#:for k1, t1 in INT_KINDS_TYPES
209
219
#:for rank in RANKS
210
- module function var_${rank}$_mask_${k1}$_dp(x, dim, mask) result(res)
220
+ #:set RName = rname("var_mask",rank, t1, k1, 'dp')
221
+ module function ${RName}$(x, dim, mask) result(res)
211
222
${t1}$, intent(in) :: x${ranksuffix(rank)}$
212
223
integer, intent(in) :: dim
213
224
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -233,7 +244,7 @@ contains
233
244
end select
234
245
res = res / (n - 1._dp)
235
246
236
- end function var_${rank}$_mask_${k1}$_dp
247
+ end function ${RName}$
237
248
#:endfor
238
249
#:endfor
239
250
0 commit comments