1 SUBROUTINE solsy (WM, IWM, X, TEM)
4 INTEGER ILLIN, INIT, LYH, LEWT, LACOR, LSAVF, LWM, LIWM,
5 1 MXSTEP, MXHNIL, NHNIL, NTREP, NSLAST, NYH,
6 2 IALTH, IPUP, LMAX, MEO, NQNYH, NSLP
7 INTEGER ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L, METH, MITER,
8 2 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
9 INTEGER I, MEBAND, ML, MU
10 DOUBLE PRECISION WM, X, TEM
11 DOUBLE PRECISION CONIT, CRATE, EL, ELCO, HOLD, RMAX, TESCO,
12 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND
13 DOUBLE PRECISION DI, HL0, PHL0, R
14 dimension wm(*), iwm(*), x(*), tem(*)
15 COMMON /ls0001/ conit, crate, el(13), elco(13,12),
16 1 hold, rmax, tesco(3,12),
17 2 ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
18 2 illin, init, lyh, lewt, lacor, lsavf, lwm, liwm,
19 3 mxstep, mxhnil, nhnil, ntrep, nslast, nyh,
20 3 ialth, ipup, lmax, meo, nqnyh, nslp,
21 4 icf, ierpj, iersl, jcur, jstart, kflag, l, meth, miter,
22 5 maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
48 GO TO (100, 100, 300, 400, 400), miter
49 100
CALL dgetrs (
'N', n, 1, wm(3), n, iwm(21), x, n, inlpck)
55 IF (hl0 .EQ. phl0)
GO TO 330
58 di = 1.0d0 - r*(1.0d0 - 1.0d0/wm(i+2))
59 IF (dabs(di) .EQ. 0.0d0)
GO TO 390
60 320 wm(i+2) = 1.0d0/di
62 340 x(i) = wm(i+2)*x(i)
69 meband = 2*ml + mu + 1
70 CALL dgbtrs (
'N', n, ml, mu, 1, wm(3), meband, iwm(21), x, n,
subroutine solsy(WM, IWM, X, TEM)