/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:33:15 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv pf=,p_sckder s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include #include #include "p_sckder.h" #include "drsckder.h" /* program DrSCKDER *>> 2007-01/02 DRSCKDER Krogh Put commas around ':' in formats. *>> 1996-06-28 DrSCKDER Krogh Format changes for conversion to C. *>> 1994-11-02 DrSCKDER Krogh Changes to use M77CON *>> 1992-04-15 DrSCKDER CLL *>> 1992-01-13 C. L. Lawson, JPL. * DRSCKDER.. Demo driver for SCKDER. Checks derivative calculation. * ------------------------------------------------------------------ *--S replaces "?": Dr?CKDER, ?CKDER, ?TRG11 * ------------------------------------------------------------------ */ /* PARAMETER translations */ #define LDFJAC 5 #define NMAX 5 /* end of PARAMETER translations */ int main( ) { long int i, imax, j, jmax, mode; float fjac[NMAX][LDFJAC], fvec[15], test[NMAX][LDFJAC], tstmax; static long m = LDFJAC; static long n = NMAX; static float x[NMAX]={0.13e0,0.14e0,0.15e0,0.16e0,0.17e0}; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *const Fvec = &fvec[0] - 1; float *const X = &x[0] - 1; /* end of OFFSET VECTORS */ /* ------------------------------------------------------------------ */ printf("Program DrSCKDER.. Demo driver for SCKDER.\n"); strg11( n, x, fvec, (float*)fjac, 2 ); mode = 1; L_10: ; sckder( &mode, m, n, x, fvec, (float*)fjac, LDFJAC, (float*)test, &imax, &jmax, &tstmax ); if (mode == 2) { strg11( n, x, fvec, (float*)fjac, 1 ); goto L_10; } strg11( n, x, fvec, (float*)fjac, 1 ); printf("\n X(J) ="); for (j = 1; j <= n; j++) { printf("%11.3g", X[j]); } printf("\n"); printf("\n I FVEC(I) .....................FJAC(I,J)........................\n\n"); for (i = 1; i <= m; i++) { printf(" %3ld %11.3g", i, Fvec[i]); printf(" "); for (j = 1; j <= n; j++) { printf("%11.3g", fjac[j - 1][i - 1]); } printf("\n"); } printf("\n TEST(,):\n\n"); for (i = 1; i <= m; i++) { printf(" %3ld", i); printf(" "); for (j = 1; j <= n; j++) { printf("%11.3g", test[j - 1][i - 1]); } printf("\n"); } printf("\n IMAX =%3ld, JMAX =%3ld, TSTMAX =%11.3g\n", imax, jmax, tstmax); exit(0); } /* end of function */ /* ================================================================== */ void /*FUNCTION*/ strg11( long n, float x[], float fvec[], float *fjac, long iflag) { #define FJAC(I_,J_) (*(fjac+(I_)*(n)+(J_))) long int i, j; float sum, temp; /* OFFSET Vectors w/subscript range: 1 to dimension */ float *const Fvec = &fvec[0] - 1; float *const X = &x[0] - 1; /* end of OFFSET VECTORS */ /* Trigonometric test case No. 11 from MINPACK test set developed by * J. J. More', B. S. Garbow, and K. E. Hillstrom, Argonne National * Laboratories, 1980. * ------------------------------------------------------------------ */ /* ------------------------------------------------------------------ */ if (iflag == 1) { /* Compute function vector. */ sum = 0.0e0; for (j = 1; j <= n; j++) { Fvec[j] = cosf( X[j] ); sum += Fvec[j]; } for (j = 1; j <= n; j++) { Fvec[j] = (float)( n + j ) - sinf( X[j] ) - sum - (float)( j )* Fvec[j]; } } else if (iflag == 2) { /* Compute Jacobian matrix. */ for (j = 1; j <= n; j++) { temp = sinf( X[j] ); for (i = 1; i <= n; i++) { FJAC(j - 1,i - 1) = temp; } FJAC(j - 1,j - 1) = (float)( j + 1 )*temp - cosf( X[j] ); } } return; #undef FJAC } /* end of function */