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