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