00001 SUBROUTINE SSOLSY (WM, IWM, X, TEM) 00002 C***BEGIN PROLOGUE SSOLSY 00003 C***SUBSIDIARY 00004 C***PURPOSE ODEPACK linear system solver. 00005 C***TYPE SINGLE PRECISION (SSOLSY-S, DSOLSY-D) 00006 C***AUTHOR Hindmarsh, Alan C., (LLNL) 00007 C***DESCRIPTION 00008 C 00009 C This routine manages the solution of the linear system arising from 00010 C a chord iteration. It is called if MITER .ne. 0. 00011 C If MITER is 1 or 2, it calls SGETRF to accomplish this. 00012 C If MITER = 3 it updates the coefficient h*EL0 in the diagonal 00013 C matrix, and then computes the solution. 00014 C If MITER is 4 or 5, it calls SGBTRS. 00015 C Communication with SSOLSY uses the following variables: 00016 C WM = real work space containing the inverse diagonal matrix if 00017 C MITER = 3 and the LU decomposition of the matrix otherwise. 00018 C Storage of matrix elements starts at WM(3). 00019 C WM also contains the following matrix-related data: 00020 C WM(1) = SQRT(UROUND) (not used here), 00021 C WM(2) = HL0, the previous value of h*EL0, used if MITER = 3. 00022 C IWM = integer work space containing pivot information, starting at 00023 C IWM(21), if MITER is 1, 2, 4, or 5. IWM also contains band 00024 C parameters ML = IWM(1) and MU = IWM(2) if MITER is 4 or 5. 00025 C X = the right-hand side vector on input, and the solution vector 00026 C on output, of length N. 00027 C TEM = vector of work space of length N, not used in this version. 00028 C IERSL = output flag (in COMMON). IERSL = 0 if no trouble occurred. 00029 C IERSL = 1 if a singular matrix arose with MITER = 3. 00030 C This routine also uses the COMMON variables EL0, H, MITER, and N. 00031 C 00032 C***SEE ALSO SLSODE 00033 C***ROUTINES CALLED SGBTRS, SGETRS 00034 C***COMMON BLOCKS SLS001 00035 C***REVISION HISTORY (YYMMDD) 00036 C 791129 DATE WRITTEN 00037 C 890501 Modified prologue to SLATEC/LDOC format. (FNF) 00038 C 890503 Minor cosmetic changes. (FNF) 00039 C 930809 Renamed to allow single/double precision versions. (ACH) 00040 C 010412 Reduced size of Common block /SLS001/. (ACH) 00041 C 031105 Restored 'own' variables to Common block /SLS001/, to 00042 C enable interrupt/restart feature. (ACH) 00043 C***END PROLOGUE SSOLSY 00044 C**End 00045 INTEGER IWM 00046 REAL WM, X, TEM 00047 DIMENSION WM(*), IWM(*), X(*), TEM(*) 00048 INTEGER IOWND, IOWNS, 00049 1 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L, 00050 2 LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER, 00051 3 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU 00052 REAL ROWNS, 00053 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND 00054 COMMON /SLS001/ ROWNS(209), 00055 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND, 00056 2 IOWND(6), IOWNS(6), 00057 3 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L, 00058 4 LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER, 00059 5 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU 00060 INTEGER I, MEBAND, ML, MU 00061 REAL DI, HL0, PHL0, R 00062 C 00063 C***FIRST EXECUTABLE STATEMENT SSOLSY 00064 IERSL = 0 00065 GO TO (100, 100, 300, 400, 400), MITER 00066 100 CALL SGETRS ( 'N', N, 1, WM(3), N, IWM(21), X, N, INLPCK) 00067 RETURN 00068 C 00069 300 PHL0 = WM(2) 00070 HL0 = H*EL0 00071 WM(2) = HL0 00072 IF (HL0 .EQ. PHL0) GO TO 330 00073 R = HL0/PHL0 00074 DO 320 I = 1,N 00075 DI = 1.0E0 - R*(1.0E0 - 1.0E0/WM(I+2)) 00076 IF (ABS(DI) .EQ. 0.0E0) GO TO 390 00077 320 WM(I+2) = 1.0E0/DI 00078 330 DO 340 I = 1,N 00079 340 X(I) = WM(I+2)*X(I) 00080 RETURN 00081 390 IERSL = 1 00082 RETURN 00083 C 00084 400 ML = IWM(1) 00085 MU = IWM(2) 00086 MEBAND = 2*ML + MU + 1 00087 CALL SGBTRS ( 'N', N, ML, MU, 1, WM(3), MEBAND, IWM(21), X, N, 00088 * INLPCK) 00089 RETURN 00090 C----------------------- END OF SUBROUTINE SSOLSY ---------------------- 00091 END
1.7.1
