End of file
Contents
Index
SUBROUTINE NLESYS (FX,M,N,JACMA,DFX,DF,LDDF,MAXIT,EPS,
+ KMAX,LUN,X,F,RNORM2,IERR,D,S,WORK)
C
C*****************************************************************
C *
C SUBROUTINE NLESYS solves a nonlinear system of equations *
C consisting of M+1 equations in N+1 unknowns by applying the *
C damped Newton method provided that it converges for the *
C starting vector. *
C The Jacobi matrix must be either determined by a subroutine *
C provided by the user or approximated by central difference *
C quotients. *
C Three break-off criteria are used: *
C 1. maximum number of iterations has been reached *
C 2. the relative difference between the euclidean norms of *
C the old and new approximations is smaller or equal to *
C EPS *
C 3. the euclidean norm of the function value for the newest *
C approximation is smaller than or equal to EPS *
C *
C this program was developed by using the SUBROUTINES SMNEWD *
C and SMNEWT by Thomas Eul and by SUBROUTINE SNLFIT by *
C Ilona Westermann. *
C *
C *
C INPUT PARAMETERS: *
C ================+ *
C FX : Function SUBROUTINE, that has to be provided by the *
C user. It defines the system of equations that are to *
C be solved. In the calling program FX has to be *
C defined as EXTERNAL. It must have the form: *
C SUBROUTINE FX (X, N, F, M) *
C INTEGER M, N *
C DOUBLE PRECISION X(0:N), F(0:M) *
C ------------------ *
C F(0) = F0 (X(0), ... , X(N) *
C . *
C . *
C F(M) = FM (X(0), ... , X(N) *
C ------------------ *
C RETURN *
C END *
C M : M+1 = number of equations *
C N : N+1 = number of unknowns *
C JACMA : logical parameter: *
C If JACMA = .TRUE., the user has provided his own *
C subroutine for determining the Jacobi matrix. *
C Otherwise the Jacobi matrix is computed intrinsically*
C by central difference quotients. *
C DFX : A SUBROUTINE that has to be provided by the user if *
C JACMA = .TRUE. DFX determines the Jacobi matrix. *
C In the calling program DFX has to be defined as *
C EXTERNAL and should have the following form: *
C SUBROUTINE DFX (X, M, N, DF, LDDF) *
C INTEGER M, N, LDDF *
C DOUBLE PRECISION X(0:N), DF(0:LDDF,0:N) *
C ---------------------- *
C DF(I,K) = partial derivative of function I *
C by X(K) at the position X *
C K=0(1)N, I=0(1)M *
C ---------------------- *
C RETURN *
C END *
C DF : 2-dim. array DF(0:LDDF,0:N+1); used for storage *
C space for the Jacobi matrix *
C LDDF : leading dimension of DF as defined in the calling *
C program *
C X : (N+1)-vector X(0:N) containing the starting vector *
C MAXIT : maximum number of iterations to be executed *
C EPS : relative error bound *
C KMAX : damping bound, if KMAX=0 => standard Newton method *
C LUN : > 0, file number onto which the iteration steps are *
C stored *
C = 0, no output *
C *
C *
C AUXILIARY PARAMETERS: *
C ===================== *
C D : (N+1)-vector D(0:N); auxiliary vector for SUBROUTINE *
C SHOUSE *
C S : (N+1)-vector S(0:N); for the Newton direction *
C WORK : (N+1)-vector WORK(0:M); auxiliary vector for *
C SUBROUTINE JACOBI *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C X : (N+1)-vector X(0:N) containing the approximate *
C solution *
C F : (N+1)-vector F(0:N) containing the function values *
C at the approximate solution *
C IERR : error parameter: *
C = 0 : everything o.k. *
C = 1 : error in the input parameters *
C = 2 : error while solving the linear minimization *
C problem (matrix singular) *
C = 3 : error bound not attained after MAXIT *
C iterations *
C RNORM2 : an estimate for the achieved accuracy, *
C RNORM2 = MIN (XNORM2, FNORM2) *
C (compare with the description of local variables) *
C *
C *
C LOCAL VARIABLES: *
C ================ *
C FNORM2 : euclidean norm of F(X) *
C FNORMN : euclidean norm of F(X + 1/2**K * DELTA X) *
C XNORM2 : relative accuracy *
C EPSMA : machine constant *
C SMOOTH : damping factor 1/2**K *
C MARK : error parameter of SHOUSE *
C K : counter for the damping loop. The damping factor is *
C 1/2**K *
C IT : Newton iteration loop counter *
C I : control variable *
C *
C----------------------------------------------------------------*
C *
C subroutines required: JACOBI, SHOUSE, SENORM, MACHPD *
C *
C*****************************************************************
C *
C author : Ilona Westermann *
C date : 09.01.1987 *
C source : FORTRAN 77 *
C *
C*****************************************************************
C
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INTEGER M, N, LDDF, MAXIT, KMAX, LUN, IERR
LOGICAL JACMA
DIMENSION DF(0:LDDF,0:N+1), X(0:N), F(0:M), D(0:N), S(0:N),
+ WORK(0:M)
EXTERNAL FX
C
C test of the input parameters
C
IF (M .GE. N .AND. LDDF .GE. M .AND. MAXIT .GT. 0 .AND.
+ KMAX .GE. 0 .AND. EPS .GT. 0.0D0 .AND. N .GE. 0 .AND.
+ M .GE. 0 .AND. LUN .GE. 0) THEN
IERR = 3
IT = 0
C
C determine machine constant in case the Jacobi matrix is calculated in
C this program by central difference quotients
C
IF (.NOT. JACMA) THEN
EPSMA = 1.0D0
10 EPSMA = EPSMA * 0.5D0
IF (MACHPD(EPSMA + 1.0D0) .EQ. 1) GOTO 10
EPSMA = EPSMA * 2.0D0
ENDIF
IF (LUN .GT. 0) THEN
I = 0
WRITE (LUN,1000)
WRITE (LUN,1100) IT,I,X(0)
WRITE (LUN,1200) (I,X(I),I=1,N)
WRITE (LUN,1300)
ENDIF
C
C determine functional value and its norm at the starting point
C
CALL FX (X, N, F, M)
FNORM2 = DSQRT(SENORM (F, M))
C
C Newton- teration
C
100 IT = IT + 1
C
C determining the Jacobi matrix
C
IF (JACMA) THEN
CALL DFX (X, M, N, DF, LDDF)
ELSE
CALL JACOBI (FX, X, M, N, DF, LDDF, EPSMA, WORK)
ENDIF
C
C minimize (DF * DELTA X + F) (DELTA X here is called S)
C
DO 15 I=0,M
DF(I,N+1) = - F(I)
15 CONTINUE
CALL SHOUSE (DF, LDDF, M, N, D, S, MARK)
C
C check for nonsingularity
C
IF (MARK .NE. 1) THEN
C
C damped Newton step
C
DO 40 K=0,KMAX
SMOOTH = 1.0D0 / 2.0D0 ** K
DO 20 I=0,N
D(I) = X(I) + S(I) * SMOOTH
20 CONTINUE
CALL FX (D, N, F, M)
FNORMN = DSQRT (SENORM (F, M))
C
C if FNORMN < FNORM2 continue calculations with damping
C
IF (FNORMN .LT. FNORM2) THEN
DO 30 I=0,N
S(I) = S(I) * SMOOTH
X(I) = D(I)
30 CONTINUE
GOTO 60
ENDIF
40 CONTINUE
C
C if the loop was completed, i.e., damping gave no improvement,
C continue calculations without damping
C
DO 50 I=0,N
X(I) = X(I) + S(I)
50 CONTINUE
CALL FX (X, N, F, M)
FNORMN = DSQRT (SENORM (F, M))
K = 0
60 CONTINUE
C
C check accuracy and if necessary stop:
C
C 1. use relative error estimate for X
C
XNORM2 = DSQRT (SENORM (X, N))
IF (XNORM2 .EQ. 0.0D0) THEN
XNORM2 = DSQRT (SENORM (S, N))
ELSE
XNORM2 = DSQRT (SENORM (S, N)) / XNORM2
ENDIF
C
C 2. find the norm of the functional value for X
C
FNORM2 = FNORMN
C
C select the smaller one of both norms
C
RNORM2 = DMIN1 (FNORM2, XNORM2)
IF (LUN .GT. 0) THEN
I = 0
WRITE (LUN,1100) IT,I,X(0),RNORM2,K
WRITE (LUN,1200) (I,X(I),I=1,N)
WRITE (LUN,1300)
ENDIF
IF (RNORM2 .LE. EPS) THEN
IERR = 0
MAXIT = IT
ENDIF
ELSE
IERR = 2
MAXIT = IT
ENDIF
IF (IT .LT. MAXIT .AND. IERR .EQ. 3) GOTO 100
ELSE
IERR = 1
MAXIT = 0
ENDIF
RETURN
1000 FORMAT (1X,'ITERATION NUMBER',10X,'APROXIMATION',14X,
1 'ACCURACY ESTIMATE K')
1100 FORMAT (1X,I6,2X,I6,8X,D22.15,6X,D22.15,2X,I3)
1200 FORMAT (1X, 6X,2X,I6,8X,D22.15)
1300 FORMAT (1X)
END
Begin of file
Contents
Index