/*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 <math.h>
#include "fcrt.h"
#include "snlafu.h"
#include <stdlib.h>
/* 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 */