| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687 |
- *DECK SLVS
- SUBROUTINE SLVS (WM, IWM, X, TEM)
- C***BEGIN PROLOGUE SLVS
- C***SUBSIDIARY
- C***PURPOSE Subsidiary to DEBDF
- C***LIBRARY SLATEC
- C***TYPE SINGLE PRECISION (SLVS-S, DSLVS-D)
- C***AUTHOR Watts, H. A., (SNLA)
- C***DESCRIPTION
- C
- C SLVS solves the linear system in the iteration scheme for the
- C integrator package DEBDF.
- C
- C***SEE ALSO DEBDF
- C***ROUTINES CALLED SGBSL, SGESL
- C***COMMON BLOCKS DEBDF1
- C***REVISION HISTORY (YYMMDD)
- C 800901 DATE WRITTEN
- C 891214 Prologue converted to Version 4.0 format. (BAB)
- C 900328 Added TYPE section. (WRB)
- C 910722 Updated AUTHOR section. (ALS)
- C 920422 Changed DIMENSION statement. (WRB)
- C***END PROLOGUE SLVS
- C
- CLLL. OPTIMIZE
- INTEGER IWM, I, IER, IOWND, IOWNS, JSTART, KFLAG, L, MAXORD,
- 1 MEBAND, METH, MITER, ML, MU, N, NFE, NJE, NQ, NQU, NST
- REAL WM, X, TEM,
- 1 ROWND, ROWNS, EL0, H, HMIN, HMXI, HU, TN, UROUND,
- 2 DI, HL0, PHL0, R
- DIMENSION WM(*), IWM(*), X(*), TEM(*)
- COMMON /DEBDF1/ ROWND, ROWNS(210),
- 1 EL0, H, HMIN, HMXI, HU, TN, UROUND, IOWND(14), IOWNS(6),
- 2 IER, JSTART, KFLAG, L, METH, MITER, MAXORD, N, NQ, NST, NFE,
- 3 NJE, NQU
- C-----------------------------------------------------------------------
- C THIS ROUTINE MANAGES THE SOLUTION OF THE LINEAR SYSTEM ARISING FROM
- C A CHORD ITERATION. IT IS CALLED BY STOD IF MITER .NE. 0.
- C IF MITER IS 1 OR 2, IT CALLS SGESL TO ACCOMPLISH THIS.
- C IF MITER = 3 IT UPDATES THE COEFFICIENT H*EL0 IN THE DIAGONAL
- C MATRIX, AND THEN COMPUTES THE SOLUTION.
- C IF MITER IS 4 OR 5, IT CALLS SGBSL.
- C COMMUNICATION WITH SLVS USES THE FOLLOWING VARIABLES..
- C WM = REAL WORK SPACE CONTAINING THE INVERSE DIAGONAL MATRIX IF MITER
- C IS 3 AND THE LU DECOMPOSITION OF THE MATRIX OTHERWISE.
- C STORAGE OF MATRIX ELEMENTS STARTS AT WM(3).
- C WM ALSO CONTAINS THE FOLLOWING MATRIX-RELATED DATA..
- C WM(1) = SQRT(UROUND) (NOT USED HERE),
- C WM(2) = HL0, THE PREVIOUS VALUE OF H*EL0, USED IF MITER = 3.
- C IWM = INTEGER WORK SPACE CONTAINING PIVOT INFORMATION, STARTING AT
- C IWM(21), IF MITER IS 1, 2, 4, OR 5. IWM ALSO CONTAINS THE
- C BAND PARAMETERS ML = IWM(1) AND MU = IWM(2) IF MITER IS 4 OR 5.
- C X = THE RIGHT-HAND SIDE VECTOR ON INPUT, AND THE SOLUTION VECTOR
- C ON OUTPUT, OF LENGTH N.
- C TEM = VECTOR OF WORK SPACE OF LENGTH N, NOT USED IN THIS VERSION.
- C IER = OUTPUT FLAG (IN COMMON). IER = 0 IF NO TROUBLE OCCURRED.
- C IER = -1 IF A SINGULAR MATRIX AROSE WITH MITER = 3.
- C THIS ROUTINE ALSO USES THE COMMON VARIABLES EL0, H, MITER, AND N.
- C-----------------------------------------------------------------------
- C***FIRST EXECUTABLE STATEMENT SLVS
- IER = 0
- GO TO (100, 100, 300, 400, 400), MITER
- 100 CALL SGESL (WM(3), N, N, IWM(21), X, 0)
- RETURN
- C
- 300 PHL0 = WM(2)
- HL0 = H*EL0
- WM(2) = HL0
- IF (HL0 .EQ. PHL0) GO TO 330
- R = HL0/PHL0
- DO 320 I = 1,N
- DI = 1.0E0 - R*(1.0E0 - 1.0E0/WM(I+2))
- IF (ABS(DI) .EQ. 0.0E0) GO TO 390
- 320 WM(I+2) = 1.0E0/DI
- 330 DO 340 I = 1,N
- 340 X(I) = WM(I+2)*X(I)
- RETURN
- 390 IER = -1
- RETURN
- C
- 400 ML = IWM(1)
- MU = IWM(2)
- MEBAND = 2*ML + MU + 1
- CALL SGBSL (WM(3), MEBAND, N, ML, MU, IWM(21), X, 0)
- RETURN
- C----------------------- END OF SUBROUTINE SLVS -----------------------
- END
|
