OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
kepler.f
Go to the documentation of this file.
1  SUBROUTINE kepler(AM,E,EA,SE,CE)
2 C VERSION OF 1/27/87
3 C PURPOSE
4 C SOLVES KEPLER EQUATION
5 C INPUT
6 C AM = MEAN ANOMALY (RAD)
7 C E = ECCENTRICITY
8 C OUTPUT
9 C EA = ECCENTRIC ANOMALY (RAD)
10 C SE = SIN(EA)
11 C CE = COS(EA)
12 C CALL SUBROUTINES
13 C NONE
14 C REFERENCES
15 C JPL EM 312/87-153, 20 APRIL 1987
16 C JPL IOM 312/79.4-426, FINAL REPORT JPL CONTRACT #955140
17 C AND USER'S GUIDE FOR MULCON, 1 JAN 79.
18 C ANALYSIS
19 C J. H. KWOK - JPL
20 C PROGRAMMER
21 C J. H. KWOK - JPL
22 C PROGRAM MODIFICATION
23 C NONE
24 C COMMENTS
25 C THIS PROGRAM IS A STRIPED VERSION OF THE ORGINAL VERSION FOR
26 C MULCON. THIS VERSION DOES NOT WORK FOR HYPERBOLIC CASES.
27 C THE TOLERANCES ARE SET FOR DOUBLE PRECISION. CHANGE TOL1 AND
28 C TOL2 FOR OTHER PRECISION. SEE REFERENCE 2 FOR ALGORITHM
29 C EXPLANATION. TOL1 SHOULD BE SET TO 1/3 OF MACHINE PRECISION.
30 C TOL2 SHOULD BE SET TO 1/2 OF MACHINE PRECISION. FOR EXAMPLE,
31 C TOL1=1.D-6 AND TOL2=1.D-9 FOR 18 DIGIT MACHINE PRECISION.
32 C
33  IMPLICIT DOUBLE PRECISION (a-h,o-z)
34  DATA tol1,tol2/1.d-5,1.d-8/
35  DATA half,zero,one/0.5d0,0.d0,1.d0/
36  DATA pi,tpi/3.141592653589793d0,6.283185307179586d0/
37  k=0
38  10 CONTINUE
39  abm=dabs(am)
40  IF (abm.LE.pi) GO TO 20
41  IF (am.GT.pi) am=am-tpi
42  IF (am.LT.-pi) am=am+tpi
43  GO TO 10
44  20 sm=dsin(abm)
45  ea=abm+e*sm/(one-dsin(abm+e)+sm)
46  30 se=dsin(ea)
47  ce=dcos(ea)
48  k=k+1
49  IF (k.GT.10) stop
50  50 ese=e*se
51  f=abm+ese-ea
52  d=one-e*ce
53  c=f/(d+half*f*ese/d)
54  ea=ea+c
55  IF (dabs(c).GT.tol1) GO TO 30
56  IF (dabs(c).LT.tol2) GO TO 40
57  a=one-half*c*c
58  sen=a*se+c*ce
59  cen=a*ce-c*se
60  se=sen
61  ce=cen
62  GO TO 50
63  40 sen=se+c*ce
64  cen=ce-c*se
65  se=sen
66  ce=cen
67  IF (am.GT.zero) RETURN
68  se=-se
69  ea=-ea
70  RETURN
71  END
subroutine kepler(AM, E, EA, SE, CE)
Definition: kepler.f:2
#define pi
Definition: vincenty.c:23
#define f
Definition: l1_czcs_hdf.c:702