@@ -89,8 +89,10 @@ module stdlib_64_bit_hash_codes
89
89
end type spooky_subhash
90
90
91
91
interface fnv_1_hash
92
+ !! Version: experimental
93
+ !!
92
94
!! FNV_1 interfaces
93
-
95
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#fnv_1-calculates-a-hash-code-from-a-key))
94
96
#:for k1 in INT_KINDS
95
97
pure module function ${k1}$_fnv_1( key ) result(hash_code)
96
98
!! FNV_1 hash function for rank 1 arrays of kind ${k1}$
@@ -109,7 +111,10 @@ module stdlib_64_bit_hash_codes
109
111
110
112
111
113
interface fnv_1a_hash
114
+ !! Version: experimental
115
+ !!
112
116
!! FNV_1A interfaces
117
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#fnv_1a-calculates-a-hash-code-from-a-key))
113
118
#:for k1 in INT_KINDS
114
119
pure module function ${k1}$_fnv_1a( key ) result(hash_code)
115
120
!! FNV_1A hash function for rank 1 arrays of kind ${k1}$
@@ -127,8 +132,10 @@ module stdlib_64_bit_hash_codes
127
132
end interface fnv_1a_hash
128
133
129
134
interface spooky_hash
135
+ !! Version: experimental
136
+ !!
130
137
!! SPOOKY_HASH interfaces
131
-
138
+ !!([Specification](../page/specs/stdlib_hash_procedures.html#spooky_hash-maps-a-character-string-or-integer-vector-to-an-integer))
132
139
#:for k1 in INT_KINDS
133
140
module function ${k1}$_spooky_hash( key, seed ) &
134
141
result(hash_code)
@@ -152,6 +159,8 @@ module stdlib_64_bit_hash_codes
152
159
interface
153
160
154
161
module subroutine spookyHash_128( key, hash_inout )
162
+ !! Version: experimental
163
+ !!
155
164
integer(int8), intent(in), target :: key(0:)
156
165
integer(int_hash), intent(inout) :: hash_inout(2)
157
166
end subroutine spookyHash_128
@@ -160,6 +169,8 @@ module stdlib_64_bit_hash_codes
160
169
161
170
162
171
interface spooky_init
172
+ !! Version: experimental
173
+ !!
163
174
164
175
pure module subroutine spookysubhash_init( self, seed )
165
176
type(spooky_subhash), intent(out) :: self
@@ -172,6 +183,8 @@ module stdlib_64_bit_hash_codes
172
183
interface spooky_update
173
184
174
185
module subroutine spookyhash_update( spooky, key )
186
+ !! Version: experimental
187
+ !!
175
188
type(spooky_subhash), intent(inout) :: spooky
176
189
integer(int8), intent(in) :: key(0:)
177
190
end subroutine spookyhash_update
@@ -182,6 +195,8 @@ module stdlib_64_bit_hash_codes
182
195
interface spooky_final
183
196
184
197
module subroutine spookyhash_final(spooky, hash_code)
198
+ !! Version: experimental
199
+ !!
185
200
type(spooky_subhash), intent(inout) :: spooky
186
201
integer(int_hash), intent(inout) :: hash_code(2)
187
202
end subroutine spookyhash_final
@@ -191,15 +206,19 @@ module stdlib_64_bit_hash_codes
191
206
interface
192
207
193
208
module subroutine new_spooky_hash_seed( seed )
194
- ! Random SEED generator for
209
+ !! Version: experimental
210
+ !!
211
+ !! Random SEED generator for
195
212
integer(int64), intent(inout) :: seed(2)
196
213
end subroutine new_spooky_hash_seed
197
214
198
215
end interface
199
216
200
217
interface pengy_hash
218
+ !! Version: experimental
219
+ !!
201
220
!! PENGY_HASH interfaces
202
-
221
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#pengy_hash-maps-a-character-string-or-integer-vector-to-an-integer))
203
222
#:for k1 in INT_KINDS
204
223
pure module function ${k1}$_pengy_hash( key, seed ) result(hash_code)
205
224
!! PENGY_HASH hash function for rank 1 array keys of kind ${k1}$
@@ -222,7 +241,9 @@ interface
222
241
interface
223
242
224
243
module subroutine new_pengy_hash_seed( seed )
225
- ! Random SEED generator for MIR_HASH_STRICT
244
+ !! Version: experimental
245
+ !!
246
+ !! Random SEED generator for MIR_HASH_STRICT
226
247
integer(int32), intent(inout) :: seed
227
248
end subroutine new_pengy_hash_seed
228
249
@@ -231,8 +252,12 @@ interface
231
252
contains
232
253
233
254
elemental function fibonacci_hash( key, nbits ) result( sample )
255
+ !! Version: experimental
256
+ !!
234
257
!! Maps the 64 bit integer KEY to an unsigned integer value with only NBITS
235
258
!! bits where NBITS is less than 64
259
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#fibonacci_hash-maps-an-integer-to-a-smaller-number-of-bits_1))
260
+
236
261
integer(int64), intent(in) :: key
237
262
integer, intent(in) :: nbits
238
263
integer(int64) :: sample
@@ -242,8 +267,12 @@ contains
242
267
end function fibonacci_hash
243
268
244
269
elemental function universal_mult_hash( key, seed, nbits ) result( sample )
270
+ !! Version: experimental
271
+ !!
245
272
!! Uses the "random" odd 64 bit integer SEED to map the 64 bit integer KEY to
246
273
!! an unsigned integer value with only NBITS bits where NBITS is less than 64.
274
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#universal_mult_hash-maps-an-integer-to-a-smaller-number-of-bits_1))
275
+
247
276
integer(int64), intent(in) :: key
248
277
integer(int64), intent(in) :: seed
249
278
integer, intent(in) :: nbits
@@ -254,8 +283,12 @@ contains
254
283
end function universal_mult_hash
255
284
256
285
subroutine odd_random_integer( harvest )
286
+ !! Version: experimental
287
+ !!
257
288
!! Returns a 64 bit pseudo random integer, HARVEST, distributed uniformly over
258
289
!! the odd integers of the 64 bit kind.
290
+ !! ([Specification](../page/specs/stdlib_hash_procedures.html#odd_random_integer-returns-odd-integer))
291
+
259
292
integer(int64), intent(out) :: harvest
260
293
real(dp) :: sample(2)
261
294
integer(int32) :: part(2)
@@ -268,6 +301,8 @@ contains
268
301
end subroutine odd_random_integer
269
302
270
303
subroutine random_integer( harvest )
304
+ !! Version: experimental
305
+ !!
271
306
!! Returns a 64 bit pseudo random integer, HARVEST, distributed uniformly over
272
307
!! the values of the 64 bit kind.
273
308
integer(int64), intent(out) :: harvest
0 commit comments