~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dfdjc1.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
*DECK DFDJC1
 
2
      SUBROUTINE DFDJC1 (FCN, N, X, FVEC, FJAC, LDFJAC, IFLAG, ML, MU,
 
3
     +   EPSFCN, WA1, WA2)
 
4
C***BEGIN PROLOGUE  DFDJC1
 
5
C***SUBSIDIARY
 
6
C***PURPOSE  Subsidiary to DNSQ and DNSQE
 
7
C***LIBRARY   SLATEC
 
8
C***TYPE      DOUBLE PRECISION (FDJAC1-S, DFDJC1-D)
 
9
C***AUTHOR  (UNKNOWN)
 
10
C***DESCRIPTION
 
11
C
 
12
C     This subroutine computes a forward-difference approximation
 
13
C     to the N by N Jacobian matrix associated with a specified
 
14
C     problem of N functions in N variables. If the Jacobian has
 
15
C     a banded form, then function evaluations are saved by only
 
16
C     approximating the nonzero terms.
 
17
C
 
18
C     The subroutine statement is
 
19
C
 
20
C       SUBROUTINE DFDJC1(FCN,N,X,FVEC,FJAC,LDFJAC,IFLAG,ML,MU,EPSFCN,
 
21
C                         WA1,WA2)
 
22
C
 
23
C     where
 
24
C
 
25
C       FCN is the name of the user-supplied subroutine which
 
26
C         calculates the functions. FCN must be declared
 
27
C         in an EXTERNAL statement in the user calling
 
28
C         program, and should be written as follows.
 
29
C
 
30
C         SUBROUTINE FCN(N,X,FVEC,IFLAG)
 
31
C         INTEGER N,IFLAG
 
32
C         DOUBLE PRECISION X(N),FVEC(N)
 
33
C         ----------
 
34
C         Calculate the functions at X and
 
35
C         return this vector in FVEC.
 
36
C         ----------
 
37
C         RETURN
 
38
C
 
39
C         The value of IFLAG should not be changed by FCN unless
 
40
C         the user wants to terminate execution of DFDJC1.
 
41
C         In this case set IFLAG to a negative integer.
 
42
C
 
43
C       N is a positive integer input variable set to the number
 
44
C         of functions and variables.
 
45
C
 
46
C       X is an input array of length N.
 
47
C
 
48
C       FVEC is an input array of length N which must contain the
 
49
C         functions evaluated at X.
 
50
C
 
51
C       FJAC is an output N by N array which contains the
 
52
C         approximation to the Jacobian matrix evaluated at X.
 
53
C
 
54
C       LDFJAC is a positive integer input variable not less than N
 
55
C         which specifies the leading dimension of the array FJAC.
 
56
C
 
57
C       IFLAG is an integer variable which can be used to terminate
 
58
C         the execution of DFDJC1. See description of FCN.
 
59
C
 
60
C       ML is a nonnegative integer input variable which specifies
 
61
C         the number of subdiagonals within the band of the
 
62
C         Jacobian matrix. If the Jacobian is not banded, set
 
63
C         ML to at least N - 1.
 
64
C
 
65
C       EPSFCN is an input variable used in determining a suitable
 
66
C         step length for the forward-difference approximation. This
 
67
C         approximation assumes that the relative errors in the
 
68
C         functions are of the order of EPSFCN. If EPSFCN is less
 
69
C         than the machine precision, it is assumed that the relative
 
70
C         errors in the functions are of the order of the machine
 
71
C         precision.
 
72
C
 
73
C       MU is a nonnegative integer input variable which specifies
 
74
C         the number of superdiagonals within the band of the
 
75
C         Jacobian matrix. If the Jacobian is not banded, set
 
76
C         MU to at least N - 1.
 
77
C
 
78
C       WA1 and WA2 are work arrays of length N. If ML + MU + 1 is at
 
79
C         least N, then the Jacobian is considered dense, and WA2 is
 
80
C         not referenced.
 
81
C
 
82
C***SEE ALSO  DNSQ, DNSQE
 
83
C***ROUTINES CALLED  D1MACH
 
84
C***REVISION HISTORY  (YYMMDD)
 
85
C   800301  DATE WRITTEN
 
86
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
87
C   890831  Modified array declarations.  (WRB)
 
88
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
89
C   900326  Removed duplicate information from DESCRIPTION section.
 
90
C           (WRB)
 
91
C   900328  Added TYPE section.  (WRB)
 
92
C***END PROLOGUE  DFDJC1
 
93
      DOUBLE PRECISION D1MACH
 
94
      INTEGER I, IFLAG, J, K, LDFJAC, ML, MSUM, MU, N
 
95
      DOUBLE PRECISION EPS, EPSFCN, EPSMCH, FJAC(LDFJAC,*),
 
96
     1     FVEC(*), H, TEMP, WA1(*), WA2(*), X(*), ZERO
 
97
      SAVE ZERO
 
98
      DATA ZERO /0.0D0/
 
99
C
 
100
C     EPSMCH IS THE MACHINE PRECISION.
 
101
C
 
102
C***FIRST EXECUTABLE STATEMENT  DFDJC1
 
103
      EPSMCH = D1MACH(4)
 
104
C
 
105
      EPS = SQRT(MAX(EPSFCN,EPSMCH))
 
106
      MSUM = ML + MU + 1
 
107
      IF (MSUM .LT. N) GO TO 40
 
108
C
 
109
C        COMPUTATION OF DENSE APPROXIMATE JACOBIAN.
 
110
C
 
111
         DO 20 J = 1, N
 
112
            TEMP = X(J)
 
113
            H = EPS*ABS(TEMP)
 
114
            IF (H .EQ. ZERO) H = EPS
 
115
            X(J) = TEMP + H
 
116
            CALL FCN(N,X,WA1,IFLAG)
 
117
            IF (IFLAG .LT. 0) GO TO 30
 
118
            X(J) = TEMP
 
119
            DO 10 I = 1, N
 
120
               FJAC(I,J) = (WA1(I) - FVEC(I))/H
 
121
   10          CONTINUE
 
122
   20       CONTINUE
 
123
   30    CONTINUE
 
124
         GO TO 110
 
125
   40 CONTINUE
 
126
C
 
127
C        COMPUTATION OF BANDED APPROXIMATE JACOBIAN.
 
128
C
 
129
         DO 90 K = 1, MSUM
 
130
            DO 60 J = K, N, MSUM
 
131
               WA2(J) = X(J)
 
132
               H = EPS*ABS(WA2(J))
 
133
               IF (H .EQ. ZERO) H = EPS
 
134
               X(J) = WA2(J) + H
 
135
   60          CONTINUE
 
136
            CALL FCN(N,X,WA1,IFLAG)
 
137
            IF (IFLAG .LT. 0) GO TO 100
 
138
            DO 80 J = K, N, MSUM
 
139
               X(J) = WA2(J)
 
140
               H = EPS*ABS(WA2(J))
 
141
               IF (H .EQ. ZERO) H = EPS
 
142
               DO 70 I = 1, N
 
143
                  FJAC(I,J) = ZERO
 
144
                  IF (I .GE. J - MU .AND. I .LE. J + ML)
 
145
     1               FJAC(I,J) = (WA1(I) - FVEC(I))/H
 
146
   70             CONTINUE
 
147
   80          CONTINUE
 
148
   90       CONTINUE
 
149
  100    CONTINUE
 
150
  110 CONTINUE
 
151
      RETURN
 
152
C
 
153
C     LAST CARD OF SUBROUTINE DFDJC1.
 
154
C
 
155
      END