annotate libcruft/daspk/dslvk.f @ 3911:8389e78e67d4

[project @ 2002-04-28 02:15:38 by jwe]
author jwe
date Sun, 28 Apr 2002 02:15:39 +0000
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
3911
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
1 C Work performed under the auspices of the U.S. Department of Energy
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
2 C by Lawrence Livermore National Laboratory under contract number
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
3 C W-7405-Eng-48.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
4 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
5 SUBROUTINE DSLVK (NEQ, Y, TN, YPRIME, SAVR, X, EWT, WM, IWM,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
6 * RES, IRES, PSOL, IERSL, CJ, EPLIN, SQRTN, RSQRTN, RHOK,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
7 * RPAR, IPAR)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
8 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
9 C***BEGIN PROLOGUE DSLVK
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
10 C***REFER TO DDASPK
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
11 C***DATE WRITTEN 890101 (YYMMDD)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
12 C***REVISION DATE 900926 (YYMMDD)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
13 C***REVISION DATE 940928 Removed MNEWT and added RHOK in call list.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
14 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
15 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
16 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
17 C***DESCRIPTION
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
18 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
19 C DSLVK uses a restart algorithm and interfaces to DSPIGM for
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
20 C the solution of the linear system arising from a Newton iteration.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
21 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
22 C In addition to variables described elsewhere,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
23 C communication with DSLVK uses the following variables..
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
24 C WM = Real work space containing data for the algorithm
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
25 C (Krylov basis vectors, Hessenberg matrix, etc.).
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
26 C IWM = Integer work space containing data for the algorithm.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
27 C X = The right-hand side vector on input, and the solution vector
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
28 C on output, of length NEQ.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
29 C IRES = Error flag from RES.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
30 C IERSL = Output flag ..
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
31 C IERSL = 0 means no trouble occurred (or user RES routine
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
32 C returned IRES < 0)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
33 C IERSL = 1 means the iterative method failed to converge
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
34 C (DSPIGM returned IFLAG > 0.)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
35 C IERSL = -1 means there was a nonrecoverable error in the
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
36 C iterative solver, and an error exit will occur.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
37 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
38 C***ROUTINES CALLED
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
39 C DSCAL, DCOPY, DSPIGM
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
40 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
41 C***END PROLOGUE DSLVK
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
42 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
43 INTEGER NEQ, IWM, IRES, IERSL, IPAR
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
44 DOUBLE PRECISION Y, TN, YPRIME, SAVR, X, EWT, WM, CJ, EPLIN,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
45 1 SQRTN, RSQRTN, RHOK, RPAR
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
46 DIMENSION Y(*), YPRIME(*), SAVR(*), X(*), EWT(*),
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
47 1 WM(*), IWM(*), RPAR(*), IPAR(*)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
48 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
49 INTEGER IFLAG, IRST, NRSTS, NRMAX, LR, LDL, LHES, LGMR, LQ, LV,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
50 1 LWK, LZ, MAXLP1, NPSL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
51 INTEGER NLI, NPS, NCFL, NRE, MAXL, KMP, MITER
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
52 EXTERNAL RES, PSOL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
53 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
54 PARAMETER (LNRE=12, LNCFL=16, LNLI=20, LNPS=21)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
55 PARAMETER (LLOCWP=29, LLCIWP=30)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
56 PARAMETER (LMITER=23, LMAXL=24, LKMP=25, LNRMAX=26)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
57 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
58 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
59 C IRST is set to 1, to indicate restarting is in effect.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
60 C NRMAX is the maximum number of restarts.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
61 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
62 DATA IRST/1/
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
63 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
64 LIWP = IWM(LLCIWP)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
65 NLI = IWM(LNLI)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
66 NPS = IWM(LNPS)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
67 NCFL = IWM(LNCFL)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
68 NRE = IWM(LNRE)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
69 LWP = IWM(LLOCWP)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
70 MAXL = IWM(LMAXL)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
71 KMP = IWM(LKMP)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
72 NRMAX = IWM(LNRMAX)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
73 MITER = IWM(LMITER)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
74 IERSL = 0
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
75 IRES = 0
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
76 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
77 C Use a restarting strategy to solve the linear system
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
78 C P*X = -F. Parse the work vector, and perform initializations.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
79 C Note that zero is the initial guess for X.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
80 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
81 MAXLP1 = MAXL + 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
82 LV = 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
83 LR = LV + NEQ*MAXL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
84 LHES = LR + NEQ + 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
85 LQ = LHES + MAXL*MAXLP1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
86 LWK = LQ + 2*MAXL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
87 LDL = LWK + MIN0(1,MAXL-KMP)*NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
88 LZ = LDL + NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
89 CALL DSCAL (NEQ, RSQRTN, EWT, 1)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
90 CALL DCOPY (NEQ, X, 1, WM(LR), 1)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
91 DO 110 I = 1,NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
92 110 X(I) = 0.D0
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
93 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
94 C Top of loop for the restart algorithm. Initial pass approximates
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
95 C X and sets up a transformed system to perform subsequent restarts
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
96 C to update X. NRSTS is initialized to -1, because restarting
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
97 C does not occur until after the first pass.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
98 C Update NRSTS; conditionally copy DL to R; call the DSPIGM
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
99 C algorithm to solve A*Z = R; updated counters; update X with
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
100 C the residual solution.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
101 C Note: if convergence is not achieved after NRMAX restarts,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
102 C then the linear solver is considered to have failed.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
103 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
104 NRSTS = -1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
105 115 CONTINUE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
106 NRSTS = NRSTS + 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
107 IF (NRSTS .GT. 0) CALL DCOPY (NEQ, WM(LDL), 1, WM(LR),1)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
108 CALL DSPIGM (NEQ, TN, Y, YPRIME, SAVR, WM(LR), EWT, MAXL, MAXLP1,
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
109 1 KMP, EPLIN, CJ, RES, IRES, NRES, PSOL, NPSL, WM(LZ), WM(LV),
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
110 2 WM(LHES), WM(LQ), LGMR, WM(LWP), IWM(LIWP), WM(LWK),
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
111 3 WM(LDL), RHOK, IFLAG, IRST, NRSTS, RPAR, IPAR)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
112 NLI = NLI + LGMR
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
113 NPS = NPS + NPSL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
114 NRE = NRE + NRES
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
115 DO 120 I = 1,NEQ
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
116 120 X(I) = X(I) + WM(LZ+I-1)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
117 IF ((IFLAG .EQ. 1) .AND. (NRSTS .LT. NRMAX) .AND. (IRES .EQ. 0))
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
118 1 GO TO 115
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
119 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
120 C The restart scheme is finished. Test IRES and IFLAG to see if
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
121 C convergence was not achieved, and set flags accordingly.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
122 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
123 IF (IRES .LT. 0) THEN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
124 NCFL = NCFL + 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
125 ELSE IF (IFLAG .NE. 0) THEN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
126 NCFL = NCFL + 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
127 IF (IFLAG .GT. 0) IERSL = 1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
128 IF (IFLAG .LT. 0) IERSL = -1
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
129 ENDIF
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
130 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
131 C Update IWM with counters, rescale EWT, and return.
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
132 C-----------------------------------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
133 IWM(LNLI) = NLI
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
134 IWM(LNPS) = NPS
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
135 IWM(LNCFL) = NCFL
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
136 IWM(LNRE) = NRE
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
137 CALL DSCAL (NEQ, SQRTN, EWT, 1)
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
138 RETURN
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
139 C
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
140 C------END OF SUBROUTINE DSLVK------------------------------------------
8389e78e67d4 [project @ 2002-04-28 02:15:38 by jwe]
jwe
parents:
diff changeset
141 END