1 |
module tanh_cautious_m |
2 |
|
3 |
implicit none |
4 |
|
5 |
contains |
6 |
|
7 |
elemental double precision function tanh_cautious(fa, fb) |
8 |
|
9 |
! Compute tanh(fa / fb) with caution. |
10 |
|
11 |
double precision, intent(in):: fa, fb |
12 |
|
13 |
!------------------------------------------------------------- |
14 |
|
15 |
IF (200d0 * fb < - fa) THEN |
16 |
tanh_cautious = - 1d0 |
17 |
ELSE IF (200d0 * fb < fa) THEN |
18 |
tanh_cautious = 1d0 |
19 |
ELSE |
20 |
IF (ABS(fa) < 1d-13 .AND. ABS(fb) < 1d-13) THEN |
21 |
IF (200d0 * fb + fa < 1d-10) THEN |
22 |
tanh_cautious = - 1d0 |
23 |
ELSE IF (200d0 * fb - fa < 1d-10) THEN |
24 |
tanh_cautious = 1d0 |
25 |
END IF |
26 |
ELSE |
27 |
tanh_cautious = TANH(fa / fb) |
28 |
END IF |
29 |
END IF |
30 |
|
31 |
end function tanh_cautious |
32 |
|
33 |
end module tanh_cautious_m |