binaries/src/disembl/Tisean_3.0.1/source_f/slatec/chkder.f

   1 *DECK CHKDER
   2       SUBROUTINE CHKDER (M, N, X, FVEC, FJAC, LDFJAC, XP, FVECP, MODE,
   3      +   ERR)
   4 C***BEGIN PROLOGUE  CHKDER
   5 C***PURPOSE  Check the gradients of M nonlinear functions in N
   6 C            variables, evaluated at a point X, for consistency
   7 C            with the functions themselves.
   8 C***LIBRARY   SLATEC
   9 C***CATEGORY  F3, G4C
  10 C***TYPE      SINGLE PRECISION (CHKDER-S, DCKDER-D)
  11 C***KEYWORDS  GRADIENTS, JACOBIAN, MINPACK, NONLINEAR
  12 C***AUTHOR  Hiebert, K. L. (SNLA)
  13 C***DESCRIPTION
  14 C
  15 C   This subroutine is a companion routine to SNLS1,SNLS1E,SNSQ,and
  16 C   SNSQE which may be used to check the calculation of the Jacobian.
  17 C
  18 C     SUBROUTINE CHKDER
  19 C
  20 C     This subroutine checks the gradients of M nonlinear functions
  21 C     in N variables, evaluated at a point X, for consistency with
  22 C     the functions themselves. The user must call CKDER twice,
  23 C     first with MODE = 1 and then with MODE = 2.
  24 C
  25 C     MODE = 1. On input, X must contain the point of evaluation.
  26 C               On output, XP is set to a neighboring point.
  27 C
  28 C     MODE = 2. On input, FVEC must contain the functions and the
  29 C                         rows of FJAC must contain the gradients
  30 C                         of the respective functions each evaluated
  31 C                         at X, and FVECP must contain the functions
  32 C                         evaluated at XP.
  33 C               On output, ERR contains measures of correctness of
  34 C                          the respective gradients.
  35 C
  36 C     The subroutine does not perform reliably if cancellation or
  37 C     rounding errors cause a severe loss of significance in the
  38 C     evaluation of a function. Therefore, none of the components
  39 C     of X should be unusually small (in particular, zero) or any
  40 C     other value which may cause loss of significance.
  41 C
  42 C     The SUBROUTINE statement is
  43 C
  44 C       SUBROUTINE CHKDER(M,N,X,FVEC,FJAC,LDFJAC,XP,FVECP,MODE,ERR)
  45 C
  46 C     where
  47 C
  48 C       M is a positive integer input variable set to the number
  49 C         of functions.
  50 C
  51 C       N is a positive integer input variable set to the number
  52 C         of variables.
  53 C
  54 C       X is an input array of length N.
  55 C
  56 C       FVEC is an array of length M. On input when MODE = 2,
  57 C         FVEC must contain the functions evaluated at X.
  58 C
  59 C       FJAC is an M by N array. On input when MODE = 2,
  60 C         the rows of FJAC must contain the gradients of
  61 C         the respective functions evaluated at X.
  62 C
  63 C       LDFJAC is a positive integer input parameter not less than M
  64 C         which specifies the leading dimension of the array FJAC.
  65 C
  66 C       XP is an array of length N. On output when MODE = 1,
  67 C         XP is set to a neighboring point of X.
  68 C
  69 C       FVECP is an array of length M. On input when MODE = 2,
  70 C         FVECP must contain the functions evaluated at XP.
  71 C
  72 C       MODE is an integer input variable set to 1 on the first call
  73 C         and 2 on the second. Other values of MODE are equivalent
  74 C         to MODE = 1.
  75 C
  76 C       ERR is an array of length M. On output when MODE = 2,
  77 C         ERR contains measures of correctness of the respective
  78 C         gradients. If there is no severe loss of significance,
  79 C         then if ERR(I) is 1.0 the I-th gradient is correct,
  80 C         while if ERR(I) is 0.0 the I-th gradient is incorrect.
  81 C         For values of ERR between 0.0 and 1.0, the categorization
  82 C         is less certain. In general, a value of ERR(I) greater
  83 C         than 0.5 indicates that the I-th gradient is probably
  84 C         correct, while a value of ERR(I) less than 0.5 indicates
  85 C         that the I-th gradient is probably incorrect.
  86 C
  87 C***REFERENCES  M. J. D. Powell, A hybrid method for nonlinear equa-
  88 C                 tions. In Numerical Methods for Nonlinear Algebraic
  89 C                 Equations, P. Rabinowitz, Editor.  Gordon and Breach,
  90 C                 1988.
  91 C***ROUTINES CALLED  R1MACH
  92 C***REVISION HISTORY  (YYMMDD)
  93 C   800301  DATE WRITTEN
  94 C   890531  Changed all specific intrinsics to generic.  (WRB)
  95 C   890831  Modified array declarations.  (WRB)
  96 C   890831  REVISION DATE from Version 3.2
  97 C   891214  Prologue converted to Version 4.0 format.  (BAB)
  98 C   900326  Removed duplicate information from DESCRIPTION section.
  99 C           (WRB)
 100 C   920501  Reformatted the REFERENCES section.  (WRB)
 101 C***END PROLOGUE  CHKDER
 102       INTEGER M,N,LDFJAC,MODE
 103       REAL X(*),FVEC(*),FJAC(LDFJAC,*),XP(*),FVECP(*),ERR(*)
 104       INTEGER I,J
 105       REAL EPS,EPSF,EPSLOG,EPSMCH,FACTOR,ONE,TEMP,ZERO
 106       REAL R1MACH
 107       SAVE FACTOR, ONE, ZERO
 108 C
 109       DATA FACTOR,ONE,ZERO /1.0E2,1.0E0,0.0E0/
 110 C***FIRST EXECUTABLE STATEMENT  CHKDER
 111       EPSMCH = R1MACH(4)
 112 C
 113       EPS = SQRT(EPSMCH)
 114 C
 115       IF (MODE .EQ. 2) GO TO 20
 116 C
 117 C        MODE = 1.
 118 C
 119          DO 10 J = 1, N
 120             TEMP = EPS*ABS(X(J))
 121             IF (TEMP .EQ. ZERO) TEMP = EPS
 122             XP(J) = X(J) + TEMP
 123    10       CONTINUE
 124          GO TO 70
 125    20 CONTINUE
 126 C
 127 C        MODE = 2.
 128 C
 129          EPSF = FACTOR*EPSMCH
 130          EPSLOG = LOG10(EPS)
 131          DO 30 I = 1, M
 132             ERR(I) = ZERO
 133    30       CONTINUE
 134          DO 50 J = 1, N
 135             TEMP = ABS(X(J))
 136             IF (TEMP .EQ. ZERO) TEMP = ONE
 137             DO 40 I = 1, M
 138                ERR(I) = ERR(I) + TEMP*FJAC(I,J)
 139    40          CONTINUE
 140    50       CONTINUE
 141          DO 60 I = 1, M
 142             TEMP = ONE
 143             IF (FVEC(I) .NE. ZERO .AND. FVECP(I) .NE. ZERO
 144      1          .AND. ABS(FVECP(I)-FVEC(I)) .GE. EPSF*ABS(FVEC(I)))
 145      2         TEMP = EPS*ABS((FVECP(I)-FVEC(I))/EPS-ERR(I))
 146      3                /(ABS(FVEC(I)) + ABS(FVECP(I)))
 147             ERR(I) = ONE
 148             IF (TEMP .GT. EPSMCH .AND. TEMP .LT. EPS)
 149      1         ERR(I) = (LOG10(TEMP) - EPSLOG)/EPSLOG
 150             IF (TEMP .GE. EPS) ERR(I) = ZERO
 151    60       CONTINUE
 152    70 CONTINUE
 153 C
 154       RETURN
 155 C
 156 C     LAST CARD OF SUBROUTINE CHKDER.
 157 C
 158       END