End of file
Contents
Index



F 17.3.4.4 Embedding Formulas


      SUBROUTINE RKTRB (X,BETA,N,DES,Y,ABSERR,RELERR,IFLAG,WORK1,
     +                  WORK2,IWORK,IERR)
C
C*****************************************************************
C                                                                *
C This program solves a system of at most 12 ordinary            *
C differential equations of first order by using a RUNGE-KUTTA   *
C embedding formula over the interval of integration             *
C I= [X0,BETA].                                                  *
C With the parameter IFLAG(1) one can chose the embedding formula*
C and IFLAG(2) assists in step size control.                     *
C When RKTRB is called                                           *
C first, we must have IFLAG(3)=0. RKTRB checks the input         *
C parameters and determines the necessary constants.             *
C The number of integration steps is adjusted so that maximally  *
C 10000 function evaluations are performed. If IERR = -2 , then  *
C the maximal number of steps was performed without reaching     *
C BETA. RKTRB can then be repeated with IFLAG(3)=1. Other        *
C parameters need not be adjusted.                               *
C If several intermediate values for the solution in [X0,BETA]   *
C are desired, then RKTRB must be started with IFLAG(3)=0.       *
C All subsequent calls can be executed with IFLAG(3)=1 and BETA. *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C X       : DOUBLE PRECISION initial value for the integration:  *
C           X=X0                                                 *
C BETA    : DOUBLE PRECISION endpoint X=BETA at which we want to *
C           find the solution                                    *
C N       : number of differential equations in the system,      *
C           or the size of Y:   0 < N < 13                       *
C DES     : SUBROUTINE DES must be declared as EXTERNAL in the   *
C           calling program. DES describes the system of         *
C           differential equations and must have the following   *
C           form:                                                *
C                  SUBROUTINE DES(X,Y,N,YPUNKT)                  *
C                  DOUBLE PRECISION Y(N),YPUNKT(N),X             *
C                  YPUNKT(1)=....                                *
C                  YPUNKT(2)=....                                *
C                         .                                      *
C                         .                                      *
C                         .                                      *
C                   YPUNKT(N)=....                               *
C                   RETURN                                       *
C                   END                                          *
C Y       : DOUBLE PRECISION vector Y(1:N), the solution at X=X0 *
C ABSERR  : DOUBLE PRECISION error bound for the absolute error  *
C           (ABSERR >= 0). If ABSERR=0, then only the relative   *
C           error is checked.                                    *
C RELERR  : DOUBLE PRECISION error bound for the relative error  *
C           (RELERR >= 0). If RELERR=0, then only the absolute   *
C           error is checked.                                    *
C IFLAG   : INTEGER vector IFLAG(1:3)                            *
C           IFLAG(1) choses the embedding formula:               *
C           IFLAG(1)=0 : RK3(2)                                  *
C           IFLAG(1)=1 : RKF4(3)   (FSAL)                        *
C           IFLAG(1)=2 : RKF5(4)                                 *
C           IFLAG(1)=3 : RK5(4)6M                                *
C           IFLAG(1)=4 : RKE5(4)                                 *
C           IFLAG(1)=5 : HIHA5     (FSAL)                        *
C           IFLAG(1)=6 : RK5(4)7S  (FSAL)                        *
C           IFLAG(1)=7 : RK5(4)7M  (FSAL)                        *
C           IFLAG(1)=8 : RK5(4)7C  (FSAL)                        *
C           IFLAG(1)=9 : RK6(5)8M                                *
C           IFLAG(1)=10: RK6(5)8S                                *
C           IFLAG(1)=11: RK6(5)8C                                *
C           IFLAG(1)=12: RKV6(5)                                 *
C           IFLAG(1)=13: RKF6(5)A                                *
C           IFLAG(1)=14: RKF6(5)B                                *
C           IFLAG(1)=15: RKC6(5)   (FSAL)                        *
C           IFLAG(1)=16: RKV6(5)9A (FSAL)                        *
C           IFLAG(1)=17: RKV6(5)9B (FSAL)                        *
C           IFLAG(1)=18: RKV7(6)                                 *
C           IFLAG(1)=19: RK8(7)13M                               *
C           IFLAG(1)=20: RKF8(7)                                 *
C           IFLAG(1)=21: RKV8(7)                                 *
C           IFLAG(1)=22: RKV9(8)                                 *
C           IFLAG(2) choses the step size control method:        *
C           IFLAG(2)=0 : HULL                                    *
C           IFLAG(2)=1 : CIVPS                                   *
C           IFLAG(3) describes the first or subsequent calls:    *
C           IFLAG(3)=0 : first call                              *
C           IFLAG(3)=1 : subsequent call                         *
C WORK1   : DOUBLE PRECISION vector WORK1(1:4)                   *
C           IFLAG(3)=0 : used for storage                        *
C           IFLAG(3)=1 : WORK1(1) : 100 times the machine        *
C                                   constant (EPS)               *
C                        WORK1(2) : largest representable        *
C                                   number for the computer      *
C                                   (XZI=DLARGE/100)             *
C                        WORK1(3) : global error order (QG)      *
C                        WORK1(4) : initial step size (H)        *
C WORK2   : 2-dim. DOUBLE PRECISION array WORK2(1:16,1:16)       *
C           IFLAG(3)=0 : storage                                 *
C           IFLAG(3)=1 : coefficients of the embedding formula   *
C IWORK   : INTEGER vector IWORK(1:2)                            *
C           IFLAG(3)=0 : storage                                 *
C           IFLAG(3)=1 : IWORK(1) : level of the embedding       *
C                                   formula                      *
C                        IWORK(2) : maximally allowed number of  *
C                                   integrations                 *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C X       : DOUBLE PRECISION value for X, where the integration  *
C           has stopped (normally X=BETA)                        *
C Y       : DOUBLE PRECISION solution vector Y(1:N) for X        *
C WORK1   : DOUBLE PRECISION vector WORK1(1:4)                   *
C           WORK1(1) : 100 times the machine constant (EPS)      *
C           WORK1(2) : largest representable number for the      *
C                      computer/100  (XZI)                       *
C           WORK1(3) : global error order (QG)                   *
C           WORK1(4) : last step size (H)                        *
C WORK2   : 2-dim. DOUBLE PRECISION array WORK2(1:16,1:16), the  *
C           coefficients of the embedding formula                *
C IWORK   : INTEGER vector IWORK(1:2)                            *
C           IWORK(1) : level of the embedding formula            *
C           IWORK(2) : maximally allowed number of integrations  *
C IERR    : error parameter:                                     *
C               IERR=0     all is ok                             *
C           Control of the transfer parameters:                  *
C               IERR=-2   IFLAG(3) erroneous                     *
C               If IERR is maximally 7 digits long:              *
C               1st error   1st digit equal to 1                 *
C                           wrong value for IFLAG(1)             *
C                           IERR=IERR+1000000                    *
C               2nd error   2nd digit equal to 1                 *
C                           wrong value for IFLAG(2)             *
C                           IERR=IERR+100000                     *
C               3rd error   3rd digit equal to 1                 *
C                           ABSERR and RELERR too small          *
C                           IERR=IERR+10000                      *
C               4th error   4th digit equal to 1                 *
C                           Interval of integration too small    *
C                           IERR=IERR+1000                       *
C               5th error   5th digit equal to 1                 *
C                           Interval of integration too small    *
C                           X or BETA not representable in the   *
C                           computer                             *
C                           IERR=IERR+100                        *
C               6th error   6th digit equal to 1                 *
C                           N <= 0 or N > 12                     *
C                           IERR=IERR+10                         *
C               7th error   7th digit equal to 1                 *
C                           initial condition not representable  *
C                           in the computer                      *
C                           IERR=IERR+1                          *
C               EXAMPLE     If IERR=10101 then three errors      *
C                           numbered 3, 5 and 7 occur            *
C           Run time errors:                                     *
C               IERR=-1    the desired relative accuracy is less *
C                          than 100 times the machine constant   *
C                          in certain parts of the integration   *
C                          interval. In these regions we compute *
C                          with 100 times the machine constant as*
C                          an absolute error bound.              *
C               IERR=-2    the nunber of maximally allowed steps *
C                          has been reached.                     *
C               IERR=-20   OVERFLOW, the program stops.          *
C               IERR=-30   the computed step size is too small.  *
C                          The program stops.                    *
C                                                                *
C                                                                *
C LOCAL VARIABLES:                                               *
C ================                                               *
C DSMALL  : DOUBLE PRECISION machine constant                    *
C DLARGE  : largest computer DOUBLE PRECISION number             *
C J       : loop variable                                        *
C FSAL    : (LOGICAL) variable indicating whether the method     *
C           FSAL (First Same As Last) is used by the RUNGE-KUTTA *
C           embedding formula                                    *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: DMPREC, COEFFI, HSTART, HULL, CIVPS     *
C                                                                *
C*****************************************************************
C                                                                *
C  Author   : Volker Krüger                                      *
C  Date     : 29.04.1993                                         *
C  Source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
C Declarations
C
      EXTERNAL DES
      DOUBLE PRECISION Y(N),WORK1(4),WORK2(16,16)
      INTEGER IFLAG(3),IWORK(2)
      DOUBLE PRECISION X,BETA,ABSERR,RELERR,DSMALL,DLARGE
      LOGICAL FSAL
C
C check input parameters, if erroneous,
C return to calling program
C
      IERR=0
      IF(IFLAG(3) .LT. 0 .OR. IFLAG(3) .GT. 1) THEN
        IERR=2
        RETURN
      ELSEIF(IFLAG(3) .EQ. 0) THEN
C
C   determine the machine constant and the largest
C   representable number for the computer
C
        CALL DMPREC(DSMALL,DLARGE)
        WORK1(1)=100.0D0*DSMALL
        WORK1(2)=DLARGE/100.0D0
      ENDIF
C
C   determine the appropriate error code
C
      IF(IFLAG(1) .LT. 0 .OR. IFLAG(1) .GT. 22) IERR=IERR+1000000
      IF(IFLAG(2) .LT. 0 .OR. IFLAG(2) .GT. 1) IERR=IERR+100000
      IF(RELERR .LT. WORK1(1) .AND. ABSERR .LT. WORK1(1))
     +                                            IERR=IERR+10000
      IF(DABS(BETA-X) .LT. WORK1(1)) IERR=IERR+1000
      IF(DABS(X) .GT. WORK1(2) .OR. DABS(BETA) .GT. WORK1(2))
     +                                            IERR=IERR+100
      IF(N .LE. 0 .OR. N .GT. 12) IERR=IERR+10
      DO 100 J=1,N
         IF(DABS(Y(J)) .GT. WORK1(2)) THEN
           IERR=IERR+1
           RETURN
         ENDIF
100   CONTINUE
      IF(IERR .NE. 0) RETURN
C
C End input check
C
C Method FSAL is used by the RUNGE-KUTTA embedding formula
C
      FSAL=(IFLAG(1) .EQ. 1 .OR. IFLAG(1) .GE. 5 .AND.
     +      IFLAG(1) .LE. 8 .OR. IFLAG(1) .GE. 15 .AND.
     +      IFLAG(1) .LE. 17)
      IF(IFLAG(3) .EQ. 0) THEN
C
C Set the level of the embedding formula and initialize
C the maximally allowed number of integration steps
C
        IF(IFLAG(1) .EQ. 0) THEN
          IWORK(1)=3
          IWORK(2)=3330
        ELSEIF(IFLAG(1) .EQ. 1) THEN
          IWORK(1)=5
          IWORK(2)=2500
        ELSEIF(IFLAG(1) .GE. 2 .AND. IFLAG(1) .LE. 4) THEN
          IWORK(1)=6
          IWORK(2)=1670
        ELSEIF(IFLAG(1) .GE. 5 .AND. IFLAG(1) .LE. 8) THEN
          IWORK(1)=7
          IWORK(2)=1665
        ELSEIF(IFLAG(1) .GE. 9 .AND. IFLAG(1) .LE. 14) THEN
          IWORK(1)=8
          IWORK(2)=1250
        ELSEIF(IFLAG(1) .GE. 15 .AND. IFLAG(1) .LE. 17) THEN
          IWORK(1)=9
          IWORK(2)=1250
        ELSEIF(IFLAG(1) .EQ. 18) THEN
          IWORK(1)=10
          IWORK(2)=1000
        ELSEIF(IFLAG(1) .GE. 19 .AND. IFLAG(1) .LE. 21) THEN
          IWORK(1)=13
          IWORK(2)=770
        ELSEIF(IFLAG(1) .EQ. 22) THEN
          IWORK(1)=16
          IWORK(2)=625
        ENDIF
C
C Find the coefficients and the global error order of the
C low order method in the desired RUNGE-KUTTA pair
C
        IF(IFLAG(1) .EQ. 0) THEN
          WORK1(3)=2.0D0
        ELSE
          CALL COEFFI(IWORK(1),IFLAG(1),WORK2,WORK1(3))
        ENDIF
C
C Initialize first step size
C
        CALL HSTART(DES,N,X,BETA,Y,RELERR,ABSERR,WORK1(3),
     +              DSMALL,DLARGE,WORK1(4))
      ENDIF
C
C Integrate using HULL or CIVPS
C
\hbox{\JDhspace\verb`
      IF(IFLAG(2) .EQ. 0) THEN
        CALL HULL(X,WORK1(4),BETA,ABSERR,RELERR,N,FSAL,IWORK(1),
     +            DES,Y,WORK1(1),WORK1(2),WORK1(3),WORK2,IWORK(2),
     +            IERR)
      ELSE
        CALL CIVPS(X,WORK1(4),BETA,ABSERR,RELERR,N,FSAL,IWORK(1),
     +             DES,Y,WORK1(1),WORK1(2),WORK1(3),WORK2,IWORK(2),
     +             IERR)
      ENDIF
      RETURN
      END


Begin of file
Contents
Index