File: tlmder1.c

package info (click to toggle)
minpack 19961126-13
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 2,676 kB
  • ctags: 643
  • sloc: sh: 8,051; fortran: 2,400; ansic: 736; makefile: 137; awk: 13
file content (85 lines) | stat: -rw-r--r-- 1,925 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
/*      driver for lmder1 example. */


#include <stdio.h>
#include <math.h>
#include <minpack.h>

void fcn(int *m, int *n, double *x, double *fvec, double *fjac, 
	 int *ldfjac, int *iflag);

int main()
{
  int j, m, n, ldfjac, info, lwa;
  int ipvt[3];
  double tol, fnorm;
  double x[3], fvec[15], fjac[15*3], wa[30];
  int one=1;

  m = 15;
  n = 3;

/*      the following starting values provide a rough fit. */

  x[1-1] = 1.;
  x[2-1] = 1.;
  x[3-1] = 1.;

  ldfjac = 15;
  lwa = 30;

/*      set tol to the square root of the machine precision. */
/*      unless high solutions are required, */
/*      this is the recommended setting. */

  tol = sqrt(dpmpar_(&one));

  lmder1_(&fcn, &m, &n, x, fvec, fjac, &ldfjac, &tol, 
	  &info, ipvt, wa, &lwa);
  fnorm = enorm_(&m, fvec);
  printf("      final l2 norm of the residuals%15.7g\n\n", fnorm);
  printf("      exit parameter                %10i\n\n", info);
  printf("      final approximate solution\n");
  for (j=1; j<=n; j++) printf("%s%15.7g", j%3==1?"\n     ":"", x[j-1]);
  printf("\n");

  return 0;
}

void fcn(int *m, int *n, double *x, double *fvec, double *fjac, 
	 int *ldfjac, int *iflag)
{

/*      subroutine fcn for lmder1 example. */

  int i;
  double tmp1, tmp2, tmp3, tmp4;
  double y[15] = {1.4e-1, 1.8e-1, 2.2e-1, 2.5e-1, 2.9e-1, 3.2e-1, 3.5e-1,
		  3.9e-1, 3.7e-1, 5.8e-1, 7.3e-1, 9.6e-1, 1.34, 2.1, 4.39};

  if (*iflag != 2)
    {
      for (i = 1; i <= 15; i++)
	{
	  tmp1 = i;
	  tmp2 = 16 - i;
	  tmp3 = tmp1;
	  if (i > 8) tmp3 = tmp2;
	  fvec[i-1] = y[i-1] - (x[1-1] + tmp1/(x[2-1]*tmp2 + x[3-1]*tmp3));
	}
    }
  else
    {
      for ( i = 1; i <= 15; i++)
	{
	  tmp1 = i;
	  tmp2 = 16 - i;
	  tmp3 = tmp1;
	  if (i > 8) tmp3 = tmp2;
	  tmp4 = (x[2-1]*tmp2 + x[3-1]*tmp3); tmp4 = tmp4*tmp4;
	  fjac[i-1 + *ldfjac*(1-1)] = -1.;
	  fjac[i-1 + *ldfjac*(2-1)] = tmp1*tmp2/tmp4;
	  fjac[i-1 + *ldfjac*(3-1)] = tmp1*tmp3/tmp4;
	}
    }
}