ssolsy.f

Go to the documentation of this file.

      SUBROUTINE ssolsy (WM, IWM, X, TEM)
C***BEGIN PROLOGUE  SSOLSY
C***SUBSIDIARY
C***PURPOSE  ODEPACK linear system solver.
C***TYPE      SINGLE PRECISION (SSOLSY-S, DSOLSY-D)
C***AUTHOR  Hindmarsh, Alan C., (LLNL)
C***DESCRIPTION
C
C  This routine manages the solution of the linear system arising from
C  a chord iteration.  It is called if MITER .ne. 0.
C  If MITER is 1 or 2, it calls SGETRF 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 SGBTRS.
C  Communication with SSOLSY uses the following variables:
C  WM    = real work space containing the inverse diagonal matrix if
C          MITER = 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 band
C          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  IERSL = output flag (in COMMON).  IERSL = 0 if no trouble occurred.
C          IERSL = 1 if a singular matrix arose with MITER = 3.
C  This routine also uses the COMMON variables EL0, H, MITER, and N.
C
C***SEE ALSO  SLSODE
C***ROUTINES CALLED  SGBTRS, SGETRS
C***COMMON BLOCKS    SLS001
C***REVISION HISTORY  (YYMMDD)
C   791129  DATE WRITTEN
C   890501  Modified prologue to SLATEC/LDOC format.  (FNF)
C   890503  Minor cosmetic changes.  (FNF)
C   930809  Renamed to allow single/double precision versions. (ACH)
C   010412  Reduced size of Common block /SLS001/. (ACH)
C   031105  Restored 'own' variables to Common block /SLS001/, to
C           enable interrupt/restart feature. (ACH)
C***END PROLOGUE  SSOLSY
C**End
      INTEGER IWM
      REAL WM, X, TEM
      dimension wm(*), iwm(*), x(*), tem(*)
      INTEGER INIT, MXSTEP, MXHNIL, NHNIL, NSLAST, NYH,
     1   IALTH, IPUP, LMAX, MEO, NQNYH, NSLP,
     1   ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L,
     2   LYH, LEWT, LACOR, LSAVF, LWM, LIWM, METH, MITER,
     3   MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
      REAL CONIT, CRATE, EL, ELCO, HOLD, RMAX, TESCO,
     1   CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND
      COMMON /sls001/ conit, crate, el(13), elco(13,12),
     1   hold, rmax, tesco(3,12),
     1   ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
     2   init, mxstep, mxhnil, nhnil, nslast, nyh,
     3   ialth, ipup, lmax, meo, nqnyh, nslp,
     3   icf, ierpj, iersl, jcur, jstart, kflag, l,
     4   lyh, lewt, lacor, lsavf, lwm, liwm, meth, miter,
     5   maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
      INTEGER I, MEBAND, ML, MU
      INTEGER INLPCK
      REAL DI, HL0, PHL0, R
C
C***FIRST EXECUTABLE STATEMENT  SSOLSY
      iersl = 0
      GO TO (100, 100, 300, 400, 400), miter
 100  CALL sgetrs ( 'N', n, 1, wm(3), n, iwm(21), x, n, inlpck)
      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  iersl = 1
      RETURN
C
 400  ml = iwm(1)
      mu = iwm(2)
      meband = 2*ml + mu + 1
      CALL sgbtrs ( 'N', n, ml, mu, 1, wm(3), meband, iwm(21), x, n,
     * inlpck)
      RETURN
C----------------------- END OF SUBROUTINE SSOLSY ----------------------
      END