summaryrefslogtreecommitdiff
path: root/Utilib/src/AFERF.f
blob: 9e929617d21eeb8ae746eb0da714e16992e7ac25 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
*DECK AFERF
      FUNCTION AFERF (XX)
C
C-----------------------------------------------------------------------
C
C ERROR FUNCTION.
C
C-----------------------------------------------------------------------
C
      IMPLICIT NONE
C----
C FUNCTION
C----
      REAL  AFERF
C----
C VARIABLES
C----
      REAL     A0,A1,A2,A3,A4,A5,A6,B0,B1,B2,B3,
     &         B4,B5,B6,B7,D1,D2,X,XX,Z,Y
      INTEGER  IS
C----
      DATA A0 / 0.12837912 /, A1 / -0.37612384 /, A2 / 0.11281417 /
     1 ,   A3 / -0.26782287E-01 /, A4 / 0.50805667E-02 /
     2 ,   A5 / -0.72514300E-03 /, A6 / 0.58167427E-04 /
     3 ,   B0 /  0.39141751E-02 /, B1 / -0.17582889E-01 /
     4 ,   B2 /  0.35873539E-01 /, B3 / -0.42869095E-01 /
     5 ,   B4 /  0.32161925E-01 /, B5 / -0.11846550E-01 /
     6 ,   B6 /  0.30705572E-02 /, B7 /  0.59813837E-02 /
     7 ,   D1,D2 / 1.317, 2.040001 /
C
      X=XX
      IF (X.GE.0.) THEN
         IS=2
      ELSE
         IS=1
         X=-X
      ENDIF
      IF (X.GT.D1) GO TO 8
      Z=X*X
      Y=(((((A6*Z+A5)*Z+A4)*Z+A3)*Z+A2)*Z+A1)*Z+A0
      Y=X*Y+X
      GO TO 6
   8  IF (X.GT.D2) GO TO 10
      X=X-D2
      Y=((((((B7*X+B6)*X+B5)*X+B4)*X+B3)*X+B2)*X+B1)*X+B0
      GO TO 7
  10  Y=1.
      GO TO 6
   7  Y=1.-Y
   6  GO TO (17,18),IS
  17  AFERF=-Y
      GO TO 30
  18  AFERF=Y
  30  RETURN
      END