Skip to content

Commit 044abc5

Browse files
committed
varaince_dev: update var modules
1 parent e966e7b commit 044abc5

File tree

3 files changed

+79
-46
lines changed

3 files changed

+79
-46
lines changed

src/common.fypp

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,20 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
113113
$:"{0}_{1}_{2}{3}_{2}{3}".format(gname, rank, type[0], kind) if suffix == '' else "{0}_{1}_{2}{3}_{4}".format(gname, rank, type[0], kind, suffix)
114114
#:enddef
115115

116+
#! Generates Fortran expressions.
117+
#!
118+
#! Args:
119+
#! varname (str): Name of the variable to be used as origin
120+
#! varname1 (str): Name of the variable to be used instead of varname
121+
#! origrank (int): Rank of the original variable
122+
#! dim (int): Index of the used expression varname1
123+
#!
124+
#! Returns:
125+
#! Shape expression enclosed in braces, except for the index dim.
126+
#!
127+
#! E.g., (:, :, :, i, :, :)
128+
#!
129+
116130
#:def rankindice(varname, varname1, origrank, dim)
117131
#:assert origrank > 0
118132
#:if origrank > 0

src/stdlib_experimental_stats.fypp

Lines changed: 28 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -107,91 +107,99 @@ module stdlib_experimental_stats
107107

108108
interface var
109109

110-
#:for k1, t1 in REAL_KINDS_TYPES
110+
#:for k1, t1 in RC_KINDS_TYPES
111111
#:for rank in RANKS
112-
module function var_${rank}$_all_${k1}$_${k1}$(x, mask) result(res)
112+
#:set RName = rname("var_all",rank, t1, k1)
113+
module function ${RName}$(x, mask) result(res)
113114
${t1}$, intent(in) :: x${ranksuffix(rank)}$
114115
logical, intent(in), optional :: mask
115116
${t1}$ :: res
116-
end function var_${rank}$_all_${k1}$_${k1}$
117+
end function ${RName}$
117118
#:endfor
118119
#:endfor
119120

120121
#:for k1, t1 in INT_KINDS_TYPES
121122
#:for rank in RANKS
122-
module function var_${rank}$_all_${k1}$_dp(x, mask) result(res)
123+
#:set RName = rname("var_all",rank, t1, k1, 'dp')
124+
module function ${RName}$(x, mask) result(res)
123125
${t1}$, intent(in) :: x${ranksuffix(rank)}$
124126
logical, intent(in), optional :: mask
125127
real(dp) :: res
126-
end function var_${rank}$_all_${k1}$_dp
128+
end function ${RName}$
127129
#:endfor
128130
#:endfor
129131

130-
#:for k1, t1 in REAL_KINDS_TYPES
132+
#:for k1, t1 in RC_KINDS_TYPES
131133
#:for rank in RANKS
132-
module function var_${rank}$_${k1}$_${k1}$(x, dim, mask) result(res)
134+
#:set RName = rname("var",rank, t1, k1)
135+
module function ${RName}$(x, dim, mask) result(res)
133136
${t1}$, intent(in) :: x${ranksuffix(rank)}$
134137
integer, intent(in) :: dim
135138
logical, intent(in), optional :: mask
136139
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
137-
end function var_${rank}$_${k1}$_${k1}$
140+
end function ${RName}$
138141
#:endfor
139142
#:endfor
140143

141144
#:for k1, t1 in INT_KINDS_TYPES
142145
#:for rank in RANKS
143-
module function var_${rank}$_${k1}$_dp(x, dim, mask) result(res)
146+
#:set RName = rname("var",rank, t1, k1, 'dp')
147+
module function ${RName}$(x, dim, mask) result(res)
144148
${t1}$, intent(in) :: x${ranksuffix(rank)}$
145149
integer, intent(in) :: dim
146150
logical, intent(in), optional :: mask
147151
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
148-
end function var_${rank}$_${k1}$_dp
152+
end function ${RName}$
149153
#:endfor
150154
#:endfor
151155

152156

153-
#:for k1, t1 in REAL_KINDS_TYPES
157+
#:for k1, t1 in RC_KINDS_TYPES
154158
#:for rank in RANKS
155-
module function var_${rank}$_mask_all_${k1}$_${k1}$(x, mask) result(res)
159+
#:set RName = rname("var_mask_all",rank, t1, k1)
160+
module function ${RName}$(x, mask) result(res)
156161
${t1}$, intent(in) :: x${ranksuffix(rank)}$
157162
logical, intent(in) :: mask${ranksuffix(rank)}$
158163
${t1}$ :: res
159-
end function var_${rank}$_mask_all_${k1}$_${k1}$
164+
end function ${RName}$
160165
#:endfor
161166
#:endfor
162167

163168

164169
#:for k1, t1 in INT_KINDS_TYPES
165170
#:for rank in RANKS
166-
module function var_${rank}$_mask_all_${k1}$_dp(x, mask) result(res)
171+
#:set RName = rname("var_mask_all",rank, t1, k1, 'dp')
172+
module function ${RName}$(x, mask) result(res)
167173
${t1}$, intent(in) :: x${ranksuffix(rank)}$
168174
logical, intent(in) :: mask${ranksuffix(rank)}$
169175
real(dp) :: res
170-
end function var_${rank}$_mask_all_${k1}$_dp
176+
end function ${RName}$
171177
#:endfor
172178
#:endfor
173179

174180

175-
#:for k1, t1 in REAL_KINDS_TYPES
181+
#:for k1, t1 in RC_KINDS_TYPES
176182
#:for rank in RANKS
177-
module function var_${rank}$_mask_${k1}$_${k1}$(x, dim, mask) result(res)
183+
#:set RName = rname("var_mask",rank, t1, k1)
184+
module function ${RName}$(x, dim, mask) result(res)
178185
${t1}$, intent(in) :: x${ranksuffix(rank)}$
179186
integer, intent(in) :: dim
180187
logical, intent(in) :: mask${ranksuffix(rank)}$
181188
${t1}$ :: res${reduced_shape('x', rank, 'dim')}$
182-
end function var_${rank}$_mask_${k1}$_${k1}$
189+
end function ${RName}$
183190
#:endfor
184191
#:endfor
185192

186193

187194
#:for k1, t1 in INT_KINDS_TYPES
188195
#:for rank in RANKS
189-
module function var_${rank}$_mask_${k1}$_dp(x, dim, mask) result(res)
196+
#:set RName = rname("var_mask",rank, t1, k1, 'dp')
197+
module function ${RName}$(x, dim, mask) result(res)
190198
${t1}$, intent(in) :: x${ranksuffix(rank)}$
191199
integer, intent(in) :: dim
192200
logical, intent(in) :: mask${ranksuffix(rank)}$
193201
real(dp) :: res${reduced_shape('x', rank, 'dim')}$
194-
end function var_${rank}$_mask_${k1}$_dp
202+
end function ${RName}$
195203
#:endfor
196204
#:endfor
197205

src/stdlib_experimental_stats_var.fypp

Lines changed: 37 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
11
#:include "common.fypp"
2-
32
#:set RANKS = range(1, MAXRANK + 1)
4-
5-
3+
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
64
submodule (stdlib_experimental_stats) stdlib_experimental_stats_var
75

86
use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan
@@ -12,17 +10,18 @@ submodule (stdlib_experimental_stats) stdlib_experimental_stats_var
1210

1311
contains
1412

15-
#:for k1, t1 in REAL_KINDS_TYPES
13+
#:for k1, t1 in RC_KINDS_TYPES
1614
#: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)
1817
${t1}$, intent(in) :: x${ranksuffix(rank)}$
1918
logical, intent(in), optional :: mask
2019
${t1}$ :: res
2120

2221
${t1}$ :: n, mean
2322

2423
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)
2625
return
2726
end if
2827

@@ -31,14 +30,15 @@ contains
3130

3231
res = sum((x - mean)**2) / (n - 1._${k1}$)
3332

34-
end function var_${rank}$_all_${k1}$_${k1}$
33+
end function ${RName}$
3534
#:endfor
3635
#:endfor
3736

3837

3938
#:for k1, t1 in INT_KINDS_TYPES
4039
#: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)
4242
${t1}$, intent(in) :: x${ranksuffix(rank)}$
4343
logical, intent(in), optional :: mask
4444
real(dp) :: res
@@ -55,14 +55,15 @@ contains
5555

5656
res = sum((real(x, dp) - mean)**2) / (n - 1._dp)
5757

58-
end function var_${rank}$_all_${k1}$_dp
58+
end function ${RName}$
5959
#:endfor
6060
#:endfor
6161

6262

63-
#:for k1, t1 in REAL_KINDS_TYPES
63+
#:for k1, t1 in RC_KINDS_TYPES
6464
#: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)
6667
${t1}$, intent(in) :: x${ranksuffix(rank)}$
6768
integer, intent(in) :: dim
6869
logical, intent(in), optional :: mask
@@ -73,7 +74,7 @@ contains
7374
${t1}$ :: mean${reduced_shape('x', rank, 'dim')}$
7475

7576
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)
7778
return
7879
end if
7980

@@ -92,14 +93,15 @@ contains
9293
end select
9394
res = res / (n - 1._${k1}$)
9495

95-
end function var_${rank}$_${k1}$_${k1}$
96+
end function ${RName}$
9697
#:endfor
9798
#:endfor
9899

99100

100101
#:for k1, t1 in INT_KINDS_TYPES
101102
#: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)
103105
${t1}$, intent(in) :: x${ranksuffix(rank)}$
104106
integer, intent(in) :: dim
105107
logical, intent(in), optional :: mask
@@ -129,14 +131,15 @@ contains
129131
end select
130132
res = res / (n - 1._dp)
131133

132-
end function var_${rank}$_${k1}$_dp
134+
end function ${RName}$
133135
#:endfor
134136
#:endfor
135137

136138

137-
#:for k1, t1 in REAL_KINDS_TYPES
139+
#:for k1, t1 in RC_KINDS_TYPES
138140
#: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)
140143
${t1}$, intent(in) :: x${ranksuffix(rank)}$
141144
logical, intent(in) :: mask${ranksuffix(rank)}$
142145
${t1}$ :: res
@@ -148,14 +151,15 @@ contains
148151

149152
res = sum((x - mean)**2, mask) / (n - 1._${k1}$)
150153

151-
end function var_${rank}$_mask_all_${k1}$_${k1}$
154+
end function ${RName}$
152155
#:endfor
153156
#:endfor
154157

155158

156159
#:for k1, t1 in INT_KINDS_TYPES
157160
#: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)
159163
${t1}$, intent(in) :: x${ranksuffix(rank)}$
160164
logical, intent(in) :: mask${ranksuffix(rank)}$
161165
real(dp) :: res
@@ -167,14 +171,15 @@ contains
167171

168172
res = sum((real(x, dp) - mean)**2, mask) / (n - 1._dp)
169173

170-
end function var_${rank}$_mask_all_${k1}$_dp
174+
end function ${RName}$
171175
#:endfor
172176
#:endfor
173177

174178

175-
#:for k1, t1 in REAL_KINDS_TYPES
179+
#:for k1, t1 in RC_KINDS_TYPES
176180
#: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)
178183
${t1}$, intent(in) :: x${ranksuffix(rank)}$
179184
integer, intent(in) :: dim
180185
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -192,22 +197,28 @@ contains
192197
mean = sum(x, dim, mask) / n
193198
do i = 1, size(x, dim)
194199
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)}$)
196206
end do
197207
#:endfor
198208
case default
199209
call error_stop("ERROR (mean): wrong dimension")
200210
end select
201211
res = res / (n - 1._${k1}$)
202212

203-
end function var_${rank}$_mask_${k1}$_${k1}$
213+
end function ${RName}$
204214
#:endfor
205215
#:endfor
206216

207217

208218
#:for k1, t1 in INT_KINDS_TYPES
209219
#: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)
211222
${t1}$, intent(in) :: x${ranksuffix(rank)}$
212223
integer, intent(in) :: dim
213224
logical, intent(in) :: mask${ranksuffix(rank)}$
@@ -233,7 +244,7 @@ contains
233244
end select
234245
res = res / (n - 1._dp)
235246

236-
end function var_${rank}$_mask_${k1}$_dp
247+
end function ${RName}$
237248
#:endfor
238249
#:endfor
239250

0 commit comments

Comments
 (0)