Last: lmstr1 Up: ../minpack.html Next: hybrd
Page 1 Documentation for MINPACK subroutine CHKDER Double precision version Argonne National Laboratory Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More March 1980 1. Purpose. The purpose of CHKDER is to check the gradients of M nonlinear functions in N variables, evaluated at a point X, for consis- tency with the functions themselves. The user must call CHKDER twice, first with MODE = 1 and then with MODE = 2. 2. Subroutine and type statements. SUBROUTINE CHKDER(M,N,X,FVEC,FJAC,LDFJAC,XP,FVECP,MODE,ERR) INTEGER M,N,LDFJAC,MODE DOUBLE PRECISION X(N),FVEC(M),FJAC(LDFJAC,N),XP(N),FVECP(M), * ERR(M) 3. Parameters. Parameters designated as input parameters must be specified on entry to CHKDER and are not changed on exit, while parameters designated as output parameters need not be specified on entry and are set to appropriate values on exit from CHKDER. M is a positive integer input variable set to the number of functions. N is a positive integer input variable set to the number of variables. X is an input array of length N. FVEC is an array of length M. On input when MODE = 2, FVEC must contain the functions evaluated at X. FJAC is an M by N array. On input when MODE = 2, the rows of FJAC must contain the gradients of the respective functions evaluated at X. LDFJAC is a positive integer input variable not less than M which specifies the leading dimension of the array FJAC. XP is an array of length N. On output when MODE = 1, XP is set to a neighboring point of X. Page 2 FVECP is an array of length M. On input when MODE = 2, FVECP must contain the functions evaluated at XP. MODE is an integer input variable set to 1 on the first call and 2 on the second. Other values of MODE are equivalent to MODE = 1. ERR is an array of length M. On output when MODE = 2, ERR con- tains measures of correctness of the respective gradients. If there is no severe loss of significance, then if ERR(I) is 1.0 the I-th gradient is correct, while if ERR(I) is 0.0 the I-th gradient is incorrect. For values of ERR between 0.0 and 1.0, the categorization is less certain. In general, a value of ERR(I) greater than 0.5 indicates that the I-th gradient is probably correct, while a value of ERR(I) less than 0.5 indi- cates that the I-th gradient is probably incorrect. 4. Successful completion. CHKDER usually guarantees that if ERR(I) is 1.0, then the I-th gradient at X is consistent with the I-th function. This sug- gests that the input X be such that consistency of the gradient at X implies consistency of the gradient at all points of inter- est. If all the components of X are distinct and the fractional part of each one has two nonzero digits, then X is likely to be a satisfactory choice. If ERR(I) is not 1.0 but is greater than 0.5, then the I-th gra- dient is probably consistent with the I-th function (the more so the larger ERR(I) is), but the conditions for ERR(I) to be 1.0 have not been completely satisfied. In this case, it is recom- mended that CHKDER be rerun with other input values of X. If ERR(I) is always greater than 0.5, then the I-th gradient is consistent with the I-th function. 5. Unsuccessful completion. CHKDER does not perform reliably if cancellation or rounding errors cause a severe loss of significance in the evaluation of a function. Therefore, none of the components of X should be unusually small (in particular, zero) or any other value which may cause loss of significance. The relative differences between corresponding elements of FVECP and FVEC should be at least two orders of magnitude greater than the machine precision (as defined by the MINPACK function DPMPAR(1)). If there is a severe loss of significance in the evaluation of the I-th func- tion, then ERR(I) may be 0.0 and yet the I-th gradient could be correct. If ERR(I) is not 0.0 but is less than 0.5, then the I-th gra- dient is probably not consistent with the I-th function (the more so the smaller ERR(I) is), but the conditions for ERR(I) to Page 3 be 0.0 have not been completely satisfied. In this case, it is recommended that CHKDER be rerun with other input values of X. If ERR(I) is always less than 0.5 and if there is no severe loss of significance, then the I-th gradient is not consistent with the I-th function. 6. Characteristics of the algorithm. CHKDER checks the I-th gradient for consistency with the I-th function by computing a forward-difference approximation along a suitably chosen direction and comparing this approximation with the user-supplied gradient along the same direction. The prin- cipal characteristic of CHKDER is its invariance to changes in scale of the variables or functions. Timing. The time required by CHKDER depends only on M and N. The number of arithmetic operations needed by CHKDER is about N when MODE = 1 and M*N when MODE = 2. Storage. CHKDER requires M*N + 3*M + 2*N double precision stor- age locations, in addition to the storage required by the pro- gram. There are no internally declared storage arrays. 7. Subprograms required. MINPACK-supplied ... DPMPAR FORTRAN-supplied ... DABS,DLOG10,DSQRT 8. References. None. 9. Example. This example checks the Jacobian matrix for the problem that determines the values of x(1), x(2), and x(3) which provide the best fit (in the least squares sense) of x(1) + u(i)/(v(i)*x(2) + w(i)*x(3)), i = 1, 15 to the data y = (0.14,0.18,0.22,0.25,0.29,0.32,0.35,0.39, 0.37,0.58,0.73,0.96,1.34,2.10,4.39), where u(i) = i, v(i) = 16 - i, and w(i) = min(u(i),v(i)). The i-th component of FVEC is thus defined by y(i) - (x(1) + u(i)/(v(i)*x(2) + w(i)*x(3))). Page 4 C ********** C C DRIVER FOR CHKDER EXAMPLE. C DOUBLE PRECISION VERSION C C ********** INTEGER I,M,N,LDFJAC,MODE,NWRITE DOUBLE PRECISION X(3),FVEC(15),FJAC(15,3),XP(3),FVECP(15), * ERR(15) C C LOGICAL OUTPUT UNIT IS ASSUMED TO BE NUMBER 6. C DATA NWRITE /6/ C M = 15 N = 3 C C THE FOLLOWING VALUES SHOULD BE SUITABLE FOR C CHECKING THE JACOBIAN MATRIX. C X(1) = 9.2D-1 X(2) = 1.3D-1 X(3) = 5.4D-1 C LDFJAC = 15 C MODE = 1 CALL CHKDER(M,N,X,FVEC,FJAC,LDFJAC,XP,FVECP,MODE,ERR) MODE = 2 CALL FCN(M,N,X,FVEC,FJAC,LDFJAC,1) CALL FCN(M,N,X,FVEC,FJAC,LDFJAC,2) CALL FCN(M,N,XP,FVECP,FJAC,LDFJAC,1) CALL CHKDER(M,N,X,FVEC,FJAC,LDFJAC,XP,FVECP,MODE,ERR) C DO 10 I = 1, M FVECP(I) = FVECP(I) - FVEC(I) 10 CONTINUE WRITE (NWRITE,1000) (FVEC(I),I=1,M) WRITE (NWRITE,2000) (FVECP(I),I=1,M) WRITE (NWRITE,3000) (ERR(I),I=1,M) STOP 1000 FORMAT (/5X,5H FVEC // (5X,3D15.7)) 2000 FORMAT (/5X,13H FVECP - FVEC // (5X,3D15.7)) 3000 FORMAT (/5X,4H ERR // (5X,3D15.7)) C C LAST CARD OF DRIVER FOR CHKDER EXAMPLE. C END SUBROUTINE FCN(M,N,X,FVEC,FJAC,LDFJAC,IFLAG) INTEGER M,N,LDFJAC,IFLAG DOUBLE PRECISION X(N),FVEC(M),FJAC(LDFJAC,N) C C SUBROUTINE FCN FOR CHKDER EXAMPLE. C Page 5 INTEGER I DOUBLE PRECISION TMP1,TMP2,TMP3,TMP4 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 IF (IFLAG .EQ. 2) GO TO 20 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 GO TO 40 20 CONTINUE DO 30 I = 1, 15 TMP1 = I TMP2 = 16 - I C C ERROR INTRODUCED INTO NEXT STATEMENT FOR ILLUSTRATION. C CORRECTED STATEMENT SHOULD READ TMP3 = TMP1 . C TMP3 = TMP2 IF (I .GT. 8) TMP3 = TMP2 TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2 FJAC(I,1) = -1.D0 FJAC(I,2) = TMP1*TMP2/TMP4 FJAC(I,3) = TMP1*TMP3/TMP4 30 CONTINUE 40 CONTINUE RETURN C C LAST CARD OF SUBROUTINE FCN. C END Results obtained with different compilers or machines may be different. In particular, the differences FVECP - FVEC are machine dependent. FVEC -0.1181606D+01 -0.1429655D+01 -0.1606344D+01 -0.1745269D+01 -0.1840654D+01 -0.1921586D+01 -0.1984141D+01 -0.2022537D+01 -0.2468977D+01 -0.2827562D+01 -0.3473582D+01 -0.4437612D+01 -0.6047662D+01 -0.9267761D+01 -0.1891806D+02 FVECP - FVEC -0.7724666D-08 -0.3432405D-08 -0.2034843D-09 Page 6 0.2313685D-08 0.4331078D-08 0.5984096D-08 0.7363281D-08 0.8531470D-08 0.1488591D-07 0.2335850D-07 0.3522012D-07 0.5301255D-07 0.8266660D-07 0.1419747D-06 0.3198990D-06 ERR 0.1141397D+00 0.9943516D-01 0.9674474D-01 0.9980447D-01 0.1073116D+00 0.1220445D+00 0.1526814D+00 0.1000000D+01 0.1000000D+01 0.1000000D+01 0.1000000D+01 0.1000000D+01 0.1000000D+01 0.1000000D+01 0.1000000D+01