End of file
Contents
Index



F 2.8.2 Pegasus Method


      SUBROUTINE PEGASU ( FCT,A,B,ABSERR,RELERR,MAXIT,XSI,X1,X2,
     +                    NUMIT,IERR)
C
C*****************************************************************
C                                                                *
C  We assume that the given continuous function FCT(X) satisfies:*
C          FCT(A) * FCT(B) < 0.0  on the interval [A,B].         *
C  Thus there is at least one zero of odd order in [A,B].        *
C  The SUBROUTINE PEGASU determines one of these zeros by        *
C  applying the Pegasus-method.                                  *
C  The method always converges provided the following condition  *
C  is met:                                                       *
C               FCT(A) * FCT(B) < 0.0                            *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  FCT   : function for which a zero is to be determined.        *
C          It is declared as                                     *
C              DOUBLE PRECISION FUNCTION FCT(X)                  *
C          and has to be defined as EXTERNAL within the          *
C          calling program (or as INTRINSIC if a FORTRAN         *
C          standard function is used).                           *
C  A,B   : endpoints of the interval containing a zero.          *
C  ABSERR: ) error parameters. ABSERR >= 0.0 and RELERR >= 0.0.  *
C  RELERR: ) Their sum has to be > 0.0. The following mixed test *
C            is used as the break-off criterion:                 *
C                 ABS(X1-X2) <= ABS(X2)*RELERR+ABSERR.           *
C            If RELERR=0.0, this tests the absolute error,       *
C            if ABSERR=0.0, this tests for the relative error.   *
C            The values entered for ABSERR and RELERR are accep- *
C            ted unchanged by the program if they both exceed    *
C            four times the machine constant.                    *
C            Or, if one value is zero and the other excceds      *
C            four times the machine constan, they are accepted   *
C            as well. If this is not the case both or one of the *
C            values are internally set to this value.            *
C  MAXIT : maximum number of iteration steps.                    *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  ABSERR: ) error parameters actually used.                     *
C  RELERR: )                                                     *
C  XSI   : zero or approximate value for the zero                *
C          of the function FCT.                                  *
C  X1,X2 : the last two iterates, so that [X1,X2] contains a     *
C          zero of FCT.                                          *
C  NUMIT : number of iteration steps executed.                   *
C  IERR  : =-2, ABSERR or RELERR is negative or both equal zero, *
C               or MAXIT < 1.                                    *
C          =-1, the condition FCT(A)*FCT(B) < 0.0 is not met.    *
C          = 0, A or B already are a zero of FCT.                *
C          = 1, XSI is a zero with ABS(FCT(XSI)) < 4* machine    *
C               constant.                                        *
C          = 2, break-off criterion has been met, XSI:=X2 if     *
C                   ABS(FCT(X2)) <= ABS(FCT(X1)),                *
C               otherwise XSI:=X1.                               *
C               The absolute error of the computed zero is less  *
C               than or equal to  ABS(X1-X2).                    *
C          = 3, the maximum number of iteration steps was        *
C               reached without meeting the break-off criterion. *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author     : Gisela Engeln-Muellges                           *
C  date       : 09.02.1985                                       *
C  source     : FORTRAN 77                                       *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C  initializing the parameters NUMIT, X1, X2.
C
      NUMIT=0
      X1=A
      X2=B
C
C  calculating the machine constant FMACHP.
C
      FMACHP=1.0D0
   10 FMACHP=0.5D0*FMACHP
      IF(MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 10
      FMACHP=2.0D0*FMACHP
C
C  calculating the functional values at the endpoints A and B.
C
      F1=FCT(X1)
      F2=FCT(X2)
C
C  testing for alternate signs of FCT at A and B:  FCT(A)*FCT(B) < 0.0 .
C
      IF(F1*F2 .GT. 0.0D0) THEN
         IERR=-1
         RETURN
      ELSE IF(F1*F2 .EQ. 0.0D0) THEN
         IERR=0
         RETURN
      END IF
C
C  testing for validity of the error bounds and MAXIT.
C
      IF(ABSERR .GE. 0.0D0 .AND. RELERR .GE. 0.0D0 .AND.
     +   ABSERR+RELERR .GT. 0.0D0 .AND. MAXIT .GE. 1) GOTO 20
         IERR=-2
         RETURN
   20 DUMMY=4.0D0*FMACHP
      IF(RELERR .EQ. 0.0D0) THEN
         IF(ABSERR .LT. DUMMY) ABSERR=DUMMY
      ELSE IF(ABSERR .EQ. 0.0D0) THEN
         IF(RELERR .LT. DUMMY) RELERR=DUMMY
      ELSE
         IF(ABSERR .LT. DUMMY) ABSERR=DUMMY
         IF(RELERR .LT. DUMMY) RELERR=DUMMY
      END IF
C
C  executing the Pegasus-method.
C
      DO 30 I = 1,MAXIT,1
         NUMIT=I
C
C     testing whether the value of F2 is less than four times
C     the machine constant. If this is the case, X2 is accepted
C     as a zero of FCT with IERR=1.
C
         IF(DABS(F2) .LT. 4.0D0*FMACHP) THEN
            XSI=X2
            IERR=1
            RETURN
C
C     testing for the break-off criterion.
C
         ELSE IF(DABS(X2-X1) .LE. DABS(X2)*RELERR+ABSERR) THEN
            XSI=X2
            IF(DABS(F1) .LT. DABS(F2)) XSI=X1
            IERR=2
            RETURN
         ELSE
C
C     calculating the secant slope.
C
            S12=(F2-F1)/(X2-X1)
C
C     calculating the secant intercept X3 with the x-axis.
C
            X3=X2-F2/S12
C
C     calculating a new functional value at X3.
C
            F3=FCT(X3)
C
C     definition of the endpoints of a smaller inclusion interval.
C
            IF(F2*F3 .LE. 0.0D0) THEN
               X1=X2
               F1=F2
            ELSE
               F1=F1*F2/(F2+F3)
            END IF
            X2=X3
            F2=F3
         END IF
   30 CONTINUE
      IERR=3
      RETURN
      END


Begin of file
Contents
Index