/*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 #include "fcrt.h" #include "dcospx.h" #include #include /* PARAMETER translations */ #define CUTOFF 0.2e-14 #define PI 3.141592653589793238462643383279502884197e00 /* end of PARAMETER translations */ double /*FUNCTION*/ dcospx( double x) { long int _l0, n; double a, dcospx_v, t, w; static double big; static double eps = -1.0e0; static double sa0 = .314159265358979e01; static double sa1 = -.516771278004995e01; static double sa2 = .255016403987327e01; static double sa3 = -.599264528932149e00; static double sa4 = .821458689493251e-01; static double sa5 = -.737001831310553e-02; static double sa6 = .461514425296398e-03; static double sb1 = -.493480220054460e01; static double sb2 = .405871212639605e01; static double sb3 = -.133526276691575e01; static double sb4 = .235330543508553e00; static double sb5 = -.258048861575714e-01; static double sb6 = .190653140279462e-02; static double a1 = -.1028083791780141522795259479153765743002e00; static double a2 = .3170868848763100170457042079710451905600e-02; static double a3 = -.4657026956105571623449026167864697920000e-04; static double a4 = .3989844942879455643410226655783424000000e-06; static double a5 = -.2237397227721999776371894030796800000000e-08; static double a6 = .8847045483056962709715066675200000000000e-11; static double a7 = -.2598715447506450292885585920000000000000e-13; static double a8 = .5893449774331011070033920000000000000000e-16; static double a9 = -.1062975472045522550784000000000000000000e-18; static double a10 = .1561182648301780992000000000000000000000e-21; static double a11 = -.1903193516670976000000000000000000000000e-24; static double a12 = .1956617650176000000000000000000000000000e-27; static double a13 = -.1711276032000000000000000000000000000000e-30; static double b1 = -.3084251375340424568385778437461297229882e00; static double b2 = .1585434424381550085228521039855226435920e-01; static double b3 = -.3259918869273900136414318317506279360000e-03; static double b4 = .3590860448591510079069203991239232000000e-05; static double b5 = -.2461136950494199754009084061808640000000e-07; static double b6 = .1150115912797405152263195572224000000000e-09; static double b7 = -.3898073171259675439899172864000000000000e-12; static double b8 = .1001886461636271969091584000000000000000e-14; static double b9 = -.2019653396886572027084800000000000000000e-17; static double b10 = .3278483561466560512000000000000000000000e-20; static double b11 = -.4377345082051788800000000000000000000000e-23; static double b12 = .4891532381388800000000000000000000000000e-26; static double b13 = -.4617089843200000000000000000000000000000e-29; /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1996-03-30 DCOSPX Krogh Added external statement. *>> 1996-01-29 DCOSPX WVS JPL Add better acknowledgement for origins. *>> 1994-10-20 DCOSPX Krogh Changes to use M77CON *>> 1994-04-22 DCOSPX CLL Made SP and DP codes similar. *>> 1993-05-06 DCOSPX WVS JPL Convert from NSWC to Math 77 * ---------------------------------------------------------------------- * This procedure was originally procedure COS1 from the Naval Surface * Warfare Center library. * ---------------------------------------------------------------------- * * EVALUATION OF COS(PI*X) * * -------------- * * THE EXPANSION FOR SIN(PI*A) (ABS(A) .LE. 1/4) USING A1,...,A13 * IS ACCURATE TO WITHIN 2 UNITS OF THE 40-TH SIGNIFICANT DIGIT, AND * THE EXPANSION FOR COS(PI*A) (ABS(A) .LE. 1/4) USING B1,...,B13 * IS ACCURATE TO WITHIN 4 UNITS OF THE 40-TH SIGNIFICANT DIGIT. * * The polynomials using coefficients SA0, ... SA6 and SB1, ..., SB6 * give approximations whose largest observed relative error in the * relevant intervals is 0.129d-14. * We will use this latter approximation when the machine epsilon * is larger than 0.2d-14. * ---------------------------------------------------------------------- *--D replaces "?": ?COSPX, ?ERM1 * ---------------------------------------------------------------------- */ /* ----------------------- */ /* ----------------------- */ /* ----------------------- */ /* ----------------------- * */ if (eps < 0.0e0) { eps = DBL_EPSILON/FLT_RADIX; big = 1.0e0/eps; } /* ----------------------- */ a = fabs( x ); if (a >= big) { derm1( "DCOSPX", 1, 2, "No precision because ABS(X) is too large" , "X", x, '.' ); dcospx_v = 1.0e0; return( dcospx_v ); } n = a; t = n; a -= t; if (a > 0.75e0) goto L_20; if (a < 0.25e0) goto L_21; /* 0.25 .LE. A .LE. 0.75 * */ a = 0.25e0 + (0.25e0 - a); if (eps < CUTOFF) { t = 16.e0*a*a; w = (((((((((((((a13*t + a12)*t + a11)*t + a10)*t + a9)*t + a8)*t + a7)*t + a6)*t + a5)*t + a4)*t + a3)*t + a2)*t + a1)* t + 0.5e0) + 0.5e0; dcospx_v = PI*a*w; } else { t = a*a; dcospx_v = ((((((sa6*t + sa5)*t + sa4)*t + sa3)*t + sa2)*t + sa1)*t + sa0)*a; } goto L_30; /* A .LT. 0.25 OR A .GT. 0.75 * */ L_20: a = 0.25e0 + (0.75e0 - a); n -= 1; L_21: ; if (eps < CUTOFF) { t = 16.e0*a*a; dcospx_v = (((((((((((((b13*t + b12)*t + b11)*t + b10)*t + b9)*t + b8)*t + b7)*t + b6)*t + b5)*t + b4)*t + b3)*t + b2)* t + b1)*t + 0.5e0) + 0.5e0; } else { t = a*a; dcospx_v = ((((((sb6*t + sb5)*t + sb4)*t + sb3)*t + sb2)*t + sb1)*t + 0.5e0) + 0.5e0; } /* TERMINATION * */ L_30: ; if ((n%2) != 0) dcospx_v = -dcospx_v; return( dcospx_v ); } /* end of function */