relibc_openlibm/slatec/dfdjc3.f

*DECK DFDJC3
      SUBROUTINE DFDJC3 (FCN, M, N, X, FVEC, FJAC, LDFJAC, IFLAG,
     +   EPSFCN, WA)
C***BEGIN PROLOGUE  DFDJC3
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DNLS1 and DNLS1E
C***LIBRARY   SLATEC
C***TYPE      DOUBLE PRECISION (FDJAC3-S, DFDJC3-D)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C  **** Double Precision version of FDJAC3 ****
C
C     This subroutine computes a forward-difference approximation
C     to the M by N Jacobian matrix associated with a specified
C     problem of M functions in N variables.
C
C     The subroutine statement is
C
C       SUBROUTINE DFDJC3(FCN,M,N,X,FVEC,FJAC,LDFJAC,IFLAG,EPSFCN,WA)
C
C     where
C
C       FCN is the name of the user-supplied subroutine which
C         calculates the functions. FCN must be declared
C         in an external statement in the user calling
C         program, and should be written as follows.
C
C         SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
C         INTEGER LDFJAC,M,N,IFLAG
C         DOUBLE PRECISION X(N),FVEC(M),FJAC(LDFJAC,N)
C         ----------
C         When IFLAG.EQ.1 calculate the functions at X and
C         return this vector in FVEC.
C         ----------
C         RETURN
C         END
C
C         The value of IFLAG should not be changed by FCN unless
C         the user wants to terminate execution of DFDJC3.
C         In this case set IFLAG to a negative integer.
C
C       M is a positive integer input variable set to the number
C         of functions.
C
C       N is a positive integer input variable set to the number
C         of variables. N must not exceed M.
C
C       X is an input array of length N.
C
C       FVEC is an input array of length M which must contain the
C         functions evaluated at X.
C
C       FJAC is an output M by N array which contains the
C         approximation to the Jacobian matrix evaluated at X.
C
C       LDFJAC is a positive integer input variable not less than M
C         which specifies the leading dimension of the array FJAC.
C
C       IFLAG is an integer variable which can be used to terminate
C         THE EXECUTION OF DFDJC3. See description of FCN.
C
C       EPSFCN is an input variable used in determining a suitable
C         step length for the forward-difference approximation. This
C         approximation assumes that the relative errors in the
C         functions are of the order of EPSFCN. If EPSFCN is less
C         than the machine precision, it is assumed that the relative
C         errors in the functions are of the order of the machine
C         precision.
C
C       WA is a work array of length M.
C
C***SEE ALSO  DNLS1, DNLS1E
C***ROUTINES CALLED  D1MACH
C***REVISION HISTORY  (YYMMDD)
C   800301  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   890831  Modified array declarations.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900326  Removed duplicate information from DESCRIPTION section.
C           (WRB)
C   900328  Added TYPE section.  (WRB)
C***END PROLOGUE  DFDJC3
      INTEGER M,N,LDFJAC,IFLAG
      DOUBLE PRECISION EPSFCN
      DOUBLE PRECISION X(*),FVEC(*),FJAC(LDFJAC,*),WA(*)
      INTEGER I,J
      DOUBLE PRECISION EPS,EPSMCH,H,TEMP,ZERO
      DOUBLE PRECISION D1MACH
      SAVE ZERO
      DATA ZERO /0.0D0/
C***FIRST EXECUTABLE STATEMENT  DFDJC3
      EPSMCH = D1MACH(4)
C
      EPS = SQRT(MAX(EPSFCN,EPSMCH))
C      SET IFLAG=1 TO INDICATE THAT FUNCTION VALUES
C           ARE TO BE RETURNED BY FCN.
      IFLAG = 1
      DO 20 J = 1, N
         TEMP = X(J)
         H = EPS*ABS(TEMP)
         IF (H .EQ. ZERO) H = EPS
         X(J) = TEMP + H
         CALL FCN(IFLAG,M,N,X,WA,FJAC,LDFJAC)
         IF (IFLAG .LT. 0) GO TO 30
         X(J) = TEMP
         DO 10 I = 1, M
            FJAC(I,J) = (WA(I) - FVEC(I))/H
   10       CONTINUE
   20    CONTINUE
   30 CONTINUE
      RETURN
C
C     LAST CARD OF SUBROUTINE DFDJC3.
C
      END