/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:40 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include "dcplte.h"
#include <float.h>
#include <stdlib.h>
double /*FUNCTION*/ dcplte(
double em)
{
	long int _l0, j;
	static long int maxt;
	double dcplte_v, emp, s3, s4, u;
	static double fac;
	static double zero = 0.e0;
	static double one = 1.e0;
	static double half = .5e0;
	static long m = 0;
	static double c[3][10]={7.65296060328e-03,3.06623474572e-02,3.17611455247e-02,
	 5.75669984841e-02,4.43152874726e-01,0.0e0,0.0e0,0.0e0,0.0e0,0.0e0,
	 3.25192015506390418e-04,4.30253777479311659e-03,1.17858410087339355e-02,
	 1.18419259955012494e-02,9.03552773754088184e-03,1.17167669446577228e-02,
	 2.18361314054868967e-02,5.68052233293082895e-02,4.43147180583368137e-01,
	 0.0e0,1.4946621757181326771e-04,2.4685033304607227339e-03,8.6384421736040744302e-03,
	 1.0770635039866455473e-02,7.8204040609595541727e-03,7.5950934225594322802e-03,
	 1.1569595745295402175e-02,2.1831811676130481568e-02,5.6805194567559156648e-02,
	 4.4314718056088952648e-01};
	static double d[3][10]={2.12479182845e-03,2.18360211693e-02,5.42605244487e-02,
	 9.35649078307e-02,2.49999202736e-01,0.0e0,0.0e0,0.0e0,0.0e0,0.0e0,
	 7.20316963457154599e-05,1.86453791840633632e-03,1.00879584943751004e-02,
	 2.26603098916041221e-02,3.28110691727210618e-02,4.26725101265917523e-02,
	 5.85927071842652739e-02,9.37499951163670673e-02,2.49999999997461423e-01,
	 0.0e0,3.1859195655501571800e-05,9.8983328462253847867e-04,6.4321465864383017666e-03,
	 1.6804023346363384981e-02,2.6145014700313878932e-02,3.3478943665761626232e-02,
	 4.2717890547383095644e-02,5.8593661255531491732e-02,9.3749999721203140658e-02,
	 2.4999999999990177208e-01};
 
	/* Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
	 * ALL RIGHTS RESERVED.
	 * Based on Government Sponsored Research NAS7-03001.
	 *>> 1998-10-29 DCPLTE Krogh  Moved external statement up for mangle.
	 *>> 1996-03-30 DCPLTE Krogh   Changed MAX to MAXT
	 *>> 1994-10-27 DCPLTE Snyder  Correct missing type declarations
	 *>> 1994-10-20 DCPLTE Krogh  Changes to use M77CON
	 *>> 1994-05-16 DCPLTE Snyder  Make SP and DP codes alike using CHGTYP
	 *>> 1989-06-16 DCPLTE Snyder  Remove implied DO from DATA stmts for CFT
	 *>> 1985-08-02 DCPLTE Lawson  Initial code.
	 *--D replaces "?": ?CPLTE, ?ERM1
	 *
	 *     Complete elliptic integral E(EM). Method given by
	 *     W.J.CODY, Math. of Comp.,Vol.19, (1965), pp. 105-111.
	 *     Data are taken from Cody's table in reverse order.
	 *     We are using N = 5 or 9 for single precision and
	 *     N = 10 for double precision.
	 *
	 *     C.L.LAWSON & STELLA CHAN,JPL,1983 JUNE.
	 *
	 *     ----------------------------------------------------
	 *
	 *     POLY DEGREE     NEGATIVE LOG BASE 10 OF MAX ABS
	 *                     ERROR OF APPROXIMATION
	 *
	 *         N           FOR K           FOR E
	 *         -           -----           -----
	 *         5            9.50            9.44
	 *         9           15.87           15.84
	 *        10           17.45           17.42
	 *
	 *     ----------------------------------------------------
	 * */
 
 
 
 
 
 
	if (m == 0)
	{
		if (DBL_EPSILON/FLT_RADIX < 6.31e-17)
		{
			/*         -LOG10(6.31D-17) = 17.2 */
			m = 3;
			maxt = 10;
		}
		else if (DBL_EPSILON/FLT_RADIX < 6.31e-9)
		{
			/*         -LOG10(6.31D-9) = 8.2 */
			m = 2;
			maxt = 9;
		}
		else
		{
			m = 1;
			maxt = 5;
		}
		fac = one + 2*DBL_EPSILON/FLT_RADIX;
	}
	if (em > one)
	{
		derm1( "DCPLTE", 1, 0, "UNDEFINED FOR EM .GT. ONE", "EM",
		 em, '.' );
		u = zero;
	}
	else if (em < zero)
	{
		derm1( "DCPLTE", 2, 0, "UNDEFINED FOR EM .LT. ZERO", "EM",
		 em, '.' );
		u = zero;
	}
	else
	{
		emp = half + (half - em);
		if (emp == zero)
		{
			u = one;
			goto L_10;
		}
		s3 = emp*c[m - 1][0];
		s4 = emp*d[m - 1][0];
		for (j = 2; j <= maxt; j++)
		{
			s3 = (s3 + c[m - 1][j - 1])*emp;
			s4 = (s4 + d[m - 1][j - 1])*emp;
		}
		u = one + s3 + log( one/emp )*s4;
	}
 
L_10:
	dcplte_v = u*fac;
	return( dcplte_v );
 
} /* end of function */