/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:16 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "dnlafu.h" #include /* PARAMETER translations */ #define COVREQ 15 #define D 27 #define DINIT 38 #define DLTFDJ 43 #define J 70 #define MODE 35 #define NEXTV 47 #define NFCALL 6 #define NFGCAL 7 #define NGCALL 30 #define NGCOV 53 #define R 61 #define REGD 67 #define REGD0 82 #define TOOBIG 2 #define VNEED 4 /* end of PARAMETER translations */ void /*FUNCTION*/ dnlafu( long n, long p, double x[], void (*dcalcr)(long,long,double[],long*,double[]), long iv[], long liv, long lv, double v[]) { long int d1, dk, dr1, i, iv1, j1k, k, n1, n2, nf, ng, r1, rd1, rn; double h, h0, xk; static double hlim = 0.1e0; static double negpt5 = -0.5e0; static double one = 1.e0; static double zero = 0.e0; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const Iv = &iv[0] - 1; double *const V = &v[0] - 1; double *const X = &x[0] - 1; /* end of OFFSET VECTORS */ /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1996-04-27 DNLAFU Krogh Changes to get desired C prototypes. *>> 1994-10-20 DNLAFU Krogh Changes to use M77CON *>> 1990-06-29 DNLAFU C. L. Lawson, JPL *>> 1990-01-31 C. L. Lawson, JPL * * *** MINIMIZE A NONLINEAR SUM OF SQUARES USING RESIDUAL VALUES ONLY. * *** THIS AMOUNTS TO DNLAGU WITHOUT THE SUBROUTINE PARAMETER DCALCJ. * * *** PARAMETERS *** * */ /* ---------------------------- DISCUSSION ---------------------------- * * THIS AMOUNTS TO SUBROUTINE NL2SNO (REF. 1) MODIFIED TO CALL * DRN2G. * THE PARAMETERS FOR DNLAFU ARE THE SAME AS THOSE FOR DNLAGU * (WHICH SEE), EXCEPT THAT DCALCJ IS OMITTED. INSTEAD OF CALLING * DCALCJ TO OBTAIN THE JACOBIAN MATRIX OF R AT X, DNLAFU COMPUTES * AN APPROXIMATION TO IT BY FINITE (FORWARD) DIFFERENCES -- SEE * V(DLTFDJ) BELOW. DNLAFU USES FUNCTION VALUES ONLY WHEN COMPUT- * THE COVARIANCE MATRIX (RATHER THAN THE FUNCTIONS AND GRADIENTS * THAT DNLAGU MAY USE). TO DO SO, DNLAFU SETS IV(COVREQ) TO MINUS * ITS ABSOLUTE VALUE. THUS V(DELTA0) IS NEVER REFERENCED AND ONLY * V(DLTFDC) MATTERS -- SEE NL2SOL FOR A DESCRIPTION OF V(DLTFDC). * THE NUMBER OF EXTRA CALLS ON DCALCR USED IN COMPUTING THE JACO- * BIAN APPROXIMATION ARE NOT INCLUDED IN THE FUNCTION EVALUATION * COUNT IV(NFCALL), BUT ARE RECORDED IN IV(NGCALL) INSTEAD. * * V(DLTFDJ)... V(43) HELPS CHOOSE THE STEP SIZE USED WHEN COMPUTING THE * FINITE-DIFFERENCE JACOBIAN MATRIX. FOR DIFFERENCES IN- * VOLVING X(I), THE STEP SIZE FIRST TRIED IS * V(DLTFDJ) * MAX(ABS(X(I)), 1/D(I)), * WHERE D IS THE CURRENT SCALE VECTOR (SEE REF. 1). (IF * THIS STEP IS TOO BIG, I.E., IF DCALCR SETS NF TO 0, THEN * SMALLER STEPS ARE TRIED UNTIL THE STEP SIZE IS SHRUNK BE- * LOW 1000 * MACHEP, WHERE MACHEP IS THE UNIT ROUNDOFF. * DEFAULT = MACHEP**0.5. * * *** REFERENCE *** * * 1. DENNIS, J.E., GAY, D.M., AND WELSCH, R.E. (1981), AN ADAPTIVE * NONLINEAR LEAST-SQUARES ALGORITHM, ACM TRANS. MATH. * SOFTWARE, VOL. 7, NO. 3. * * *** GENERAL *** * * CODED BY DAVID M. GAY. * * ++++++++++++++++++++++++++ DECLARATIONS +++++++++++++++++++++++++++ * * *** EXTERNAL SUBROUTINES *** * */ /*--D replaces "?": ?NLAFU, ?NLAGU, ?RN2G, ?IVSET, ?N2RDP, ?V7SCP *--& ?CALCR, ?CALCJ * * DIVSET.... PROVIDES DEFAULT IV AND V INPUT COMPONENTS. * DRN2G... CARRIES OUT OPTIMIZATION ITERATIONS. * DN2RDP... PRINTS REGRESSION DIAGNOSTICS. * DV7SCP... SETS ALL COMPONENTS OF A VECTOR TO A SCALAR. * * *** LOCAL VARIABLES *** * */ /* *** IV AND V COMPONENTS *** * */ /*/6 * DATA COVREQ/15/, D/27/, DINIT/38/, DLTFDJ/43/, J/70/, MODE/35/, * 1 NEXTV/47/, NFCALL/6/, NFGCAL/7/, NGCALL/30/, NGCOV/53/, * 2 R/61/, REGD/67/, REGD0/82/, TOOBIG/2/, VNEED/4/ * /7 */ /*/ */ /* -------------------------------- BODY ------------------------------ * */ if (Iv[1] == 0) divset( 1, iv, liv, lv, v ); Iv[COVREQ] = -labs( Iv[COVREQ] ); iv1 = Iv[1]; if (iv1 == 14) goto L_10; if (iv1 > 2 && iv1 < 12) goto L_10; if (iv1 == 12) Iv[1] = 13; if (Iv[1] == 13) Iv[VNEED] += p + n*(p + 2); drn2g( x, v, iv, liv, lv, n, n, &n1, &n2, p, v, v, v, x ); if (Iv[1] != 14) goto L_999; /* *** STORAGE ALLOCATION *** * */ Iv[D] = Iv[NEXTV]; Iv[R] = Iv[D] + p; Iv[REGD0] = Iv[R] + n; Iv[J] = Iv[REGD0] + n; Iv[NEXTV] = Iv[J] + n*p; if (iv1 == 13) goto L_999; L_10: d1 = Iv[D]; dr1 = Iv[J]; r1 = Iv[R]; rn = r1 + n - 1; rd1 = Iv[REGD0]; L_20: drn2g( &V[d1], &V[dr1], iv, liv, lv, n, n, &n1, &n2, p, &V[r1], &V[rd1], v, x ); switch (IARITHIF(Iv[1] - 2)) { case -1: goto L_30; case 0: goto L_50; case 1: goto L_100; } /* *** NEW FUNCTION VALUE (R VALUE) NEEDED *** * */ L_30: nf = Iv[NFCALL]; (*dcalcr)( n, p, x, &nf, &V[r1] ); if (nf > 0) goto L_40; /* CALL DCALCR(N, P, X, NF, V(R1)) */ Iv[TOOBIG] = 1; goto L_20; L_40: if (Iv[1] > 0) goto L_20; /* *** COMPUTE FINITE-DIFFERENCE APPROXIMATION TO DR = GRAD. OF R *** * * *** INITIALIZE D IF NECESSARY *** * */ L_50: if (Iv[MODE] < 0 && V[DINIT] == zero) dv7scp( p, &V[d1], one ); j1k = dr1; dk = d1; ng = Iv[NGCALL] - 1; if (Iv[1] == (-1)) Iv[NGCOV] -= 1; for (k = 1; k <= p; k++) { xk = X[k]; h = V[DLTFDJ]*fmax( fabs( xk ), one/V[dk] ); h0 = h; dk += 1; L_60: X[k] = xk + h; nf = Iv[NFGCAL]; (*dcalcr)( n, p, x, &nf, &V[j1k] ); ng += 1; /* CALL DCALCR (N, P, X, NF, V(J1K)) */ if (nf > 0) goto L_70; h *= negpt5; if (fabs( h/h0 ) >= hlim) goto L_60; Iv[TOOBIG] = 1; Iv[NGCALL] = ng; goto L_20; L_70: X[k] = xk; Iv[NGCALL] = ng; for (i = r1; i <= rn; i++) { V[j1k] = (V[j1k] - V[i])/h; j1k += 1; } } goto L_20; L_100: if (Iv[REGD] > 0) Iv[REGD] = rd1; dn2rdp( iv, liv, n, &V[rd1] ); L_999: return; /* *** LAST LINE OF DNLAFU FOLLOWS *** */ } /* end of function */