End of file
Contents
Index
SUBROUTINE IRKCOE (MMAX,LUN,C,A,ALPHA,BETA)
C
C*****************************************************************
C *
C This subroutine determines the coefficients for the implicit *
C RUNGE-KUTTA methods (IRKM) of order 1 up to MMAX, as specified *
C in the calling program. *
C The results are stored unformatted in an external file with *
C the logical number LUN. There they can be called up and pro- *
C cessed further by the SUBROUTINE IMRUKU. *
C For each order the GAUSS-LEGENDRE nodes ALPHA(J), J=1, ..., M, *
C of the interval of integration are determined first. *
C These are determined from the zeros of the LEGENDRE polynomials*
C The coefficients BETA(I,J) and A(J), I,J=1, ..., M, are ob- *
C tained as the solution of a M*(M+1) linear system of equations.*
C The solution of the linear system of equations can be deter- *
C mined by multiplying LAGRANGE polynomials. *
C *
C *
C INPUT PARAMETERS: *
C ================= *
C MMAX : maximum order up to which the coefficients of the *
C IRKM are to be created *
C LUN : number of the output file, in which the coefficients *
C are to be stored (unformatted) *
C ALPHA : vector ALPHA(1:MMAX); ) the coefficients *
C BETA : 2-dim. array BETA(1:MMAX,1:MMAX); ) of the IRKM *
C A : vector A(1:MMAX); ) *
C C : vector C(0:MMAX); auxiliary vector for GALE0 and *
C vector used to store the coefficients of the *
C LAGRANGE polynomials. Only used for storage space. *
C *
C *
C OUTPUT PARAMETER: *
C ================= *
C n o n e *
C *
C *
C All results, i.e., the orders and the coefficients of the IRKM,*
C are saved unformatted in the file with the logic number LUN. *
C This file is to be read by SUBROUTINE IMRUKU. *
C *
C *
C LOCAL VARIABLES: *
C ================ *
C M : current order for which the coefficients are *
C determined. *
C MM1 : auxiliary variable for M-1 *
C MM2 : auxiliary variable for M-2 *
C I,J,K : control variables *
C JM1 : auxiliary variable for J-1 *
C JP1 : auxiliary variable for J+1 *
C NG : counter for the number of factors *
C (ALPHA(K)-ALPHA(J)) (J constant,K=1,...,J-1,J+1,...,M)*
C of the LAGRANGE-polynomials that are multiplied. *
C ZJ : counter of the J-th LAGRANGE-polynomial *
C BETAJK : ) auxiliary variables for determining the coefficients*
C ALPHAK : ) BETA(J,K) or ALPHA(K) when multiplying the *
C ) LAGRANGE polynomials *
C FLAG : logic variable; input parameter of GALE0 *
C *
C----------------------------------------------------------------*
C *
C subroutines required: GALE0 *
C *
C *
C source : 1. W. Glasmacher, D. Sommer, see [GLAS66]. *
C *
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
INTEGER MMAX, LUN
DIMENSION C(0:MMAX), A(MMAX), ALPHA(MMAX), BETA(MMAX,MMAX)
C
C local variables
INTEGER M, MM1, MM2, I, J, JM1, JP1, K, NG
DOUBLE PRECISION ZJ, BETAJK, ALPHAK
LOGICAL FLAG
C
C*****************************************************************
C* the weights A(J) and BETA(J,L), as well as the nodes *
C* ALPHA(J) are produced for the orders of 1 to MMAX and they *
C* are stored, unformatted, in the file numbered LUN. *
C*****************************************************************
C
FLAG = .FALSE.
DO 2000 M = 1,MMAX
MM1 = M - 1
MM2 = M - 2
C
C*****************************************************************
C* G A U S S - L E G E N D R E n o d e s *
C*****************************************************************
C determine all zeros of the LEGENDRE polynomials, i.e.,
C the ALPHA(J). These are are all real and lie
C symmetrically in the interval -1. <= ALPHA(J) <= 1.
C
IF (M .GT. 1) THEN
CALL GALE0 (M,FLAG,ALPHA,C)
ELSE
ALPHA(1) = 0.0D0
ENDIF
C
C transform the ALPHA(J) to the interval
C 0 <= alpha(j) <= 1
C
DO 10 I = 1,M
ALPHA(I) = 0.5D0*ALPHA(I) + 0.5D0
10 CONTINUE
C
C*****************************************************************
C* determine the weights BETA(J,K) and A(J) *
C*****************************************************************
C counter ZJ of the J-th LAGRANGE polynomial of degree M
C
DO 1000 J = 1,M
JM1 = J - 1
JP1 = J + 1
ZJ = 1.0D0
DO 20 K = 1,JM1
ZJ = (ALPHA(J)-ALPHA(K)) * ZJ
20 CONTINUE
DO 30 K = JP1,M
ZJ = (ALPHA(J)-ALPHA(K)) * ZJ
30 CONTINUE
C
C determine the coefficient of the J-th
C LAGRANGE-polynomial of degree M
C
C(0) = 1.0D0
NG = 0
DO 60 K = 1,JM1
ALPHAK = -ALPHA(K)
DO 40 I = NG,0,-1
C(I+1) = C(I)
40 CONTINUE
C(0) = ALPHAK * C(1)
DO 50 I = 1,NG
C(I) = C(I) + ALPHAK*C(I+1)
50 CONTINUE
NG = NG + 1
60 CONTINUE
DO 90 K = JP1,M
ALPHAK = -ALPHA(K)
DO 70 I = NG,0,-1
C(I+1) = C(I)
70 CONTINUE
C(0) = ALPHAK * C(1)
DO 80 I = 1,NG
C(I) = C(I) + ALPHAK*C(I+1)
80 CONTINUE
NG = NG + 1
90 CONTINUE
C
C determine the BETA(J,L) and all A(J)
C
ZJ = 1.0D0 / ZJ
AJ = 0.0D0
DO 110 K = 1,M
BETAJK = 0.0D0
DO 100 L = 1,M
BETAJK = BETAJK + C(L-1) * ALPHA(K)**L / DBLE(L)
100 CONTINUE
BETA(J,K) = BETAJK * ZJ
AJ = AJ + C(K-1) / DBLE(K)
110 CONTINUE
A(J) = AJ * ZJ
1000 CONTINUE
C
C unformatted output of the order combined with the corres-
C ponding coefficients to the file numbered LUN
C
WRITE (LUN) M,(ALPHA(I),I=1,M)
1 ,((BETA(I,J),I=1,M),J=1,M)
2 ,(A(I),I=1,M)
2000 CONTINUE
RETURN
END
Begin of file
Contents
Index