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