fortran_test_helper 1.0.0
A Fortran library to provide assistance to testing.
Loading...
Searching...
No Matches
fth_arrays.f90
1submodule(fortran_test_helper) fth_arrays
2contains
3! ******************************************************************************
4! REAL32 SUPPORT
5! ------------------------------------------------------------------------------
6 module subroutine create_r32_array(x, xmin, xmax)
7 ! Arguments
8 real(real32), intent(out) :: x(:)
9 real(real32), intent(in), optional :: xmin, xmax
10
11 ! Local Variables
12 real(real32), parameter :: one = 1.0
13 real(real32), parameter :: tol = 0.99
14 real(real32) :: low, high
15
16 ! Process
17 if (present(xmin)) then
18 low = xmin
19 else
20 low = -one
21 end if
22 if (present(xmax)) then
23 high = xmax
24 else
25 high = one
26 end if
27 call random_number(x)
28 x = tol * (low + (high + one - low) * x)
29 end subroutine
30
31! ------------------------------------------------------------------------------
32 module subroutine create_r32_matrix(x, xmin, xmax)
33 ! Arguments
34 real(real32), intent(out) :: x(:,:)
35 real(real32), intent(in), optional :: xmin, xmax
36
37 ! Local Variables
38 real(real32), parameter :: one = 1.0
39 real(real32), parameter :: tol = 0.99
40 real(real32) :: low, high
41
42 ! Process
43 if (present(xmin)) then
44 low = xmin
45 else
46 low = -one
47 end if
48 if (present(xmax)) then
49 high = xmax
50 else
51 high = one
52 end if
53 call random_number(x)
54 x = tol * (low + (high + one - low) * x)
55 end subroutine
56
57! ******************************************************************************
58! REAL64 SUPPORT
59! ------------------------------------------------------------------------------
60 module subroutine create_r64_array(x, xmin, xmax)
61 ! Arguments
62 real(real64), intent(out) :: x(:)
63 real(real64), intent(in), optional :: xmin, xmax
64
65 ! Local Variables
66 real(real64), parameter :: one = 1.0d0
67 real(real32), parameter :: tol = 0.99d0
68 real(real64) :: low, high
69
70 ! Process
71 if (present(xmin)) then
72 low = xmin
73 else
74 low = -one
75 end if
76 if (present(xmax)) then
77 high = xmax
78 else
79 high = one
80 end if
81 call random_number(x)
82 x = tol * (low + (high + one - low) * x)
83 end subroutine
84
85! ------------------------------------------------------------------------------
86 module subroutine create_r64_matrix(x, xmin, xmax)
87 ! Arguments
88 real(real64), intent(out) :: x(:,:)
89 real(real64), intent(in), optional :: xmin, xmax
90
91 ! Local Variables
92 real(real64), parameter :: one = 1.0d0
93 real(real32), parameter :: tol = 0.99d0
94 real(real64) :: low, high
95
96 ! Process
97 if (present(xmin)) then
98 low = xmin
99 else
100 low = -one
101 end if
102 if (present(xmax)) then
103 high = xmax
104 else
105 high = one
106 end if
107 call random_number(x)
108 x = tol * (low + (high + one - low) * x)
109 end subroutine
110
111! ******************************************************************************
112! COMPLEX32 SUPPORT
113! ------------------------------------------------------------------------------
114 module subroutine create_c32_array(x, xmin, xmax)
115 ! Arguments
116 complex(real32), intent(out) :: x(:)
117 complex(real32), intent(in), optional :: xmin, xmax
118
119 ! Local Variables
120 complex(real32), parameter :: one = (1.0, 0.0)
121 real(real32), parameter :: tol = 0.99
122 complex(real32) :: low, high
123 real(real32), allocatable, dimension(:) :: xr, xi
124 integer(int32) :: n
125
126 ! Process
127 n = size(x)
128 allocate(xr(n))
129 allocate(xi(n))
130 if (present(xmin)) then
131 low = xmin
132 else
133 low = -one
134 end if
135 if (present(xmax)) then
136 high = xmax
137 else
138 high = one
139 end if
140 call random_number(xr)
141 call random_number(xi)
142 x = tol * (low + (high + one - low) * cmplx(xr, xi, real32))
143 end subroutine
144
145! ------------------------------------------------------------------------------
146 module subroutine create_c32_matrix(x, xmin, xmax)
147 ! Arguments
148 complex(real32), intent(out) :: x(:,:)
149 complex(real32), intent(in), optional :: xmin, xmax
150
151 ! Local Variables
152 complex(real32), parameter :: one = (1.0, 0.0)
153 real(real32), parameter :: tol = 0.99
154 complex(real32) :: low, high
155 real(real32), allocatable, dimension(:,:) :: xr, xi
156 integer(int32) :: m, n
157
158 ! Process
159 m = size(x, 1)
160 n = size(x, 2)
161 allocate(xr(m, n))
162 allocate(xi(m, n))
163 if (present(xmin)) then
164 low = xmin
165 else
166 low = -one
167 end if
168 if (present(xmax)) then
169 high = xmax
170 else
171 high = one
172 end if
173 call random_number(xr)
174 call random_number(xi)
175 x = tol * (low + (high + one - low) * cmplx(xr, xi, real32))
176 end subroutine
177
178! ******************************************************************************
179! INT16 SUPPORT
180! ------------------------------------------------------------------------------
181 module subroutine create_i16_array(x, xmin, xmax)
182 ! Arguments
183 integer(int16), intent(out) :: x(:)
184 integer(int16), intent(in), optional :: xmin, xmax
185
186 ! Local Variables
187 integer(int16), parameter :: one = 1
188 integer(int16) :: low, high
189 real(real64), allocatable :: u(:)
190
191 ! Process
192 if (present(xmin)) then
193 low = xmin
194 else
195 low = -one
196 end if
197 if (present(xmax)) then
198 high = xmax
199 else
200 high = one
201 end if
202 allocate(u(size(x)))
203 call random_number(u)
204 x = low + floor((high + one - low) * u)
205 end subroutine
206
207! ------------------------------------------------------------------------------
208 module subroutine create_i16_matrix(x, xmin, xmax)
209 ! Arguments
210 integer(int16), intent(out) :: x(:,:)
211 integer(int16), intent(in), optional :: xmin, xmax
212
213 ! Local Variables
214 integer(int16), parameter :: one = 1
215 integer(int16) :: low, high
216 real(real64), allocatable :: u(:,:)
217
218 ! Process
219 if (present(xmin)) then
220 low = xmin
221 else
222 low = -one
223 end if
224 if (present(xmax)) then
225 high = xmax
226 else
227 high = one
228 end if
229 allocate(u(size(x, 1), size(x, 2)))
230 call random_number(u)
231 x = low + floor((high + one - low) * u)
232 end subroutine
233
234! ******************************************************************************
235! INT32 SUPPORT
236! ------------------------------------------------------------------------------
237 module subroutine create_i32_array(x, xmin, xmax)
238 ! Arguments
239 integer(int32), intent(out) :: x(:)
240 integer(int32), intent(in), optional :: xmin, xmax
241
242 ! Local Variables
243 integer(int32), parameter :: one = 1
244 integer(int32) :: low, high
245 real(real64), allocatable :: u(:)
246
247 ! Process
248 if (present(xmin)) then
249 low = xmin
250 else
251 low = -one
252 end if
253 if (present(xmax)) then
254 high = xmax
255 else
256 high = one
257 end if
258 allocate(u(size(x)))
259 call random_number(u)
260 x = low + floor((high + one - low) * u)
261 end subroutine
262
263! ------------------------------------------------------------------------------
264 module subroutine create_i32_matrix(x, xmin, xmax)
265 ! Arguments
266 integer(int32), intent(out) :: x(:,:)
267 integer(int32), intent(in), optional :: xmin, xmax
268
269 ! Local Variables
270 integer(int32), parameter :: one = 1
271 integer(int32) :: low, high
272 real(real64), allocatable :: u(:,:)
273
274 ! Process
275 if (present(xmin)) then
276 low = xmin
277 else
278 low = -one
279 end if
280 if (present(xmax)) then
281 high = xmax
282 else
283 high = one
284 end if
285 allocate(u(size(x, 1), size(x, 2)))
286 call random_number(u)
287 x = low + floor((high + one - low) * u)
288 end subroutine
289
290! ******************************************************************************
291! INT64 SUPPORT
292! ------------------------------------------------------------------------------
293 module subroutine create_i64_array(x, xmin, xmax)
294 ! Arguments
295 integer(int64), intent(out) :: x(:)
296 integer(int64), intent(in), optional :: xmin, xmax
297
298 ! Local Variables
299 integer(int64), parameter :: one = 1
300 integer(int64) :: low, high
301 real(real64), allocatable :: u(:)
302
303 ! Process
304 if (present(xmin)) then
305 low = xmin
306 else
307 low = -one
308 end if
309 if (present(xmax)) then
310 high = xmax
311 else
312 high = one
313 end if
314 allocate(u(size(x)))
315 call random_number(u)
316 x = low + floor((high + one - low) * u)
317 end subroutine
318
319! ------------------------------------------------------------------------------
320 module subroutine create_i64_matrix(x, xmin, xmax)
321 ! Arguments
322 integer(int64), intent(out) :: x(:,:)
323 integer(int64), intent(in), optional :: xmin, xmax
324
325 ! Local Variables
326 integer(int64), parameter :: one = 1
327 integer(int64) :: low, high
328 real(real64), allocatable :: u(:,:)
329
330 ! Process
331 if (present(xmin)) then
332 low = xmin
333 else
334 low = -one
335 end if
336 if (present(xmax)) then
337 high = xmax
338 else
339 high = one
340 end if
341 allocate(u(size(x, 1), size(x, 2)))
342 call random_number(u)
343 x = low + floor((high + one - low) * u)
344 end subroutine
345
346! ------------------------------------------------------------------------------
347end submodule
A collection of routines to assist in testing.