00001 SUBROUTINE SOLSY (WM, IWM, X, TEM)
00002
00003 INTEGER IWM
00004 INTEGER IOWND, IOWNS,
00005 1 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L, METH, MITER,
00006 2 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
00007 INTEGER I, MEBAND, ML, MU
00008 DOUBLE PRECISION WM, X, TEM
00009 DOUBLE PRECISION ROWNS,
00010 1 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND
00011 DOUBLE PRECISION DI, HL0, PHL0, R
00012 DIMENSION WM(*), IWM(*), X(*), TEM(*)
00013 COMMON /LS0001/ ROWNS(209),
00014 2 CCMAX, EL0, H, HMIN, HMXI, HU, RC, TN, UROUND,
00015 3 IOWND(14), IOWNS(6),
00016 4 ICF, IERPJ, IERSL, JCUR, JSTART, KFLAG, L, METH, MITER,
00017 5 MAXORD, MAXCOR, MSBP, MXNCF, N, NQ, NST, NFE, NJE, NQU
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042 IERSL = 0
00043 GO TO (100, 100, 300, 400, 400), MITER
00044 100 CALL DGETRS ( 'N', N, 1, WM(3), N, IWM(21), X, N, INLPCK)
00045 RETURN
00046
00047 300 PHL0 = WM(2)
00048 HL0 = H*EL0
00049 WM(2) = HL0
00050 IF (HL0 .EQ. PHL0) GO TO 330
00051 R = HL0/PHL0
00052 DO 320 I = 1,N
00053 DI = 1.0D0 - R*(1.0D0 - 1.0D0/WM(I+2))
00054 IF (DABS(DI) .EQ. 0.0D0) GO TO 390
00055 320 WM(I+2) = 1.0D0/DI
00056 330 DO 340 I = 1,N
00057 340 X(I) = WM(I+2)*X(I)
00058 RETURN
00059 390 IERSL = 1
00060 RETURN
00061
00062 400 ML = IWM(1)
00063 MU = IWM(2)
00064 MEBAND = 2*ML + MU + 1
00065 CALL DGBTRS ( 'N', N, ML, MU, 1, WM(3), MEBAND, IWM(21), X, N,
00066 * INLPCK)
00067 RETURN
00068
00069 END