Mercurial > hg > octave-nkf
view libcruft/minpack/fdjac1.f @ 5070:1e6f653ef1e3 ss-2-1-61
[project @ 2004-11-06 00:33:38 by jwe]
author | jwe |
---|---|
date | Sat, 06 Nov 2004 00:33:38 +0000 |
parents | 30c606bec7a8 |
children |
line wrap: on
line source
SUBROUTINE FDJAC1(FCN,N,X,FVEC,FJAC,LDFJAC,IFLAG,ML,MU,EPSFCN, * WA1,WA2) INTEGER N,LDFJAC,IFLAG,ML,MU DOUBLE PRECISION EPSFCN DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N),WA1(N),WA2(N) EXTERNAL FCN C ********** C C SUBROUTINE FDJAC1 C C THIS SUBROUTINE COMPUTES A FORWARD-DIFFERENCE APPROXIMATION C TO THE N BY N JACOBIAN MATRIX ASSOCIATED WITH A SPECIFIED C PROBLEM OF N FUNCTIONS IN N VARIABLES. IF THE JACOBIAN HAS C A BANDED FORM, THEN FUNCTION EVALUATIONS ARE SAVED BY ONLY C APPROXIMATING THE NONZERO TERMS. C C THE SUBROUTINE STATEMENT IS C C SUBROUTINE FDJAC1(FCN,N,X,FVEC,FJAC,LDFJAC,IFLAG,ML,MU,EPSFCN, C WA1,WA2) 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(N,X,FVEC,IFLAG) C INTEGER N,IFLAG C DOUBLE PRECISION X(N),FVEC(N) C ---------- C 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 FDJAC1. C IN THIS CASE SET IFLAG TO A NEGATIVE INTEGER. C C N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER C OF FUNCTIONS AND VARIABLES. C C X IS AN INPUT ARRAY OF LENGTH N. C C FVEC IS AN INPUT ARRAY OF LENGTH N WHICH MUST CONTAIN THE C FUNCTIONS EVALUATED AT X. C C FJAC IS AN OUTPUT N 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 N 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 FDJAC1. SEE DESCRIPTION OF FCN. C C ML IS A NONNEGATIVE INTEGER INPUT VARIABLE WHICH SPECIFIES C THE NUMBER OF SUBDIAGONALS WITHIN THE BAND OF THE C JACOBIAN MATRIX. IF THE JACOBIAN IS NOT BANDED, SET C ML TO AT LEAST N - 1. 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 MU IS A NONNEGATIVE INTEGER INPUT VARIABLE WHICH SPECIFIES C THE NUMBER OF SUPERDIAGONALS WITHIN THE BAND OF THE C JACOBIAN MATRIX. IF THE JACOBIAN IS NOT BANDED, SET C MU TO AT LEAST N - 1. C C WA1 AND WA2 ARE WORK ARRAYS OF LENGTH N. IF ML + MU + 1 IS AT C LEAST N, THEN THE JACOBIAN IS CONSIDERED DENSE, AND WA2 IS C NOT REFERENCED. C C SUBPROGRAMS CALLED C C MINPACK-SUPPLIED ... DPMPAR C C FORTRAN-SUPPLIED ... DABS,DMAX1,DSQRT C C MINPACK. VERSION OF JUNE 1979. C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE C C ********** INTEGER I,J,K,MSUM DOUBLE PRECISION EPS,EPSMCH,H,TEMP,ZERO DOUBLE PRECISION DPMPAR DATA ZERO /0.0D0/ C C EPSMCH IS THE MACHINE PRECISION. C EPSMCH = DPMPAR(1) C EPS = DSQRT(DMAX1(EPSFCN,EPSMCH)) MSUM = ML + MU + 1 IF (MSUM .LT. N) GO TO 40 C C COMPUTATION OF DENSE APPROXIMATE JACOBIAN. C DO 20 J = 1, N TEMP = X(J) H = EPS*DABS(TEMP) IF (H .EQ. ZERO) H = EPS X(J) = TEMP + H CALL FCN(N,X,WA1,IFLAG) IF (IFLAG .LT. 0) GO TO 30 X(J) = TEMP DO 10 I = 1, N FJAC(I,J) = (WA1(I) - FVEC(I))/H 10 CONTINUE 20 CONTINUE 30 CONTINUE GO TO 110 40 CONTINUE C C COMPUTATION OF BANDED APPROXIMATE JACOBIAN. C DO 90 K = 1, MSUM DO 60 J = K, N, MSUM WA2(J) = X(J) H = EPS*DABS(WA2(J)) IF (H .EQ. ZERO) H = EPS X(J) = WA2(J) + H 60 CONTINUE CALL FCN(N,X,WA1,IFLAG) IF (IFLAG .LT. 0) GO TO 100 DO 80 J = K, N, MSUM X(J) = WA2(J) H = EPS*DABS(WA2(J)) IF (H .EQ. ZERO) H = EPS DO 70 I = 1, N FJAC(I,J) = ZERO IF (I .GE. J - MU .AND. I .LE. J + ML) * FJAC(I,J) = (WA1(I) - FVEC(I))/H 70 CONTINUE 80 CONTINUE 90 CONTINUE 100 CONTINUE 110 CONTINUE RETURN C C LAST CARD OF SUBROUTINE FDJAC1. C END