End of file
Contents
Index



F 8.2.2 Nonlinear Root-Mean-Square Fitting


      SUBROUTINE SNLFIT (X, Y, W, IWFL, PHI, JNDVT, DVT, MAXIT,
     +                  PSI, LDA, M, N, INUM, EPS, A, D, S, C,
     +                  FV, SQERR, IERR)
C
C*****************************************************************
C                                                                *
C  The SUBROUTINE SNLFIT computes a non-linear discrete fitting  *
C  for M+1 given pairs of values (X(I), Y(I)), I=0, ..., M,      *
C  possibly using weights, by finding a non-linear approximating *
C  function defined by N+1 parameters C(K), K=0, ..., M.         *
C  The model functions have to be provided by the user as a      *
C  FUNCTION-subroutine. Additionally a SUBROUTINE called DVT may *
C  be provided by the user (if JNDVT = 0) that determines the    *
C  partial derivatives with respect to C(K) for K=0, ..., N.     *
C  Based on an initial approximation for the desired parameters, *
C  the optimal parameters for the fitting function are           *
C  determined using the damped Newton-method for non-linear      *
C  systems. The linear minimization problem that is to be solved *
C  for each iteration step is solved using Householder           *
C  transformations.                                              *
C  Finally, the value of the fitting function is determined for  *
C  INUM given locations.                                         *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C                                                                *
C  X     (N+1)-vector X(0:M) containing the X-values of the nodes*
C  Y     (N+1)-vector Y(0:M) containing the Y-values at the nodes*
C  W     (N+1)-vector W(0:M) containing the positive weights     *
C  IWFL  if IWFL = 0, the nodes will be weighed according to the *
C        weights in W.                                           *
C        Otherwise, all weights are set to 1, i.e., there is no  *
C        need to define values for W                             *
C  PHI   FUNCTION-subroutine for the model functions defined in  *
C        the following form:                                     *
C                                                                *
C           DOUBLE PRECISION FUNCTION PHI (C, N, X)              *
C           IMPLICIT DOUBLE PRECISION (A-H,O-Z)                  *
C           INTEGER N                                            *
C           DIMENSION C(0:N), X                                  *
C           --------------------                                 *
C           PHI = value of the model function at X               *
C           --------------------                                 *
C           RETURN                                               *
C           END                                                  *
C                                                                *
C        In the calling program PHI has to be declared as        *
C        EXTERNAL.                                               *
C                                                                *
C  JNDVT if JNDVT = 0, the user has provided a subroutine called *
C        DVT that determines the partial derivatives.            *
C        Otherwise the partial derivatives are approximated by   *
C        central difference quotients.                           *
C  DVT   user supplied SUBROUTINE that determines the partial    *
C        derivatives:                                            *
C                                                                *
C            SUBROUTINE DVT (X, C, N, F)                         *
C            IMPLICIT DOUBLE PRECISION (A-H,O-Z)                 *
C            INTEGER N                                           *
C            DIMENSION C(0:N), F(0:N)                            *
C            ----------------------                              *
C            F(0) = partial derivative w. r. t. C(0) at X        *
C             .                                                  *
C             .                                                  *
C             .                                                  *
C            F(N) = partial derivative w.r.t C(N) at X           *
C            ----------------------                              *
C            RETURN                                              *
C            END                                                 *
C                                                                *
C        In the calling program DVT has to be defined as         *
C        EXTERNAL.                                               *
C  MAXIT maximum number of iterations to be performed            *
C  PSI   INUM-vector PSI(1:INUM) containing the locations where  *
C        the fitting function is to be evaluated                 *
C  LDA   leading dimension of the matrix A   (LDA >= M )         *
C  M     M+1 = number of nodes                                   *
C  N     N+1 = number of model functions used                    *
C  INUM  at INUM locations the fitting function is to evaluated  *
C  EPS   relative error bound for the precision of the optimal   *
C        parameters                                              *
C  C     (N+1)-vector C(0:N) containing the initial approxima-   *
C        tions for the parameters                                *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETERS:                                         *
C  =====================                                         *
C                                                                *
C  A     2-dim array A(0:LDA, 0:N+2), the Jacobi matrix          *
C  D     (N+1)-vector D(0:N), auxiliary vector for SHOUSE        *
C  S     (N+1)-vector S(0:N) for the Newton-direction            *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C                                                                *
C  C      (N+1)-vector C(0:N), containing the parameters for the *
C         fitting function                                       *
C  FV     INUM-vector FV(1:INUM), containing the values of the   *
C         fitting function at the INUM given locations           *
C         PSI(I), I=1(1)INUM                                     *
C  IERR   error parameter:                                       *
C         = 0  : everything o.k.                                 *
C         = 1  : error in the input parameters                   *
C         = 2  : an error occurred in SUBROUTINE SHOUSE because  *
C                (numerically) the functional matrix does not    *
C                have maximal rank                               *
C         = 3  : after MAXIT iterations the required precision   *
C                was not reached, i.e., either EPS was chosen    *
C                too small or the iteration does not converge    *
C                possibly because the original approximations    *
C                were too imprecise.                             *
C  SQERR  least square error                                     *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: SNLPRE, 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)
      DOUBLE PRECISION NEWERR
      INTEGER IWFL, JNDVT, MAXIT, LDA, M, N, INUM, IERR
      DIMENSION  X(0:M), Y(0:M), W(0:M), PSI(INUM), A(0:LDA,0:N+2),
     +           D(0:N), S(0:N), C(0:N), FV(INUM)
      EXTERNAL DVT, PHI
      IERR = 0
C
C  testing the input parameters
C
      IF (M .LT. N .OR. LDA .LT. M .OR. MAXIT .LE. 0
     +           .OR. EPS .LE. 0.0D0 .OR. M .LE. 0 .OR. N .LE. 0) THEN
         IERR = 1
         RETURN
      ENDIF
C
C  determine the machine constant if the Jacobi matrix
C  will be computed via central difference quotients
C
      IF (JNDVT .NE. 0) THEN
         EPSMA = 1.0D0
    2    EPSMA = EPSMA * 0.5D0
         IF (MACHPD(EPSMA + 1.0D0) .EQ. 1) GOTO 2
         EPSMA = EPSMA * 2.0D0
      ENDIF
C
C  store the weights W in the N+2-nd column of A
C
      IF (IWFL .EQ. 0) THEN
         DO 5 I=0,M
            A(I,N+2) = DSQRT (W(I))
    5    CONTINUE
      ELSE
         DO 6 I=0,M
            A(I,N+2) = 1.0D0
    6    CONTINUE
      ENDIF
C
C  form the differences between the Y-values at the nodes
C  and the values of the fitting function (considering the
C  weights) and store in the N+1-st column of A
C
      DO 10 I=0,M
         A(I,N+1) = (Y(I) - PHI (C, N, X(I))) * A(I,N+2)
   10 CONTINUE
C
C  determine the square error
C
      SQERR = SENORM (A(0,N+1), M)
      L = 1
C
C  Newton-iteration:
C  -----------------
C  form the functional matrix considering the weights
C
  100 CALL SNLPRE (X, A(0,N+2), PHI, DVT, JNDVT, C, LDA, M, N,
     +             EPSMA, D, A)
C
C  determine an improvement S;
C  if in this process an error occurs in SUBROUTINE SHOUSE,
C  due to the matrix A (numerically) not having maximal rank,
C  then we set  IERR = 2 and return
C
      CALL SHOUSE (A, LDA, M, N, D, S, MARK)
      IF (MARK .EQ. 1) THEN
         IERR = 2
         RETURN
      ENDIF
C
C  damped Newton step
C
      DO 40 K=0,10
         SMOOTH = 1.0D0 / 2.0D0 ** K
         DO 20 I=0,N
            D(I) = C(I) + S(I) * SMOOTH
   20    CONTINUE
         DO 30 I=0,M
            A(I,N+1) = (Y(I) - PHI(D, N, X(I))) * A(I,N+2)
   30    CONTINUE
         NEWERR = SENORM (A(0,N+1), M)
         IF (NEWERR .LE. SQERR) GOTO 50
   40 CONTINUE
C
C  next, the difference between the old and the new
C  approximations is stored in S and thereafter the new
C  approximation is stored in C
C
   50 DO 60 I=0,N
         S(I) = C(I) - D(I)
         C(I) = D(I)
   60 CONTINUE
C
C  check the stopping criteria
C
      IF (SENORM(S,N) .GT. EPS * SENORM(C,N)) THEN
         IF (L .LT. MAXIT) THEN
            SQERR = NEWERR
            L = L + 1
            GOTO 100
         ELSE
            IERR = 3
            RETURN
         ENDIF
      ENDIF
C
C  if the required precision has been reached, the functional
C  values of the computed fitting function are computed at
C  the locations specified in PSI
C
      DO 70 I=1,INUM
         FV(I) = PHI(C, N, PSI(I))
   70 CONTINUE
C
C  determine least square error
C
      SQERR = DSQRT(NEWERR)
      MAXIT = L
      RETURN
      END


Begin of file
Contents
Index