/*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 "dnlafb.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 REGD0 82 #define TOOBIG 2 #define VNEED 4 /* end of PARAMETER translations */ void /*FUNCTION*/ dnlafb( long n, long p, double x[], double b[][2], 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, t, xk, xk1; 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. *>> 2000-12-01 DNLAFB Krogh Removed unused parameter REGD. *>> 1996-04-27 DNLAFB Krogh Changes to get desired C prototypes. *>> 1994-10-20 DNLAFB Krogh Changes to use M77CON *>> 1990-06-29 DNLAFB CLL @ JPL *>> 1990-06-12 CLL @ JPL *>> 1990-02-16 CLL @ JPL *** from netlib, Wed Feb 7 13:51:26 EST 1990 *** * * *** MINIMIZE A NONLINEAR SUM OF SQUARES USING RESIDUAL VALUES ONLY. * *** This VERSION HANDLES SIMPLE BOUNDS ON X *** * * *** PARAMETERS *** * */ /* ---------------------------- DISCUSSION ---------------------------- * * THIS AMOUNTS TO SUBROUTINE NL2SNO (REF. 1) MODIFIED TO HANDLE * SIMPLE BOUNDS ON THE VARIABLES... * B(1,I) .LE. X(I) .LE. B(2,I), I = 1(1)P. * THE PARAMETERS FOR DNLAFB ARE THE SAME AS THOSE FOR DNLAGB * (WHICH SEE), EXCEPT THAT DCALCJ IS OMITTED. INSTEAD OF CALLING * DCALCJ TO OBTAIN THE JACOBIAN MATRIX OF R AT X, DNLAFB COMPUTES * AN APPROXIMATION TO IT BY FINITE (FORWARD) DIFFERENCES -- SEE * V(DLTFDJ) BELOW. DNLAFB DOES NOT COMPUTE A COVARIANCE MATRIX. * 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 "?": ?NLAFB, ?IVSET, ?RN2GB, ?V7SCP, ?CALCR * * DIVSET.... PROVIDES DEFAULT IV AND V INPUT COMPONENTS. * DRN2GB... CARRIES OUT OPTIMIZATION ITERATIONS. * DV7SCP... SETS ALL ELEMENTS OF A VECTOR TO A SCALAR. * * *** LOCAL VARIABLES *** * */ /* *** IV AND V COMPONENTS *** * */ /* -------------------------------- BODY ------------------------------ * */ if (Iv[1] == 0) divset( 1, iv, liv, lv, v ); Iv[COVREQ] = 0; 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); drn2gb( b, 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: drn2gb( b, &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_999; } /* *** 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++) { if (b[k - 1][0] >= b[k - 1][1]) goto L_110; xk = X[k]; h = V[DLTFDJ]*fmax( fabs( xk ), one/V[dk] ); h0 = h; dk += 1; t = negpt5; xk1 = xk + h; if (xk - h >= b[k - 1][0]) goto L_60; t = -t; if (xk1 > b[k - 1][1]) goto L_80; L_60: if (xk1 <= b[k - 1][1]) goto L_70; t = -t; h = -h; xk1 = xk + h; if (xk1 < b[k - 1][0]) goto L_80; L_70: X[k] = xk1; 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_90; h *= t; xk1 = xk + h; if (fabs( h/h0 ) >= hlim) goto L_70; L_80: Iv[TOOBIG] = 1; Iv[NGCALL] = ng; goto L_20; L_90: X[k] = xk; Iv[NGCALL] = ng; for (i = r1; i <= rn; i++) { V[j1k] = (V[j1k] - V[i])/h; j1k += 1; } goto L_120; /* *** SUPPLY A ZERO DERIVATIVE FOR CONSTANT COMPONENTS... */ L_110: dv7scp( n, &V[j1k], zero ); j1k += n; L_120: ; } goto L_20; L_999: return; /* *** LAST CARD OF DNLAFB FOLLOWS *** */ } /* end of function */