mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
103 lines
3.9 KiB
Fortran
103 lines
3.9 KiB
Fortran
*DECK DSLVS
|
|
SUBROUTINE DSLVS (WM, IWM, X, TEM)
|
|
C***BEGIN PROLOGUE DSLVS
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DDEBDF
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (SLVS-S, DSLVS-D)
|
|
C***AUTHOR Watts, H. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C DSLVS solves the linear system in the iteration scheme for the
|
|
C integrator package DDEBDF.
|
|
C
|
|
C***SEE ALSO DDEBDF
|
|
C***ROUTINES CALLED DGBSL, DGESL
|
|
C***COMMON BLOCKS DDEBD1
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 820301 DATE WRITTEN
|
|
C 890531 Changed all specific intrinsics to generic. (WRB)
|
|
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 DSLVS
|
|
C
|
|
INTEGER I, IER, IOWND, IOWNS, IWM, JSTART, KFLAG, L, MAXORD,
|
|
1 MEBAND, METH, MITER, ML, MU, N, NFE, NJE, NQ, NQU, NST
|
|
DOUBLE PRECISION DI, EL0, H, HL0, HMIN, HMXI, HU, PHL0,
|
|
1 R, ROWND, ROWNS, TEM, TN, UROUND, WM, X
|
|
DIMENSION WM(*), IWM(*), X(*), TEM(*)
|
|
COMMON /DDEBD1/ ROWND,ROWNS(210),EL0,H,HMIN,HMXI,HU,TN,UROUND,
|
|
1 IOWND(14),IOWNS(6),IER,JSTART,KFLAG,L,METH,MITER,
|
|
2 MAXORD,N,NQ,NST,NFE,NJE,NQU
|
|
C ------------------------------------------------------------------
|
|
C THIS ROUTINE MANAGES THE SOLUTION OF THE LINEAR SYSTEM ARISING
|
|
C FROM A CHORD ITERATION. IT IS CALLED BY DSTOD IF MITER .NE. 0.
|
|
C IF MITER IS 1 OR 2, IT CALLS DGESL 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 DGBSL.
|
|
C COMMUNICATION WITH DSLVS USES THE FOLLOWING VARIABLES..
|
|
C WM = DOUBLE PRECISION WORK SPACE CONTAINING THE INVERSE DIAGONAL
|
|
C 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 =
|
|
C 3.
|
|
C IWM = INTEGER WORK SPACE CONTAINING PIVOT INFORMATION, STARTING
|
|
C AT IWM(21), IF MITER IS 1, 2, 4, OR 5. IWM ALSO CONTAINS
|
|
C THE BAND PARAMETERS ML = IWM(1) AND MU = IWM(2) IF MITER IS
|
|
C 4 OR 5.
|
|
C X = THE RIGHT-HAND SIDE VECTOR ON INPUT, AND THE SOLUTION
|
|
C VECTOR 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 BEGIN BLOCK PERMITTING ...EXITS TO 80
|
|
C BEGIN BLOCK PERMITTING ...EXITS TO 60
|
|
C***FIRST EXECUTABLE STATEMENT DSLVS
|
|
IER = 0
|
|
GO TO (10,10,20,70,70), MITER
|
|
10 CONTINUE
|
|
CALL DGESL(WM(3),N,N,IWM(21),X,0)
|
|
C ......EXIT
|
|
GO TO 80
|
|
C
|
|
20 CONTINUE
|
|
PHL0 = WM(2)
|
|
HL0 = H*EL0
|
|
WM(2) = HL0
|
|
IF (HL0 .EQ. PHL0) GO TO 40
|
|
R = HL0/PHL0
|
|
DO 30 I = 1, N
|
|
DI = 1.0D0 - R*(1.0D0 - 1.0D0/WM(I+2))
|
|
C .........EXIT
|
|
IF (ABS(DI) .EQ. 0.0D0) GO TO 60
|
|
WM(I+2) = 1.0D0/DI
|
|
30 CONTINUE
|
|
40 CONTINUE
|
|
DO 50 I = 1, N
|
|
X(I) = WM(I+2)*X(I)
|
|
50 CONTINUE
|
|
C ......EXIT
|
|
GO TO 80
|
|
60 CONTINUE
|
|
IER = -1
|
|
C ...EXIT
|
|
GO TO 80
|
|
C
|
|
70 CONTINUE
|
|
ML = IWM(1)
|
|
MU = IWM(2)
|
|
MEBAND = 2*ML + MU + 1
|
|
CALL DGBSL(WM(3),MEBAND,N,ML,MU,IWM(21),X,0)
|
|
80 CONTINUE
|
|
RETURN
|
|
C ----------------------- END OF SUBROUTINE DSLVS
|
|
C -----------------------
|
|
END
|