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_4var_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_4var_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 : differentiate_2, &
87 : differentiate_3, &
88 : differentiate_4
89 : type :: auto_diff_real_4var_order1
90 : real(dp) :: val
91 : real(dp) :: d1val1
92 : real(dp) :: d1val2
93 : real(dp) :: d1val3
94 : real(dp) :: d1val4
95 : end type auto_diff_real_4var_order1
96 :
97 : interface assignment(=)
98 : module procedure assign_from_self
99 : module procedure assign_from_real_dp
100 : module procedure assign_from_int
101 : end interface assignment(=)
102 :
103 : interface operator(.eq.)
104 : module procedure equal_self
105 : module procedure equal_auto_diff_real_4var_order1_real_dp
106 : module procedure equal_real_dp_auto_diff_real_4var_order1
107 : module procedure equal_auto_diff_real_4var_order1_int
108 : module procedure equal_int_auto_diff_real_4var_order1
109 : end interface operator(.eq.)
110 :
111 : interface operator(.ne.)
112 : module procedure neq_self
113 : module procedure neq_auto_diff_real_4var_order1_real_dp
114 : module procedure neq_real_dp_auto_diff_real_4var_order1
115 : module procedure neq_auto_diff_real_4var_order1_int
116 : module procedure neq_int_auto_diff_real_4var_order1
117 : end interface operator(.ne.)
118 :
119 : interface operator(.gt.)
120 : module procedure greater_self
121 : module procedure greater_auto_diff_real_4var_order1_real_dp
122 : module procedure greater_real_dp_auto_diff_real_4var_order1
123 : module procedure greater_auto_diff_real_4var_order1_int
124 : module procedure greater_int_auto_diff_real_4var_order1
125 : end interface operator(.gt.)
126 :
127 : interface operator(.lt.)
128 : module procedure less_self
129 : module procedure less_auto_diff_real_4var_order1_real_dp
130 : module procedure less_real_dp_auto_diff_real_4var_order1
131 : module procedure less_auto_diff_real_4var_order1_int
132 : module procedure less_int_auto_diff_real_4var_order1
133 : end interface operator(.lt.)
134 :
135 : interface operator(.le.)
136 : module procedure leq_self
137 : module procedure leq_auto_diff_real_4var_order1_real_dp
138 : module procedure leq_real_dp_auto_diff_real_4var_order1
139 : module procedure leq_auto_diff_real_4var_order1_int
140 : module procedure leq_int_auto_diff_real_4var_order1
141 : end interface operator(.le.)
142 :
143 : interface operator(.ge.)
144 : module procedure geq_self
145 : module procedure geq_auto_diff_real_4var_order1_real_dp
146 : module procedure geq_real_dp_auto_diff_real_4var_order1
147 : module procedure geq_auto_diff_real_4var_order1_int
148 : module procedure geq_int_auto_diff_real_4var_order1
149 : end interface operator(.ge.)
150 :
151 : interface make_unop
152 : module procedure make_unary_operator
153 : end interface make_unop
154 :
155 : interface make_binop
156 : module procedure make_binary_operator
157 : end interface make_binop
158 :
159 : interface sign
160 : module procedure sign_self
161 : end interface sign
162 :
163 : interface safe_sqrt
164 : module procedure safe_sqrt_self
165 : end interface safe_sqrt
166 :
167 : interface operator(-)
168 : module procedure unary_minus_self
169 : end interface operator(-)
170 :
171 : interface exp
172 : module procedure exp_self
173 : end interface exp
174 :
175 : interface expm1
176 : module procedure expm1_self
177 : end interface expm1
178 :
179 : interface exp10
180 : module procedure exp10_self
181 : end interface exp10
182 :
183 : interface powm1
184 : module procedure powm1_self
185 : end interface powm1
186 :
187 : interface log
188 : module procedure log_self
189 : end interface log
190 :
191 : interface log1p
192 : module procedure log1p_self
193 : end interface log1p
194 :
195 : interface safe_log
196 : module procedure safe_log_self
197 : end interface safe_log
198 :
199 : interface log10
200 : module procedure log10_self
201 : end interface log10
202 :
203 : interface safe_log10
204 : module procedure safe_log10_self
205 : end interface safe_log10
206 :
207 : interface log2
208 : module procedure log2_self
209 : end interface log2
210 :
211 : interface sin
212 : module procedure sin_self
213 : end interface sin
214 :
215 : interface cos
216 : module procedure cos_self
217 : end interface cos
218 :
219 : interface tan
220 : module procedure tan_self
221 : end interface tan
222 :
223 : interface sinpi
224 : module procedure sinpi_self
225 : end interface sinpi
226 :
227 : interface cospi
228 : module procedure cospi_self
229 : end interface cospi
230 :
231 : interface tanpi
232 : module procedure tanpi_self
233 : end interface tanpi
234 :
235 : interface sinh
236 : module procedure sinh_self
237 : end interface sinh
238 :
239 : interface cosh
240 : module procedure cosh_self
241 : end interface cosh
242 :
243 : interface tanh
244 : module procedure tanh_self
245 : end interface tanh
246 :
247 : interface asin
248 : module procedure asin_self
249 : end interface asin
250 :
251 : interface acos
252 : module procedure acos_self
253 : end interface acos
254 :
255 : interface atan
256 : module procedure atan_self
257 : end interface atan
258 :
259 : interface asinpi
260 : module procedure asinpi_self
261 : end interface asinpi
262 :
263 : interface acospi
264 : module procedure acospi_self
265 : end interface acospi
266 :
267 : interface atanpi
268 : module procedure atanpi_self
269 : end interface atanpi
270 :
271 : interface asinh
272 : module procedure asinh_self
273 : end interface asinh
274 :
275 : interface acosh
276 : module procedure acosh_self
277 : end interface acosh
278 :
279 : interface atanh
280 : module procedure atanh_self
281 : end interface atanh
282 :
283 : interface sqrt
284 : module procedure sqrt_self
285 : end interface sqrt
286 :
287 : interface pow2
288 : module procedure pow2_self
289 : end interface pow2
290 :
291 : interface pow3
292 : module procedure pow3_self
293 : end interface pow3
294 :
295 : interface pow4
296 : module procedure pow4_self
297 : end interface pow4
298 :
299 : interface pow5
300 : module procedure pow5_self
301 : end interface pow5
302 :
303 : interface pow6
304 : module procedure pow6_self
305 : end interface pow6
306 :
307 : interface pow7
308 : module procedure pow7_self
309 : end interface pow7
310 :
311 : interface pow8
312 : module procedure pow8_self
313 : end interface pow8
314 :
315 : interface abs
316 : module procedure abs_self
317 : end interface abs
318 :
319 : interface operator(+)
320 : module procedure add_self
321 : module procedure add_self_real
322 : module procedure add_real_self
323 : module procedure add_self_int
324 : module procedure add_int_self
325 : end interface operator(+)
326 :
327 : interface operator(-)
328 : module procedure sub_self
329 : module procedure sub_self_real
330 : module procedure sub_real_self
331 : module procedure sub_self_int
332 : module procedure sub_int_self
333 : end interface operator(-)
334 :
335 : interface operator(*)
336 : module procedure mul_self
337 : module procedure mul_self_real
338 : module procedure mul_real_self
339 : module procedure mul_self_int
340 : module procedure mul_int_self
341 : end interface operator(*)
342 :
343 : interface operator(/)
344 : module procedure div_self
345 : module procedure div_self_real
346 : module procedure div_real_self
347 : module procedure div_self_int
348 : module procedure div_int_self
349 : end interface operator(/)
350 :
351 : interface pow
352 : module procedure pow_self
353 : module procedure pow_self_real
354 : module procedure pow_real_self
355 : module procedure pow_self_int
356 : module procedure pow_int_self
357 : end interface pow
358 :
359 : interface max
360 : module procedure max_self
361 : module procedure max_self_real
362 : module procedure max_real_self
363 : module procedure max_self_int
364 : module procedure max_int_self
365 : end interface max
366 :
367 : interface min
368 : module procedure min_self
369 : module procedure min_self_real
370 : module procedure min_real_self
371 : module procedure min_self_int
372 : module procedure min_int_self
373 : end interface min
374 :
375 : interface dim
376 : module procedure dim_self
377 : module procedure dim_self_real
378 : module procedure dim_real_self
379 : module procedure dim_self_int
380 : module procedure dim_int_self
381 : end interface dim
382 :
383 : interface differentiate_1
384 : module procedure differentiate_auto_diff_real_4var_order1_1
385 : end interface differentiate_1
386 :
387 : interface differentiate_2
388 : module procedure differentiate_auto_diff_real_4var_order1_2
389 : end interface differentiate_2
390 :
391 : interface differentiate_3
392 : module procedure differentiate_auto_diff_real_4var_order1_3
393 : end interface differentiate_3
394 :
395 : interface differentiate_4
396 : module procedure differentiate_auto_diff_real_4var_order1_4
397 : end interface differentiate_4
398 :
399 : contains
400 :
401 0 : subroutine assign_from_self(this, other)
402 : type(auto_diff_real_4var_order1), intent(out) :: this
403 : type(auto_diff_real_4var_order1), intent(in) :: other
404 0 : this%val = other%val
405 0 : this%d1val1 = other%d1val1
406 0 : this%d1val2 = other%d1val2
407 0 : this%d1val3 = other%d1val3
408 0 : this%d1val4 = other%d1val4
409 0 : end subroutine assign_from_self
410 :
411 0 : subroutine assign_from_real_dp(this, other)
412 : type(auto_diff_real_4var_order1), intent(out) :: this
413 : real(dp), intent(in) :: other
414 0 : this%val = other
415 0 : this%d1val1 = 0.0_dp
416 0 : this%d1val2 = 0.0_dp
417 0 : this%d1val3 = 0.0_dp
418 0 : this%d1val4 = 0.0_dp
419 0 : end subroutine assign_from_real_dp
420 :
421 0 : subroutine assign_from_int(this, other)
422 : type(auto_diff_real_4var_order1), intent(out) :: this
423 : integer, intent(in) :: other
424 0 : this%val = other
425 0 : this%d1val1 = 0.0_dp
426 0 : this%d1val2 = 0.0_dp
427 0 : this%d1val3 = 0.0_dp
428 0 : this%d1val4 = 0.0_dp
429 0 : end subroutine assign_from_int
430 :
431 0 : function equal_self(this, other) result(z)
432 : type(auto_diff_real_4var_order1), intent(in) :: this
433 : type(auto_diff_real_4var_order1), intent(in) :: other
434 : logical :: z
435 0 : z = (this%val == other%val)
436 0 : end function equal_self
437 :
438 0 : function equal_auto_diff_real_4var_order1_real_dp(this, other) result(z)
439 : type(auto_diff_real_4var_order1), intent(in) :: this
440 : real(dp), intent(in) :: other
441 : logical :: z
442 0 : z = (this%val == other)
443 0 : end function equal_auto_diff_real_4var_order1_real_dp
444 :
445 0 : function equal_real_dp_auto_diff_real_4var_order1(this, other) result(z)
446 : real(dp), intent(in) :: this
447 : type(auto_diff_real_4var_order1), intent(in) :: other
448 : logical :: z
449 0 : z = (this == other%val)
450 0 : end function equal_real_dp_auto_diff_real_4var_order1
451 :
452 0 : function equal_auto_diff_real_4var_order1_int(this, other) result(z)
453 : type(auto_diff_real_4var_order1), intent(in) :: this
454 : integer, intent(in) :: other
455 : logical :: z
456 0 : z = (this%val == other)
457 0 : end function equal_auto_diff_real_4var_order1_int
458 :
459 0 : function equal_int_auto_diff_real_4var_order1(this, other) result(z)
460 : integer, intent(in) :: this
461 : type(auto_diff_real_4var_order1), intent(in) :: other
462 : logical :: z
463 0 : z = (this == other%val)
464 0 : end function equal_int_auto_diff_real_4var_order1
465 :
466 0 : function neq_self(this, other) result(z)
467 : type(auto_diff_real_4var_order1), intent(in) :: this
468 : type(auto_diff_real_4var_order1), intent(in) :: other
469 : logical :: z
470 0 : z = (this%val /= other%val)
471 0 : end function neq_self
472 :
473 0 : function neq_auto_diff_real_4var_order1_real_dp(this, other) result(z)
474 : type(auto_diff_real_4var_order1), intent(in) :: this
475 : real(dp), intent(in) :: other
476 : logical :: z
477 0 : z = (this%val /= other)
478 0 : end function neq_auto_diff_real_4var_order1_real_dp
479 :
480 0 : function neq_real_dp_auto_diff_real_4var_order1(this, other) result(z)
481 : real(dp), intent(in) :: this
482 : type(auto_diff_real_4var_order1), intent(in) :: other
483 : logical :: z
484 0 : z = (this /= other%val)
485 0 : end function neq_real_dp_auto_diff_real_4var_order1
486 :
487 0 : function neq_auto_diff_real_4var_order1_int(this, other) result(z)
488 : type(auto_diff_real_4var_order1), intent(in) :: this
489 : integer, intent(in) :: other
490 : logical :: z
491 0 : z = (this%val /= other)
492 0 : end function neq_auto_diff_real_4var_order1_int
493 :
494 0 : function neq_int_auto_diff_real_4var_order1(this, other) result(z)
495 : integer, intent(in) :: this
496 : type(auto_diff_real_4var_order1), intent(in) :: other
497 : logical :: z
498 0 : z = (this /= other%val)
499 0 : end function neq_int_auto_diff_real_4var_order1
500 :
501 0 : function greater_self(this, other) result(z)
502 : type(auto_diff_real_4var_order1), intent(in) :: this
503 : type(auto_diff_real_4var_order1), intent(in) :: other
504 : logical :: z
505 0 : z = (this%val > other%val)
506 0 : end function greater_self
507 :
508 0 : function greater_auto_diff_real_4var_order1_real_dp(this, other) result(z)
509 : type(auto_diff_real_4var_order1), intent(in) :: this
510 : real(dp), intent(in) :: other
511 : logical :: z
512 0 : z = (this%val > other)
513 0 : end function greater_auto_diff_real_4var_order1_real_dp
514 :
515 0 : function greater_real_dp_auto_diff_real_4var_order1(this, other) result(z)
516 : real(dp), intent(in) :: this
517 : type(auto_diff_real_4var_order1), intent(in) :: other
518 : logical :: z
519 0 : z = (this > other%val)
520 0 : end function greater_real_dp_auto_diff_real_4var_order1
521 :
522 0 : function greater_auto_diff_real_4var_order1_int(this, other) result(z)
523 : type(auto_diff_real_4var_order1), intent(in) :: this
524 : integer, intent(in) :: other
525 : logical :: z
526 0 : z = (this%val > other)
527 0 : end function greater_auto_diff_real_4var_order1_int
528 :
529 0 : function greater_int_auto_diff_real_4var_order1(this, other) result(z)
530 : integer, intent(in) :: this
531 : type(auto_diff_real_4var_order1), intent(in) :: other
532 : logical :: z
533 0 : z = (this > other%val)
534 0 : end function greater_int_auto_diff_real_4var_order1
535 :
536 0 : function less_self(this, other) result(z)
537 : type(auto_diff_real_4var_order1), intent(in) :: this
538 : type(auto_diff_real_4var_order1), intent(in) :: other
539 : logical :: z
540 0 : z = (this%val < other%val)
541 0 : end function less_self
542 :
543 0 : function less_auto_diff_real_4var_order1_real_dp(this, other) result(z)
544 : type(auto_diff_real_4var_order1), intent(in) :: this
545 : real(dp), intent(in) :: other
546 : logical :: z
547 0 : z = (this%val < other)
548 0 : end function less_auto_diff_real_4var_order1_real_dp
549 :
550 0 : function less_real_dp_auto_diff_real_4var_order1(this, other) result(z)
551 : real(dp), intent(in) :: this
552 : type(auto_diff_real_4var_order1), intent(in) :: other
553 : logical :: z
554 0 : z = (this < other%val)
555 0 : end function less_real_dp_auto_diff_real_4var_order1
556 :
557 0 : function less_auto_diff_real_4var_order1_int(this, other) result(z)
558 : type(auto_diff_real_4var_order1), intent(in) :: this
559 : integer, intent(in) :: other
560 : logical :: z
561 0 : z = (this%val < other)
562 0 : end function less_auto_diff_real_4var_order1_int
563 :
564 0 : function less_int_auto_diff_real_4var_order1(this, other) result(z)
565 : integer, intent(in) :: this
566 : type(auto_diff_real_4var_order1), intent(in) :: other
567 : logical :: z
568 0 : z = (this < other%val)
569 0 : end function less_int_auto_diff_real_4var_order1
570 :
571 0 : function leq_self(this, other) result(z)
572 : type(auto_diff_real_4var_order1), intent(in) :: this
573 : type(auto_diff_real_4var_order1), intent(in) :: other
574 : logical :: z
575 0 : z = (this%val <= other%val)
576 0 : end function leq_self
577 :
578 0 : function leq_auto_diff_real_4var_order1_real_dp(this, other) result(z)
579 : type(auto_diff_real_4var_order1), intent(in) :: this
580 : real(dp), intent(in) :: other
581 : logical :: z
582 0 : z = (this%val <= other)
583 0 : end function leq_auto_diff_real_4var_order1_real_dp
584 :
585 0 : function leq_real_dp_auto_diff_real_4var_order1(this, other) result(z)
586 : real(dp), intent(in) :: this
587 : type(auto_diff_real_4var_order1), intent(in) :: other
588 : logical :: z
589 0 : z = (this <= other%val)
590 0 : end function leq_real_dp_auto_diff_real_4var_order1
591 :
592 0 : function leq_auto_diff_real_4var_order1_int(this, other) result(z)
593 : type(auto_diff_real_4var_order1), intent(in) :: this
594 : integer, intent(in) :: other
595 : logical :: z
596 0 : z = (this%val <= other)
597 0 : end function leq_auto_diff_real_4var_order1_int
598 :
599 0 : function leq_int_auto_diff_real_4var_order1(this, other) result(z)
600 : integer, intent(in) :: this
601 : type(auto_diff_real_4var_order1), intent(in) :: other
602 : logical :: z
603 0 : z = (this <= other%val)
604 0 : end function leq_int_auto_diff_real_4var_order1
605 :
606 0 : function geq_self(this, other) result(z)
607 : type(auto_diff_real_4var_order1), intent(in) :: this
608 : type(auto_diff_real_4var_order1), intent(in) :: other
609 : logical :: z
610 0 : z = (this%val >= other%val)
611 0 : end function geq_self
612 :
613 0 : function geq_auto_diff_real_4var_order1_real_dp(this, other) result(z)
614 : type(auto_diff_real_4var_order1), intent(in) :: this
615 : real(dp), intent(in) :: other
616 : logical :: z
617 0 : z = (this%val >= other)
618 0 : end function geq_auto_diff_real_4var_order1_real_dp
619 :
620 0 : function geq_real_dp_auto_diff_real_4var_order1(this, other) result(z)
621 : real(dp), intent(in) :: this
622 : type(auto_diff_real_4var_order1), intent(in) :: other
623 : logical :: z
624 0 : z = (this >= other%val)
625 0 : end function geq_real_dp_auto_diff_real_4var_order1
626 :
627 0 : function geq_auto_diff_real_4var_order1_int(this, other) result(z)
628 : type(auto_diff_real_4var_order1), intent(in) :: this
629 : integer, intent(in) :: other
630 : logical :: z
631 0 : z = (this%val >= other)
632 0 : end function geq_auto_diff_real_4var_order1_int
633 :
634 0 : function geq_int_auto_diff_real_4var_order1(this, other) result(z)
635 : integer, intent(in) :: this
636 : type(auto_diff_real_4var_order1), intent(in) :: other
637 : logical :: z
638 0 : z = (this >= other%val)
639 0 : end function geq_int_auto_diff_real_4var_order1
640 :
641 0 : function make_unary_operator(x, z_val, z_d1x) result(unary)
642 : type(auto_diff_real_4var_order1), intent(in) :: x
643 : real(dp), intent(in) :: z_val
644 : real(dp), intent(in) :: z_d1x
645 : type(auto_diff_real_4var_order1) :: unary
646 0 : unary%val = z_val
647 0 : unary%d1val1 = x%d1val1*z_d1x
648 0 : unary%d1val2 = x%d1val2*z_d1x
649 0 : unary%d1val3 = x%d1val3*z_d1x
650 0 : unary%d1val4 = x%d1val4*z_d1x
651 0 : end function make_unary_operator
652 :
653 0 : function make_binary_operator(x, y, z_val, z_d1x, z_d1y) result(binary)
654 : type(auto_diff_real_4var_order1), intent(in) :: x
655 : type(auto_diff_real_4var_order1), intent(in) :: y
656 : real(dp), intent(in) :: z_val
657 : real(dp), intent(in) :: z_d1x
658 : real(dp), intent(in) :: z_d1y
659 : type(auto_diff_real_4var_order1) :: binary
660 0 : binary%val = z_val
661 0 : binary%d1val1 = x%d1val1*z_d1x + y%d1val1*z_d1y
662 0 : binary%d1val2 = x%d1val2*z_d1x + y%d1val2*z_d1y
663 0 : binary%d1val3 = x%d1val3*z_d1x + y%d1val3*z_d1y
664 0 : binary%d1val4 = x%d1val4*z_d1x + y%d1val4*z_d1y
665 0 : end function make_binary_operator
666 :
667 0 : function sign_self(x) result(unary)
668 : type(auto_diff_real_4var_order1), intent(in) :: x
669 : type(auto_diff_real_4var_order1) :: unary
670 0 : unary%val = sgn(x%val)
671 0 : unary%d1val1 = 0.0_dp
672 0 : unary%d1val2 = 0.0_dp
673 0 : unary%d1val3 = 0.0_dp
674 0 : unary%d1val4 = 0.0_dp
675 0 : end function sign_self
676 :
677 0 : function safe_sqrt_self(x) result(unary)
678 : type(auto_diff_real_4var_order1), intent(in) :: x
679 : type(auto_diff_real_4var_order1) :: unary
680 0 : real(dp) :: q1
681 0 : real(dp) :: q0
682 0 : q0 = sqrt(x%val*Heaviside(x%val))
683 0 : q1 = 0.5_dp*q0*powm1(x%val)
684 0 : unary%val = q0
685 0 : unary%d1val1 = q1*x%d1val1
686 0 : unary%d1val2 = q1*x%d1val2
687 0 : unary%d1val3 = q1*x%d1val3
688 0 : unary%d1val4 = q1*x%d1val4
689 0 : end function safe_sqrt_self
690 :
691 0 : function unary_minus_self(x) result(unary)
692 : type(auto_diff_real_4var_order1), intent(in) :: x
693 : type(auto_diff_real_4var_order1) :: unary
694 0 : unary%val = -x%val
695 0 : unary%d1val1 = -x%d1val1
696 0 : unary%d1val2 = -x%d1val2
697 0 : unary%d1val3 = -x%d1val3
698 0 : unary%d1val4 = -x%d1val4
699 0 : end function unary_minus_self
700 :
701 0 : function exp_self(x) result(unary)
702 : type(auto_diff_real_4var_order1), intent(in) :: x
703 : type(auto_diff_real_4var_order1) :: unary
704 0 : real(dp) :: q0
705 0 : q0 = exp(x%val)
706 0 : unary%val = q0
707 0 : unary%d1val1 = q0*x%d1val1
708 0 : unary%d1val2 = q0*x%d1val2
709 0 : unary%d1val3 = q0*x%d1val3
710 0 : unary%d1val4 = q0*x%d1val4
711 0 : end function exp_self
712 :
713 0 : function expm1_self(x) result(unary)
714 : type(auto_diff_real_4var_order1), intent(in) :: x
715 : type(auto_diff_real_4var_order1) :: unary
716 0 : real(dp) :: q0
717 0 : q0 = exp(x%val)
718 0 : unary%val = expm1(x%val)
719 0 : unary%d1val1 = q0*x%d1val1
720 0 : unary%d1val2 = q0*x%d1val2
721 0 : unary%d1val3 = q0*x%d1val3
722 0 : unary%d1val4 = q0*x%d1val4
723 0 : end function expm1_self
724 :
725 0 : function exp10_self(x) result(unary)
726 : type(auto_diff_real_4var_order1), intent(in) :: x
727 : type(auto_diff_real_4var_order1) :: unary
728 0 : real(dp) :: q1
729 0 : real(dp) :: q0
730 0 : q0 = pow(10.0_dp, x%val)
731 0 : q1 = q0*ln10
732 0 : unary%val = q0
733 0 : unary%d1val1 = q1*x%d1val1
734 0 : unary%d1val2 = q1*x%d1val2
735 0 : unary%d1val3 = q1*x%d1val3
736 0 : unary%d1val4 = q1*x%d1val4
737 0 : end function exp10_self
738 :
739 0 : function powm1_self(x) result(unary)
740 : type(auto_diff_real_4var_order1), intent(in) :: x
741 : type(auto_diff_real_4var_order1) :: unary
742 0 : real(dp) :: q0
743 0 : q0 = powm1(pow2(x%val))
744 0 : unary%val = powm1(x%val)
745 0 : unary%d1val1 = -q0*x%d1val1
746 0 : unary%d1val2 = -q0*x%d1val2
747 0 : unary%d1val3 = -q0*x%d1val3
748 0 : unary%d1val4 = -q0*x%d1val4
749 0 : end function powm1_self
750 :
751 0 : function log_self(x) result(unary)
752 : type(auto_diff_real_4var_order1), intent(in) :: x
753 : type(auto_diff_real_4var_order1) :: unary
754 0 : real(dp) :: q0
755 0 : q0 = powm1(x%val)
756 0 : unary%val = log(x%val)
757 0 : unary%d1val1 = q0*x%d1val1
758 0 : unary%d1val2 = q0*x%d1val2
759 0 : unary%d1val3 = q0*x%d1val3
760 0 : unary%d1val4 = q0*x%d1val4
761 0 : end function log_self
762 :
763 0 : function log1p_self(x) result(unary)
764 : type(auto_diff_real_4var_order1), intent(in) :: x
765 : type(auto_diff_real_4var_order1) :: unary
766 0 : real(dp) :: q0
767 0 : q0 = powm1(x%val + 1)
768 0 : unary%val = log1p(x%val)
769 0 : unary%d1val1 = q0*x%d1val1
770 0 : unary%d1val2 = q0*x%d1val2
771 0 : unary%d1val3 = q0*x%d1val3
772 0 : unary%d1val4 = q0*x%d1val4
773 0 : end function log1p_self
774 :
775 0 : function safe_log_self(x) result(unary)
776 : type(auto_diff_real_4var_order1), intent(in) :: x
777 : type(auto_diff_real_4var_order1) :: unary
778 0 : real(dp) :: q0
779 0 : q0 = powm1(x%val)
780 0 : unary%val = safe_log(x%val)
781 0 : unary%d1val1 = q0*x%d1val1
782 0 : unary%d1val2 = q0*x%d1val2
783 0 : unary%d1val3 = q0*x%d1val3
784 0 : unary%d1val4 = q0*x%d1val4
785 0 : end function safe_log_self
786 :
787 0 : function log10_self(x) result(unary)
788 : type(auto_diff_real_4var_order1), intent(in) :: x
789 : type(auto_diff_real_4var_order1) :: unary
790 0 : real(dp) :: q1
791 0 : real(dp) :: q0
792 0 : q0 = powm1(ln10)
793 0 : q1 = q0*powm1(x%val)
794 0 : unary%val = q0*log(x%val)
795 0 : unary%d1val1 = q1*x%d1val1
796 0 : unary%d1val2 = q1*x%d1val2
797 0 : unary%d1val3 = q1*x%d1val3
798 0 : unary%d1val4 = q1*x%d1val4
799 0 : end function log10_self
800 :
801 0 : function safe_log10_self(x) result(unary)
802 : type(auto_diff_real_4var_order1), intent(in) :: x
803 : type(auto_diff_real_4var_order1) :: unary
804 0 : real(dp) :: q1
805 0 : real(dp) :: q0
806 0 : q0 = powm1(ln10)
807 0 : q1 = q0*powm1(x%val)
808 0 : unary%val = q0*safe_log(x%val)
809 0 : unary%d1val1 = q1*x%d1val1
810 0 : unary%d1val2 = q1*x%d1val2
811 0 : unary%d1val3 = q1*x%d1val3
812 0 : unary%d1val4 = q1*x%d1val4
813 0 : end function safe_log10_self
814 :
815 0 : function log2_self(x) result(unary)
816 : type(auto_diff_real_4var_order1), intent(in) :: x
817 : type(auto_diff_real_4var_order1) :: unary
818 0 : real(dp) :: q1
819 0 : real(dp) :: q0
820 0 : q0 = powm1(log(2.0_dp))
821 0 : q1 = q0*powm1(x%val)
822 0 : unary%val = q0*log(x%val)
823 0 : unary%d1val1 = q1*x%d1val1
824 0 : unary%d1val2 = q1*x%d1val2
825 0 : unary%d1val3 = q1*x%d1val3
826 0 : unary%d1val4 = q1*x%d1val4
827 0 : end function log2_self
828 :
829 0 : function sin_self(x) result(unary)
830 : type(auto_diff_real_4var_order1), intent(in) :: x
831 : type(auto_diff_real_4var_order1) :: unary
832 0 : real(dp) :: q0
833 0 : q0 = cos(x%val)
834 0 : unary%val = sin(x%val)
835 0 : unary%d1val1 = q0*x%d1val1
836 0 : unary%d1val2 = q0*x%d1val2
837 0 : unary%d1val3 = q0*x%d1val3
838 0 : unary%d1val4 = q0*x%d1val4
839 0 : end function sin_self
840 :
841 0 : function cos_self(x) result(unary)
842 : type(auto_diff_real_4var_order1), intent(in) :: x
843 : type(auto_diff_real_4var_order1) :: unary
844 0 : real(dp) :: q0
845 0 : q0 = sin(x%val)
846 0 : unary%val = cos(x%val)
847 0 : unary%d1val1 = -q0*x%d1val1
848 0 : unary%d1val2 = -q0*x%d1val2
849 0 : unary%d1val3 = -q0*x%d1val3
850 0 : unary%d1val4 = -q0*x%d1val4
851 0 : end function cos_self
852 :
853 0 : function tan_self(x) result(unary)
854 : type(auto_diff_real_4var_order1), intent(in) :: x
855 : type(auto_diff_real_4var_order1) :: unary
856 0 : real(dp) :: q1
857 : real(dp) :: q0
858 0 : q0 = tan(x%val)
859 0 : q1 = pow2(q0) + 1
860 0 : unary%val = q0
861 0 : unary%d1val1 = q1*x%d1val1
862 0 : unary%d1val2 = q1*x%d1val2
863 0 : unary%d1val3 = q1*x%d1val3
864 0 : unary%d1val4 = q1*x%d1val4
865 0 : end function tan_self
866 :
867 0 : function sinpi_self(x) result(unary)
868 : type(auto_diff_real_4var_order1), intent(in) :: x
869 : type(auto_diff_real_4var_order1) :: unary
870 0 : real(dp) :: q1
871 : real(dp) :: q0
872 0 : q0 = pi*x%val
873 0 : q1 = pi*cos(q0)
874 0 : unary%val = sin(q0)
875 0 : unary%d1val1 = q1*x%d1val1
876 0 : unary%d1val2 = q1*x%d1val2
877 0 : unary%d1val3 = q1*x%d1val3
878 0 : unary%d1val4 = q1*x%d1val4
879 0 : end function sinpi_self
880 :
881 0 : function cospi_self(x) result(unary)
882 : type(auto_diff_real_4var_order1), intent(in) :: x
883 : type(auto_diff_real_4var_order1) :: unary
884 0 : real(dp) :: q1
885 : real(dp) :: q0
886 0 : q0 = pi*x%val
887 0 : q1 = pi*sin(q0)
888 0 : unary%val = cos(q0)
889 0 : unary%d1val1 = -q1*x%d1val1
890 0 : unary%d1val2 = -q1*x%d1val2
891 0 : unary%d1val3 = -q1*x%d1val3
892 0 : unary%d1val4 = -q1*x%d1val4
893 0 : end function cospi_self
894 :
895 0 : function tanpi_self(x) result(unary)
896 : type(auto_diff_real_4var_order1), intent(in) :: x
897 : type(auto_diff_real_4var_order1) :: unary
898 0 : real(dp) :: q1
899 : real(dp) :: q0
900 0 : q0 = tan(pi*x%val)
901 0 : q1 = pi*(pow2(q0) + 1)
902 0 : unary%val = q0
903 0 : unary%d1val1 = q1*x%d1val1
904 0 : unary%d1val2 = q1*x%d1val2
905 0 : unary%d1val3 = q1*x%d1val3
906 0 : unary%d1val4 = q1*x%d1val4
907 0 : end function tanpi_self
908 :
909 0 : function sinh_self(x) result(unary)
910 : type(auto_diff_real_4var_order1), intent(in) :: x
911 : type(auto_diff_real_4var_order1) :: unary
912 0 : real(dp) :: q0
913 0 : q0 = cosh(x%val)
914 0 : unary%val = sinh(x%val)
915 0 : unary%d1val1 = q0*x%d1val1
916 0 : unary%d1val2 = q0*x%d1val2
917 0 : unary%d1val3 = q0*x%d1val3
918 0 : unary%d1val4 = q0*x%d1val4
919 0 : end function sinh_self
920 :
921 0 : function cosh_self(x) result(unary)
922 : type(auto_diff_real_4var_order1), intent(in) :: x
923 : type(auto_diff_real_4var_order1) :: unary
924 0 : real(dp) :: q0
925 0 : q0 = sinh(x%val)
926 0 : unary%val = cosh(x%val)
927 0 : unary%d1val1 = q0*x%d1val1
928 0 : unary%d1val2 = q0*x%d1val2
929 0 : unary%d1val3 = q0*x%d1val3
930 0 : unary%d1val4 = q0*x%d1val4
931 0 : end function cosh_self
932 :
933 0 : function tanh_self(x) result(unary)
934 : type(auto_diff_real_4var_order1), intent(in) :: x
935 : type(auto_diff_real_4var_order1) :: unary
936 0 : real(dp) :: q1
937 : real(dp) :: q0
938 0 : q0 = tanh(x%val)
939 0 : q1 = pow2(q0) - 1
940 0 : unary%val = q0
941 0 : unary%d1val1 = -q1*x%d1val1
942 0 : unary%d1val2 = -q1*x%d1val2
943 0 : unary%d1val3 = -q1*x%d1val3
944 0 : unary%d1val4 = -q1*x%d1val4
945 0 : end function tanh_self
946 :
947 0 : function asin_self(x) result(unary)
948 : type(auto_diff_real_4var_order1), intent(in) :: x
949 : type(auto_diff_real_4var_order1) :: unary
950 0 : real(dp) :: q0
951 0 : q0 = powm1(sqrt(1 - pow2(x%val)))
952 0 : unary%val = asin(x%val)
953 0 : unary%d1val1 = q0*x%d1val1
954 0 : unary%d1val2 = q0*x%d1val2
955 0 : unary%d1val3 = q0*x%d1val3
956 0 : unary%d1val4 = q0*x%d1val4
957 0 : end function asin_self
958 :
959 0 : function acos_self(x) result(unary)
960 : type(auto_diff_real_4var_order1), intent(in) :: x
961 : type(auto_diff_real_4var_order1) :: unary
962 0 : real(dp) :: q0
963 0 : q0 = powm1(sqrt(1 - pow2(x%val)))
964 0 : unary%val = acos(x%val)
965 0 : unary%d1val1 = -q0*x%d1val1
966 0 : unary%d1val2 = -q0*x%d1val2
967 0 : unary%d1val3 = -q0*x%d1val3
968 0 : unary%d1val4 = -q0*x%d1val4
969 0 : end function acos_self
970 :
971 0 : function atan_self(x) result(unary)
972 : type(auto_diff_real_4var_order1), intent(in) :: x
973 : type(auto_diff_real_4var_order1) :: unary
974 0 : real(dp) :: q0
975 0 : q0 = powm1(pow2(x%val) + 1)
976 0 : unary%val = atan(x%val)
977 0 : unary%d1val1 = q0*x%d1val1
978 0 : unary%d1val2 = q0*x%d1val2
979 0 : unary%d1val3 = q0*x%d1val3
980 0 : unary%d1val4 = q0*x%d1val4
981 0 : end function atan_self
982 :
983 0 : function asinpi_self(x) result(unary)
984 : type(auto_diff_real_4var_order1), intent(in) :: x
985 : type(auto_diff_real_4var_order1) :: unary
986 0 : real(dp) :: q1
987 0 : real(dp) :: q0
988 0 : q0 = powm1(pi)
989 0 : q1 = q0*powm1(sqrt(1 - pow2(x%val)))
990 0 : unary%val = q0*asin(x%val)
991 0 : unary%d1val1 = q1*x%d1val1
992 0 : unary%d1val2 = q1*x%d1val2
993 0 : unary%d1val3 = q1*x%d1val3
994 0 : unary%d1val4 = q1*x%d1val4
995 0 : end function asinpi_self
996 :
997 0 : function acospi_self(x) result(unary)
998 : type(auto_diff_real_4var_order1), intent(in) :: x
999 : type(auto_diff_real_4var_order1) :: unary
1000 0 : real(dp) :: q1
1001 0 : real(dp) :: q0
1002 0 : q0 = powm1(pi)
1003 0 : q1 = q0*powm1(sqrt(1 - pow2(x%val)))
1004 0 : unary%val = q0*acos(x%val)
1005 0 : unary%d1val1 = -q1*x%d1val1
1006 0 : unary%d1val2 = -q1*x%d1val2
1007 0 : unary%d1val3 = -q1*x%d1val3
1008 0 : unary%d1val4 = -q1*x%d1val4
1009 0 : end function acospi_self
1010 :
1011 0 : function atanpi_self(x) result(unary)
1012 : type(auto_diff_real_4var_order1), intent(in) :: x
1013 : type(auto_diff_real_4var_order1) :: unary
1014 0 : real(dp) :: q0
1015 0 : q0 = powm1(pi*pow2(x%val) + pi)
1016 0 : unary%val = powm1(pi)*atan(x%val)
1017 0 : unary%d1val1 = q0*x%d1val1
1018 0 : unary%d1val2 = q0*x%d1val2
1019 0 : unary%d1val3 = q0*x%d1val3
1020 0 : unary%d1val4 = q0*x%d1val4
1021 0 : end function atanpi_self
1022 :
1023 0 : function asinh_self(x) result(unary)
1024 : type(auto_diff_real_4var_order1), intent(in) :: x
1025 : type(auto_diff_real_4var_order1) :: unary
1026 0 : real(dp) :: q0
1027 0 : q0 = powm1(sqrt(pow2(x%val) + 1))
1028 0 : unary%val = asinh(x%val)
1029 0 : unary%d1val1 = q0*x%d1val1
1030 0 : unary%d1val2 = q0*x%d1val2
1031 0 : unary%d1val3 = q0*x%d1val3
1032 0 : unary%d1val4 = q0*x%d1val4
1033 0 : end function asinh_self
1034 :
1035 0 : function acosh_self(x) result(unary)
1036 : type(auto_diff_real_4var_order1), intent(in) :: x
1037 : type(auto_diff_real_4var_order1) :: unary
1038 0 : real(dp) :: q0
1039 0 : q0 = powm1(sqrt(pow2(x%val) - 1))
1040 0 : unary%val = acosh(x%val)
1041 0 : unary%d1val1 = q0*x%d1val1
1042 0 : unary%d1val2 = q0*x%d1val2
1043 0 : unary%d1val3 = q0*x%d1val3
1044 0 : unary%d1val4 = q0*x%d1val4
1045 0 : end function acosh_self
1046 :
1047 0 : function atanh_self(x) result(unary)
1048 : type(auto_diff_real_4var_order1), intent(in) :: x
1049 : type(auto_diff_real_4var_order1) :: unary
1050 0 : real(dp) :: q0
1051 0 : q0 = powm1(pow2(x%val) - 1)
1052 0 : unary%val = atanh(x%val)
1053 0 : unary%d1val1 = -q0*x%d1val1
1054 0 : unary%d1val2 = -q0*x%d1val2
1055 0 : unary%d1val3 = -q0*x%d1val3
1056 0 : unary%d1val4 = -q0*x%d1val4
1057 0 : end function atanh_self
1058 :
1059 0 : function sqrt_self(x) result(unary)
1060 : type(auto_diff_real_4var_order1), intent(in) :: x
1061 : type(auto_diff_real_4var_order1) :: unary
1062 0 : real(dp) :: q1
1063 : real(dp) :: q0
1064 0 : q0 = sqrt(x%val)
1065 0 : q1 = 0.5_dp*powm1(q0)
1066 0 : unary%val = q0
1067 0 : unary%d1val1 = q1*x%d1val1
1068 0 : unary%d1val2 = q1*x%d1val2
1069 0 : unary%d1val3 = q1*x%d1val3
1070 0 : unary%d1val4 = q1*x%d1val4
1071 0 : end function sqrt_self
1072 :
1073 0 : function pow2_self(x) result(unary)
1074 : type(auto_diff_real_4var_order1), intent(in) :: x
1075 : type(auto_diff_real_4var_order1) :: unary
1076 0 : real(dp) :: q0
1077 0 : q0 = 2.0_dp*x%val
1078 0 : unary%val = pow2(x%val)
1079 0 : unary%d1val1 = q0*x%d1val1
1080 0 : unary%d1val2 = q0*x%d1val2
1081 0 : unary%d1val3 = q0*x%d1val3
1082 0 : unary%d1val4 = q0*x%d1val4
1083 0 : end function pow2_self
1084 :
1085 0 : function pow3_self(x) result(unary)
1086 : type(auto_diff_real_4var_order1), intent(in) :: x
1087 : type(auto_diff_real_4var_order1) :: unary
1088 0 : real(dp) :: q0
1089 0 : q0 = 3.0_dp*pow2(x%val)
1090 0 : unary%val = pow3(x%val)
1091 0 : unary%d1val1 = q0*x%d1val1
1092 0 : unary%d1val2 = q0*x%d1val2
1093 0 : unary%d1val3 = q0*x%d1val3
1094 0 : unary%d1val4 = q0*x%d1val4
1095 0 : end function pow3_self
1096 :
1097 0 : function pow4_self(x) result(unary)
1098 : type(auto_diff_real_4var_order1), intent(in) :: x
1099 : type(auto_diff_real_4var_order1) :: unary
1100 0 : real(dp) :: q0
1101 0 : q0 = 4.0_dp*pow3(x%val)
1102 0 : unary%val = pow4(x%val)
1103 0 : unary%d1val1 = q0*x%d1val1
1104 0 : unary%d1val2 = q0*x%d1val2
1105 0 : unary%d1val3 = q0*x%d1val3
1106 0 : unary%d1val4 = q0*x%d1val4
1107 0 : end function pow4_self
1108 :
1109 0 : function pow5_self(x) result(unary)
1110 : type(auto_diff_real_4var_order1), intent(in) :: x
1111 : type(auto_diff_real_4var_order1) :: unary
1112 0 : real(dp) :: q0
1113 0 : q0 = 5.0_dp*pow4(x%val)
1114 0 : unary%val = pow5(x%val)
1115 0 : unary%d1val1 = q0*x%d1val1
1116 0 : unary%d1val2 = q0*x%d1val2
1117 0 : unary%d1val3 = q0*x%d1val3
1118 0 : unary%d1val4 = q0*x%d1val4
1119 0 : end function pow5_self
1120 :
1121 0 : function pow6_self(x) result(unary)
1122 : type(auto_diff_real_4var_order1), intent(in) :: x
1123 : type(auto_diff_real_4var_order1) :: unary
1124 0 : real(dp) :: q0
1125 0 : q0 = 6.0_dp*pow5(x%val)
1126 0 : unary%val = pow6(x%val)
1127 0 : unary%d1val1 = q0*x%d1val1
1128 0 : unary%d1val2 = q0*x%d1val2
1129 0 : unary%d1val3 = q0*x%d1val3
1130 0 : unary%d1val4 = q0*x%d1val4
1131 0 : end function pow6_self
1132 :
1133 0 : function pow7_self(x) result(unary)
1134 : type(auto_diff_real_4var_order1), intent(in) :: x
1135 : type(auto_diff_real_4var_order1) :: unary
1136 0 : real(dp) :: q0
1137 0 : q0 = 7.0_dp*pow6(x%val)
1138 0 : unary%val = pow7(x%val)
1139 0 : unary%d1val1 = q0*x%d1val1
1140 0 : unary%d1val2 = q0*x%d1val2
1141 0 : unary%d1val3 = q0*x%d1val3
1142 0 : unary%d1val4 = q0*x%d1val4
1143 0 : end function pow7_self
1144 :
1145 0 : function pow8_self(x) result(unary)
1146 : type(auto_diff_real_4var_order1), intent(in) :: x
1147 : type(auto_diff_real_4var_order1) :: unary
1148 0 : real(dp) :: q0
1149 0 : q0 = 8.0_dp*pow7(x%val)
1150 0 : unary%val = pow8(x%val)
1151 0 : unary%d1val1 = q0*x%d1val1
1152 0 : unary%d1val2 = q0*x%d1val2
1153 0 : unary%d1val3 = q0*x%d1val3
1154 0 : unary%d1val4 = q0*x%d1val4
1155 0 : end function pow8_self
1156 :
1157 0 : function abs_self(x) result(unary)
1158 : type(auto_diff_real_4var_order1), intent(in) :: x
1159 : type(auto_diff_real_4var_order1) :: unary
1160 0 : real(dp) :: q0
1161 0 : q0 = sgn(x%val)
1162 0 : unary%val = Abs(x%val)
1163 0 : unary%d1val1 = q0*x%d1val1
1164 0 : unary%d1val2 = q0*x%d1val2
1165 0 : unary%d1val3 = q0*x%d1val3
1166 0 : unary%d1val4 = q0*x%d1val4
1167 0 : end function abs_self
1168 :
1169 0 : function add_self(x, y) result(binary)
1170 : type(auto_diff_real_4var_order1), intent(in) :: x
1171 : type(auto_diff_real_4var_order1), intent(in) :: y
1172 : type(auto_diff_real_4var_order1) :: binary
1173 0 : binary%val = x%val + y%val
1174 0 : binary%d1val1 = x%d1val1 + y%d1val1
1175 0 : binary%d1val2 = x%d1val2 + y%d1val2
1176 0 : binary%d1val3 = x%d1val3 + y%d1val3
1177 0 : binary%d1val4 = x%d1val4 + y%d1val4
1178 0 : end function add_self
1179 :
1180 0 : function add_self_real(x, y) result(unary)
1181 : type(auto_diff_real_4var_order1), intent(in) :: x
1182 : real(dp), intent(in) :: y
1183 : type(auto_diff_real_4var_order1) :: unary
1184 0 : unary%val = x%val + y
1185 0 : unary%d1val1 = x%d1val1
1186 0 : unary%d1val2 = x%d1val2
1187 0 : unary%d1val3 = x%d1val3
1188 0 : unary%d1val4 = x%d1val4
1189 0 : end function add_self_real
1190 :
1191 0 : function add_real_self(z, x) result(unary)
1192 : real(dp), intent(in) :: z
1193 : type(auto_diff_real_4var_order1), intent(in) :: x
1194 : type(auto_diff_real_4var_order1) :: unary
1195 0 : unary%val = x%val + z
1196 0 : unary%d1val1 = x%d1val1
1197 0 : unary%d1val2 = x%d1val2
1198 0 : unary%d1val3 = x%d1val3
1199 0 : unary%d1val4 = x%d1val4
1200 0 : end function add_real_self
1201 :
1202 0 : function add_self_int(x, y) result(unary)
1203 : type(auto_diff_real_4var_order1), intent(in) :: x
1204 : integer, intent(in) :: y
1205 : type(auto_diff_real_4var_order1) :: unary
1206 0 : real(dp) :: y_dp
1207 0 : y_dp = y
1208 0 : unary%val = x%val + y_dp
1209 0 : unary%d1val1 = x%d1val1
1210 0 : unary%d1val2 = x%d1val2
1211 0 : unary%d1val3 = x%d1val3
1212 0 : unary%d1val4 = x%d1val4
1213 0 : end function add_self_int
1214 :
1215 0 : function add_int_self(z, x) result(unary)
1216 : integer, intent(in) :: z
1217 : type(auto_diff_real_4var_order1), intent(in) :: x
1218 : type(auto_diff_real_4var_order1) :: unary
1219 0 : real(dp) :: y_dp
1220 0 : y_dp = z
1221 0 : unary%val = x%val + y_dp
1222 0 : unary%d1val1 = x%d1val1
1223 0 : unary%d1val2 = x%d1val2
1224 0 : unary%d1val3 = x%d1val3
1225 0 : unary%d1val4 = x%d1val4
1226 0 : end function add_int_self
1227 :
1228 0 : function sub_self(x, y) result(binary)
1229 : type(auto_diff_real_4var_order1), intent(in) :: x
1230 : type(auto_diff_real_4var_order1), intent(in) :: y
1231 : type(auto_diff_real_4var_order1) :: binary
1232 0 : binary%val = x%val - y%val
1233 0 : binary%d1val1 = x%d1val1 - y%d1val1
1234 0 : binary%d1val2 = x%d1val2 - y%d1val2
1235 0 : binary%d1val3 = x%d1val3 - y%d1val3
1236 0 : binary%d1val4 = x%d1val4 - y%d1val4
1237 0 : end function sub_self
1238 :
1239 0 : function sub_self_real(x, y) result(unary)
1240 : type(auto_diff_real_4var_order1), intent(in) :: x
1241 : real(dp), intent(in) :: y
1242 : type(auto_diff_real_4var_order1) :: unary
1243 0 : unary%val = x%val - y
1244 0 : unary%d1val1 = x%d1val1
1245 0 : unary%d1val2 = x%d1val2
1246 0 : unary%d1val3 = x%d1val3
1247 0 : unary%d1val4 = x%d1val4
1248 0 : end function sub_self_real
1249 :
1250 0 : function sub_real_self(z, x) result(unary)
1251 : real(dp), intent(in) :: z
1252 : type(auto_diff_real_4var_order1), intent(in) :: x
1253 : type(auto_diff_real_4var_order1) :: unary
1254 0 : unary%val = -x%val + z
1255 0 : unary%d1val1 = -x%d1val1
1256 0 : unary%d1val2 = -x%d1val2
1257 0 : unary%d1val3 = -x%d1val3
1258 0 : unary%d1val4 = -x%d1val4
1259 0 : end function sub_real_self
1260 :
1261 0 : function sub_self_int(x, y) result(unary)
1262 : type(auto_diff_real_4var_order1), intent(in) :: x
1263 : integer, intent(in) :: y
1264 : type(auto_diff_real_4var_order1) :: unary
1265 0 : real(dp) :: y_dp
1266 0 : y_dp = y
1267 0 : unary%val = x%val - y_dp
1268 0 : unary%d1val1 = x%d1val1
1269 0 : unary%d1val2 = x%d1val2
1270 0 : unary%d1val3 = x%d1val3
1271 0 : unary%d1val4 = x%d1val4
1272 0 : end function sub_self_int
1273 :
1274 0 : function sub_int_self(z, x) result(unary)
1275 : integer, intent(in) :: z
1276 : type(auto_diff_real_4var_order1), intent(in) :: x
1277 : type(auto_diff_real_4var_order1) :: unary
1278 0 : real(dp) :: y_dp
1279 0 : y_dp = z
1280 0 : unary%val = -x%val + y_dp
1281 0 : unary%d1val1 = -x%d1val1
1282 0 : unary%d1val2 = -x%d1val2
1283 0 : unary%d1val3 = -x%d1val3
1284 0 : unary%d1val4 = -x%d1val4
1285 0 : end function sub_int_self
1286 :
1287 0 : function mul_self(x, y) result(binary)
1288 : type(auto_diff_real_4var_order1), intent(in) :: x
1289 : type(auto_diff_real_4var_order1), intent(in) :: y
1290 : type(auto_diff_real_4var_order1) :: binary
1291 0 : binary%val = x%val*y%val
1292 0 : binary%d1val1 = x%d1val1*y%val + x%val*y%d1val1
1293 0 : binary%d1val2 = x%d1val2*y%val + x%val*y%d1val2
1294 0 : binary%d1val3 = x%d1val3*y%val + x%val*y%d1val3
1295 0 : binary%d1val4 = x%d1val4*y%val + x%val*y%d1val4
1296 0 : end function mul_self
1297 :
1298 0 : function mul_self_real(x, y) result(unary)
1299 : type(auto_diff_real_4var_order1), intent(in) :: x
1300 : real(dp), intent(in) :: y
1301 : type(auto_diff_real_4var_order1) :: unary
1302 0 : unary%val = x%val*y
1303 0 : unary%d1val1 = x%d1val1*y
1304 0 : unary%d1val2 = x%d1val2*y
1305 0 : unary%d1val3 = x%d1val3*y
1306 0 : unary%d1val4 = x%d1val4*y
1307 0 : end function mul_self_real
1308 :
1309 0 : function mul_real_self(z, x) result(unary)
1310 : real(dp), intent(in) :: z
1311 : type(auto_diff_real_4var_order1), intent(in) :: x
1312 : type(auto_diff_real_4var_order1) :: unary
1313 0 : unary%val = x%val*z
1314 0 : unary%d1val1 = x%d1val1*z
1315 0 : unary%d1val2 = x%d1val2*z
1316 0 : unary%d1val3 = x%d1val3*z
1317 0 : unary%d1val4 = x%d1val4*z
1318 0 : end function mul_real_self
1319 :
1320 0 : function mul_self_int(x, y) result(unary)
1321 : type(auto_diff_real_4var_order1), intent(in) :: x
1322 : integer, intent(in) :: y
1323 : type(auto_diff_real_4var_order1) :: unary
1324 0 : real(dp) :: y_dp
1325 0 : y_dp = y
1326 0 : unary%val = x%val*y_dp
1327 0 : unary%d1val1 = x%d1val1*y_dp
1328 0 : unary%d1val2 = x%d1val2*y_dp
1329 0 : unary%d1val3 = x%d1val3*y_dp
1330 0 : unary%d1val4 = x%d1val4*y_dp
1331 0 : end function mul_self_int
1332 :
1333 0 : function mul_int_self(z, x) result(unary)
1334 : integer, intent(in) :: z
1335 : type(auto_diff_real_4var_order1), intent(in) :: x
1336 : type(auto_diff_real_4var_order1) :: unary
1337 0 : real(dp) :: y_dp
1338 0 : y_dp = z
1339 0 : unary%val = x%val*y_dp
1340 0 : unary%d1val1 = x%d1val1*y_dp
1341 0 : unary%d1val2 = x%d1val2*y_dp
1342 0 : unary%d1val3 = x%d1val3*y_dp
1343 0 : unary%d1val4 = x%d1val4*y_dp
1344 0 : end function mul_int_self
1345 :
1346 0 : function div_self(x, y) result(binary)
1347 : type(auto_diff_real_4var_order1), intent(in) :: x
1348 : type(auto_diff_real_4var_order1), intent(in) :: y
1349 : type(auto_diff_real_4var_order1) :: binary
1350 0 : real(dp) :: q0
1351 0 : q0 = powm1(pow2(y%val))
1352 0 : binary%val = x%val*powm1(y%val)
1353 0 : binary%d1val1 = q0*(x%d1val1*y%val - x%val*y%d1val1)
1354 0 : binary%d1val2 = q0*(x%d1val2*y%val - x%val*y%d1val2)
1355 0 : binary%d1val3 = q0*(x%d1val3*y%val - x%val*y%d1val3)
1356 0 : binary%d1val4 = q0*(x%d1val4*y%val - x%val*y%d1val4)
1357 0 : end function div_self
1358 :
1359 0 : function div_self_real(x, y) result(unary)
1360 : type(auto_diff_real_4var_order1), intent(in) :: x
1361 : real(dp), intent(in) :: y
1362 : type(auto_diff_real_4var_order1) :: unary
1363 0 : real(dp) :: q0
1364 0 : q0 = powm1(y)
1365 0 : unary%val = q0*x%val
1366 0 : unary%d1val1 = q0*x%d1val1
1367 0 : unary%d1val2 = q0*x%d1val2
1368 0 : unary%d1val3 = q0*x%d1val3
1369 0 : unary%d1val4 = q0*x%d1val4
1370 0 : end function div_self_real
1371 :
1372 0 : function div_real_self(z, x) result(unary)
1373 : real(dp), intent(in) :: z
1374 : type(auto_diff_real_4var_order1), intent(in) :: x
1375 : type(auto_diff_real_4var_order1) :: unary
1376 0 : real(dp) :: q0
1377 0 : q0 = z*powm1(pow2(x%val))
1378 0 : unary%val = z*powm1(x%val)
1379 0 : unary%d1val1 = -q0*x%d1val1
1380 0 : unary%d1val2 = -q0*x%d1val2
1381 0 : unary%d1val3 = -q0*x%d1val3
1382 0 : unary%d1val4 = -q0*x%d1val4
1383 0 : end function div_real_self
1384 :
1385 0 : function div_self_int(x, y) result(unary)
1386 : type(auto_diff_real_4var_order1), intent(in) :: x
1387 : integer, intent(in) :: y
1388 : type(auto_diff_real_4var_order1) :: unary
1389 : real(dp) :: y_dp
1390 0 : real(dp) :: q0
1391 0 : y_dp = y
1392 0 : q0 = powm1(y_dp)
1393 0 : unary%val = q0*x%val
1394 0 : unary%d1val1 = q0*x%d1val1
1395 0 : unary%d1val2 = q0*x%d1val2
1396 0 : unary%d1val3 = q0*x%d1val3
1397 0 : unary%d1val4 = q0*x%d1val4
1398 0 : end function div_self_int
1399 :
1400 0 : function div_int_self(z, x) result(unary)
1401 : integer, intent(in) :: z
1402 : type(auto_diff_real_4var_order1), intent(in) :: x
1403 : type(auto_diff_real_4var_order1) :: unary
1404 0 : real(dp) :: y_dp
1405 0 : real(dp) :: q0
1406 0 : y_dp = z
1407 0 : q0 = y_dp*powm1(pow2(x%val))
1408 0 : unary%val = y_dp*powm1(x%val)
1409 0 : unary%d1val1 = -q0*x%d1val1
1410 0 : unary%d1val2 = -q0*x%d1val2
1411 0 : unary%d1val3 = -q0*x%d1val3
1412 0 : unary%d1val4 = -q0*x%d1val4
1413 0 : end function div_int_self
1414 :
1415 0 : function pow_self(x, y) result(binary)
1416 : type(auto_diff_real_4var_order1), intent(in) :: x
1417 : type(auto_diff_real_4var_order1), intent(in) :: y
1418 : type(auto_diff_real_4var_order1) :: binary
1419 0 : real(dp) :: q1
1420 0 : real(dp) :: q0
1421 0 : q0 = pow(x%val, y%val - 1)
1422 0 : q1 = x%val*log(x%val)
1423 0 : binary%val = pow(x%val, y%val)
1424 0 : binary%d1val1 = q0*(q1*y%d1val1 + x%d1val1*y%val)
1425 0 : binary%d1val2 = q0*(q1*y%d1val2 + x%d1val2*y%val)
1426 0 : binary%d1val3 = q0*(q1*y%d1val3 + x%d1val3*y%val)
1427 0 : binary%d1val4 = q0*(q1*y%d1val4 + x%d1val4*y%val)
1428 0 : end function pow_self
1429 :
1430 0 : function pow_self_real(x, y) result(unary)
1431 : type(auto_diff_real_4var_order1), intent(in) :: x
1432 : real(dp), intent(in) :: y
1433 : type(auto_diff_real_4var_order1) :: unary
1434 0 : real(dp) :: q0
1435 0 : q0 = y*pow(x%val, y - 1)
1436 0 : unary%val = pow(x%val, y)
1437 0 : unary%d1val1 = q0*x%d1val1
1438 0 : unary%d1val2 = q0*x%d1val2
1439 0 : unary%d1val3 = q0*x%d1val3
1440 0 : unary%d1val4 = q0*x%d1val4
1441 0 : end function pow_self_real
1442 :
1443 0 : function pow_real_self(z, x) result(unary)
1444 : real(dp), intent(in) :: z
1445 : type(auto_diff_real_4var_order1), intent(in) :: x
1446 : type(auto_diff_real_4var_order1) :: unary
1447 0 : real(dp) :: q1
1448 0 : real(dp) :: q0
1449 0 : q0 = pow(z, x%val)
1450 0 : q1 = q0*log(z)
1451 0 : unary%val = q0
1452 0 : unary%d1val1 = q1*x%d1val1
1453 0 : unary%d1val2 = q1*x%d1val2
1454 0 : unary%d1val3 = q1*x%d1val3
1455 0 : unary%d1val4 = q1*x%d1val4
1456 0 : end function pow_real_self
1457 :
1458 0 : function pow_self_int(x, y) result(unary)
1459 : type(auto_diff_real_4var_order1), intent(in) :: x
1460 : integer, intent(in) :: y
1461 : type(auto_diff_real_4var_order1) :: unary
1462 : real(dp) :: y_dp
1463 0 : real(dp) :: q0
1464 0 : y_dp = y
1465 0 : q0 = y_dp*pow(x%val, y_dp - 1)
1466 0 : unary%val = pow(x%val, y_dp)
1467 0 : unary%d1val1 = q0*x%d1val1
1468 0 : unary%d1val2 = q0*x%d1val2
1469 0 : unary%d1val3 = q0*x%d1val3
1470 0 : unary%d1val4 = q0*x%d1val4
1471 0 : end function pow_self_int
1472 :
1473 0 : function pow_int_self(z, x) result(unary)
1474 : integer, intent(in) :: z
1475 : type(auto_diff_real_4var_order1), intent(in) :: x
1476 : type(auto_diff_real_4var_order1) :: unary
1477 : real(dp) :: y_dp
1478 0 : real(dp) :: q1
1479 0 : real(dp) :: q0
1480 0 : y_dp = z
1481 0 : q0 = pow(y_dp, x%val)
1482 0 : q1 = q0*log(y_dp)
1483 0 : unary%val = q0
1484 0 : unary%d1val1 = q1*x%d1val1
1485 0 : unary%d1val2 = q1*x%d1val2
1486 0 : unary%d1val3 = q1*x%d1val3
1487 0 : unary%d1val4 = q1*x%d1val4
1488 0 : end function pow_int_self
1489 :
1490 0 : function max_self(x, y) result(binary)
1491 : type(auto_diff_real_4var_order1), intent(in) :: x
1492 : type(auto_diff_real_4var_order1), intent(in) :: y
1493 : type(auto_diff_real_4var_order1) :: binary
1494 0 : real(dp) :: q1
1495 0 : real(dp) :: q0
1496 0 : q0 = Heaviside(x%val - y%val)
1497 0 : q1 = Heaviside(-x%val + y%val)
1498 0 : binary%val = Max(x%val, y%val)
1499 0 : binary%d1val1 = q0*x%d1val1 + q1*y%d1val1
1500 0 : binary%d1val2 = q0*x%d1val2 + q1*y%d1val2
1501 0 : binary%d1val3 = q0*x%d1val3 + q1*y%d1val3
1502 0 : binary%d1val4 = q0*x%d1val4 + q1*y%d1val4
1503 0 : end function max_self
1504 :
1505 0 : function max_self_real(x, y) result(unary)
1506 : type(auto_diff_real_4var_order1), intent(in) :: x
1507 : real(dp), intent(in) :: y
1508 : type(auto_diff_real_4var_order1) :: unary
1509 0 : real(dp) :: q0
1510 0 : q0 = Heaviside(x%val - y)
1511 0 : unary%val = Max(x%val, y)
1512 0 : unary%d1val1 = q0*x%d1val1
1513 0 : unary%d1val2 = q0*x%d1val2
1514 0 : unary%d1val3 = q0*x%d1val3
1515 0 : unary%d1val4 = q0*x%d1val4
1516 0 : end function max_self_real
1517 :
1518 0 : function max_real_self(z, x) result(unary)
1519 : real(dp), intent(in) :: z
1520 : type(auto_diff_real_4var_order1), intent(in) :: x
1521 : type(auto_diff_real_4var_order1) :: unary
1522 0 : real(dp) :: q0
1523 0 : q0 = Heaviside(x%val - z)
1524 0 : unary%val = Max(x%val, z)
1525 0 : unary%d1val1 = q0*x%d1val1
1526 0 : unary%d1val2 = q0*x%d1val2
1527 0 : unary%d1val3 = q0*x%d1val3
1528 0 : unary%d1val4 = q0*x%d1val4
1529 0 : end function max_real_self
1530 :
1531 0 : function max_self_int(x, y) result(unary)
1532 : type(auto_diff_real_4var_order1), intent(in) :: x
1533 : integer, intent(in) :: y
1534 : type(auto_diff_real_4var_order1) :: unary
1535 0 : real(dp) :: y_dp
1536 0 : real(dp) :: q0
1537 0 : y_dp = y
1538 0 : q0 = Heaviside(x%val - y_dp)
1539 0 : unary%val = Max(x%val, y_dp)
1540 0 : unary%d1val1 = q0*x%d1val1
1541 0 : unary%d1val2 = q0*x%d1val2
1542 0 : unary%d1val3 = q0*x%d1val3
1543 0 : unary%d1val4 = q0*x%d1val4
1544 0 : end function max_self_int
1545 :
1546 0 : function max_int_self(z, x) result(unary)
1547 : integer, intent(in) :: z
1548 : type(auto_diff_real_4var_order1), intent(in) :: x
1549 : type(auto_diff_real_4var_order1) :: unary
1550 0 : real(dp) :: y_dp
1551 0 : real(dp) :: q0
1552 0 : y_dp = z
1553 0 : q0 = Heaviside(x%val - y_dp)
1554 0 : unary%val = Max(x%val, y_dp)
1555 0 : unary%d1val1 = q0*x%d1val1
1556 0 : unary%d1val2 = q0*x%d1val2
1557 0 : unary%d1val3 = q0*x%d1val3
1558 0 : unary%d1val4 = q0*x%d1val4
1559 0 : end function max_int_self
1560 :
1561 0 : function min_self(x, y) result(binary)
1562 : type(auto_diff_real_4var_order1), intent(in) :: x
1563 : type(auto_diff_real_4var_order1), intent(in) :: y
1564 : type(auto_diff_real_4var_order1) :: binary
1565 0 : real(dp) :: q1
1566 0 : real(dp) :: q0
1567 0 : q0 = Heaviside(-x%val + y%val)
1568 0 : q1 = Heaviside(x%val - y%val)
1569 0 : binary%val = Min(x%val, y%val)
1570 0 : binary%d1val1 = q0*x%d1val1 + q1*y%d1val1
1571 0 : binary%d1val2 = q0*x%d1val2 + q1*y%d1val2
1572 0 : binary%d1val3 = q0*x%d1val3 + q1*y%d1val3
1573 0 : binary%d1val4 = q0*x%d1val4 + q1*y%d1val4
1574 0 : end function min_self
1575 :
1576 0 : function min_self_real(x, y) result(unary)
1577 : type(auto_diff_real_4var_order1), intent(in) :: x
1578 : real(dp), intent(in) :: y
1579 : type(auto_diff_real_4var_order1) :: unary
1580 0 : real(dp) :: q0
1581 0 : q0 = Heaviside(-x%val + y)
1582 0 : unary%val = Min(x%val, y)
1583 0 : unary%d1val1 = q0*x%d1val1
1584 0 : unary%d1val2 = q0*x%d1val2
1585 0 : unary%d1val3 = q0*x%d1val3
1586 0 : unary%d1val4 = q0*x%d1val4
1587 0 : end function min_self_real
1588 :
1589 0 : function min_real_self(z, x) result(unary)
1590 : real(dp), intent(in) :: z
1591 : type(auto_diff_real_4var_order1), intent(in) :: x
1592 : type(auto_diff_real_4var_order1) :: unary
1593 0 : real(dp) :: q0
1594 0 : q0 = Heaviside(-x%val + z)
1595 0 : unary%val = Min(x%val, z)
1596 0 : unary%d1val1 = q0*x%d1val1
1597 0 : unary%d1val2 = q0*x%d1val2
1598 0 : unary%d1val3 = q0*x%d1val3
1599 0 : unary%d1val4 = q0*x%d1val4
1600 0 : end function min_real_self
1601 :
1602 0 : function min_self_int(x, y) result(unary)
1603 : type(auto_diff_real_4var_order1), intent(in) :: x
1604 : integer, intent(in) :: y
1605 : type(auto_diff_real_4var_order1) :: unary
1606 0 : real(dp) :: y_dp
1607 0 : real(dp) :: q0
1608 0 : y_dp = y
1609 0 : q0 = Heaviside(-x%val + y_dp)
1610 0 : unary%val = Min(x%val, y_dp)
1611 0 : unary%d1val1 = q0*x%d1val1
1612 0 : unary%d1val2 = q0*x%d1val2
1613 0 : unary%d1val3 = q0*x%d1val3
1614 0 : unary%d1val4 = q0*x%d1val4
1615 0 : end function min_self_int
1616 :
1617 0 : function min_int_self(z, x) result(unary)
1618 : integer, intent(in) :: z
1619 : type(auto_diff_real_4var_order1), intent(in) :: x
1620 : type(auto_diff_real_4var_order1) :: unary
1621 0 : real(dp) :: y_dp
1622 0 : real(dp) :: q0
1623 0 : y_dp = z
1624 0 : q0 = Heaviside(-x%val + y_dp)
1625 0 : unary%val = Min(x%val, y_dp)
1626 0 : unary%d1val1 = q0*x%d1val1
1627 0 : unary%d1val2 = q0*x%d1val2
1628 0 : unary%d1val3 = q0*x%d1val3
1629 0 : unary%d1val4 = q0*x%d1val4
1630 0 : end function min_int_self
1631 :
1632 0 : function dim_self(x, y) result(binary)
1633 : type(auto_diff_real_4var_order1), intent(in) :: x
1634 : type(auto_diff_real_4var_order1), intent(in) :: y
1635 : type(auto_diff_real_4var_order1) :: binary
1636 0 : real(dp) :: q1
1637 : real(dp) :: q0
1638 0 : q0 = x%val - y%val
1639 0 : q1 = 0.5_dp*sgn(q0)
1640 0 : binary%val = -0.5_dp*y%val + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1641 0 : binary%d1val1 = -0.5_dp*y%d1val1 + 0.5_dp*x%d1val1 + q1*(x%d1val1 - y%d1val1)
1642 0 : binary%d1val2 = -0.5_dp*y%d1val2 + 0.5_dp*x%d1val2 + q1*(x%d1val2 - y%d1val2)
1643 0 : binary%d1val3 = -0.5_dp*y%d1val3 + 0.5_dp*x%d1val3 + q1*(x%d1val3 - y%d1val3)
1644 0 : binary%d1val4 = -0.5_dp*y%d1val4 + 0.5_dp*x%d1val4 + q1*(x%d1val4 - y%d1val4)
1645 0 : end function dim_self
1646 :
1647 0 : function dim_self_real(x, y) result(unary)
1648 : type(auto_diff_real_4var_order1), intent(in) :: x
1649 : real(dp), intent(in) :: y
1650 : type(auto_diff_real_4var_order1) :: unary
1651 0 : real(dp) :: q1
1652 : real(dp) :: q0
1653 0 : q0 = x%val - y
1654 0 : q1 = 0.5_dp*sgn(q0) + 0.5_dp
1655 0 : unary%val = -0.5_dp*y + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1656 0 : unary%d1val1 = q1*x%d1val1
1657 0 : unary%d1val2 = q1*x%d1val2
1658 0 : unary%d1val3 = q1*x%d1val3
1659 0 : unary%d1val4 = q1*x%d1val4
1660 0 : end function dim_self_real
1661 :
1662 0 : function dim_real_self(z, x) result(unary)
1663 : real(dp), intent(in) :: z
1664 : type(auto_diff_real_4var_order1), intent(in) :: x
1665 : type(auto_diff_real_4var_order1) :: unary
1666 0 : real(dp) :: q1
1667 : real(dp) :: q0
1668 0 : q0 = x%val - z
1669 0 : q1 = -0.5_dp + 0.5_dp*sgn(q0)
1670 0 : unary%val = -0.5_dp*x%val + 0.5_dp*z + 0.5_dp*Abs(q0)
1671 0 : unary%d1val1 = q1*x%d1val1
1672 0 : unary%d1val2 = q1*x%d1val2
1673 0 : unary%d1val3 = q1*x%d1val3
1674 0 : unary%d1val4 = q1*x%d1val4
1675 0 : end function dim_real_self
1676 :
1677 0 : function dim_self_int(x, y) result(unary)
1678 : type(auto_diff_real_4var_order1), intent(in) :: x
1679 : integer, intent(in) :: y
1680 : type(auto_diff_real_4var_order1) :: unary
1681 0 : real(dp) :: y_dp
1682 0 : real(dp) :: q1
1683 : real(dp) :: q0
1684 0 : y_dp = y
1685 0 : q0 = x%val - y_dp
1686 0 : q1 = 0.5_dp*sgn(q0) + 0.5_dp
1687 0 : unary%val = -0.5_dp*y_dp + 0.5_dp*x%val + 0.5_dp*Abs(q0)
1688 0 : unary%d1val1 = q1*x%d1val1
1689 0 : unary%d1val2 = q1*x%d1val2
1690 0 : unary%d1val3 = q1*x%d1val3
1691 0 : unary%d1val4 = q1*x%d1val4
1692 0 : end function dim_self_int
1693 :
1694 0 : function dim_int_self(z, x) result(unary)
1695 : integer, intent(in) :: z
1696 : type(auto_diff_real_4var_order1), intent(in) :: x
1697 : type(auto_diff_real_4var_order1) :: unary
1698 0 : real(dp) :: y_dp
1699 0 : real(dp) :: q1
1700 : real(dp) :: q0
1701 0 : y_dp = z
1702 0 : q0 = x%val - y_dp
1703 0 : q1 = -0.5_dp + 0.5_dp*sgn(q0)
1704 0 : unary%val = -0.5_dp*x%val + 0.5_dp*y_dp + 0.5_dp*Abs(q0)
1705 0 : unary%d1val1 = q1*x%d1val1
1706 0 : unary%d1val2 = q1*x%d1val2
1707 0 : unary%d1val3 = q1*x%d1val3
1708 0 : unary%d1val4 = q1*x%d1val4
1709 0 : end function dim_int_self
1710 :
1711 0 : function differentiate_auto_diff_real_4var_order1_1(this) result(derivative)
1712 : type(auto_diff_real_4var_order1), intent(in) :: this
1713 : type(auto_diff_real_4var_order1) :: derivative
1714 0 : derivative%val = this%d1val1
1715 0 : derivative%d1val1 = 0.0_dp
1716 0 : derivative%d1val2 = 0.0_dp
1717 0 : derivative%d1val3 = 0.0_dp
1718 0 : derivative%d1val4 = 0.0_dp
1719 0 : end function differentiate_auto_diff_real_4var_order1_1
1720 :
1721 0 : function differentiate_auto_diff_real_4var_order1_2(this) result(derivative)
1722 : type(auto_diff_real_4var_order1), intent(in) :: this
1723 : type(auto_diff_real_4var_order1) :: derivative
1724 0 : derivative%val = this%d1val2
1725 0 : derivative%d1val1 = 0.0_dp
1726 0 : derivative%d1val2 = 0.0_dp
1727 0 : derivative%d1val3 = 0.0_dp
1728 0 : derivative%d1val4 = 0.0_dp
1729 0 : end function differentiate_auto_diff_real_4var_order1_2
1730 :
1731 0 : function differentiate_auto_diff_real_4var_order1_3(this) result(derivative)
1732 : type(auto_diff_real_4var_order1), intent(in) :: this
1733 : type(auto_diff_real_4var_order1) :: derivative
1734 0 : derivative%val = this%d1val3
1735 0 : derivative%d1val1 = 0.0_dp
1736 0 : derivative%d1val2 = 0.0_dp
1737 0 : derivative%d1val3 = 0.0_dp
1738 0 : derivative%d1val4 = 0.0_dp
1739 0 : end function differentiate_auto_diff_real_4var_order1_3
1740 :
1741 0 : function differentiate_auto_diff_real_4var_order1_4(this) result(derivative)
1742 : type(auto_diff_real_4var_order1), intent(in) :: this
1743 : type(auto_diff_real_4var_order1) :: derivative
1744 0 : derivative%val = this%d1val4
1745 0 : derivative%d1val1 = 0.0_dp
1746 0 : derivative%d1val2 = 0.0_dp
1747 0 : derivative%d1val3 = 0.0_dp
1748 0 : derivative%d1val4 = 0.0_dp
1749 0 : end function differentiate_auto_diff_real_4var_order1_4
1750 :
1751 0 : end module auto_diff_real_4var_order1_module
|
