End of file
Contents
Index
SUBROUTINE SMNEWT (FX,DFX,N,MAXIT,IERR,KMAX,LUN,EPS,
1 RNORM2,F,X,DF,LDDF,IWORK,WORK)
C
C*****************************************************************
C *
C SMNEWT finds a solution of the nonlinear system of *
C equations *
C F1(X(1),...,X(N))=0 *
C F2(X(1),...,X(N))=0 *
C - - - - - - - - - - *
C FN(X(1),...,X(N))=0 *
C *
C via the damped Newton method, if it converges for the *
C starting vector. *
C *
C Three break-off criteria are used: *
C 1. maximum number of iterations is reached *
C 2. euclidean norm of the difference between the old and *
C new approximate solutions is smaller than or equal to *
C the preset accuracy bound EPS *
C 3. euclidean norm the function value at the the new *
C approximation is smaller than or equal to EPS *
C *
C If desired, output of intermediate results can be *
C generated via input parameter LUN. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C FX : SUBROUTINE that has to be provided by the user. *
C It defines the system of equations to be solved. *
C In the calling program FX has to be defined as *
C EXTERNAL and must have the form: *
C SUBROUTINE FX (N,X,F) *
C DOUBLE PRECISION X(N),F(N) *
C F(1) = F1 (X(1),...,X(N)) *
C F(2) = F2 (X(1),...,X(N)) *
C - - - - - - - - - - - - - - *
C F(N) = FN (X(1),...,X(N)) *
C RETURN *
C END *
C DFX : SUBROUTINE, that has to be provided by the user. *
C It determines the Jacobi matrix of FX. *
C In the calling program DFX has to be defined as *
C EXTERNAL in the form: *
C SUBROUTINE DFX (N,X,DF,LDDF) *
C DOUBLE PRECISION DF(LDDF,N), X(N) *
C DF(1,1) = (D F1/D X1) (X(1),...,X(N)) *
C ..................................... *
C DF(1,N) = (D F1/D XN) (X(1),...,X(N)) *
C DF(2,1) = (D F2/D X1) (X(1),...,X(N)) *
C ..................................... *
C DF(2,N) = (D F2/D XN) (X(1),...,X(N)) *
C - - - - - - - - - - - - - - - - - - - *
C DF(LDDF,1)=(D FN/D X1) (X(1),...,X(N)) *
C ..................................... *
C DF(LDDF,N)=(D FN/D XN) (X(1),...,X(N)) *
C RETURN *
C END *
C N : number of equations and number of unknowns in the *
C given system of equations *
C LUN : > 0, file number onto which the iteration steps *
C are output *
C = 0, no output *
C MAXIT : maximum number of iterations to be executed *
C KMAX : damping bound >= 0 ; if KMAX = 0 the standard *
C Newton method is used *
C EPS : error parameter *
C X : N-vector X(1:N); starting vector *
C DF : 2-dimensional array DF(1:LDDF,1:N); the Jakobi matrix*
C (provision of storage space) *
C LDDF : leading dimension of DF as defined in the calling *
C program. LDDF >= N *
C IWORK : N-vector IWORK(1:N); auxiliary vector for the pivot *
C vector for solving the linear system of equations *
C WORK : (4N)-vector WORK(1:4*N); work vector for X, -DELTA X,*
C the old X and for the scaling factors in GAUSSP or *
C for the functional values *
C *
C *
C OUTPUT PARAMETERS: *
C ================== *
C MAXIT : number of iterations executed *
C IERR : error parameter *
C IERR=0 : successful run *
C IERR=1 : after MAXIT steps the desired accuracy was *
C not reached *
C IERR=2 : error when solving the linear system of *
C equations (matrix is singular) *
C IERR=3 : incorrect input parameter *
C RNORM2 : accuracy estimate *
C RNORM2 = MIN (XNORM2,FNORM2) *
C (compare description of local variables) *
C X : N-vector X(1:N); approximate solution *
C F : N-vector F(1:N); functional values at the new *
C approximate solution *
C *
C *
C LOCAL VARIABLES: *
C ================ *
C MARK : error parameter of GAUSSP *
C IX : starting index for the vector X in WORK *
C IDELTA : starting index for the stepsize DELTA X in WORK *
C IXOLD : starting index for the old approximate solution X in *
C WORK *
C IFGAUS : starting index for the scaling factors of GAUSSP in *
C WORK *
C IF : starting index for the functional value vector at X. *
C In work this storage space is shared with the one *
C for the scaling factors in GAUSSP. *
C XANRM2 : euclidean norm of F(X) *
C XNNRM2 : euclidean norm of F(X + 1/2**K * DELTA X) *
C XNNRMH : set equal to XNNRM2; however, it is not erased during*
C damping. Therefore it can be used later instead of *
C XNNRM2 if there has been no damping; thus XNNRM2 is *
C equal to XNRMH with K=0. *
C XNORM2 : relative accuracy *
C FNORM2 : euclidean norm of the function at the new approximate*
C solution *
C K : damping loop counter. The damping factor is 1/2**K *
C IT : Newton iteration loop counter *
C I : control variable *
C *
C----------------------------------------------------------------*
C *
C subroutines required: GAUSSP, GAUSSS, FENORM *
C *
C*****************************************************************
C *
C author : Thomas Eul *
C date : 05.13.1985 *
C source : FORTRAN 77 *
C *
C*****************************************************************
C
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INTEGER MARK,N,MAXIT,IERR,IX,IF,IXOLD,IFGAUS,IT,K,I,LUN,
1 KMAX,LDDF
INTEGER IWORK(N)
DOUBLE PRECISION F(N), DF(LDDF,N), X(N), WORK(4*N)
C
C*****************************************************************
C* checking the input parameters *
C*****************************************************************
C
IF (MAXIT .GT. 0 .AND. KMAX .GE. 0 .AND. EPS .GT. 0.0D0 .AND.
1 N .GT. 0 .AND. LUN .GE. 0 .AND. LDDF .GE. N) THEN
C
C*****************************************************************
C* initialization *
C*****************************************************************
C
IERR = 1
IX = 1
IDELTA = N + 1
IXOLD = 2*N + 1
IFGAUS = 3*N + 1
IF = 3*N + 1
K = 0
IT = 0
C
C*****************************************************************
C* Newton iteration *
C*****************************************************************
C
IF (LUN .GT. 0) THEN
I = 1
WRITE (LUN,1000)
WRITE (LUN,1100) IT,I,X(1)
WRITE (LUN,1200) (I,X(I),I=2,N)
ENDIF
C
C calculating the function value and its euclidean
C norm at the starting point
C
CALL FX (N,X,F)
FNORM2 = FENORM (N,F)
100 CONTINUE
IT = IT + 1
C
C calculation of the function value at new approximation.
C If damping was used, this amounts only to a relabelling
C since the use of norms in the damped algorithm presuppose
C knowledge of the new function values
C
IF (K .GT. 0) THEN
DO 10 I = 1,N
F(I) = WORK(IF+I-1)
10 CONTINUE
ENDIF
C
C in the new step the euclidean norm of the function value,
C FNORM2, at the new approximation becomes the norm of
C the function value at the old approximate solution
C
XANRM2 = FNORM2
C
C calculation of the Jacobi matrix
C
CALL DFX (N,X,DF,LDDF)
C
C*****************************************************************
C* solving DF * DELTA X = F *
C*****************************************************************
C
C 1. LR factorization
C
CALL GAUSSP (N,DF,LDDF,IWORK,MARK,WORK(IFGAUS))
C
C checking for nonsingularity
C
IF (MARK .NE. 0) THEN
C
C 2. solving the linear system of equations by
C using the LR factors from GAUSSP
C
CALL GAUSSS (N,DF,LDDF,IWORK,F,WORK(IDELTA))
C
C*****************************************************************
C* iteration step without damping, saving of the old X, and *
C* determining the euclidean norm of F(X + DELTA X) *
C*****************************************************************
C
DO 20 I = 1,N
WORK(IX +I-1) = X(I)
WORK(IXOLD+I-1) = X(I)
X(I) = X(I) - WORK(IDELTA+I-1)
20 CONTINUE
C
C determination of the norm of F(X + DELTA X)
C
CALL FX (N,X,F)
XNNRM2 = FENORM (N,F)
XNNRMH = XNNRM2
C
C*****************************************************************
C* damping *
C*****************************************************************
C
K = 0
200 IF (K .EQ. KMAX .OR. XANRM2 .GT. XNNRM2) GOTO 300
K = K + 1
C
C Newton step with damping
C
DO 30 I = 1,N
WORK(IDELTA+I-1) = 0.5D0 * WORK(IDELTA+I-1)
WORK(IX+I-1) = WORK(IXOLD+I-1) - WORK(IDELTA+I-1)
30 CONTINUE
C
C determining the euclidean norm of F(X + 1/2**K * DELTA X)
C
CALL FX (N,WORK(IX),WORK(IF))
XNNRM2 = FENORM (N,WORK(IF))
GOTO 200
300 CONTINUE
C
C if XANRM2 > XNNRM2, calculations are continued
C with damping; K=0 indicates that there was
C no damping
C
IF (XANRM2 .GT. XNNRM2 .AND. K .GT. 0) THEN
DO 40 I = 1,N
X(I) = WORK(IX+I-1)
40 CONTINUE
ELSE
K = 0
ENDIF
C
C*****************************************************************
C* test for accuracy and possible stop *
C*****************************************************************
C
C 1. checking the second break-off criterion,
C i.e., determining XNORM2
C
DO 50 I = 1,N
WORK(IX+I-1) = X(I) - WORK(IXOLD+I-1)
50 CONTINUE
XNORM2 = FENORM (N,X)
IF (XNORM2 .GT. 0) THEN
XNORM2 = FENORM (N,WORK(IX)) / XNORM2
ELSE
XNORM2 = FENORM (N,WORK(IX))
ENDIF
C
C 2. checking the third break-off criterion,
C i.e., determining FNORM2
C
IF (K .GT. 0) THEN
FNORM2 = XNNRM2
ELSE
FNORM2 = XNNRMH
ENDIF
C
C the smallest of the two error estimates is chosen
C
IF (XNORM2 .GT. FNORM2) THEN
RNORM2 = FNORM2
ELSE
RNORM2 = XNORM2
ENDIF
IF (LUN .GT. 0) THEN
I = 1
WRITE (LUN,1100) IT,I,X(1),RNORM2,K
WRITE (LUN,1200) (I,X(I),I=2,N)
ENDIF
IF (RNORM2 .LE. EPS) THEN
MAXIT = IT
IERR = 0
ENDIF
ELSE
IERR = 2
MAXIT = IT
ENDIF
IF (IT .LT. MAXIT .AND. IERR .EQ. 1) GOTO 100
ELSE
IERR = 3
MAXIT = 0
ENDIF
C
C*****************************************************************
C* formats *
C*****************************************************************
C
1000 FORMAT (1X,'ITERATION STEP',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)
C
RETURN
END
Begin of file
Contents
Index