File: tlmdif1.f

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 (71 lines) | stat: -rw-r--r-- 1,796 bytes parent folder | download | duplicates (9)
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
C     DRIVER FOR LMDIF1 EXAMPLE.
C     DOUBLE PRECISION VERSION
C

C     **********
      INTEGER J,M,N,INFO,LWA,NWRITE
      INTEGER IWA(3)
      DOUBLE PRECISION TOL,FNORM
      DOUBLE PRECISION X(3),FVEC(15),WA(75)
      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
      LWA = 75
C
C     SET TOL TO THE SQUARE ROOT OF THE MACHINE PRECISION.
C     UNLESS HIGH PRECISION SOLUTIONS ARE REQUIRED,
C     THIS IS THE RECOMMENDED SETTING.
C
      TOL = DSQRT(DPMPAR(1))
C
      CALL LMDIF1(FCN,M,N,X,FVEC,TOL,INFO,IWA,WA,LWA)
      FNORM = ENORM(M,FVEC)
      WRITE (NWRITE,1000) FNORM,INFO,(X(J),J=1,N)
      STOP
 1000 FORMAT (5X,31H FINAL L2 NORM OF THE RESIDUALS,D15.7 //
     *        5X,15H EXIT PARAMETER,16X,I10 //
     *        5X,27H FINAL APPROXIMATE SOLUTION // 5X,3D15.7)
C
C     LAST CARD OF DRIVER FOR LMDIF1 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 LMDIF1 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

      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