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
89
90
91
92
93
94
95
96
97
|
C DRIVER FOR HYBRJ EXAMPLE.
C DOUBLE PRECISION VERSION
C
C **********
INTEGER J,N,LDFJAC,MAXFEV,MODE,NPRINT,INFO,NFEV,NJEV,LR,NWRITE
DOUBLE PRECISION XTOL,FACTOR,FNORM
DOUBLE PRECISION X(9),FVEC(9),FJAC(9,9),DIAG(9),R(45),QTF(9),
* WA1(9),WA2(9),WA3(9),WA4(9)
DOUBLE PRECISION ENORM,DPMPAR
EXTERNAL FCN
C
C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6.
C
DATA NWRITE /6/
C
N = 9
C
C THE FOLLOWING STARTING VALUES PROVIDE A ROUGH SOLUTION.
C
DO 10 J = 1, 9
X(J) = -1.D0
10 CONTINUE
C
LDFJAC = 9
LR = 45
C
C SET XTOL TO THE SQUARE ROOT OF THE MACHINE PRECISION.
C UNLESS HIGH PRECISION SOLUTIONS ARE REQUIRED,
C THIS IS THE RECOMMENDED SETTING.
C
XTOL = DSQRT(DPMPAR(1))
C
MAXFEV = 1000
MODE = 2
DO 20 J = 1, 9
DIAG(J) = 1.D0
20 CONTINUE
FACTOR = 1.D2
NPRINT = 0
C
CALL HYBRJ(FCN,N,X,FVEC,FJAC,LDFJAC,XTOL,MAXFEV,DIAG,
* MODE,FACTOR,NPRINT,INFO,NFEV,NJEV,R,LR,QTF,
* WA1,WA2,WA3,WA4)
FNORM = ENORM(N,FVEC)
WRITE (NWRITE,1000) FNORM,NFEV,NJEV,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,31H NUMBER OF JACOBIAN EVALUATIONS,I10 //
* 5X,15H EXIT PARAMETER,16X,I10 //
* 5X,27H FINAL APPROXIMATE SOLUTION // (5X,3D15.7))
C
C LAST CARD OF DRIVER FOR HYBRJ EXAMPLE.
C
END
SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG)
INTEGER N,LDFJAC,IFLAG
DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N)
C
C SUBROUTINE FCN FOR HYBRJ EXAMPLE.
C
INTEGER J,K
DOUBLE PRECISION ONE,TEMP,TEMP1,TEMP2,THREE,TWO,ZERO
DATA ZERO,ONE,TWO,THREE,FOUR /0.D0,1.D0,2.D0,3.D0,4.D0/
C
IF (IFLAG .NE. 0) GO TO 5
C
C INSERT PRINT STATEMENTS HERE WHEN NPRINT IS POSITIVE.
C
RETURN
5 CONTINUE
IF (IFLAG .EQ. 2) GO TO 20
DO 10 K = 1, N
TEMP = (THREE - TWO*X(K))*X(K)
TEMP1 = ZERO
IF (K .NE. 1) TEMP1 = X(K-1)
TEMP2 = ZERO
IF (K .NE. N) TEMP2 = X(K+1)
FVEC(K) = TEMP - TEMP1 - TWO*TEMP2 + ONE
10 CONTINUE
GO TO 50
20 CONTINUE
DO 40 K = 1, N
DO 30 J = 1, N
FJAC(K,J) = ZERO
30 CONTINUE
FJAC(K,K) = THREE - FOUR*X(K)
IF (K .NE. 1) FJAC(K,K-1) = -ONE
IF (K .NE. N) FJAC(K,K+1) = -TWO
40 CONTINUE
50 CONTINUE
RETURN
C
C LAST CARD OF SUBROUTINE FCN.
C
END
|
