End of file
Contents
Index



F 17.5 Bulirsch-Stoer-Gragg Extrapolation


      SUBROUTINE DESEXT (X,Y,FCT,N,XEND,H,HMAX,ABSERR,RELERR,
     F                   IERR,AUXF,LDF)
C
C*****************************************************************
C                                                                *
C  Numerical solution of a system of ordinary differential       *
C  equations                                                     *
C                                                                *
C      Y' = F(X,Y)  with  given initial condition Y(X0) = Y0     *
C                                                                *
C  using the extrapolations method of BULIRSCH-STOER.            *
C  The maximal order of the extrapolation is determined depending*
C  the machine constant; the step size control lollows [HALL76]. *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C                                                                *
C  X     : initial x value.                                      *
C  Y     : REAL vector Y(1:N), the initial value at X.           *
C  FCT   : SUBROUTINE, that evaluates the right hand side of the *
C          system of differential equations. It has to be of the *
C          following form:                                       *
C                                                                *
C             SUBROUTINE FCT(X,Y,F,N)                            *
C             DOUBLE PRECISION X, Y(N), F(N)                     *
C                  .                                             *
C                  .                                             *
C                  .                                             *
C                                                                *
C          In the calling program it has to be defined as        *
C          EXTERNAL. In it the variables have the following      *
C          meaning:                                              *
C             X   independent variable.                          *
C             Y   dependent variable.                            *
C             F   function value of the right hand side of the   *
C                 system of differential equations Y'=F(X,Y)     *
C             N   number of differential equations.              *
C  N     : number of differential equations.                     *
C  XEND  : location where the solution is desired; may be        *
C          smaller than X.                                       *
C  H     : step size for the next step. Normally it is deter-    *
C          mined by the program.                                 *
C  HMAX  : maximally allowed step size, it has to be positivs.   *
C  ABSERR:)                                                      *
C  RELERR:) error parameters, which have to be >= 0. A mixed     *
C           test is performed:                                   *
C              ABS (LOCAL ERROR) .LE. ABS(Y)*RELERR + ABSERR.    *
C           Thus if RELERR = 0 is chosen, this corresponds to a  *
C           test for the absolute error. If ABSERR = 0 is chosen,*
C           this corresponds to a test for the relative error.   *
C           RELERR and ABSERR should be chosen larger than ten   *
C           times the machine constant. If this is not the case, *
C           they are automatically set equal to this value.      *
C  IERR  : error parameter, on first call it has to be set equal *
C          to 0.                                                 *
C  AUXF  : REAL auxiliary array AUXF(1:LDF,12), LDF .GE. N, with *
C          LDF as defined in the calling program.                *
C  LDF   : leading dimension of AUXF.                            *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C                                                                *
C  X     : x value that was reached after last during integration*
C          Normally  X = XEND.                                   *
C  Y     : solution value at X.                                  *
C  H     : step size used last, this should remain unchanged for *
C          the next step. If it is changed IERR has to be set to *
C          equal zero.                                           *
C  IERR  : error parameter.                                      *
C          = 0: everything o.k., after resetting of XEND,        *
C               DESEXT can be called again.                      *
C          = 1: after 700 function evaluations the procedure did *
C               not reach XEND. A repeated call without any      *
C               change of the parameters may be successful.      *
C               (otherwise try with increased error parameters)  *
C          = 2: the step size is below four times the machine    *
C               constant for an x value. Before further calls H  *
C               and the error parameters must be increased.      *
C          = 3: ABSERR or RELERR is negative or both             *
C               ABSERR = 0.0 and RELERR = 0.0.                   *
C          = 4: XEND is equal to X.                              *
C          = 5: HMAX is negative.                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Jobst Hoffmann                                     *
C  date     : 04.21.1990                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      DIMENSION Y(N),AUXF(LDF,12),BUFOL(12)
      LOGICAL IND
C
      SAVE IEXTMX, FMACHP, IND
C
      DATA IND /.TRUE./, ICTMAX/700/
      DATA BUFOL/ 2.0D0, 4.0D0, 6.0D0, 8.0D0,12.0D0, 16.0D0,
     F           24.0D0,32.0D0,48.0D0,64.0D0,96.0D0,128.0D0/
      IF ( IND ) THEN
C.
C     determine machine constant
C.
        FMACHP = 1.0D0
    5   FMACHP = 0.5D0 * FMACHP
        IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 5
        FMACHP = FMACHP * 2.0D0
C.
C     determine the maximal level of extrapolation. Due to
C     increasing rounding errors effects, extrapolation should not be
C     performed at a higher level.
C.
        IEXTMX = INT(-DLOG(FMACHP)/DLOG(2.0D0)/7.0D0 + 0.5D0)
        IND = .FALSE.
      ENDIF
C.
C     Checking input data, initializing variables.
C.
      IF ( ABSERR .LT. 0.0D0 .OR. RELERR .LT. 0.0D0 .OR.
     F     ABSERR + RELERR .LE. 0.0D0 ) THEN
         IERR = 3
         RETURN
      ELSEIF ( XEND .EQ. X ) THEN
         IERR = 4
         RETURN
      ELSEIF ( HMAX .LE. 0.0D0 ) THEN
         IERR = 5
         RETURN
      ENDIF
      ICOUNT = 0
      IF ( IERR .EQ. 1 ) GOTO 150
      ILINE = 0
      YMAX = 0.0D0
C.
C     determin the first step size
C.
   20 ABSH = DABS(H)
      IF ( HMAX .LT. ABSH ) ABSH = HMAX
      HLOC = DSIGN(DMIN1(ABSH,DABS(XEND-X)),XEND - X)
      IF ( DABS(HLOC) .LE. FMACHP*DABS(X) ) THEN
         IERR = 0
         RETURN
      ENDIF
C.
C     determine the step size for the extrapolation.
C.
   30 ILINE = ILINE + 1
      H0 = HLOC/BUFOL(ILINE)
C.
C     EULER step, store the initial values.
C.
      X0 = X
      DO 40 I=1,N
         AUXF(I,9) = Y(I)
   40 CONTINUE
      CALL FCT (X0,AUXF(1,9),N,AUXF(1,12))
      DO 50 I=1,N
         AUXF(I,10) = AUXF(I,9) + H0*AUXF(I,12)
   50 CONTINUE
      X0 = X0 + H0
      CALL FCT (X0,AUXF(1,10),N,AUXF(1,12))
C.
C     the midpoint rule is applied
C     BUFOL(ILINE)-1 - times.
C.
      IBUFO = INT(BUFOL(ILINE)) - 1
      DO 90 NLOOPS=1,IBUFO
         DO 60 I=1,N
            AUXF(I,11) = AUXF(I,9) + 2.0D0*H0*AUXF(I,12)
   60    CONTINUE
         X0 = X0 + H0
         CALL FCT (X0,AUXF(1,11),N,AUXF(1,12))
C.
C     alter storage for the next step.
C.
         DO 80 J=9,11
            DO 70 I=1,N
               AUXF(I,J) = AUXF(I,J+1)
   70       CONTINUE
   80    CONTINUE
   90 CONTINUE
C.
C     stabilize using the trapezoidal rule.
C.
      CALL FCT (X0,AUXF(1,10),N,AUXF(1,12))
      DO 100 I=1,N
         AUXF(I,ILINE) = 0.5D0*(AUXF(I,10) + AUXF(I,9) +
     F                         H0*AUXF(I,12))
  100 CONTINUE
C.
C     at least two values are required for the extrapolation.
C.
      IF ( ILINE .EQ. 1 ) GOTO 30
C.
C     extrapolation.
C.
      MINZ = MIN0(ILINE,IEXTMX)
      DO 120 ICOLUM=2,MINZ
         IDUMMY = MIN0(11-ICOLUM,ILINE-ICOLUM+2)
         DMAX = 0.0D0
         DO 110 I=1,N
            AUXF(I,IDUMMY-1) = AUXF(I,IDUMMY) + ( AUXF(I,IDUMMY)
     F       - AUXF(I,IDUMMY-1))/((BUFOL(ILINE)/BUFOL(IDUMMY-1))**2 - 1)
            YMAX = DMAX1(YMAX,DABS(AUXF(I,IDUMMY-1)))
            DMAX = DMAX1(DMAX,DABS(AUXF(I,IDUMMY-1) - AUXF(I,IDUMMY)))
  110    CONTINUE
         IF ( DMAX .LT. RELERR*YMAX + ABSERR ) GOTO 180
  120 CONTINUE
      ICOUNT = ICOUNT + INT(BUFOL(ILINE)) + 1
      IF ( ICOUNT .GE. ICTMAX ) THEN
C.
C        return with message for excessive functional evaluations,
C        store the current data.
C.
         IERR = 1
         AUXF(1,10) = X
         DO 130 I=1,N
            AUXF(I,9) = Y(I)
  130    CONTINUE
         X = X0
         DO 140 I=1,N
            Y(I) = AUXF(I,IDUMMY-1)
  140    CONTINUE
         RETURN
      ENDIF
      GOTO 170
C.
C     entry point on repeat call following return due to
C     excessive functional evaluations.
C.
  150    X = AUXF(1,10)
         DO 160 I=1,N
            Y(I) = AUXF(I,9)
  160    CONTINUE
  170 IF ( ILINE .LT. 8 ) GOTO 30
C.
C     despite a completed extrapolation scheme the
C     required accuracyprecision was not achieved,
C     calculations are repeated with a smaller step size.
C.
      H = 0.9D0*0.6D0**(ILINE-IEXTMX)*H
      IF ( DABS(H) .LE. 4.0D0*FMACHP*DABS(X0) ) THEN
         IERR = 2
         RETURN
      ENDIF
      ILINE = 0
      GOTO 30
C.
C     the required accuracy was achieved.
C.
  180 X = X + HLOC
      DO 190 I=1,N
         Y(I) = AUXF(I,IDUMMY-1)
  190 CONTINUE
C.
C     the next step size is determined.
C.
      H = 0.9D0*0.6D0**(ICOLUM - IEXTMX)*H
      ILINE = 0
      GOTO 20
      END


Begin of file
Contents
Index