/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:33:10 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv pf=,p_divdb s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include #include #include "p_divdb.h" /* program DRDIVDB *>> 2009-11-03 DRDIVDB Krogh -- Used option 11 *>> 2001-07-16 DRDIVDB Krogh -- Declared type for paramter TOL. *>> 2001-05-25 DRDIVDB Krogh -- Added comma to format. *>> 1996-06-14 DRDIVDB Krogh Small change in output format *>> 1994-09-12 DRDIVDB Krogh Fixed for CHGTYP. *>> 1993-07-18 DRDIVDB Krogh Fixed to get same output in S.P. and D.P. *>> 1993-05-05 DRDIVDB Krogh Adjusted to simplify conversion to C. *>> 1989-05-04 Fred T. Krogh * *--D replaces "?": DR?IVDB, ?IVA, ?IVADB, ?IVAF, ?IVAO, ?MESS * * Sample driver for DIVA -- Set up to solve two second order equations. * Tests debug output * */ /* PARAMETER translations */ #define IFDIM (16*INEQ + 1) #define INEQ 2 #define IYDIM (4*INEQ) #define NDIG 10 #define TOL (powi(10.e0,-NDIG)) /* end of PARAMETER translations */ int main( ) { long int _i, _r; static long int iopt[7], kord[6]; static double f[IFDIM], y[IYDIM]; static long neq = 2; static int _aini = 1; /* EQUIVALENCE translations */ static double _es0[4]; double *const delt = (double*)((double*)_es0 + 2); double *const h = (double*)((double*)_es0 + 1); double *const t = (double*)_es0; double *const tfinal = (double*)((double*)_es0 + 3); double *const tspecs = (double*)_es0; /* end of EQUIVALENCE translations */ /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const F = &f[0] - 1; long *const Iopt = &iopt[0] - 1; long *const Kord = &kord[0] - 1; double *const Tspecs = &tspecs[0] - 1; double *const Y = &y[0] - 1; /* end of OFFSET VECTORS */ if( _aini ){ /* Do 1 TIME INITIALIZATIONS! */ *t = 0.e0; *h = 1.e0; *delt = 6.283185307179586477e0; *tfinal = 2.e1; Y[1] = 1.e0; Y[2] = 0.e0; Y[3] = 0.e0; Y[4] = 1.e0; Iopt[1] = 16; Iopt[2] = 6; Iopt[3] = 3; Kord[6] = 2; F[3] = TOL; Iopt[4] = 17; Iopt[5] = 2; Iopt[6] = 11; Iopt[7] = 0; _aini = 0; } /*++ Code for SHORT_LINE is inactive * integer MACT(5) *++ END */ /*++S Default NDIG = 4 *++ Default NDIG = 10 *++ Substitute for NDIG below */ /* Parameters for setting up message processor to specify the number of * digits, and the line length. */ /* Set option for error control, local absolute error < 1.D-10. */ /* Group the system to be treated as a single unit, set tolerance value * Set option for second order equations */ /* Set option to initialize some space to 0, and end of options. */ /* Do the integration * */ Kord[1] = 0; L_100: ; diva( tspecs, y, f, kord, neq, divaf, divao, 4, IYDIM, IFDIM, 6, iopt ); if (Kord[1] != 1) goto L_100; /*++ Code for SHORT_LINE is inactive * MACT(1) = MEDDIG * MACT(2) = 7 * MACT(3) = MEMLIN * MACT(4) = 79 * MACT(5) = MERET * call DMESS(MACT, ' ', MACT, F) *++ END */ divadb( 44, tspecs, y, f, kord, " Test of DIVADB" ); exit(0); } /* end of function */ void /*FUNCTION*/ divaf( double *t, double y[], double f[], long *kord) { double tp; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const F = &f[0] - 1; double *const Y = &y[0] - 1; /* end of OFFSET VECTORS */ /* Sample derivative subroutine for use with DIVA * This evaluates derivatives for a simple two body problem. * */ /* Evaluate the derivatives * */ tp = Y[1]*Y[1] + Y[3]*Y[3]; tp = 1.e0/(tp*sqrt( tp )); F[1] = -Y[1]*tp; F[2] = -Y[3]*tp; return; } /* end of function */ void /*FUNCTION*/ divao( double tspecs[], double y[], double f[], long *kord) { /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const F = &f[0] - 1; double *const Tspecs = &tspecs[0] - 1; double *const Y = &y[0] - 1; /* end of OFFSET VECTORS */ /* Sample output subroutine for use with DIVA. * This subroutine gives output for a simple two body problem. * */ /* Do the output * */ if (*kord == 1) { printf(" RESULTS FOR A SIMPLE 2-BODY PROBLEM\n\n T U/V UP/VP UPP/VPP\n"); } printf("%15.6e%15.6e%15.6e%15.6e\n %15.6e%15.6e%15.6e\n \n", Tspecs[1], Y[1], Y[2], F[1], Y[3], Y[4], F[2]); return; } /* end of function */