/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:21 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "snlafu.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*/ snlafu( long n, long p, float x[], void (*scalcr)(long,long,float[],long*,float[]), long iv[], long liv, long lv, float v[]) { long int d1, dk, dr1, i, iv1, j1k, k, n1, n2, nf, ng, r1, rd1, rn; float h, h0, xk; static float hlim = 0.1e0; static float negpt5 = -0.5e0; static float one = 1.e0; static float zero = 0.e0; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const Iv = &iv[0] - 1; float *const V = &v[0] - 1; float *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 SNLAFU Krogh Changes to get desired C prototypes. *>> 1994-10-20 SNLAFU Krogh Changes to use M77CON *>> 1990-06-29 SNLAFU C. L. Lawson, JPL *>> 1990-01-31 C. L. Lawson, JPL * * *** MINIMIZE A NONLINEAR SUM OF SQUARES USING RESIDUAL VALUES ONLY. * *** THIS AMOUNTS TO SNLAGU WITHOUT THE SUBROUTINE PARAMETER SCALCJ. * * *** PARAMETERS *** * */ /* ---------------------------- DISCUSSION ---------------------------- * * THIS AMOUNTS TO SUBROUTINE NL2SNO (REF. 1) MODIFIED TO CALL * SRN2G. * THE PARAMETERS FOR SNLAFU ARE THE SAME AS THOSE FOR SNLAGU * (WHICH SEE), EXCEPT THAT SCALCJ IS OMITTED. INSTEAD OF CALLING * SCALCJ TO OBTAIN THE JACOBIAN MATRIX OF R AT X, SNLAFU COMPUTES * AN APPROXIMATION TO IT BY FINITE (FORWARD) DIFFERENCES -- SEE * V(DLTFDJ) BELOW. SNLAFU USES FUNCTION VALUES ONLY WHEN COMPUT- * THE COVARIANCE MATRIX (RATHER THAN THE FUNCTIONS AND GRADIENTS * THAT SNLAGU MAY USE). TO DO SO, SNLAFU 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 SCALCR 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 SCALCR 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 *** * */ /*--S replaces "?": ?NLAFU, ?NLAGU, ?RN2G, ?IVSET, ?N2RDP, ?V7SCP *--& ?CALCR, ?CALCJ * * SIVSET.... PROVIDES DEFAULT IV AND V INPUT COMPONENTS. * SRN2G... CARRIES OUT OPTIMIZATION ITERATIONS. * SN2RDP... PRINTS REGRESSION DIAGNOSTICS. * SV7SCP... 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) sivset( 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); srn2g( 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: srn2g( &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]; (*scalcr)( n, p, x, &nf, &V[r1] ); if (nf > 0) goto L_40; /* CALL SCALCR(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) sv7scp( 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]*fmaxf( fabsf( xk ), one/V[dk] ); h0 = h; dk += 1; L_60: X[k] = xk + h; nf = Iv[NFGCAL]; (*scalcr)( n, p, x, &nf, &V[j1k] ); ng += 1; /* CALL SCALCR (N, P, X, NF, V(J1K)) */ if (nf > 0) goto L_70; h *= negpt5; if (fabsf( 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; sn2rdp( iv, liv, n, &V[rd1] ); L_999: return; /* *** LAST LINE OF SNLAFU FOLLOWS *** */ } /* end of function */