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