/*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 "snlafb.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 REGD0 82
#define TOOBIG 2
#define VNEED 4
/* end of PARAMETER translations */
void /*FUNCTION*/ snlafb(
long n,
long p,
float x[],
float b[][2],
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, t, xk, xk1;
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.
*>> 2000-12-01 SNLAFB Krogh Removed unused parameter REGD.
*>> 1996-04-27 SNLAFB Krogh Changes to get desired C prototypes.
*>> 1994-10-20 SNLAFB Krogh Changes to use M77CON
*>> 1990-06-29 SNLAFB 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 SNLAFB 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, SNLAFB COMPUTES
* AN APPROXIMATION TO IT BY FINITE (FORWARD) DIFFERENCES -- SEE
* V(DLTFDJ) BELOW. SNLAFB DOES NOT COMPUTE A COVARIANCE MATRIX.
* 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 "?": ?NLAFB, ?IVSET, ?RN2GB, ?V7SCP, ?CALCR
*
* SIVSET.... PROVIDES DEFAULT IV AND V INPUT COMPONENTS.
* SRN2GB... CARRIES OUT OPTIMIZATION ITERATIONS.
* SV7SCP... SETS ALL ELEMENTS OF A VECTOR TO A SCALAR.
*
* *** LOCAL VARIABLES ***
* */
/* *** IV AND V COMPONENTS ***
* */
/* -------------------------------- BODY ------------------------------
* */
if (Iv[1] == 0)
sivset( 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);
srn2gb( 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:
srn2gb( 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];
(*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++)
{
if (b[k - 1][0] >= b[k - 1][1])
goto L_110;
xk = X[k];
h = V[DLTFDJ]*fmaxf( fabsf( 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];
(*scalcr)( n, p, x, &nf, &V[j1k] );
ng += 1;
/* CALL SCALCR (N, P, X, NF, V(J1K)) */
if (nf > 0)
goto L_90;
h *= t;
xk1 = xk + h;
if (fabsf( 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:
sv7scp( n, &V[j1k], zero );
j1k += n;
L_120:
;
}
goto L_20;
L_999:
return;
/* *** LAST CARD OF SNLAFB FOLLOWS *** */
} /* end of function */