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
86
87
88
|
C DRIVER FOR LMDIF EXAMPLE.
C DOUBLE PRECISION VERSION
C
C **********
INTEGER J,M,N,MAXFEV,MODE,NPRINT,INFO,NFEV,LDFJAC,NWRITE
INTEGER IPVT(3)
DOUBLE PRECISION FTOL,XTOL,GTOL,EPSFCN,FACTOR,FNORM
DOUBLE PRECISION X(3),FVEC(15),DIAG(3),FJAC(15,3),QTF(3),
* WA1(3),WA2(3),WA3(3),WA4(15)
DOUBLE PRECISION ENORM,DPMPAR
EXTERNAL FCN
C
C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.
C
DATA NWRITE /6/
C
M = 15
N = 3
C
C THE FOLLOWING STARTING VALUES PROVIDE A ROUGH FIT.
C
X(1) = 1.D0
X(2) = 1.D0
X(3) = 1.D0
C
LDFJAC = 15
C
C SET FTOL AND XTOL TO THE SQUARE ROOT OF THE MACHINE PRECISION
C AND GTOL TO ZERO. UNLESS HIGH PRECISION SOLUTIONS ARE
C REQUIRED, THESE ARE THE RECOMMENDED SETTINGS.
C
FTOL = DSQRT(DPMPAR(1))
XTOL = DSQRT(DPMPAR(1))
GTOL = 0.D0
C
MAXFEV = 800
EPSFCN = 0.D0
MODE = 1
FACTOR = 1.D2
NPRINT = 0
C
CALL LMDIF(FCN,M,N,X,FVEC,FTOL,XTOL,GTOL,MAXFEV,EPSFCN,
* DIAG,MODE,FACTOR,NPRINT,INFO,NFEV,FJAC,LDFJAC,
* IPVT,QTF,WA1,WA2,WA3,WA4)
FNORM = ENORM(M,FVEC)
WRITE (NWRITE,1000) FNORM,NFEV,INFO,(X(J),J=1,N)
STOP
1000 FORMAT (5X,31H FINAL L2 NORM OF THE RESIDUALS,D15.7 //
* 5X,31H NUMBER OF FUNCTION EVALUATIONS,I10 //
* 5X,15H EXIT PARAMETER,16X,I10 //
* 5X,27H FINAL APPROXIMATE SOLUTION // 5X,3D15.7)
C
C LAST CARD OF DRIVER FOR LMDIF EXAMPLE.
C
END
SUBROUTINE FCN(M,N,X,FVEC,IFLAG)
INTEGER M,N,IFLAG
DOUBLE PRECISION X(N),FVEC(M)
C
C SUBROUTINE FCN FOR LMDIF EXAMPLE.
C
INTEGER I
DOUBLE PRECISION TMP1,TMP2,TMP3
DOUBLE PRECISION Y(15)
DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
* Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
* /1.4D-1,1.8D-1,2.2D-1,2.5D-1,2.9D-1,3.2D-1,3.5D-1,3.9D-1,
* 3.7D-1,5.8D-1,7.3D-1,9.6D-1,1.34D0,2.1D0,4.39D0/
C
IF (IFLAG .NE. 0) GO TO 5
C
C INSERT PRINT STATEMENTS HERE WHEN NPRINT IS POSITIVE.
C
RETURN
5 CONTINUE
DO 10 I = 1, 15
TMP1 = I
TMP2 = 16 - I
TMP3 = TMP1
IF (I .GT. 8) TMP3 = TMP2
FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
10 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE FCN.
C
END
|
