Line data Source code
1 1 : program test_auto_diff
2 :
3 1 : use math_lib
4 : use auto_diff
5 : use const_def, only: dp, ln10, pi
6 :
7 : implicit none
8 :
9 1 : call do_test_auto_diff_1var_order1()
10 1 : call do_test_auto_diff_2var_order1()
11 1 : call do_test_auto_diff_star_order1()
12 :
13 : contains
14 :
15 9 : subroutine header(text)
16 : character(len=*), intent(in) :: text
17 :
18 9 : write (*, '(a)') ' ----------------------------------------------------------------'
19 9 : write (*, '(a)') ' '
20 9 : write (*, '(a)') ' '//text
21 9 : write (*, '(a)') ' '
22 9 : write (*, '(a)') ' ----------------------------------------------------------------'
23 :
24 10 : end subroutine header
25 :
26 90 : subroutine should_print0(affix, a, z)
27 : character(len=*), intent(in) :: affix ! to insert ' approximately'
28 : real(dp), intent(in) :: a, z
29 :
30 : write (*, '(2(a),1(1pd26.16),a,99(1pd26.16))') &
31 90 : ' Should print', affix, a, ' : ', z
32 90 : write (*, '(a)') ''
33 90 : end subroutine should_print0
34 :
35 51 : subroutine should_print1(affix, a, b, z)
36 : character(len=*), intent(in) :: affix ! to insert ' approximately'
37 : real(dp), intent(in) :: a, b
38 : type(auto_diff_real_1var_order1), intent(in) :: z
39 :
40 : write (*, '(2(a),2(1pd26.16),a,99(1pd26.16))') &
41 51 : ' Should print', affix, a, b, ' : ', z
42 51 : write (*, '(a)') ''
43 51 : end subroutine should_print1
44 :
45 65 : subroutine should_print2(affix, a, b, c, z)
46 : character(len=*), intent(in) :: affix ! to insert ' approximately'
47 : real(dp), intent(in) :: a, b, c
48 : type(auto_diff_real_2var_order1), intent(in) :: z
49 : write (*, '(2(a),3(1pd26.16),a,99(1pd26.16))') &
50 65 : ' Should print', affix, a, b, c, ' : ', z
51 65 : write (*, '(a)') ''
52 65 : end subroutine should_print2
53 :
54 1 : subroutine do_test_auto_diff_star_order1()
55 : type(auto_diff_real_star_order1) :: x, y, z
56 : integer :: i
57 :
58 1 : call header('Testing assignment')
59 1 : x = 3d0
60 1 : x%d1Array(4) = 1d0
61 16 : do i = 1, 15
62 16 : if (i /= 4) then
63 14 : call should_print0('', 0d0, x%d1Array(i))
64 : else
65 1 : call should_print0('', 1d0, x%d1Array(i))
66 : end if
67 : end do
68 :
69 1 : call header('Testing unary operators')
70 :
71 1 : write (*, *) 'Test y = x**2'
72 1 : x = 3d0
73 16 : do i = 1, 15
74 16 : x%d1Array(i) = 1d0*i
75 : end do
76 1 : y = pow2(x)
77 16 : do i = 1, 15
78 16 : call should_print0('', 6d0*i, y%d1Array(i))
79 : end do
80 :
81 1 : write (*, *) 'Test x = x**2'
82 1 : x = pow2(x)
83 16 : do i = 1, 15
84 16 : call should_print0('', 6d0*i, x%d1Array(i))
85 : end do
86 :
87 1 : call header('Testing binary operators')
88 :
89 1 : write (*, *) 'Test y = x + 1d0'
90 1 : x = 3d0
91 16 : do i = 1, 15
92 16 : x%d1Array(i) = 1d0*i
93 : end do
94 1 : y = x + 1d0
95 16 : do i = 1, 15
96 16 : call should_print0('', 1d0*i, y%d1Array(i))
97 : end do
98 :
99 1 : write (*, *) 'Test y = x + x'
100 1 : x = 3d0
101 16 : do i = 1, 15
102 16 : x%d1Array(i) = 1d0*i
103 : end do
104 1 : y = x + x
105 16 : do i = 1, 15
106 16 : call should_print0('', 2d0*i, y%d1Array(i))
107 : end do
108 :
109 1 : write (*, *) 'Test y = exp(x) * z'
110 1 : x = 3d0
111 1 : z = 2d0
112 16 : do i = 1, 15
113 15 : x%d1Array(i) = 1d0*i
114 16 : z%d1Array(i) = 1d0 - i
115 : end do
116 1 : y = exp(x)*z
117 16 : do i = 1, 15
118 16 : call should_print0('', exp(3d0)*(1d0*i)*2d0 + (1d0 - i)*exp(3d0), y%d1Array(i))
119 : end do
120 :
121 1 : end subroutine do_test_auto_diff_star_order1
122 :
123 1 : subroutine do_test_auto_diff_1var_order1()
124 : type(auto_diff_real_1var_order1) :: x, y, z
125 :
126 1 : call header('Testing assignment and comparison')
127 :
128 1 : write (*, *) 'Test real -> auto_diff_real_1var_order1 assignment'
129 1 : x = 3.1d0
130 1 : call should_print1('', 3.1d0, 0d0, x)
131 :
132 1 : write (*, *) 'Test auto_diff_real_1var_order1 == auto_diff_real_1var_order1'
133 1 : y = 3.1d0
134 1 : write (*, *) 'Should print T:', (x == y)
135 1 : write (*, *) ''
136 :
137 1 : write (*, *) 'Test auto_diff_real_1var_order1 > auto_diff_real_1var_order1'
138 1 : y = 2.9d0
139 1 : write (*, *) 'Should print T:', (x > y)
140 1 : write (*, *) ''
141 :
142 1 : write (*, *) 'Test auto_diff_real_1var_order1 < auto_diff_real_1var_order1'
143 1 : write (*, *) 'Should print F:', (x < y)
144 1 : write (*, *) ''
145 :
146 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= auto_diff_real_1var_order1'
147 1 : write (*, *) 'Should print T:', (x >= y)
148 1 : write (*, *) ''
149 :
150 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= auto_diff_real_1var_order1'
151 1 : write (*, *) 'Should print F:', (x <= y)
152 1 : write (*, *) ''
153 :
154 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= auto_diff_real_1var_order1'
155 1 : y = 3.1d0
156 1 : write (*, *) 'Should print T:', (x >= y)
157 1 : write (*, *) ''
158 :
159 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= auto_diff_real_1var_order1'
160 1 : write (*, *) 'Should print T:', (x <= y)
161 1 : write (*, *) ''
162 :
163 1 : write (*, *) 'Test auto_diff_real_1var_order1 == real(dp)'
164 1 : write (*, *) 'Should print T:', (x == 3.1d0)
165 1 : write (*, *) ''
166 :
167 1 : write (*, *) 'Test auto_diff_real_1var_order1 > real(dp)'
168 1 : write (*, *) 'Should print T:', (x > 2.9d0)
169 1 : write (*, *) ''
170 :
171 1 : write (*, *) 'Test auto_diff_real_1var_order1 < real(dp)'
172 1 : write (*, *) 'Should print F:', (x < 2.9d0)
173 1 : write (*, *) ''
174 :
175 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= real(dp)'
176 1 : write (*, *) 'Should print T:', (x >= 2.9d0)
177 1 : write (*, *) ''
178 :
179 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= real(dp)'
180 1 : write (*, *) 'Should print F:', (x <= 2.9d0)
181 1 : write (*, *) ''
182 :
183 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= real(dp)'
184 1 : write (*, *) 'Should print T:', (x >= 3.1d0)
185 1 : write (*, *) ''
186 :
187 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= real(dp)'
188 1 : write (*, *) 'Should print T:', (x <= 3.1d0)
189 1 : write (*, *) ''
190 :
191 1 : write (*, *) 'Test auto_diff_real_1var_order1 == integer'
192 1 : x = 3
193 1 : write (*, *) 'Should print T:', (x == 3)
194 1 : write (*, *) ''
195 :
196 1 : write (*, *) 'Test auto_diff_real_1var_order1 > integer'
197 1 : write (*, *) 'Should print T:', (x > 2)
198 1 : write (*, *) ''
199 :
200 1 : write (*, *) 'Test auto_diff_real_1var_order1 < integer'
201 1 : write (*, *) 'Should print F:', (x < 2)
202 1 : write (*, *) ''
203 :
204 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= integer'
205 1 : write (*, *) 'Should print T:', (x >= 3)
206 1 : write (*, *) ''
207 :
208 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= integer'
209 1 : write (*, *) 'Should print F:', (x <= 2)
210 1 : write (*, *) ''
211 :
212 1 : write (*, *) 'Test auto_diff_real_1var_order1 >= integer'
213 1 : write (*, *) 'Should print T:', (x >= 2)
214 1 : write (*, *) ''
215 :
216 1 : write (*, *) 'Test auto_diff_real_1var_order1 <= integer'
217 1 : write (*, *) 'Should print T:', (x <= 3)
218 1 : write (*, *) ''
219 :
220 1 : call header('Testing binary operators')
221 :
222 1 : write (*, *) 'Test auto_diff_real_1var_order1+auto_diff_real_1var_order1'
223 1 : x = 1d0
224 1 : x%d1val1 = 1d0
225 1 : y = 2d0
226 1 : y%d1val1 = 1d0
227 1 : z = x + y
228 1 : call should_print1('', 3d0, 2d0, z)
229 :
230 1 : write (*, *) 'Test auto_diff_real_1var_order1+real(dp)'
231 1 : x = 1d0
232 1 : x%d1val1 = 1d0
233 1 : z = x + 2d0
234 1 : call should_print1('', 3d0, 1d0, z)
235 :
236 1 : write (*, *) 'Test real(dp)+auto_diff_real_1var_order1'
237 1 : x = 1d0
238 1 : x%d1val1 = 1d0
239 1 : z = 2d0 + x
240 1 : call should_print1('', 3d0, 1d0, z)
241 :
242 1 : write (*, *) 'Test auto_diff_real_1var_order1*auto_diff_real_1var_order1'
243 1 : x = 3d0
244 1 : x%d1val1 = 1d0
245 1 : y = 2d0
246 1 : y%d1val1 = 1d0
247 1 : z = x*y
248 1 : call should_print1('', 6d0, 5d0, z)
249 :
250 1 : write (*, *) 'Test auto_diff_real_1var_order1*real(dp)'
251 1 : x = 3d0
252 1 : x%d1val1 = 1d0
253 1 : z = x*2d0
254 1 : call should_print1('', 6d0, 2d0, z)
255 :
256 1 : write (*, *) 'Test real(dp)*auto_diff_real_1var_order1'
257 1 : x = 3d0
258 1 : x%d1val1 = 1d0
259 1 : z = 2d0*x
260 1 : call should_print1('', 6d0, 2d0, z)
261 :
262 1 : write (*, *) 'Test max(auto_diff_real_1var_order1, auto_diff_real_1var_order1)'
263 1 : x = 1d0
264 1 : x%d1val1 = 1d0
265 1 : y = 2d0
266 1 : y%d1val1 = 2d0
267 1 : z = max(x, y)
268 1 : call should_print1('', 2d0, 2d0, z)
269 :
270 1 : write (*, *) 'Test max(auto_diff_real_1var_order1, real(dp))'
271 1 : x = 1d0
272 1 : x%d1val1 = 1d0
273 1 : z = max(x, 2d0)
274 1 : call should_print1('', 2d0, 0d0, z)
275 :
276 1 : write (*, *) 'Test max(auto_diff_real_1var_order1, real(dp))'
277 1 : x = 1d0
278 1 : x%d1val1 = 1d0
279 1 : z = max(x, 0d0)
280 1 : call should_print1('', 1d0, 1d0, z)
281 :
282 1 : write (*, *) 'Test max(real(dp), auto_diff_real_1var_order1)'
283 1 : x = 1d0
284 1 : x%d1val1 = 1d0
285 1 : z = max(2d0, x)
286 1 : call should_print1('', 2d0, 0d0, z)
287 :
288 1 : write (*, *) 'Test max(real(dp), auto_diff_real_1var_order1)'
289 1 : x = 1d0
290 1 : x%d1val1 = 1d0
291 1 : z = max(0d0, x)
292 1 : call should_print1('', 1d0, 1d0, z)
293 :
294 1 : write (*, *) 'Test dim(auto_diff_real_1var_order1, auto_diff_real_1var_order1)'
295 1 : x = 2d0
296 1 : x%d1val1 = 2d0
297 1 : y = 1d0
298 1 : y%d1val1 = 1d0
299 1 : z = dim(x, y)
300 1 : call should_print1('', 1d0, 1d0, z)
301 :
302 1 : write (*, *) 'Test dim(auto_diff_real_1var_order1, auto_diff_real_1var_order1)'
303 1 : x = 2d0
304 1 : x%d1val1 = 2d0
305 1 : y = 1d0
306 1 : y%d1val1 = 1d0
307 1 : z = dim(y, x)
308 1 : call should_print1('', 0d0, 0d0, z)
309 :
310 1 : write (*, *) 'Test dim(auto_diff_real_1var_order1, real(dp))'
311 1 : x = 2d0
312 1 : x%d1val1 = 2d0
313 1 : z = dim(x, 1d0)
314 1 : call should_print1('', 1d0, 2d0, z)
315 :
316 1 : call header('Testing unary operators')
317 :
318 1 : write (*, *) 'Testing exp(auto_diff_real_1var_order1)'
319 1 : x = 1d0
320 1 : x%d1val1 = 1d0
321 1 : x = exp(x)
322 1 : call should_print1('', exp(1d0), exp(1d0), x)
323 :
324 1 : write (*, *) 'Testing abs(auto_diff_real_1var_order1)'
325 1 : x = 1d0
326 1 : x%d1val1 = 1d0
327 1 : x = abs(x)
328 1 : call should_print1('', 1d0, 1d0, x)
329 :
330 1 : write (*, *) 'Testing abs(auto_diff_real_1var_order1)'
331 1 : x = -1d0
332 1 : x%d1val1 = 1d0
333 1 : x = abs(x)
334 1 : call should_print1('', 1d0, -1d0, x)
335 :
336 1 : write (*, *) 'Testing exp(auto_diff_real_1var_order1)'
337 1 : x = 2d0
338 1 : x%d1val1 = 1d0
339 1 : x = exp(x)
340 1 : call should_print1('', exp(2d0), exp(2d0), x)
341 :
342 1 : write (*, *) 'Testing sin(auto_diff_real_1var_order1)'
343 1 : x = pi
344 1 : x%d1val1 = 1d0
345 1 : x = sin(x)
346 1 : call should_print1('', sin(pi), cos(pi), x)
347 :
348 1 : write (*, *) 'Testing cos(auto_diff_real_1var_order1)'
349 1 : x = pi
350 1 : x%d1val1 = 1d0
351 1 : x = cos(x)
352 1 : call should_print1('', cos(pi), -sin(pi), x)
353 :
354 1 : write (*, *) 'Testing tan(auto_diff_real_1var_order1)'
355 1 : x = pi
356 1 : x%d1val1 = 1d0
357 1 : x = tan(x)
358 1 : call should_print1(' approximately', tan(pi), 1/pow2(cos(pi)), x)
359 :
360 1 : write (*, *) 'Testing sinh(auto_diff_real_1var_order1)'
361 1 : x = pi
362 1 : x%d1val1 = 1d0
363 1 : x = sinh(x)
364 1 : call should_print1('', sinh(pi), cosh(pi), x)
365 :
366 1 : write (*, *) 'Testing cosh(auto_diff_real_1var_order1)'
367 1 : x = pi
368 1 : x%d1val1 = 1d0
369 1 : x = cosh(x)
370 1 : call should_print1('', cosh(pi), sinh(pi), x)
371 :
372 1 : write (*, *) 'Testing tanh(auto_diff_real_1var_order1)'
373 1 : x = pi
374 1 : x%d1val1 = 1d0
375 1 : x = tanh(x)
376 1 : call should_print1(' approximately', tanh(pi), 1/pow2(cosh(pi)), x)
377 :
378 1 : write (*, *) 'Testing asin(auto_diff_real_1var_order1)'
379 1 : x = 0.5d0
380 1 : x%d1val1 = 1d0
381 1 : x = asin(x)
382 1 : call should_print1('', asin(0.5d0), 2d0/sqrt(3d0), x)
383 :
384 1 : write (*, *) 'Testing acos(auto_diff_real_1var_order1)'
385 1 : x = 0.5d0
386 1 : x%d1val1 = 1d0
387 1 : x = acos(x)
388 1 : call should_print1('', acos(0.5d0), -2d0/sqrt(3d0), x)
389 :
390 1 : write (*, *) 'Testing atan(auto_diff_real_1var_order1)'
391 1 : x = 0.5d0
392 1 : x%d1val1 = 1d0
393 1 : x = atan(x)
394 1 : call should_print1(' approximately', atan(0.5d0), 4d0/5d0, x)
395 :
396 1 : write (*, *) 'Testing asinh(auto_diff_real_1var_order1)'
397 1 : x = 2d0
398 1 : x%d1val1 = 1d0
399 1 : x = asinh(x)
400 1 : call should_print1(' approximately', asinh(2d0), 1d0/sqrt(5d0), x)
401 :
402 1 : write (*, *) 'Testing acosh(auto_diff_real_1var_order1)'
403 1 : x = 2d0
404 1 : x%d1val1 = 1d0
405 1 : x = acosh(x)
406 1 : call should_print1(' approximately', acosh(2d0), 1d0/sqrt(3d0), x)
407 :
408 1 : write (*, *) 'Testing atanh(auto_diff_real_1var_order1)'
409 1 : x = 0.5d0
410 1 : x%d1val1 = 1d0
411 1 : x = atanh(x)
412 1 : call should_print1(' approximately', atanh(0.5d0), 4d0/3d0, x)
413 :
414 1 : write (*, *) 'Testing unary_minus(auto_diff_real_1var_order1)'
415 1 : x = 1d0
416 1 : x%d1val1 = 1d0
417 1 : x = -x
418 1 : call should_print1('', -1d0, -1d0, x)
419 :
420 1 : write (*, *) 'Testing unary_minus(auto_diff_real_1var_order1)'
421 1 : x = -1d0
422 1 : x%d1val1 = 1d0
423 1 : x = -x
424 1 : call should_print1('', 1d0, -1d0, x)
425 :
426 1 : write (*, *) 'Testing log(auto_diff_real_1var_order1)'
427 1 : x = 1d0
428 1 : x%d1val1 = 1d0
429 1 : x = log(x)
430 1 : call should_print1('', 0d0, 1d0, x)
431 :
432 1 : write (*, *) 'Testing safe_log(auto_diff_real_1var_order1)'
433 1 : x = 1d0
434 1 : x%d1val1 = 1d0
435 1 : x = log(x)
436 1 : call should_print1('', 0d0, 1d0, x)
437 :
438 1 : write (*, *) 'Testing log10(auto_diff_real_1var_order1)'
439 1 : x = 1d1
440 1 : x%d1val1 = 1d0
441 1 : x = log10(x)
442 1 : call should_print1('', 1d0, 1d0/(10*ln10), x)
443 :
444 1 : write (*, *) 'Testing safe_log10(auto_diff_real_1var_order1)'
445 1 : x = 1d1
446 1 : x%d1val1 = 1d0
447 1 : x = safe_log10(x)
448 1 : call should_print1('', 1d0, 1d0/(10*ln10), x)
449 :
450 1 : write (*, *) 'Testing log(auto_diff_real_1var_order1)'
451 1 : x = exp(1d0)
452 1 : x%d1val1 = 1d0
453 1 : x = log(x)
454 1 : call should_print1('', 1d0, exp(-1d0), x)
455 :
456 1 : write (*, *) 'Testing safe_log(auto_diff_real_1var_order1)'
457 1 : x = exp(1d0)
458 1 : x%d1val1 = 1d0
459 1 : x = log(x)
460 1 : call should_print1(' approximately', 1d0, exp(-1d0), x)
461 :
462 1 : write (*, *) 'Testing log10(auto_diff_real_1var_order1)'
463 1 : x = 1d2
464 1 : x%d1val1 = 1d0
465 1 : x = log10(x)
466 1 : call should_print1(' approximately', 2d0, 1d0/(100*ln10), x)
467 :
468 1 : write (*, *) 'Testing safe_log10(auto_diff_real_1var_order1)'
469 1 : x = 1d2
470 1 : x%d1val1 = 1d0
471 1 : x = log10(x)
472 1 : call should_print1(' approximately', 2d0, 1d0/(100*ln10), x)
473 :
474 1 : write (*, *) 'Testing pow2(auto_diff_real_1var_order1)'
475 1 : x = 3d0
476 1 : x%d1val1 = 1d0
477 1 : x = pow2(x)
478 1 : call should_print1(' approximately', 9d0, 6d0, x)
479 :
480 1 : write (*, *) 'Testing pow3(auto_diff_real_1var_order1)'
481 1 : x = 2d0
482 1 : x%d1val1 = 1d0
483 1 : x = pow3(x)
484 1 : call should_print1('', 8d0, 3*4d0, x)
485 :
486 1 : write (*, *) 'Testing pow4(auto_diff_real_1var_order1)'
487 1 : x = 2d0
488 1 : x%d1val1 = 1d0
489 1 : x = pow4(x)
490 1 : call should_print1('', 16d0, 4*8d0, x)
491 :
492 1 : write (*, *) 'Testing pow5(auto_diff_real_1var_order1)'
493 1 : x = 3d0
494 1 : x%d1val1 = 1d0
495 1 : x = pow5(x)
496 1 : call should_print1('', 243d0, 405d0, x)
497 :
498 1 : write (*, *) 'Testing pow6(auto_diff_real_1var_order1)'
499 1 : x = 2d0
500 1 : x%d1val1 = 1d0
501 1 : x = pow6(x)
502 1 : call should_print1('', 64d0, 6*32d0, x)
503 :
504 1 : write (*, *) 'Testing pow7(auto_diff_real_1var_order1)'
505 1 : x = 2d0
506 1 : x%d1val1 = 1d0
507 1 : x = pow7(x)
508 1 : call should_print1('', 128d0, 7*64d0, x)
509 :
510 1 : write (*, *) 'Testing pow(auto_diff_real_1var_order1, real(dp))'
511 1 : x = 4d0
512 1 : x%d1val1 = 1d0
513 1 : x = pow(x, 0.5d0)
514 1 : call should_print1(' approximately', 2d0, 0.25d0, x)
515 :
516 1 : write (*, *) 'Testing pow(real(dp), auto_diff_real_1var_order1)'
517 1 : x = 2d0
518 1 : x%d1val1 = 1d0
519 1 : x = pow(exp(1d0), x)
520 1 : call should_print1(' approximately', exp(2d0), exp(2d0), x)
521 :
522 1 : write (*, *) 'Testing pow(auto_diff_real_1var_order1, integer)'
523 1 : x = 4d0
524 1 : x%d1val1 = 1d0
525 1 : x = pow(x, 2d0)
526 1 : call should_print1('', 16d0, 8d0, x)
527 :
528 1 : write (*, *) 'Testing pow(integer, auto_diff_real_1var_order1)'
529 1 : x = 2d0
530 1 : x%d1val1 = 1d0
531 1 : x = pow(2d0, x)
532 1 : call should_print1('', 4d0, 4d0*log(2d0), x)
533 :
534 1 : end subroutine do_test_auto_diff_1var_order1
535 :
536 1 : subroutine do_test_auto_diff_2var_order1()
537 : type(auto_diff_real_2var_order1) :: x, y, z
538 :
539 1 : call header('Testing assignment and comparison')
540 :
541 1 : write (*, *) 'Test real -> auto_diff_real_2var_order1 assignment'
542 1 : x = 3.1d0
543 1 : call should_print2('', 3.1d0, 0d0, 0d0, x)
544 :
545 1 : write (*, *) 'Test auto_diff_real_2var_order1 == auto_diff_real_2var_order1'
546 1 : y = 3.1d0
547 1 : write (*, *) 'Should print T:', (x == y)
548 1 : write (*, *) ''
549 :
550 1 : write (*, *) 'Test auto_diff_real_2var_order1 > auto_diff_real_2var_order1'
551 1 : y = 2.9d0
552 1 : write (*, *) 'Should print T:', (x > y)
553 1 : write (*, *) ''
554 :
555 1 : write (*, *) 'Test auto_diff_real_2var_order1 < auto_diff_real_2var_order1'
556 1 : write (*, *) 'Should print F:', (x < y)
557 1 : write (*, *) ''
558 :
559 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= auto_diff_real_2var_order1'
560 1 : write (*, *) 'Should print T:', (x >= y)
561 1 : write (*, *) ''
562 :
563 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= auto_diff_real_2var_order1'
564 1 : write (*, *) 'Should print F:', (x <= y)
565 1 : write (*, *) ''
566 :
567 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= auto_diff_real_2var_order1'
568 1 : y = 3.1d0
569 1 : write (*, *) 'Should print T:', (x >= y)
570 1 : write (*, *) ''
571 :
572 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= auto_diff_real_2var_order1'
573 1 : write (*, *) 'Should print T:', (x <= y)
574 1 : write (*, *) ''
575 :
576 1 : write (*, *) 'Test auto_diff_real_2var_order1 == real(dp)'
577 1 : write (*, *) 'Should print T:', (x == 3.1d0)
578 1 : write (*, *) ''
579 :
580 1 : write (*, *) 'Test auto_diff_real_2var_order1 > real(dp)'
581 1 : write (*, *) 'Should print T:', (x > 2.9d0)
582 1 : write (*, *) ''
583 :
584 1 : write (*, *) 'Test auto_diff_real_2var_order1 < real(dp)'
585 1 : write (*, *) 'Should print F:', (x < 2.9d0)
586 1 : write (*, *) ''
587 :
588 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= real(dp)'
589 1 : write (*, *) 'Should print T:', (x >= 2.9d0)
590 1 : write (*, *) ''
591 :
592 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= real(dp)'
593 1 : write (*, *) 'Should print F:', (x <= 2.9d0)
594 1 : write (*, *) ''
595 :
596 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= real(dp)'
597 1 : write (*, *) 'Should print T:', (x >= 3.1d0)
598 1 : write (*, *) ''
599 :
600 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= real(dp)'
601 1 : write (*, *) 'Should print T:', (x <= 3.1d0)
602 1 : write (*, *) ''
603 :
604 1 : write (*, *) 'Test auto_diff_real_2var_order1 == integer'
605 1 : x = 3
606 1 : write (*, *) 'Should print T:', (x == 3)
607 1 : write (*, *) ''
608 :
609 1 : write (*, *) 'Test auto_diff_real_2var_order1 > integer'
610 1 : write (*, *) 'Should print T:', (x > 2)
611 1 : write (*, *) ''
612 :
613 1 : write (*, *) 'Test auto_diff_real_2var_order1 < integer'
614 1 : write (*, *) 'Should print F:', (x < 2)
615 1 : write (*, *) ''
616 :
617 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= integer'
618 1 : write (*, *) 'Should print T:', (x >= 3)
619 1 : write (*, *) ''
620 :
621 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= integer'
622 1 : write (*, *) 'Should print F:', (x <= 2)
623 1 : write (*, *) ''
624 :
625 1 : write (*, *) 'Test auto_diff_real_2var_order1 >= integer'
626 1 : write (*, *) 'Should print T:', (x >= 2)
627 1 : write (*, *) ''
628 :
629 1 : write (*, *) 'Test auto_diff_real_2var_order1 <= integer'
630 1 : write (*, *) 'Should print T:', (x <= 3)
631 1 : write (*, *) ''
632 :
633 1 : call header('Testing binary operators')
634 :
635 1 : write (*, *) 'Test auto_diff_real_2var_order1+auto_diff_real_2var_order1'
636 1 : x = 1d0
637 1 : x%d1val1 = 1d0
638 1 : y = 2d0
639 1 : y%d1val1 = 1d0
640 1 : z = x + y
641 1 : call should_print2('', 3d0, 2d0, 0d0, z)
642 :
643 1 : write (*, *) 'Test auto_diff_real_2var_order1+real(dp)'
644 1 : x = 1d0
645 1 : x%d1val1 = 1d0
646 1 : z = x + 2d0
647 1 : call should_print2('', 3d0, 1d0, 0d0, z)
648 :
649 1 : write (*, *) 'Test real(dp)+auto_diff_real_2var_order1'
650 1 : x = 1d0
651 1 : x%d1val1 = 1d0
652 1 : z = 2d0 + x
653 1 : call should_print2('', 3d0, 1d0, 0d0, z)
654 :
655 1 : write (*, *) 'Test auto_diff_real_2var_order1+integer'
656 1 : x = 1d0
657 1 : x%d1val1 = 1d0
658 1 : z = x + 2
659 1 : call should_print2('', 3d0, 1d0, 0d0, z)
660 :
661 1 : write (*, *) 'Test integer+auto_diff_real_2var_order1'
662 1 : x = 1d0
663 1 : x%d1val1 = 1d0
664 1 : z = 2 + x
665 1 : call should_print2('', 3d0, 1d0, 0d0, z)
666 :
667 1 : write (*, *) 'Test auto_diff_real_2var_order1*auto_diff_real_2var_order1'
668 1 : x = 3d0
669 1 : x%d1val1 = 1d0
670 1 : y = 2d0
671 1 : y%d1val2 = 1d0
672 1 : z = x*y
673 1 : call should_print2('', 6d0, 2d0, 3d0, z)
674 :
675 1 : write (*, *) 'Test auto_diff_real_2var_order1*real(dp)'
676 1 : x = 3d0
677 1 : x%d1val1 = 1d0
678 1 : z = x*2d0
679 1 : call should_print2('', 6d0, 2d0, 0d0, z)
680 :
681 1 : write (*, *) 'Test auto_diff_real_2var_order1/auto_diff_real_2var_order1'
682 1 : x = 3d0
683 1 : x%d1val1 = 1d0
684 1 : y = 2d0
685 1 : y%d1val2 = 1d0
686 1 : z = x/y
687 1 : call should_print2('', 1.5d0, 0.5d0, -0.75d0, z)
688 :
689 1 : write (*, *) 'Test auto_diff_real_2var_order1/real(dp)'
690 1 : x = 3d0
691 1 : x%d1val1 = 1d0
692 1 : z = x/2d0
693 1 : call should_print2('', 1.5d0, 0.5d0, 0d0, z)
694 :
695 1 : write (*, *) 'Test auto_diff_real_2var_order1-auto_diff_real_2var_order1'
696 1 : x = 1d0
697 1 : x%d1val1 = 1d0
698 1 : y = 2d0
699 1 : y%d1val2 = 1d0
700 1 : z = x - y
701 1 : call should_print2('', -1d0, 1d0, -1d0, z)
702 :
703 1 : write (*, *) 'Test auto_diff_real_2var_order1-auto_diff_real_2var_order1'
704 1 : x = 1d0
705 1 : x%d1val1 = 1d0
706 1 : y = 5d0
707 1 : y%d1val2 = 2d0
708 1 : z = x - y
709 1 : call should_print2('', -4d0, 1d0, -2d0, z)
710 :
711 1 : write (*, *) 'Test auto_diff_real_2var_order1-real(dp)'
712 1 : x = 2d0
713 1 : x%d1val1 = 1d0
714 1 : z = x - 1d0
715 1 : call should_print2('', 1d0, 1d0, 0d0, z)
716 :
717 1 : write (*, *) 'Test real(dp)*auto_diff_real_2var_order1'
718 1 : x = 3d0
719 1 : x%d1val1 = 1d0
720 1 : z = 2d0*x
721 1 : call should_print2('', 6d0, 2d0, 0d0, z)
722 :
723 1 : write (*, *) 'Test max(auto_diff_real_2var_order1, auto_diff_real_2var_order1)'
724 1 : x = 1d0
725 1 : x%d1val1 = 1d0
726 1 : y = 2d0
727 1 : y%d1val2 = 2d0
728 1 : z = max(x, y)
729 1 : call should_print2('', 2d0, 0d0, 2d0, z)
730 :
731 1 : write (*, *) 'Test max(auto_diff_real_2var_order1, real(dp))'
732 1 : x = 1d0
733 1 : x%d1val1 = 1d0
734 1 : z = max(x, 2d0)
735 1 : call should_print2('', 2d0, 0d0, 0d0, z)
736 :
737 1 : write (*, *) 'Test max(auto_diff_real_2var_order1, real(dp))'
738 1 : x = 1d0
739 1 : x%d1val1 = 1d0
740 1 : z = max(x, 0d0)
741 1 : call should_print2('', 1d0, 1d0, 0d0, z)
742 :
743 1 : write (*, *) 'Test max(real(dp), auto_diff_real_2var_order1)'
744 1 : x = 1d0
745 1 : x%d1val1 = 1d0
746 1 : z = max(2d0, x)
747 1 : call should_print2('', 2d0, 0d0, 0d0, z)
748 :
749 1 : write (*, *) 'Test max(real(dp), auto_diff_real_2var_order1)'
750 1 : x = 1d0
751 1 : x%d1val1 = 1d0
752 1 : z = max(0d0, x)
753 1 : call should_print2('', 1d0, 1d0, 0d0, z)
754 :
755 1 : write (*, *) 'Test min(auto_diff_real_2var_order1, auto_diff_real_2var_order1)'
756 1 : x = 1d0
757 1 : x%d1val1 = 1d0
758 1 : y = 2d0
759 1 : y%d1val2 = 2d0
760 1 : z = min(x, y)
761 1 : call should_print2('', 1d0, 1d0, 0d0, z)
762 :
763 1 : write (*, *) 'Test min(auto_diff_real_2var_order1, real(dp))'
764 1 : x = 1d0
765 1 : x%d1val1 = 1d0
766 1 : z = min(x, 2d0)
767 1 : call should_print2('', 1d0, 1d0, 0d0, z)
768 :
769 1 : write (*, *) 'Test min(auto_diff_real_2var_order1, real(dp))'
770 1 : x = 1d0
771 1 : x%d1val1 = 1d0
772 1 : z = min(x, 0d0)
773 1 : call should_print2('', 0d0, 0d0, 0d0, z)
774 :
775 1 : write (*, *) 'Test min(real(dp), auto_diff_real_2var_order1)'
776 1 : x = 1d0
777 1 : x%d1val1 = 1d0
778 1 : z = min(2d0, x)
779 1 : call should_print2('', 1d0, 1d0, 0d0, z)
780 :
781 1 : write (*, *) 'Test min(real(dp), auto_diff_real_2var_order1)'
782 1 : x = 1d0
783 1 : x%d1val1 = 1d0
784 1 : z = min(0d0, x)
785 1 : call should_print2('', 0d0, 0d0, 0d0, z)
786 1 : write (*, *) 'Test dim(auto_diff_real_2var_order1, auto_diff_real_2var_order1)'
787 1 : x = 2d0
788 1 : x%d1val1 = 2d0
789 1 : y = 1d0
790 1 : y%d1val2 = 1d0
791 1 : z = dim(x, y)
792 1 : call should_print2('', 1d0, 2d0, -1d0, z)
793 :
794 1 : write (*, *) 'Test dim(auto_diff_real_2var_order1, auto_diff_real_2var_order1)'
795 1 : x = 2d0
796 1 : x%d1val1 = 2d0
797 1 : y = 1d0
798 1 : y%d1val2 = 1d0
799 1 : z = dim(y, x)
800 1 : call should_print2('', 0d0, 0d0, 0d0, z)
801 :
802 1 : write (*, *) 'Test dim(auto_diff_real_2var_order1, real(dp))'
803 1 : x = 2d0
804 1 : x%d1val1 = 2d0
805 1 : z = dim(x, 1d0)
806 1 : call should_print2('', 1d0, 2d0, 0d0, z)
807 :
808 1 : write (*, *) 'Testing pow(auto_diff_real_2var_order1, auto_diff_real_2var_order1)'
809 1 : x = 2d0
810 1 : x%d1val1 = 1d0
811 1 : y = 2d0
812 1 : y%d1val2 = 1d0
813 1 : z = pow(x, y)
814 1 : call should_print2(' approximately', 4d0, 2d0*2d0, 4*log(2d0), z)
815 :
816 1 : call header('Testing unary operators')
817 :
818 1 : write (*, *) 'Testing exp(auto_diff_real_2var_order1)'
819 1 : x = 1d0
820 1 : x%d1val1 = 1d0
821 1 : x = exp(x)
822 1 : call should_print2('', exp(1d0), exp(1d0), 0d0, x)
823 :
824 1 : write (*, *) 'Testing exp(auto_diff_real_2var_order1)'
825 1 : x = 1d0
826 1 : x%d1val2 = 1d0
827 1 : x = exp(x)
828 1 : call should_print2('', exp(1d0), 0d0, exp(1d0), x)
829 :
830 1 : write (*, *) 'Testing exp(auto_diff_real_2var_order1)'
831 1 : x = 2d0
832 1 : x%d1val1 = 1d0
833 1 : x = exp(x)
834 1 : call should_print2('', exp(2d0), exp(2d0), 0d0, x)
835 :
836 1 : write (*, *) 'Testing abs(auto_diff_real_2var_order1)'
837 1 : x = 1d0
838 1 : x%d1val1 = 1d0
839 1 : x = abs(x)
840 1 : call should_print2('', 1d0, 1d0, 0d0, x)
841 :
842 1 : write (*, *) 'Testing abs(auto_diff_real_2var_order1)'
843 1 : x = -1d0
844 1 : x%d1val1 = 1d0
845 1 : x = abs(x)
846 1 : call should_print2('', 1d0, -1d0, 0d0, x)
847 :
848 1 : write (*, *) 'Testing sin(auto_diff_real_2var_order1)'
849 1 : x = pi
850 1 : x%d1val1 = 1d0
851 1 : x = sin(x)
852 1 : call should_print2('', sin(pi), cos(pi), 0d0, x)
853 :
854 1 : write (*, *) 'Testing cos(auto_diff_real_2var_order1)'
855 1 : x = pi
856 1 : x%d1val1 = 1d0
857 1 : x = cos(x)
858 1 : call should_print2('', cos(pi), -sin(pi), 0d0, x)
859 :
860 1 : write (*, *) 'Testing tan(auto_diff_real_2var_order1)'
861 1 : x = pi
862 1 : x%d1val1 = 1d0
863 1 : x = tan(x)
864 1 : call should_print2(' approximately', tan(pi), 1/pow2(cos(pi)), 0d0, x)
865 :
866 1 : write (*, *) 'Testing sinh(auto_diff_real_2var_order1)'
867 1 : x = pi
868 1 : x%d1val1 = 1d0
869 1 : x = sinh(x)
870 1 : call should_print2('', sinh(pi), cosh(pi), 0d0, x)
871 :
872 1 : write (*, *) 'Testing cosh(auto_diff_real_2var_order1)'
873 1 : x = pi
874 1 : x%d1val1 = 1d0
875 1 : x = cosh(x)
876 1 : call should_print2('', cosh(pi), sinh(pi), 0d0, x)
877 :
878 1 : write (*, *) 'Testing tanh(auto_diff_real_2var_order1)'
879 1 : x = pi
880 1 : x%d1val1 = 1d0
881 1 : x = tanh(x)
882 1 : call should_print2(' approximately', tanh(pi), 1/pow2(cosh(pi)), 0d0, x)
883 :
884 1 : write (*, *) 'Testing asin(auto_diff_real_2var_order1)'
885 1 : x = 0.5d0
886 1 : x%d1val1 = 1d0
887 1 : x = asin(x)
888 1 : call should_print2('', asin(0.5d0), 2d0/sqrt(3d0), 0d0, x)
889 :
890 1 : write (*, *) 'Testing acos(auto_diff_real_2var_order1)'
891 1 : x = 0.5d0
892 1 : x%d1val1 = 1d0
893 1 : x = acos(x)
894 1 : call should_print2('', acos(0.5d0), -2d0/sqrt(3d0), 0d0, x)
895 :
896 1 : write (*, *) 'Testing atan(auto_diff_real_2var_order1)'
897 1 : x = 0.5d0
898 1 : x%d1val1 = 1d0
899 1 : x = atan(x)
900 1 : call should_print2(' approximately', atan(0.5d0), 4d0/5d0, 0d0, x)
901 :
902 1 : write (*, *) 'Testing asinh(auto_diff_real_2var_order1)'
903 1 : x = 2d0
904 1 : x%d1val1 = 1d0
905 1 : x = asinh(x)
906 1 : call should_print2(' approximately', asinh(2d0), 1d0/sqrt(5d0), 0d0, x)
907 :
908 1 : write (*, *) 'Testing acosh(auto_diff_real_2var_order1)'
909 1 : x = 2d0
910 1 : x%d1val1 = 1d0
911 1 : x = acosh(x)
912 1 : call should_print2(' approximately', acosh(2d0), 1d0/sqrt(3d0), 0d0, x)
913 :
914 1 : write (*, *) 'Testing atanh(auto_diff_real_2var_order1)'
915 1 : x = 0.5d0
916 1 : x%d1val1 = 1d0
917 1 : x = atanh(x)
918 1 : call should_print2(' approximately', atanh(0.5d0), 4d0/3d0, 0d0, x)
919 :
920 1 : write (*, *) 'Testing unary_minus(auto_diff_real_2var_order1)'
921 1 : x = 1d0
922 1 : x%d1val1 = 1d0
923 1 : x = -x
924 1 : call should_print2('', -1d0, -1d0, 0d0, x)
925 :
926 1 : write (*, *) 'Testing unary_minus(auto_diff_real_2var_order1)'
927 1 : x = -1d0
928 1 : x%d1val1 = 1d0
929 1 : x = -x
930 1 : call should_print2('', 1d0, -1d0, 0d0, x)
931 :
932 1 : write (*, *) 'Testing log(auto_diff_real_2var_order1)'
933 1 : x = 1d0
934 1 : x%d1val1 = 1d0
935 1 : x = log(x)
936 1 : call should_print2('', 0d0, 1d0, 0d0, x)
937 :
938 1 : write (*, *) 'Testing safe_log(auto_diff_real_2var_order1)'
939 1 : x = 1d0
940 1 : x%d1val1 = 1d0
941 1 : x = log(x)
942 1 : call should_print2('', 0d0, 1d0, 0d0, x)
943 :
944 1 : write (*, *) 'Testing log10(auto_diff_real_2var_order1)'
945 1 : x = 1d1
946 1 : x%d1val1 = 1d0
947 1 : x = log10(x)
948 1 : call should_print2('', 1d0, 1d0/(10*ln10), 0d0, x)
949 :
950 1 : write (*, *) 'Testing safe_log10(auto_diff_real_2var_order1)'
951 1 : x = 1d1
952 1 : x%d1val1 = 1d0
953 1 : x = safe_log10(x)
954 1 : call should_print2('', 1d0, 1d0/(10*ln10), 0d0, x)
955 :
956 1 : write (*, *) 'Testing log(auto_diff_real_2var_order1)'
957 1 : x = exp(1d0)
958 1 : x%d1val1 = 1d0
959 1 : x = log(x)
960 1 : call should_print2('', 1d0, exp(-1d0), 0d0, x)
961 :
962 1 : write (*, *) 'Testing safe_log(auto_diff_real_2var_order1)'
963 1 : x = exp(1d0)
964 1 : x%d1val1 = 1d0
965 1 : x = log(x)
966 1 : call should_print2(' approximately', 1d0, exp(-1d0), 0d0, x)
967 :
968 1 : write (*, *) 'Testing log10(auto_diff_real_2var_order1)'
969 1 : x = 1d2
970 1 : x%d1val1 = 1d0
971 1 : x = log10(x)
972 1 : call should_print2(' approximately', 2d0, 1d0/(100*ln10), 0d0, x)
973 :
974 1 : write (*, *) 'Testing safe_log10(auto_diff_real_2var_order1)'
975 1 : x = 1d2
976 1 : x%d1val1 = 1d0
977 1 : x = log10(x)
978 1 : call should_print2(' approximately', 2d0, 1d0/(100*ln10), 0d0, x)
979 :
980 1 : write (*, *) 'Testing pow2(auto_diff_real_2var_order1)'
981 1 : x = 3d0
982 1 : x%d1val1 = 1d0
983 1 : x = pow2(x)
984 1 : call should_print2(' approximately', 9d0, 6d0, 0d0, x)
985 :
986 1 : write (*, *) 'Testing pow3(auto_diff_real_2var_order1)'
987 1 : x = 2d0
988 1 : x%d1val1 = 1d0
989 1 : x = pow3(x)
990 1 : call should_print2('', 8d0, 3*4d0, 0d0, x)
991 :
992 1 : write (*, *) 'Testing pow4(auto_diff_real_2var_order1)'
993 1 : x = 2d0
994 1 : x%d1val1 = 1d0
995 1 : x = pow4(x)
996 1 : call should_print2('', 16d0, 4*8d0, 0d0, x)
997 :
998 1 : write (*, *) 'Testing pow5(auto_diff_real_2var_order1)'
999 1 : x = 3d0
1000 1 : x%d1val1 = 1d0
1001 1 : x = pow5(x)
1002 1 : call should_print2('', 243d0, 405d0, 0d0, x)
1003 :
1004 1 : write (*, *) 'Testing pow6(auto_diff_real_2var_order1)'
1005 1 : x = 2d0
1006 1 : x%d1val1 = 1d0
1007 1 : x = pow6(x)
1008 1 : call should_print2('', 64d0, 6*32d0, 0d0, x)
1009 :
1010 1 : write (*, *) 'Testing pow7(auto_diff_real_2var_order1)'
1011 1 : x = 2d0
1012 1 : x%d1val1 = 1d0
1013 1 : x = pow7(x)
1014 1 : call should_print2('', 128d0, 7*64d0, 0d0, x)
1015 :
1016 1 : write (*, *) 'Testing pow(auto_diff_real_2var_order1, real(dp))'
1017 1 : x = 4d0
1018 1 : x%d1val1 = 1d0
1019 1 : x = pow(x, 0.5d0)
1020 1 : call should_print2(' approximately', 2d0, 0.25d0, 0d0, x)
1021 :
1022 1 : write (*, *) 'Testing pow(real(dp), auto_diff_real_2var_order1)'
1023 1 : x = 2d0
1024 1 : x%d1val1 = 1d0
1025 1 : x = pow(exp(1d0), x)
1026 1 : call should_print2(' approximately', exp(2d0), exp(2d0), 0d0, x)
1027 :
1028 1 : write (*, *) 'Testing pow(auto_diff_real_2var_order1, integer)'
1029 1 : x = 4d0
1030 1 : x%d1val1 = 1d0
1031 1 : x = pow(x, 2d0)
1032 1 : call should_print2('', 16d0, 8d0, 0d0, x)
1033 :
1034 1 : write (*, *) 'Testing pow(integer, auto_diff_real_2var_order1)'
1035 1 : x = 2d0
1036 1 : x%d1val1 = 1d0
1037 1 : x = pow(2d0, x)
1038 1 : call should_print2('', 4d0, 4d0*log(2d0), 0d0, x)
1039 :
1040 1 : end subroutine do_test_auto_diff_2var_order1
1041 :
1042 : end program test_auto_diff
|
