End of file
Contents
Index

      SUBROUTINE HSTART(DES,N,X,BETA,Y,RELERR,ABSERR,QG,DSMALL,
     +                  DLARGE,H)
C
C*****************************************************************
C                                                                *
C HSTART computes the initial step size for solving an initial   *
C value problem numerically. The number of differential          *
C equations in the system is limited to 12.                      *
C To compute this step size we determine a LIPSCHITZ constant,   *
C an upper bound for the first and second derivative of the      *
C differential equation in a neighborhood of X=X0.               *
C The algorithm used in HSTART is adapted from the software      *
C package DEPAC (design of a user oriented package of ode        *
C solvers).                                                      *
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 QG      : global error order of the method                     *
C DSMALL  : DOUBLE PRECISION machine constant                    *
C DLARGE  : DOUBLE PRECISION largest representable number        *
C                                                                *
C OUTPUT PARAMETER:                                              *
C =================                                              *
C H       : DOUBLE PRECISION computed step size                  *
C                                                                *
C                                                                *
C LOCAL VARIABLES:                                               *
C ================                                               *
C WORK    : 2-dim. DOUBLE PRECISION array WORK(1:12,1:5)         *
C DX      : DOUBLE PRECISION interval length                     *
C ABSDX   : DOUBLE PRECISION absolute value of DX                *
C RELPER  : DOUBLE PRECISION, RELPER=DSMALL**0.375D0           *
C DA      : DOUBLE PRECISION variation in X                      *
C DELF    : DOUBLE PRECISION auxiliary variable                  *
C DFDXB   : DOUBLE PRECISION upper bound for second derivative,  *
C           determined via differential quotient                 *
C FBND    : DOUBLE PRECISION upper bound for first derivative    *
C DELY    : DOUBLE PRECISION auxiliary variable                  *
C DFDUB   : DOUBLE PRECISION LIPSCHITZ constant                  *
C DY      : DOUBLE PRECISION auxiliary variable                  *
C YDPB    : DOUBLE PRECISION upper bound of second derivative    *
C TOLMIN  :-                                                     *
C TOLSUM  :- DOUBLE PRECISION auxiliary variables for            *
C TOL     :-                  computing TOLP                     *
C TOLEXP  :-                                                     *
C TOLP    : DOUBLE PRECISION tolerance value                     *
C SRYDPB  : DOUBLE PRECISION, SRYDPB=SQRT(0.5*YDPB)              *
C J, K    : loop variables                                       *
C LK      : Number of iterations to compute the LIPSCHITZ        *
C           constant                                             *
C                                                                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: VMNORM                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Volker Krüger                                     *
C  Date      : 07.08.1990                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
C Declarations
C
      DOUBLE PRECISION Y(N),WORK(12,5)
      DOUBLE PRECISION X,BETA,RELERR,ABSERR,QG,DSMALL,DLARGE,H,
     +                 DX,ABSDX,RELPER,DA,DELF,VMNORM,DFDXB,FBND,
     +                 DELY,DFDUB,DY,YDPB,TOLMIN,TOLSUM,TOL,
     +                 TOLEXP,TOLP,SRYDPB
C
C Determine an upper bound for the second derivative (DFDXB) via
C the differential quotient and an upper bound for the first
C derivative (FBND).
C
      DX=BETA-X
      ABSDX=DABS(DX)
      RELPER=DSMALL**0.375D0
      DA=DSIGN( DMAX1( DMIN1( RELPER*DABS(X),ABSDX ),
     +                 1.0D2*DSMALL*DABS(X) ),DX )
      IF(DABS(DA) .LT. DSMALL) DA=RELPER*DX
      CALL DES(X+DA,Y,N,WORK(1,1))
      CALL DES(X,Y,N,WORK(1,5))
      DO 10 J=1,N
         WORK(J,2)=WORK(J,1)-WORK(J,5)
10    CONTINUE
      DELF=VMNORM(WORK(1,2),N)
      DFDXB=DLARGE
      IF(DELF .LT. DLARGE*DABS(DA)) DFDXB=DELF/DABS(DA)
      FBND=VMNORM(WORK(1,1),N)
C
C Estimate the LIPSCHITZ constant (DFDUB) of the system of
C differential equations and chose an upper bound (FBND)
C for the first derivative.
C
      DELY=RELPER*VMNORM(Y,N)
      IF(DELY .LT. DSMALL) DELY=RELPER
      DELY=DSIGN(DELY,DX)
      DELF=VMNORM(WORK(1,5),N)
      FBND=DMAX1(FBND,DELF)
      IF(DELF .LT. DSMALL) THEN
        DO 40 J=1,N
           WORK(J,3)=0.0D0
           WORK(J,2)=1.0D0
40      CONTINUE
        DELF=1.0D0
      ELSE
        DO 20 J=1,N
           WORK(J,3)=WORK(J,5)
           WORK(J,2)=WORK(J,5)
20      CONTINUE
      ENDIF
      DFDUB=0.0D0
      LK=MIN(N+1,3)
      DO 140 K=1,LK
         DO 60 J=1,N
            WORK(J,4)=Y(J)+DELY*(WORK(J,2)/DELF)
60       CONTINUE
         IF(K .EQ. 2) THEN
           CALL DES(X+DA,WORK(1,4),N,WORK(1,2))
           DO 90 J=1,N
              WORK(J,4)=WORK(J,2)-WORK(J,1)
90         CONTINUE
         ELSE
           CALL DES(X,WORK(1,4),N,WORK(1,2))
           DO 70 J=1,N
              WORK(J,4)=WORK(J,2)-WORK(J,5)
70         CONTINUE
         ENDIF
         FBND=DMAX1(FBND,VMNORM(WORK(1,2),N))
         DELF=VMNORM(WORK(1,4),N)
         IF(DELF .GE. DLARGE*DABS(DELY)) THEN
           DFDUB=DLARGE
           GOTO 150
         ENDIF
         DFDUB=DMAX1(DFDUB,DELF/DABS(DELY))
         IF(K .LT. LK) THEN
           IF(DELF .LT. DSMALL) DELF=1.0D0
           DO 130 J=1,N
              IF(K .EQ. 2) THEN
                DY=Y(J)
                IF(DABS(DY) .LT. DSMALL) DY=DELY/RELPER
              ELSE
                DY=DABS(WORK(J,4))
                IF(DY .LT. DSMALL) DY=DELF
              ENDIF
              IF(DABS(WORK(J,3)) .LT. DSMALL) WORK(J,3)=WORK(J,2)
              DY=DSIGN(DY,WORK(J,3))
              WORK(J,2)=DY
130        CONTINUE
           DELF=VMNORM(WORK(1,2),N)
         ENDIF
140   CONTINUE
150   YDPB=DFDXB+DFDUB*FBND
C
C Set tolerance value (TOLP) for computing the initial
C step size.
C
      TOLMIN=DLARGE
      TOLSUM=0.0D0
      DO 170 K=1,N
         TOL=RELERR*DABS(Y(K))+ABSERR
         IF(TOL .LT. DSMALL) TOL=DABS(DELY)*RELERR
         TOLEXP=DLOG10(TOL)
         TOLMIN=DMIN1(TOLMIN,TOLEXP)
         TOLSUM=TOLSUM+TOLEXP
170   CONTINUE
      TOLP=1.0D1**(0.5D0*(TOLSUM/DBLE(N)+TOLMIN)/(QG+1.0D0))
C
C Determine initial step size and direction of the integration
C
      H=ABSDX
      IF(YDPB .GT. DSMALL .OR. FBND .GT. DSMALL) THEN
        IF(YDPB .GT. DSMALL) THEN
          SRYDPB=DSQRT(0.5D0*YDPB)
          IF(TOLP .LT. SRYDPB*ABSDX) H=TOLP/SRYDPB
        ELSEIF(TOLP .LT. FBND*ABSDX) THEN
          H=TOLP/FBND
        ENDIF
      ELSEIF(TOLP .LT. 1.0D0) THEN
        H=ABSDX*TOLP
      ENDIF
      IF(H*DFDUB .GT. 1.0D0) H=1.0D0/DFDUB
      H=DMAX1(H,1.0D2*DSMALL*DABS(X))
      IF(H .LT. DSMALL) H=DSMALL*DABS(BETA)
      H=DSIGN(H,DX)
      RETURN
      END
\hbox{\JDhspace\verb`
\hbox{\JDhspace\verb`


Begin of file
Contents
Index