End of file
Contents
Index



F 17.3.5 Implicit Runge-Kutta Methods of Gaussian Type


      SUBROUTINE IRKDRV (DES,N,MMAX,IFLAG,LUNIN,LUNOUT,LUNPR,IERR,
     1                   EPSM,EPS,G,X0,XEND,Y0,YQ,
     2                   WORK1,WORK21,WORK22,WORK23)
C
C*****************************************************************
C                                                                *
C IRKDRV solves an initial value problem (IVP) with N            *
C differential equations of 1st order.                           *
C The IVP is solved by the implicit RUNGE-KUTTA method (IRKV).   *
C In it both step size control and a control of the order of the *
C IRKV is used. The nodes for the IRKV are stored in a file,     *
C numbered LUNIN. This file can be produced by the SUBROUTINE    *
C IRKCOE.                                                        *
C SUBROUTINE IRKDRV is only a driver routine for providing       *
C storage space, for testing of the input parameters and for     *
C calling two subroutines according to the setting of the        *
C parameter IFLAG:                                               *
C IFLAG=0       : We only solve the SVP. We assume that the node *
C                 file already exists.                           *
C IFLAG=1       : Before solving the IVP we must produce the node*
C                 file numbered LUNIN, by SUBROUTINE IRKCOE.     *
C                                                                *
C The solution of the IVP is found in the SUBROUTINE IMRUKU.     *
C A description of the algorithm used can be found there.        *
C                                                                *
C                                                                *
C INPUT PARAMETERS:                                              *
C =================                                              *
C DES     : name of a subroutine, that represents the system of  *
C           differential equations. This subroutine has to be    *
C           declared as EXTERNAL in the calling program. It has  *
C           the form:                                            *
C                 SUBROUTINE DES (N,X,Y,F)                       *
C                 INTEGER N                                      *
C                 DOUBLE PRECISION X, Y(N), F(N)                 *
C                 F(1) = F1(X,Y(1),Y(2),...,Y(N))                *
C                 F(2) = F2(X,Y(1),Y(2),...,Y(N))                *
C                 -------------------------------                *
C                 F(N) = FN(X,Y(1),Y(2),...,Y(N))                *
C                 RETURN                                         *
C                 END                                            *
C N       : The number of differential equations                 *
C MMAX    : maximally allowed order, i.e. the highest order for  *
C           which coefficients are available in an auxiliary     *
C           file addressed at LUNIN. MMAX has to be >= 5.        *
C           It is not advisable to chose the maximum order NMAX  *
C           too high, since the quality of this procedure        *
C           strongly depends on the machine constant. E.g. on a  *
C           CONTROL DATA CYBER 175 with a DOUBLE PRECISION       *
C           machine constant of 2.5D-29, chosing NMAX = 12 has   *
C           proved adequate at the Computer center of the RWTH   *
C           Aachen. For other machines a larger MMAX may well be *
C           meaningful.                                          *
C IFLAG   : =0; solve the IVP only.                              *
C           =1; before solving the IVP, we must produce the node *
C               file. The generated nodes are the GAUSS-LEGENDRE *
C               nodes.                                           *
C LUNIN   : number of the file that contains the nodes for all   *
C           IRKMs up to order MMAX.                              *
C           This file can be produced by the SUBROUTINE IRKCOE.  *
C LUNOUT  : if output of intermediate points is desired (as de-  *
C           termined by the algorithm), a file with number LUNOUT*
C           is created for any LUNOUT > 0. If LUNOUT=0, there is *
C           no output.                                           *
C LUNPR   : >0; create a log file under number LUNPR, which      *
C               contains intermediate results and the algorithm  *
C               flow log.                                        *
C           =0; no output                                        *
C EPSM    : DOUBLE PRECISION machine constant                    *
C           If EPSM <= 0, the machine constant is taken from     *
C           IRKDVR.                                              *
C EPS     : desired relative accuracy                            *
C G       : vector G(1:N); the weights G(I) allow varied weighing*
C                          of the components Y(I) with respect to*
C                          the machine constant EPS. If all com- *
C                          ponents are to have the same weight,  *
C                          then G(I)=1 is chosen for all I.      *
C                          W A R N I N G:                        *
C                          If G(I)=0 for one I, division by zero *
C                          could occur if the corresponding      *
C                          components of the partial derivatives *
C                          on the right hand side are equal to   *
C                          zero. The program will not cover for  *
C                          this terminal error!                  *
C X0      : lower limit of the integration interval              *
C XEND    : upper limit of the integration interval              *
C Y0      : vector Y0(1:N); initial values Y(X0) at X0           *
C WORK1   : auxiliary vector WORK1(1:8*MMAX+5*N-2)               *
C WORK21  : 2-dimensional auxiliary array WORK21(1:N,1:N)        *
C WORK22  : 2-dimensional auxiliary array                        *
C           WORK22(1:N+MMAX-1,1:MMAX-1)                          *
C WORK23  : 2-dimensional auxiliary array                        *
C           WORK23(1:2*N+MMAX,1:MMAX)                            *
C                                                                *
C                                                                *
C OUTPUT PARAMETERS:                                             *
C ==================                                             *
C IERR    : error parameter                                      *
C           =0; run was successful                               *
C           =1; no convergence. Possible remedy: increase the    *
C               maximal order MMAX.                              *
C           =2; wrong input parameter(s)                         *
C EPS     : estimate for the largest local relative error        *
C YQ      : vector YQ(1:N); approximation for the solution of    *
C           the IVP.                                             *
C                                                                *
C                                                                *
C LOCAL VARIABLES:                                               *
C ================                                               *
C I       : loop variable                                        *
C FMACHP  : auxiliary variable for determining the machine       *
C           constant                                             *
C ZERO    : logic variable                                       *
C           =.TRUE. ,if G(I)=0 for all I                         *
C           =.FALSE. otherwise                                   *
C                                                                *
C                                                                *
C All other local variables are INTEGER variables and serve for  *
C subdividing the auxiliary arrays for the subroutines:          *
C                                                                *
C IFAC, IDELTK, IHEPS, IALPH, IALPHQ, IA, IAQ, IF0, IF1, IDFDX,  *
C IY, IYOLD, IDBLK, IBETA, IBETAQ, IDBLKQ, IDB, IC.              *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: IRKCOE, IMRUKU, IRKRT, GALE0, MACHPD    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Thomas Eul                                         *
C  date     : 09.17.1985                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C     parameters
C
      EXTERNAL DES
      INTEGER   N, MMAX, IFLAG, LUNIN, LUNOUT, LUNPR, IERR
      DIMENSION G(N), Y0(N), YQ(N),
     1          WORK1(8*MMAX+5*N-2), WORK21(N,N),
     2          WORK22(N+MMAX-1,MMAX-1), WORK23(2*N+MMAX,MMAX)
      DOUBLE PRECISION EPSM, EPS, X0, XEND
C
C     local variables
C
      LOGICAL ZERO
      INTEGER I, IFAC, IDELTK, IHEPS, IALPH, IALPHQ, IA, IAQ,
     1        IF0, IF1, IDFDX, IY, IYOLD, IDBLK, IBETA, IBETAQ,
     2        IDBLKQ, IDB, IC ,IHELP, IBETA2, IDBKQ2, IDB2
      DOUBLE PRECISION FMACHP
C
C*****************************************************************
C*               testing the input parameters                    *
C*****************************************************************
C
      I = 1
      ZERO = .TRUE.
   10 CONTINUE
         IF (G(I) .NE. 0.0D0) ZERO = .FALSE.
         I = I + 1
      IF (ZERO .AND. I .LE. N) GOTO 10
C
      IF (N .LE. 0 .OR. MMAX .LE. 4 .OR. LUNIN .LE. 0 .OR.
     1    LUNOUT .LT. 0 .OR. LUNPR .LT. 0 .OR. EPS .LE. 0.0D0 .OR.
     2    ZERO .OR. IFLAG .LT. 0 .OR. IFLAG .GT. 1) THEN
         IERR = 2
      ELSE
C
C*****************************************************************
C*  determine the addresses for subdividing the auxiliary arrays *
C*****************************************************************
C
         IFAC   = 1
         IDELTK = IFAC   + MMAX
         IHEPS  = IDELTK + 2*MMAX
         IALPH  = IHEPS  + MMAX
         IALPHQ = IALPH  + MMAX-1
         IA     = IALPHQ + MMAX
         IAQ    = IA     + MMAX-1
         IF0    = IAQ    + MMAX
         IF1    = IF0    + N
         IDFDX  = IF1    + N
         IY     = IDFDX  + N
         IYOLD  = IY     + N
C
         IDBLK  = 1
         IBETA  = IDBLK  + N*(MMAX-1)
         IHELP  = N + MMAX - 1
         IF (IHELP .LT. IBETA) THEN
           IBETA2 = INT(IBETA/IHELP)
           IBETA  = MOD(IBETA,IHELP)
           IF (IBETA .EQ. 0) THEN
             IBETA = IHELP
           ELSE
             IBETA2 = IBETA2 + 1
           ENDIF
         ELSE
           IBETA2 = 1
         ENDIF
         IBETAQ = 1
         IDBLKQ = IBETAQ + MMAX*MMAX
         IHELP  = 2*N+MMAX
         IF (IHELP .LT. IDBLKQ) THEN
           IDBKQ2 = INT(IDBLKQ/IHELP)
           IDBLKQ  = MOD(IDBLKQ,IHELP)
           IF (IDBLKQ .EQ. 0) THEN
             IDBLKQ = IHELP
           ELSE
             IDBKQ2 = IDBKQ2 + 1
           ENDIF
         ELSE
           IDBKQ2 = 1
         ENDIF
         IDB = IBETAQ + MMAX * (MMAX + N)
         IF (IHELP .LT. IDB) THEN
           IDB2 = INT(IDB/IHELP)
           IDB  = MOD(IDB,IHELP)
           IF (IDB .EQ. 0) THEN
             IDB = IHELP
           ELSE
             IDB2 = IDB2 + 1
           ENDIF
         ELSE
           IDB2 = 1
         ENDIF
C
C
C*****************************************************************
C*       create the node file, if IFLAG > 0                      *
C*****************************************************************
C
         IF (IFLAG .GT. 0) THEN
            IC  = 1
C
            CALL IRKCOE (MMAX,LUNIN,WORK1(IC),WORK1(IAQ),
     1                   WORK1(IALPHQ),WORK23(IBETAQ,1))
         ENDIF
         IF (EPSM .LE. 0.0D0) THEN
C
C*****************************************************************
C*             determine the machine constant                    *
C*****************************************************************
C
C           EPSM ist the smallest positive machine number with
C           (1.0+EPSM) .GT. 1.0 . EPSM  is determined
C           approximately as a power of 1./2. .
C
            FMACHP = 1.0D0
   20       CONTINUE
               FMACHP = 0.5D0 * FMACHP
            IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 20
            EPSM = 2.0D0 * FMACHP
         ENDIF
C
C*****************************************************************
C*              solve the initialt value problem                 *
C*****************************************************************
C
         CALL IMRUKU (DES,N,MMAX,LUNIN,LUNOUT,LUNPR,IERR,EPSM,
     1                EPS,G,X0,XEND,Y0,YQ,
     2                WORK1(IFAC),WORK1(IDELTK),WORK1(IHEPS),
     3                WORK1(IALPH),WORK1(IALPHQ),WORK1(IA),
     4                WORK1(IAQ),WORK1(IF0),WORK1(IF1),
     5                WORK1(IDFDX),WORK1(IY),WORK1(IYOLD),
     6                WORK21,WORK22(IDBLK,1),WORK22(IBETA,IBETA2),
     7                WORK23(IBETAQ,1),WORK23(IDBLKQ,IDBKQ2),
     8                WORK23(IDB,IDB2))
      ENDIF
C
      RETURN
      END


Begin of file
Contents
Index