Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2022 The MESA Team
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module auto_diff_real_1var_order1_module
21 : use const_def, only: dp, ln10, pi
22 : use utils_lib
23 : use support_functions
24 : use math_lib
25 :
26 : implicit none
27 : private
28 : public :: auto_diff_real_1var_order1, &
29 : assignment(=), &
30 : operator(.eq.), &
31 : operator(.ne.), &
32 : operator(.gt.), &
33 : operator(.lt.), &
34 : operator(.le.), &
35 : operator(.ge.), &
36 : make_unop, &
37 : make_binop, &
38 : sign, &
39 : safe_sqrt, &
40 : operator(-), &
41 : exp, &
42 : expm1, &
43 : exp10, &
44 : powm1, &
45 : log, &
46 : log1p, &
47 : safe_log, &
48 : log10, &
49 : safe_log10, &
50 : log2, &
51 : sin, &
52 : cos, &
53 : tan, &
54 : sinpi, &
55 : cospi, &
56 : tanpi, &
57 : sinh, &
58 : cosh, &
59 : tanh, &
60 : asin, &
61 : acos, &
62 : atan, &
63 : asinpi, &
64 : acospi, &
65 : atanpi, &
66 : asinh, &
67 : acosh, &
68 : atanh, &
69 : sqrt, &
70 : pow2, &
71 : pow3, &
72 : pow4, &
73 : pow5, &
74 : pow6, &
75 : pow7, &
76 : pow8, &
77 : abs, &
78 : operator(+), &
79 : operator(*), &
80 : operator(/), &
81 : pow, &
82 : max, &
83 : min, &
84 : dim, &
85 : differentiate_1
86 : type :: auto_diff_real_1var_order1
87 : real(dp) :: val
88 : real(dp) :: d1val1
89 : end type auto_diff_real_1var_order1
90 :
91 : interface assignment(=)
92 : module procedure assign_from_self
93 : module procedure assign_from_real_dp
94 : module procedure assign_from_int
95 : end interface assignment(=)
96 :
97 : interface operator(.eq.)
98 : module procedure equal_self
99 : module procedure equal_auto_diff_real_1var_order1_real_dp
100 : module procedure equal_real_dp_auto_diff_real_1var_order1
101 : module procedure equal_auto_diff_real_1var_order1_int
102 : module procedure equal_int_auto_diff_real_1var_order1
103 : end interface operator(.eq.)
104 :
105 : interface operator(.ne.)
106 : module procedure neq_self
107 : module procedure neq_auto_diff_real_1var_order1_real_dp
108 : module procedure neq_real_dp_auto_diff_real_1var_order1
109 : module procedure neq_auto_diff_real_1var_order1_int
110 : module procedure neq_int_auto_diff_real_1var_order1
111 : end interface operator(.ne.)
112 :
113 : interface operator(.gt.)
114 : module procedure greater_self
115 : module procedure greater_auto_diff_real_1var_order1_real_dp
116 : module procedure greater_real_dp_auto_diff_real_1var_order1
117 : module procedure greater_auto_diff_real_1var_order1_int
118 : module procedure greater_int_auto_diff_real_1var_order1
119 : end interface operator(.gt.)
120 :
121 : interface operator(.lt.)
122 : module procedure less_self
123 : module procedure less_auto_diff_real_1var_order1_real_dp
124 : module procedure less_real_dp_auto_diff_real_1var_order1
125 : module procedure less_auto_diff_real_1var_order1_int
126 : module procedure less_int_auto_diff_real_1var_order1
127 : end interface operator(.lt.)
128 :
129 : interface operator(.le.)
130 : module procedure leq_self
131 : module procedure leq_auto_diff_real_1var_order1_real_dp
132 : module procedure leq_real_dp_auto_diff_real_1var_order1
133 : module procedure leq_auto_diff_real_1var_order1_int
134 : module procedure leq_int_auto_diff_real_1var_order1
135 : end interface operator(.le.)
136 :
137 : interface operator(.ge.)
138 : module procedure geq_self
139 : module procedure geq_auto_diff_real_1var_order1_real_dp
140 : module procedure geq_real_dp_auto_diff_real_1var_order1
141 : module procedure geq_auto_diff_real_1var_order1_int
142 : module procedure geq_int_auto_diff_real_1var_order1
143 : end interface operator(.ge.)
144 :
145 : interface make_unop
146 : module procedure make_unary_operator
147 : end interface make_unop
148 :
149 : interface make_binop
150 : module procedure make_binary_operator
151 : end interface make_binop
152 :
153 : interface sign
154 : module procedure sign_self
155 : end interface sign
156 :
157 : interface safe_sqrt
158 : module procedure safe_sqrt_self
159 : end interface safe_sqrt
160 :
161 : interface operator(-)
162 : module procedure unary_minus_self
163 : end interface operator(-)
164 :
165 : interface exp
166 : module procedure exp_self
167 : end interface exp
168 :
169 : interface expm1
170 : module procedure expm1_self
171 : end interface expm1
172 :
173 : interface exp10
174 : module procedure exp10_self
175 : end interface exp10
176 :
177 : interface powm1
178 : module procedure powm1_self
179 : end interface powm1
180 :
181 : interface log
182 : module procedure log_self
183 : end interface log
184 :
185 : interface log1p
186 : module procedure log1p_self
187 : end interface log1p
188 :
189 : interface safe_log
190 : module procedure safe_log_self
191 : end interface safe_log
192 :
193 : interface log10
194 : module procedure log10_self
195 : end interface log10
196 :
197 : interface safe_log10
198 : module procedure safe_log10_self
199 : end interface safe_log10
200 :
201 : interface log2
202 : module procedure log2_self
203 : end interface log2
204 :
205 : interface sin
206 : module procedure sin_self
207 : end interface sin
208 :
209 : interface cos
210 : module procedure cos_self
211 : end interface cos
212 :
213 : interface tan
214 : module procedure tan_self
215 : end interface tan
216 :
217 : interface sinpi
218 : module procedure sinpi_self
219 : end interface sinpi
220 :
221 : interface cospi
222 : module procedure cospi_self
223 : end interface cospi
224 :
225 : interface tanpi
226 : module procedure tanpi_self
227 : end interface tanpi
228 :
229 : interface sinh
230 : module procedure sinh_self
231 : end interface sinh
232 :
233 : interface cosh
234 : module procedure cosh_self
235 : end interface cosh
236 :
237 : interface tanh
238 : module procedure tanh_self
239 : end interface tanh
240 :
241 : interface asin
242 : module procedure asin_self
243 : end interface asin
244 :
245 : interface acos
246 : module procedure acos_self
247 : end interface acos
248 :
249 : interface atan
250 : module procedure atan_self
251 : end interface atan
252 :
253 : interface asinpi
254 : module procedure asinpi_self
255 : end interface asinpi
256 :
257 : interface acospi
258 : module procedure acospi_self
259 : end interface acospi
260 :
261 : interface atanpi
262 : module procedure atanpi_self
263 : end interface atanpi
264 :
265 : interface asinh
266 : module procedure asinh_self
267 : end interface asinh
268 :
269 : interface acosh
270 : module procedure acosh_self
271 : end interface acosh
272 :
273 : interface atanh
274 : module procedure atanh_self
275 : end interface atanh
276 :
277 : interface sqrt
278 : module procedure sqrt_self
279 : end interface sqrt
280 :
281 : interface pow2
282 : module procedure pow2_self
283 : end interface pow2
284 :
285 : interface pow3
286 : module procedure pow3_self
287 : end interface pow3
288 :
289 : interface pow4
290 : module procedure pow4_self
291 : end interface pow4
292 :
293 : interface pow5
294 : module procedure pow5_self
295 : end interface pow5
296 :
297 : interface pow6
298 : module procedure pow6_self
299 : end interface pow6
300 :
301 : interface pow7
302 : module procedure pow7_self
303 : end interface pow7
304 :
305 : interface pow8
306 : module procedure pow8_self
307 : end interface pow8
308 :
309 : interface abs
310 : module procedure abs_self
311 : end interface abs
312 :
313 : interface operator(+)
314 : module procedure add_self
315 : module procedure add_self_real
316 : module procedure add_real_self
317 : module procedure add_self_int
318 : module procedure add_int_self
319 : end interface operator(+)
320 :
321 : interface operator(-)
322 : module procedure sub_self
323 : module procedure sub_self_real
324 : module procedure sub_real_self
325 : module procedure sub_self_int
326 : module procedure sub_int_self
327 : end interface operator(-)
328 :
329 : interface operator(*)
330 : module procedure mul_self
331 : module procedure mul_self_real
332 : module procedure mul_real_self
333 : module procedure mul_self_int
334 : module procedure mul_int_self
335 : end interface operator(*)
336 :
337 : interface operator(/)
338 : module procedure div_self
339 : module procedure div_self_real
340 : module procedure div_real_self
341 : module procedure div_self_int
342 : module procedure div_int_self
343 : end interface operator(/)
344 :
345 : interface pow
346 : module procedure pow_self
347 : module procedure pow_self_real
348 : module procedure pow_real_self
349 : module procedure pow_self_int
350 : module procedure pow_int_self
351 : end interface pow
352 :
353 : interface max
354 : module procedure max_self
355 : module procedure max_self_real
356 : module procedure max_real_self
357 : module procedure max_self_int
358 : module procedure max_int_self
359 : end interface max
360 :
361 : interface min
362 : module procedure min_self
363 : module procedure min_self_real
364 : module procedure min_real_self
365 : module procedure min_self_int
366 : module procedure min_int_self
367 : end interface min
368 :
369 : interface dim
370 : module procedure dim_self
371 : module procedure dim_self_real
372 : module procedure dim_real_self
373 : module procedure dim_self_int
374 : module procedure dim_int_self
375 : end interface dim
376 :
377 : interface differentiate_1
378 : module procedure differentiate_auto_diff_real_1var_order1_1
379 : end interface differentiate_1
380 :
381 : contains
382 :
383 50 : subroutine assign_from_self(this, other)
384 : type(auto_diff_real_1var_order1), intent(out) :: this
385 : type(auto_diff_real_1var_order1), intent(in) :: other
386 50 : this%val = other%val
387 50 : this%d1val1 = other%d1val1
388 50 : end subroutine assign_from_self
389 :
390 59 : subroutine assign_from_real_dp(this, other)
391 : type(auto_diff_real_1var_order1), intent(out) :: this
392 : real(dp), intent(in) :: other
393 59 : this%val = other
394 59 : this%d1val1 = 0.0_dp
395 59 : end subroutine assign_from_real_dp
396 :
397 1 : subroutine assign_from_int(this, other)
398 : type(auto_diff_real_1var_order1), intent(out) :: this
399 : integer, intent(in) :: other
400 1 : this%val = other
401 1 : this%d1val1 = 0.0_dp
402 1 : end subroutine assign_from_int
403 :
404 1 : function equal_self(this, other) result(z)
405 : type(auto_diff_real_1var_order1), intent(in) :: this
406 : type(auto_diff_real_1var_order1), intent(in) :: other
407 : logical :: z
408 1 : z = (this%val == other%val)
409 1 : end function equal_self
410 :
411 1 : function equal_auto_diff_real_1var_order1_real_dp(this, other) result(z)
412 : type(auto_diff_real_1var_order1), intent(in) :: this
413 : real(dp), intent(in) :: other
414 : logical :: z
415 1 : z = (this%val == other)
416 1 : end function equal_auto_diff_real_1var_order1_real_dp
417 :
418 0 : function equal_real_dp_auto_diff_real_1var_order1(this, other) result(z)
419 : real(dp), intent(in) :: this
420 : type(auto_diff_real_1var_order1), intent(in) :: other
421 : logical :: z
422 0 : z = (this == other%val)
423 0 : end function equal_real_dp_auto_diff_real_1var_order1
424 :
425 1 : function equal_auto_diff_real_1var_order1_int(this, other) result(z)
426 : type(auto_diff_real_1var_order1), intent(in) :: this
427 : integer, intent(in) :: other
428 : logical :: z
429 1 : z = (this%val == other)
430 1 : end function equal_auto_diff_real_1var_order1_int
431 :
432 0 : function equal_int_auto_diff_real_1var_order1(this, other) result(z)
433 : integer, intent(in) :: this
434 : type(auto_diff_real_1var_order1), intent(in) :: other
435 : logical :: z
436 0 : z = (this == other%val)
437 0 : end function equal_int_auto_diff_real_1var_order1
438 :
439 0 : function neq_self(this, other) result(z)
440 : type(auto_diff_real_1var_order1), intent(in) :: this
441 : type(auto_diff_real_1var_order1), intent(in) :: other
442 : logical :: z
443 0 : z = (this%val /= other%val)
444 0 : end function neq_self
445 :
446 0 : function neq_auto_diff_real_1var_order1_real_dp(this, other) result(z)
447 : type(auto_diff_real_1var_order1), intent(in) :: this
448 : real(dp), intent(in) :: other
449 : logical :: z
450 0 : z = (this%val /= other)
451 0 : end function neq_auto_diff_real_1var_order1_real_dp
452 :
453 0 : function neq_real_dp_auto_diff_real_1var_order1(this, other) result(z)
454 : real(dp), intent(in) :: this
455 : type(auto_diff_real_1var_order1), intent(in) :: other
456 : logical :: z
457 0 : z = (this /= other%val)
458 0 : end function neq_real_dp_auto_diff_real_1var_order1
459 :
460 0 : function neq_auto_diff_real_1var_order1_int(this, other) result(z)
461 : type(auto_diff_real_1var_order1), intent(in) :: this
462 : integer, intent(in) :: other
463 : logical :: z
464 0 : z = (this%val /= other)
465 0 : end function neq_auto_diff_real_1var_order1_int
466 :
467 0 : function neq_int_auto_diff_real_1var_order1(this, other) result(z)
468 : integer, intent(in) :: this
469 : type(auto_diff_real_1var_order1), intent(in) :: other
470 : logical :: z
471 0 : z = (this /= other%val)
472 0 : end function neq_int_auto_diff_real_1var_order1
473 :
474 1 : function greater_self(this, other) result(z)
475 : type(auto_diff_real_1var_order1), intent(in) :: this
476 : type(auto_diff_real_1var_order1), intent(in) :: other
477 : logical :: z
478 1 : z = (this%val > other%val)
479 1 : end function greater_self
480 :
481 1 : function greater_auto_diff_real_1var_order1_real_dp(this, other) result(z)
482 : type(auto_diff_real_1var_order1), intent(in) :: this
483 : real(dp), intent(in) :: other
484 : logical :: z
485 1 : z = (this%val > other)
486 1 : end function greater_auto_diff_real_1var_order1_real_dp
487 :
488 0 : function greater_real_dp_auto_diff_real_1var_order1(this, other) result(z)
489 : real(dp), intent(in) :: this
490 : type(auto_diff_real_1var_order1), intent(in) :: other
491 : logical :: z
492 0 : z = (this > other%val)
493 0 : end function greater_real_dp_auto_diff_real_1var_order1
494 :
495 1 : function greater_auto_diff_real_1var_order1_int(this, other) result(z)
496 : type(auto_diff_real_1var_order1), intent(in) :: this
497 : integer, intent(in) :: other
498 : logical :: z
499 1 : z = (this%val > other)
500 1 : end function greater_auto_diff_real_1var_order1_int
501 :
502 0 : function greater_int_auto_diff_real_1var_order1(this, other) result(z)
503 : integer, intent(in) :: this
504 : type(auto_diff_real_1var_order1), intent(in) :: other
505 : logical :: z
506 0 : z = (this > other%val)
507 0 : end function greater_int_auto_diff_real_1var_order1
508 :
509 1 : function less_self(this, other) result(z)
510 : type(auto_diff_real_1var_order1), intent(in) :: this
511 : type(auto_diff_real_1var_order1), intent(in) :: other
512 : logical :: z
513 1 : z = (this%val < other%val)
514 1 : end function less_self
515 :
516 1 : function less_auto_diff_real_1var_order1_real_dp(this, other) result(z)
517 : type(auto_diff_real_1var_order1), intent(in) :: this
518 : real(dp), intent(in) :: other
519 : logical :: z
520 1 : z = (this%val < other)
521 1 : end function less_auto_diff_real_1var_order1_real_dp
522 :
523 0 : function less_real_dp_auto_diff_real_1var_order1(this, other) result(z)
524 : real(dp), intent(in) :: this
525 : type(auto_diff_real_1var_order1), intent(in) :: other
526 : logical :: z
527 0 : z = (this < other%val)
528 0 : end function less_real_dp_auto_diff_real_1var_order1
529 :
530 1 : function less_auto_diff_real_1var_order1_int(this, other) result(z)
531 : type(auto_diff_real_1var_order1), intent(in) :: this
532 : integer, intent(in) :: other
533 : logical :: z
534 1 : z = (this%val < other)
535 1 : end function less_auto_diff_real_1var_order1_int
536 :
537 0 : function less_int_auto_diff_real_1var_order1(this, other) result(z)
538 : integer, intent(in) :: this
539 : type(auto_diff_real_1var_order1), intent(in) :: other
540 : logical :: z
541 0 : z = (this < other%val)
542 0 : end function less_int_auto_diff_real_1var_order1
543 :
544 2 : function leq_self(this, other) result(z)
545 : type(auto_diff_real_1var_order1), intent(in) :: this
546 : type(auto_diff_real_1var_order1), intent(in) :: other
547 : logical :: z
548 2 : z = (this%val <= other%val)
549 2 : end function leq_self
550 :
551 2 : function leq_auto_diff_real_1var_order1_real_dp(this, other) result(z)
552 : type(auto_diff_real_1var_order1), intent(in) :: this
553 : real(dp), intent(in) :: other
554 : logical :: z
555 2 : z = (this%val <= other)
556 2 : end function leq_auto_diff_real_1var_order1_real_dp
557 :
558 0 : function leq_real_dp_auto_diff_real_1var_order1(this, other) result(z)
559 : real(dp), intent(in) :: this
560 : type(auto_diff_real_1var_order1), intent(in) :: other
561 : logical :: z
562 0 : z = (this <= other%val)
563 0 : end function leq_real_dp_auto_diff_real_1var_order1
564 :
565 2 : function leq_auto_diff_real_1var_order1_int(this, other) result(z)
566 : type(auto_diff_real_1var_order1), intent(in) :: this
567 : integer, intent(in) :: other
568 : logical :: z
569 2 : z = (this%val <= other)
570 2 : end function leq_auto_diff_real_1var_order1_int
571 :
572 0 : function leq_int_auto_diff_real_1var_order1(this, other) result(z)
573 : integer, intent(in) :: this
574 : type(auto_diff_real_1var_order1), intent(in) :: other
575 : logical :: z
576 0 : z = (this <= other%val)
577 0 : end function leq_int_auto_diff_real_1var_order1
578 :
579 2 : function geq_self(this, other) result(z)
580 : type(auto_diff_real_1var_order1), intent(in) :: this
581 : type(auto_diff_real_1var_order1), intent(in) :: other
582 : logical :: z
583 2 : z = (this%val >= other%val)
584 2 : end function geq_self
585 :
586 2 : function geq_auto_diff_real_1var_order1_real_dp(this, other) result(z)
587 : type(auto_diff_real_1var_order1), intent(in) :: this
588 : real(dp), intent(in) :: other
589 : logical :: z
590 2 : z = (this%val >= other)
591 2 : end function geq_auto_diff_real_1var_order1_real_dp
592 :
593 0 : function geq_real_dp_auto_diff_real_1var_order1(this, other) result(z)
594 : real(dp), intent(in) :: this
595 : type(auto_diff_real_1var_order1), intent(in) :: other
596 : logical :: z
597 0 : z = (this >= other%val)
598 0 : end function geq_real_dp_auto_diff_real_1var_order1
599 :
600 2 : function geq_auto_diff_real_1var_order1_int(this, other) result(z)
601 : type(auto_diff_real_1var_order1), intent(in) :: this
602 : integer, intent(in) :: other
603 : logical :: z
604 2 : z = (this%val >= other)
605 2 : end function geq_auto_diff_real_1var_order1_int
606 :
607 0 : function geq_int_auto_diff_real_1var_order1(this, other) result(z)
608 : integer, intent(in) :: this
609 : type(auto_diff_real_1var_order1), intent(in) :: other
610 : logical :: z
611 0 : z = (this >= other%val)
612 0 : end function geq_int_auto_diff_real_1var_order1
613 :
614 0 : function make_unary_operator(x, z_val, z_d1x) result(unary)
615 : type(auto_diff_real_1var_order1), intent(in) :: x
616 : real(dp), intent(in) :: z_val
617 : real(dp), intent(in) :: z_d1x
618 : type(auto_diff_real_1var_order1) :: unary
619 0 : unary%val = z_val
620 0 : unary%d1val1 = x%d1val1*z_d1x
621 0 : end function make_unary_operator
622 :
623 0 : function make_binary_operator(x, y, z_val, z_d1x, z_d1y) result(binary)
624 : type(auto_diff_real_1var_order1), intent(in) :: x
625 : type(auto_diff_real_1var_order1), intent(in) :: y
626 : real(dp), intent(in) :: z_val
627 : real(dp), intent(in) :: z_d1x
628 : real(dp), intent(in) :: z_d1y
629 : type(auto_diff_real_1var_order1) :: binary
630 0 : binary%val = z_val
631 0 : binary%d1val1 = x%d1val1*z_d1x + y%d1val1*z_d1y
632 0 : end function make_binary_operator
633 :
634 0 : function sign_self(x) result(unary)
635 : type(auto_diff_real_1var_order1), intent(in) :: x
636 : type(auto_diff_real_1var_order1) :: unary
637 0 : unary%val = sgn(x%val)
638 0 : unary%d1val1 = 0.0_dp
639 0 : end function sign_self
640 :
641 0 : function safe_sqrt_self(x) result(unary)
642 : type(auto_diff_real_1var_order1), intent(in) :: x
643 : type(auto_diff_real_1var_order1) :: unary
644 0 : real(dp) :: q0
645 0 : q0 = sqrt(x%val*Heaviside(x%val))
646 0 : unary%val = q0
647 0 : unary%d1val1 = 0.5_dp*q0*x%d1val1*powm1(x%val)
648 0 : end function safe_sqrt_self
649 :
650 2 : function unary_minus_self(x) result(unary)
651 : type(auto_diff_real_1var_order1), intent(in) :: x
652 : type(auto_diff_real_1var_order1) :: unary
653 2 : unary%val = -x%val
654 2 : unary%d1val1 = -x%d1val1
655 2 : end function unary_minus_self
656 :
657 2 : function exp_self(x) result(unary)
658 : type(auto_diff_real_1var_order1), intent(in) :: x
659 : type(auto_diff_real_1var_order1) :: unary
660 2 : real(dp) :: q0
661 2 : q0 = exp(x%val)
662 2 : unary%val = q0
663 2 : unary%d1val1 = q0*x%d1val1
664 2 : end function exp_self
665 :
666 0 : function expm1_self(x) result(unary)
667 : type(auto_diff_real_1var_order1), intent(in) :: x
668 : type(auto_diff_real_1var_order1) :: unary
669 0 : unary%val = expm1(x%val)
670 0 : unary%d1val1 = x%d1val1*exp(x%val)
671 0 : end function expm1_self
672 :
673 0 : function exp10_self(x) result(unary)
674 : type(auto_diff_real_1var_order1), intent(in) :: x
675 : type(auto_diff_real_1var_order1) :: unary
676 0 : real(dp) :: q0
677 0 : q0 = pow(10.0_dp, x%val)
678 0 : unary%val = q0
679 0 : unary%d1val1 = q0*x%d1val1*ln10
680 0 : end function exp10_self
681 :
682 0 : function powm1_self(x) result(unary)
683 : type(auto_diff_real_1var_order1), intent(in) :: x
684 : type(auto_diff_real_1var_order1) :: unary
685 0 : unary%val = powm1(x%val)
686 0 : unary%d1val1 = -x%d1val1*powm1(pow2(x%val))
687 0 : end function powm1_self
688 :
689 4 : function log_self(x) result(unary)
690 : type(auto_diff_real_1var_order1), intent(in) :: x
691 : type(auto_diff_real_1var_order1) :: unary
692 4 : unary%val = log(x%val)
693 4 : unary%d1val1 = x%d1val1*powm1(x%val)
694 4 : end function log_self
695 :
696 0 : function log1p_self(x) result(unary)
697 : type(auto_diff_real_1var_order1), intent(in) :: x
698 : type(auto_diff_real_1var_order1) :: unary
699 0 : unary%val = log1p(x%val)
700 0 : unary%d1val1 = x%d1val1*powm1(x%val + 1)
701 0 : end function log1p_self
702 :
703 0 : function safe_log_self(x) result(unary)
704 : type(auto_diff_real_1var_order1), intent(in) :: x
705 : type(auto_diff_real_1var_order1) :: unary
706 0 : unary%val = safe_log(x%val)
707 0 : unary%d1val1 = x%d1val1*powm1(x%val)
708 0 : end function safe_log_self
709 :
710 3 : function log10_self(x) result(unary)
711 : type(auto_diff_real_1var_order1), intent(in) :: x
712 : type(auto_diff_real_1var_order1) :: unary
713 3 : real(dp) :: q0
714 3 : q0 = powm1(ln10)
715 3 : unary%val = q0*log(x%val)
716 3 : unary%d1val1 = q0*x%d1val1*powm1(x%val)
717 3 : end function log10_self
718 :
719 1 : function safe_log10_self(x) result(unary)
720 : type(auto_diff_real_1var_order1), intent(in) :: x
721 : type(auto_diff_real_1var_order1) :: unary
722 1 : real(dp) :: q0
723 1 : q0 = powm1(ln10)
724 1 : unary%val = q0*safe_log(x%val)
725 1 : unary%d1val1 = q0*x%d1val1*powm1(x%val)
726 1 : end function safe_log10_self
727 :
728 0 : function log2_self(x) result(unary)
729 : type(auto_diff_real_1var_order1), intent(in) :: x
730 : type(auto_diff_real_1var_order1) :: unary
731 0 : real(dp) :: q0
732 0 : q0 = powm1(log(2.0_dp))
733 0 : unary%val = q0*log(x%val)
734 0 : unary%d1val1 = q0*x%d1val1*powm1(x%val)
735 0 : end function log2_self
736 :
737 1 : function sin_self(x) result(unary)
738 : type(auto_diff_real_1var_order1), intent(in) :: x
739 : type(auto_diff_real_1var_order1) :: unary
740 1 : unary%val = sin(x%val)
741 1 : unary%d1val1 = x%d1val1*cos(x%val)
742 1 : end function sin_self
743 :
744 1 : function cos_self(x) result(unary)
745 : type(auto_diff_real_1var_order1), intent(in) :: x
746 : type(auto_diff_real_1var_order1) :: unary
747 1 : unary%val = cos(x%val)
748 1 : unary%d1val1 = -x%d1val1*sin(x%val)
749 1 : end function cos_self
750 :
751 1 : function tan_self(x) result(unary)
752 : type(auto_diff_real_1var_order1), intent(in) :: x
753 : type(auto_diff_real_1var_order1) :: unary
754 : real(dp) :: q0
755 1 : q0 = tan(x%val)
756 1 : unary%val = q0
757 1 : unary%d1val1 = x%d1val1*(pow2(q0) + 1)
758 1 : end function tan_self
759 :
760 0 : function sinpi_self(x) result(unary)
761 : type(auto_diff_real_1var_order1), intent(in) :: x
762 : type(auto_diff_real_1var_order1) :: unary
763 : real(dp) :: q0
764 0 : q0 = pi*x%val
765 0 : unary%val = sin(q0)
766 0 : unary%d1val1 = pi*x%d1val1*cos(q0)
767 0 : end function sinpi_self
768 :
769 0 : function cospi_self(x) result(unary)
770 : type(auto_diff_real_1var_order1), intent(in) :: x
771 : type(auto_diff_real_1var_order1) :: unary
772 : real(dp) :: q0
773 0 : q0 = pi*x%val
774 0 : unary%val = cos(q0)
775 0 : unary%d1val1 = -pi*x%d1val1*sin(q0)
776 0 : end function cospi_self
777 :
778 0 : function tanpi_self(x) result(unary)
779 : type(auto_diff_real_1var_order1), intent(in) :: x
780 : type(auto_diff_real_1var_order1) :: unary
781 : real(dp) :: q0
782 0 : q0 = tan(pi*x%val)
783 0 : unary%val = q0
784 0 : unary%d1val1 = pi*x%d1val1*(pow2(q0) + 1)
785 0 : end function tanpi_self
786 :
787 1 : function sinh_self(x) result(unary)
788 : type(auto_diff_real_1var_order1), intent(in) :: x
789 : type(auto_diff_real_1var_order1) :: unary
790 1 : unary%val = sinh(x%val)
791 1 : unary%d1val1 = x%d1val1*cosh(x%val)
792 1 : end function sinh_self
793 :
794 1 : function cosh_self(x) result(unary)
795 : type(auto_diff_real_1var_order1), intent(in) :: x
796 : type(auto_diff_real_1var_order1) :: unary
797 1 : unary%val = cosh(x%val)
798 1 : unary%d1val1 = x%d1val1*sinh(x%val)
799 1 : end function cosh_self
800 :
801 1 : function tanh_self(x) result(unary)
802 : type(auto_diff_real_1var_order1), intent(in) :: x
803 : type(auto_diff_real_1var_order1) :: unary
804 : real(dp) :: q0
805 1 : q0 = tanh(x%val)
806 1 : unary%val = q0
807 1 : unary%d1val1 = -x%d1val1*(pow2(q0) - 1)
808 1 : end function tanh_self
809 :
810 1 : function asin_self(x) result(unary)
811 : type(auto_diff_real_1var_order1), intent(in) :: x
812 : type(auto_diff_real_1var_order1) :: unary
813 1 : unary%val = asin(x%val)
814 1 : unary%d1val1 = x%d1val1*powm1(sqrt(1 - pow2(x%val)))
815 1 : end function asin_self
816 :
817 1 : function acos_self(x) result(unary)
818 : type(auto_diff_real_1var_order1), intent(in) :: x
819 : type(auto_diff_real_1var_order1) :: unary
820 1 : unary%val = acos(x%val)
821 1 : unary%d1val1 = -x%d1val1*powm1(sqrt(1 - pow2(x%val)))
822 1 : end function acos_self
823 :
824 1 : function atan_self(x) result(unary)
825 : type(auto_diff_real_1var_order1), intent(in) :: x
826 : type(auto_diff_real_1var_order1) :: unary
827 1 : unary%val = atan(x%val)
828 1 : unary%d1val1 = x%d1val1*powm1(pow2(x%val) + 1)
829 1 : end function atan_self
830 :
831 0 : function asinpi_self(x) result(unary)
832 : type(auto_diff_real_1var_order1), intent(in) :: x
833 : type(auto_diff_real_1var_order1) :: unary
834 0 : real(dp) :: q0
835 0 : q0 = powm1(pi)
836 0 : unary%val = q0*asin(x%val)
837 0 : unary%d1val1 = q0*x%d1val1*powm1(sqrt(1 - pow2(x%val)))
838 0 : end function asinpi_self
839 :
840 0 : function acospi_self(x) result(unary)
841 : type(auto_diff_real_1var_order1), intent(in) :: x
842 : type(auto_diff_real_1var_order1) :: unary
843 0 : real(dp) :: q0
844 0 : q0 = powm1(pi)
845 0 : unary%val = q0*acos(x%val)
846 0 : unary%d1val1 = -q0*x%d1val1*powm1(sqrt(1 - pow2(x%val)))
847 0 : end function acospi_self
848 :
849 0 : function atanpi_self(x) result(unary)
850 : type(auto_diff_real_1var_order1), intent(in) :: x
851 : type(auto_diff_real_1var_order1) :: unary
852 0 : unary%val = powm1(pi)*atan(x%val)
853 0 : unary%d1val1 = x%d1val1*powm1(pi*pow2(x%val) + pi)
854 0 : end function atanpi_self
855 :
856 1 : function asinh_self(x) result(unary)
857 : type(auto_diff_real_1var_order1), intent(in) :: x
858 : type(auto_diff_real_1var_order1) :: unary
859 1 : unary%val = asinh(x%val)
860 1 : unary%d1val1 = x%d1val1*powm1(sqrt(pow2(x%val) + 1))
861 1 : end function asinh_self
862 :
863 1 : function acosh_self(x) result(unary)
864 : type(auto_diff_real_1var_order1), intent(in) :: x
865 : type(auto_diff_real_1var_order1) :: unary
866 1 : unary%val = acosh(x%val)
867 1 : unary%d1val1 = x%d1val1*powm1(sqrt(pow2(x%val) - 1))
868 1 : end function acosh_self
869 :
870 1 : function atanh_self(x) result(unary)
871 : type(auto_diff_real_1var_order1), intent(in) :: x
872 : type(auto_diff_real_1var_order1) :: unary
873 1 : unary%val = atanh(x%val)
874 1 : unary%d1val1 = -x%d1val1*powm1(pow2(x%val) - 1)
875 1 : end function atanh_self
876 :
877 0 : function sqrt_self(x) result(unary)
878 : type(auto_diff_real_1var_order1), intent(in) :: x
879 : type(auto_diff_real_1var_order1) :: unary
880 : real(dp) :: q0
881 0 : q0 = sqrt(x%val)
882 0 : unary%val = q0
883 0 : unary%d1val1 = 0.5_dp*x%d1val1*powm1(q0)
884 0 : end function sqrt_self
885 :
886 1 : function pow2_self(x) result(unary)
887 : type(auto_diff_real_1var_order1), intent(in) :: x
888 : type(auto_diff_real_1var_order1) :: unary
889 1 : unary%val = pow2(x%val)
890 1 : unary%d1val1 = 2.0_dp*x%d1val1*x%val
891 1 : end function pow2_self
892 :
893 1 : function pow3_self(x) result(unary)
894 : type(auto_diff_real_1var_order1), intent(in) :: x
895 : type(auto_diff_real_1var_order1) :: unary
896 1 : unary%val = pow3(x%val)
897 1 : unary%d1val1 = 3.0_dp*x%d1val1*pow2(x%val)
898 1 : end function pow3_self
899 :
900 1 : function pow4_self(x) result(unary)
901 : type(auto_diff_real_1var_order1), intent(in) :: x
902 : type(auto_diff_real_1var_order1) :: unary
903 1 : unary%val = pow4(x%val)
904 1 : unary%d1val1 = 4.0_dp*x%d1val1*pow3(x%val)
905 1 : end function pow4_self
906 :
907 1 : function pow5_self(x) result(unary)
908 : type(auto_diff_real_1var_order1), intent(in) :: x
909 : type(auto_diff_real_1var_order1) :: unary
910 1 : unary%val = pow5(x%val)
911 1 : unary%d1val1 = 5.0_dp*x%d1val1*pow4(x%val)
912 1 : end function pow5_self
913 :
914 1 : function pow6_self(x) result(unary)
915 : type(auto_diff_real_1var_order1), intent(in) :: x
916 : type(auto_diff_real_1var_order1) :: unary
917 1 : unary%val = pow6(x%val)
918 1 : unary%d1val1 = 6.0_dp*x%d1val1*pow5(x%val)
919 1 : end function pow6_self
920 :
921 1 : function pow7_self(x) result(unary)
922 : type(auto_diff_real_1var_order1), intent(in) :: x
923 : type(auto_diff_real_1var_order1) :: unary
924 1 : unary%val = pow7(x%val)
925 1 : unary%d1val1 = 7.0_dp*x%d1val1*pow6(x%val)
926 1 : end function pow7_self
927 :
928 0 : function pow8_self(x) result(unary)
929 : type(auto_diff_real_1var_order1), intent(in) :: x
930 : type(auto_diff_real_1var_order1) :: unary
931 0 : unary%val = pow8(x%val)
932 0 : unary%d1val1 = 8.0_dp*x%d1val1*pow7(x%val)
933 0 : end function pow8_self
934 :
935 2 : function abs_self(x) result(unary)
936 : type(auto_diff_real_1var_order1), intent(in) :: x
937 : type(auto_diff_real_1var_order1) :: unary
938 2 : unary%val = Abs(x%val)
939 2 : unary%d1val1 = x%d1val1*sgn(x%val)
940 2 : end function abs_self
941 :
942 1 : function add_self(x, y) result(binary)
943 : type(auto_diff_real_1var_order1), intent(in) :: x
944 : type(auto_diff_real_1var_order1), intent(in) :: y
945 : type(auto_diff_real_1var_order1) :: binary
946 1 : binary%val = x%val + y%val
947 1 : binary%d1val1 = x%d1val1 + y%d1val1
948 1 : end function add_self
949 :
950 1 : function add_self_real(x, y) result(unary)
951 : type(auto_diff_real_1var_order1), intent(in) :: x
952 : real(dp), intent(in) :: y
953 : type(auto_diff_real_1var_order1) :: unary
954 1 : unary%val = x%val + y
955 1 : unary%d1val1 = x%d1val1
956 1 : end function add_self_real
957 :
958 1 : function add_real_self(z, x) result(unary)
959 : real(dp), intent(in) :: z
960 : type(auto_diff_real_1var_order1), intent(in) :: x
961 : type(auto_diff_real_1var_order1) :: unary
962 1 : unary%val = x%val + z
963 1 : unary%d1val1 = x%d1val1
964 1 : end function add_real_self
965 :
966 0 : function add_self_int(x, y) result(unary)
967 : type(auto_diff_real_1var_order1), intent(in) :: x
968 : integer, intent(in) :: y
969 : type(auto_diff_real_1var_order1) :: unary
970 0 : real(dp) :: y_dp
971 0 : y_dp = y
972 0 : unary%val = x%val + y_dp
973 0 : unary%d1val1 = x%d1val1
974 0 : end function add_self_int
975 :
976 0 : function add_int_self(z, x) result(unary)
977 : integer, intent(in) :: z
978 : type(auto_diff_real_1var_order1), intent(in) :: x
979 : type(auto_diff_real_1var_order1) :: unary
980 0 : real(dp) :: y_dp
981 0 : y_dp = z
982 0 : unary%val = x%val + y_dp
983 0 : unary%d1val1 = x%d1val1
984 0 : end function add_int_self
985 :
986 0 : function sub_self(x, y) result(binary)
987 : type(auto_diff_real_1var_order1), intent(in) :: x
988 : type(auto_diff_real_1var_order1), intent(in) :: y
989 : type(auto_diff_real_1var_order1) :: binary
990 0 : binary%val = x%val - y%val
991 0 : binary%d1val1 = x%d1val1 - y%d1val1
992 0 : end function sub_self
993 :
994 0 : function sub_self_real(x, y) result(unary)
995 : type(auto_diff_real_1var_order1), intent(in) :: x
996 : real(dp), intent(in) :: y
997 : type(auto_diff_real_1var_order1) :: unary
998 0 : unary%val = x%val - y
999 0 : unary%d1val1 = x%d1val1
1000 0 : end function sub_self_real
1001 :
1002 0 : function sub_real_self(z, x) result(unary)
1003 : real(dp), intent(in) :: z
1004 : type(auto_diff_real_1var_order1), intent(in) :: x
1005 : type(auto_diff_real_1var_order1) :: unary
1006 0 : unary%val = -x%val + z
1007 0 : unary%d1val1 = -x%d1val1
1008 0 : end function sub_real_self
1009 :
1010 0 : function sub_self_int(x, y) result(unary)
1011 : type(auto_diff_real_1var_order1), intent(in) :: x
1012 : integer, intent(in) :: y
1013 : type(auto_diff_real_1var_order1) :: unary
1014 0 : real(dp) :: y_dp
1015 0 : y_dp = y
1016 0 : unary%val = x%val - y_dp
1017 0 : unary%d1val1 = x%d1val1
1018 0 : end function sub_self_int
1019 :
1020 0 : function sub_int_self(z, x) result(unary)
1021 : integer, intent(in) :: z
1022 : type(auto_diff_real_1var_order1), intent(in) :: x
1023 : type(auto_diff_real_1var_order1) :: unary
1024 0 : real(dp) :: y_dp
1025 0 : y_dp = z
1026 0 : unary%val = -x%val + y_dp
1027 0 : unary%d1val1 = -x%d1val1
1028 0 : end function sub_int_self
1029 :
1030 1 : function mul_self(x, y) result(binary)
1031 : type(auto_diff_real_1var_order1), intent(in) :: x
1032 : type(auto_diff_real_1var_order1), intent(in) :: y
1033 : type(auto_diff_real_1var_order1) :: binary
1034 1 : binary%val = x%val*y%val
1035 1 : binary%d1val1 = x%d1val1*y%val + x%val*y%d1val1
1036 1 : end function mul_self
1037 :
1038 1 : function mul_self_real(x, y) result(unary)
1039 : type(auto_diff_real_1var_order1), intent(in) :: x
1040 : real(dp), intent(in) :: y
1041 : type(auto_diff_real_1var_order1) :: unary
1042 1 : unary%val = x%val*y
1043 1 : unary%d1val1 = x%d1val1*y
1044 1 : end function mul_self_real
1045 :
1046 1 : function mul_real_self(z, x) result(unary)
1047 : real(dp), intent(in) :: z
1048 : type(auto_diff_real_1var_order1), intent(in) :: x
1049 : type(auto_diff_real_1var_order1) :: unary
1050 1 : unary%val = x%val*z
1051 1 : unary%d1val1 = x%d1val1*z
1052 1 : end function mul_real_self
1053 :
1054 0 : function mul_self_int(x, y) result(unary)
1055 : type(auto_diff_real_1var_order1), intent(in) :: x
1056 : integer, intent(in) :: y
1057 : type(auto_diff_real_1var_order1) :: unary
1058 0 : real(dp) :: y_dp
1059 0 : y_dp = y
1060 0 : unary%val = x%val*y_dp
1061 0 : unary%d1val1 = x%d1val1*y_dp
1062 0 : end function mul_self_int
1063 :
1064 0 : function mul_int_self(z, x) result(unary)
1065 : integer, intent(in) :: z
1066 : type(auto_diff_real_1var_order1), intent(in) :: x
1067 : type(auto_diff_real_1var_order1) :: unary
1068 0 : real(dp) :: y_dp
1069 0 : y_dp = z
1070 0 : unary%val = x%val*y_dp
1071 0 : unary%d1val1 = x%d1val1*y_dp
1072 0 : end function mul_int_self
1073 :
1074 0 : function div_self(x, y) result(binary)
1075 : type(auto_diff_real_1var_order1), intent(in) :: x
1076 : type(auto_diff_real_1var_order1), intent(in) :: y
1077 : type(auto_diff_real_1var_order1) :: binary
1078 0 : binary%val = x%val*powm1(y%val)
1079 0 : binary%d1val1 = (x%d1val1*y%val - x%val*y%d1val1)*powm1(pow2(y%val))
1080 0 : end function div_self
1081 :
1082 0 : function div_self_real(x, y) result(unary)
1083 : type(auto_diff_real_1var_order1), intent(in) :: x
1084 : real(dp), intent(in) :: y
1085 : type(auto_diff_real_1var_order1) :: unary
1086 0 : real(dp) :: q0
1087 0 : q0 = powm1(y)
1088 0 : unary%val = q0*x%val
1089 0 : unary%d1val1 = q0*x%d1val1
1090 0 : end function div_self_real
1091 :
1092 0 : function div_real_self(z, x) result(unary)
1093 : real(dp), intent(in) :: z
1094 : type(auto_diff_real_1var_order1), intent(in) :: x
1095 : type(auto_diff_real_1var_order1) :: unary
1096 0 : unary%val = z*powm1(x%val)
1097 0 : unary%d1val1 = -x%d1val1*z*powm1(pow2(x%val))
1098 0 : end function div_real_self
1099 :
1100 0 : function div_self_int(x, y) result(unary)
1101 : type(auto_diff_real_1var_order1), intent(in) :: x
1102 : integer, intent(in) :: y
1103 : type(auto_diff_real_1var_order1) :: unary
1104 : real(dp) :: y_dp
1105 0 : real(dp) :: q0
1106 0 : y_dp = y
1107 0 : q0 = powm1(y_dp)
1108 0 : unary%val = q0*x%val
1109 0 : unary%d1val1 = q0*x%d1val1
1110 0 : end function div_self_int
1111 :
1112 0 : function div_int_self(z, x) result(unary)
1113 : integer, intent(in) :: z
1114 : type(auto_diff_real_1var_order1), intent(in) :: x
1115 : type(auto_diff_real_1var_order1) :: unary
1116 0 : real(dp) :: y_dp
1117 0 : y_dp = z
1118 0 : unary%val = y_dp*powm1(x%val)
1119 0 : unary%d1val1 = -x%d1val1*y_dp*powm1(pow2(x%val))
1120 0 : end function div_int_self
1121 :
1122 0 : function pow_self(x, y) result(binary)
1123 : type(auto_diff_real_1var_order1), intent(in) :: x
1124 : type(auto_diff_real_1var_order1), intent(in) :: y
1125 : type(auto_diff_real_1var_order1) :: binary
1126 0 : binary%val = pow(x%val, y%val)
1127 0 : binary%d1val1 = (x%d1val1*y%val + x%val*y%d1val1*log(x%val))*pow(x%val, y%val - 1)
1128 0 : end function pow_self
1129 :
1130 2 : function pow_self_real(x, y) result(unary)
1131 : type(auto_diff_real_1var_order1), intent(in) :: x
1132 : real(dp), intent(in) :: y
1133 : type(auto_diff_real_1var_order1) :: unary
1134 2 : unary%val = pow(x%val, y)
1135 2 : unary%d1val1 = x%d1val1*y*pow(x%val, y - 1)
1136 2 : end function pow_self_real
1137 :
1138 2 : function pow_real_self(z, x) result(unary)
1139 : real(dp), intent(in) :: z
1140 : type(auto_diff_real_1var_order1), intent(in) :: x
1141 : type(auto_diff_real_1var_order1) :: unary
1142 2 : real(dp) :: q0
1143 2 : q0 = pow(z, x%val)
1144 2 : unary%val = q0
1145 2 : unary%d1val1 = q0*x%d1val1*log(z)
1146 2 : end function pow_real_self
1147 :
1148 0 : function pow_self_int(x, y) result(unary)
1149 : type(auto_diff_real_1var_order1), intent(in) :: x
1150 : integer, intent(in) :: y
1151 : type(auto_diff_real_1var_order1) :: unary
1152 : real(dp) :: y_dp
1153 0 : y_dp = y
1154 0 : unary%val = pow(x%val, y_dp)
1155 0 : unary%d1val1 = x%d1val1*y_dp*pow(x%val, y_dp - 1)
1156 0 : end function pow_self_int
1157 :
1158 0 : function pow_int_self(z, x) result(unary)
1159 : integer, intent(in) :: z
1160 : type(auto_diff_real_1var_order1), intent(in) :: x
1161 : type(auto_diff_real_1var_order1) :: unary
1162 : real(dp) :: y_dp
1163 0 : real(dp) :: q0
1164 0 : y_dp = z
1165 0 : q0 = pow(y_dp, x%val)
1166 0 : unary%val = q0
1167 0 : unary%d1val1 = q0*x%d1val1*log(y_dp)
1168 0 : end function pow_int_self
1169 :
1170 1 : function max_self(x, y) result(binary)
1171 : type(auto_diff_real_1var_order1), intent(in) :: x
1172 : type(auto_diff_real_1var_order1), intent(in) :: y
1173 : type(auto_diff_real_1var_order1) :: binary
1174 1 : binary%val = Max(x%val, y%val)
1175 1 : binary%d1val1 = x%d1val1*Heaviside(x%val - y%val) + y%d1val1*Heaviside(-x%val + y%val)
1176 1 : end function max_self
1177 :
1178 2 : function max_self_real(x, y) result(unary)
1179 : type(auto_diff_real_1var_order1), intent(in) :: x
1180 : real(dp), intent(in) :: y
1181 : type(auto_diff_real_1var_order1) :: unary
1182 2 : unary%val = Max(x%val, y)
1183 2 : unary%d1val1 = x%d1val1*Heaviside(x%val - y)
1184 2 : end function max_self_real
1185 :
1186 2 : function max_real_self(z, x) result(unary)
1187 : real(dp), intent(in) :: z
1188 : type(auto_diff_real_1var_order1), intent(in) :: x
1189 : type(auto_diff_real_1var_order1) :: unary
1190 2 : unary%val = Max(x%val, z)
1191 2 : unary%d1val1 = x%d1val1*Heaviside(x%val - z)
1192 2 : end function max_real_self
1193 :
1194 0 : function max_self_int(x, y) result(unary)
1195 : type(auto_diff_real_1var_order1), intent(in) :: x
1196 : integer, intent(in) :: y
1197 : type(auto_diff_real_1var_order1) :: unary
1198 0 : real(dp) :: y_dp
1199 0 : y_dp = y
1200 0 : unary%val = Max(x%val, y_dp)
1201 0 : unary%d1val1 = x%d1val1*Heaviside(x%val - y_dp)
1202 0 : end function max_self_int
1203 :
1204 0 : function max_int_self(z, x) result(unary)
1205 : integer, intent(in) :: z
1206 : type(auto_diff_real_1var_order1), intent(in) :: x
1207 : type(auto_diff_real_1var_order1) :: unary
1208 0 : real(dp) :: y_dp
1209 0 : y_dp = z
1210 0 : unary%val = Max(x%val, y_dp)
1211 0 : unary%d1val1 = x%d1val1*Heaviside(x%val - y_dp)
1212 0 : end function max_int_self
1213 :
1214 0 : function min_self(x, y) result(binary)
1215 : type(auto_diff_real_1var_order1), intent(in) :: x
1216 : type(auto_diff_real_1var_order1), intent(in) :: y
1217 : type(auto_diff_real_1var_order1) :: binary
1218 0 : binary%val = Min(x%val, y%val)
1219 0 : binary%d1val1 = x%d1val1*Heaviside(-x%val + y%val) + y%d1val1*Heaviside(x%val - y%val)
1220 0 : end function min_self
1221 :
1222 0 : function min_self_real(x, y) result(unary)
1223 : type(auto_diff_real_1var_order1), intent(in) :: x
1224 : real(dp), intent(in) :: y
1225 : type(auto_diff_real_1var_order1) :: unary
1226 0 : unary%val = Min(x%val, y)
1227 0 : unary%d1val1 = x%d1val1*Heaviside(-x%val + y)
1228 0 : end function min_self_real
1229 :
1230 0 : function min_real_self(z, x) result(unary)
1231 : real(dp), intent(in) :: z
1232 : type(auto_diff_real_1var_order1), intent(in) :: x
1233 : type(auto_diff_real_1var_order1) :: unary
1234 0 : unary%val = Min(x%val, z)
1235 0 : unary%d1val1 = x%d1val1*Heaviside(-x%val + z)
1236 0 : end function min_real_self
1237 :
1238 0 : function min_self_int(x, y) result(unary)
1239 : type(auto_diff_real_1var_order1), intent(in) :: x
1240 : integer, intent(in) :: y
1241 : type(auto_diff_real_1var_order1) :: unary
1242 0 : real(dp) :: y_dp
1243 0 : y_dp = y
1244 0 : unary%val = Min(x%val, y_dp)
1245 0 : unary%d1val1 = x%d1val1*Heaviside(-x%val + y_dp)
1246 0 : end function min_self_int
1247 :
1248 0 : function min_int_self(z, x) result(unary)
1249 : integer, intent(in) :: z
1250 : type(auto_diff_real_1var_order1), intent(in) :: x
1251 : type(auto_diff_real_1var_order1) :: unary
1252 0 : real(dp) :: y_dp
1253 0 : y_dp = z
1254 0 : unary%val = Min(x%val, y_dp)
1255 0 : unary%d1val1 = x%d1val1*Heaviside(-x%val + y_dp)
1256 0 : end function min_int_self
1257 :
1258 2 : function dim_self(x, y) result(binary)
1259 : type(auto_diff_real_1var_order1), intent(in) :: x
1260 : type(auto_diff_real_1var_order1), intent(in) :: y
1261 : type(auto_diff_real_1var_order1) :: binary
1262 : real(dp) :: q0
1263 2 : q0 = x%val - y%val
1264 2 : binary%val = -0.5_dp*y%val + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1265 2 : binary%d1val1 = -0.5_dp*y%d1val1 + 0.5_dp*x%d1val1 + 0.5_dp*(x%d1val1 - y%d1val1)*sgn(q0)
1266 2 : end function dim_self
1267 :
1268 1 : function dim_self_real(x, y) result(unary)
1269 : type(auto_diff_real_1var_order1), intent(in) :: x
1270 : real(dp), intent(in) :: y
1271 : type(auto_diff_real_1var_order1) :: unary
1272 : real(dp) :: q0
1273 1 : q0 = x%val - y
1274 1 : unary%val = -0.5_dp*y + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1275 1 : unary%d1val1 = 0.5_dp*x%d1val1*(sgn(q0) + 1)
1276 1 : end function dim_self_real
1277 :
1278 0 : function dim_real_self(z, x) result(unary)
1279 : real(dp), intent(in) :: z
1280 : type(auto_diff_real_1var_order1), intent(in) :: x
1281 : type(auto_diff_real_1var_order1) :: unary
1282 : real(dp) :: q0
1283 0 : q0 = x%val - z
1284 0 : unary%val = -0.5_dp*x%val + 0.5_dp*z + 0.5_dp*Abs(q0)
1285 0 : unary%d1val1 = 0.5_dp*x%d1val1*(sgn(q0) - 1)
1286 0 : end function dim_real_self
1287 :
1288 0 : function dim_self_int(x, y) result(unary)
1289 : type(auto_diff_real_1var_order1), intent(in) :: x
1290 : integer, intent(in) :: y
1291 : type(auto_diff_real_1var_order1) :: unary
1292 0 : real(dp) :: y_dp
1293 : real(dp) :: q0
1294 0 : y_dp = y
1295 0 : q0 = x%val - y_dp
1296 0 : unary%val = -0.5_dp*y_dp + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1297 0 : unary%d1val1 = 0.5_dp*x%d1val1*(sgn(q0) + 1)
1298 0 : end function dim_self_int
1299 :
1300 0 : function dim_int_self(z, x) result(unary)
1301 : integer, intent(in) :: z
1302 : type(auto_diff_real_1var_order1), intent(in) :: x
1303 : type(auto_diff_real_1var_order1) :: unary
1304 0 : real(dp) :: y_dp
1305 : real(dp) :: q0
1306 0 : y_dp = z
1307 0 : q0 = x%val - y_dp
1308 0 : unary%val = -0.5_dp*x%val + 0.5_dp*y_dp + 0.5_dp*Abs(q0)
1309 0 : unary%d1val1 = 0.5_dp*x%d1val1*(sgn(q0) - 1)
1310 0 : end function dim_int_self
1311 :
1312 0 : function differentiate_auto_diff_real_1var_order1_1(this) result(derivative)
1313 : type(auto_diff_real_1var_order1), intent(in) :: this
1314 : type(auto_diff_real_1var_order1) :: derivative
1315 0 : derivative%val = this%d1val1
1316 0 : derivative%d1val1 = 0.0_dp
1317 0 : end function differentiate_auto_diff_real_1var_order1_1
1318 :
1319 0 : end module auto_diff_real_1var_order1_module
|
