GNU Octave  4.4.1
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dnedk.f
Go to the documentation of this file.
1 C Work performed under the auspices of the U.S. Department of Energy
2 C by Lawrence Livermore National Laboratory under contract number
3 C W-7405-Eng-48.
4 C
5  SUBROUTINE dnedk(X,Y,YPRIME,NEQ,RES,JACK,PSOL,
6  * H,WT,JSTART,IDID,RPAR,IPAR,PHI,GAMMA,SAVR,DELTA,E,
7  * WM,IWM,CJ,CJOLD,CJLAST,S,UROUND,EPLI,SQRTN,RSQRTN,
8  * EPCON,JCALC,JFLG,KP1,NONNEG,NTYPE,IERNLS)
9 C
10 C***BEGIN PROLOGUE DNEDK
11 C***REFER TO DDASPK
12 C***DATE WRITTEN 891219 (YYMMDD)
13 C***REVISION DATE 900926 (YYMMDD)
14 C***REVISION DATE 940701 (YYMMDD)
15 C
16 C
17 C-----------------------------------------------------------------------
18 C***DESCRIPTION
19 C
20 C DNEDK solves a nonlinear system of
21 C algebraic equations of the form
22 C G(X,Y,YPRIME) = 0 for the unknown Y.
23 C
24 C The method used is a matrix-free Newton scheme.
25 C
26 C The parameters represent
27 C X -- Independent variable.
28 C Y -- Solution vector at x.
29 C YPRIME -- Derivative of solution vector
30 C after successful step.
31 C NEQ -- Number of equations to be integrated.
32 C RES -- External user-supplied subroutine
33 C to evaluate the residual. See RES description
34 C in DDASPK prologue.
35 C JACK -- External user-supplied routine to update
36 C the preconditioner. (This is optional).
37 C See JAC description for the case
38 C INFO(12) = 1 in the DDASPK prologue.
39 C PSOL -- External user-supplied routine to solve
40 C a linear system using preconditioning.
41 C (This is optional). See explanation inside DDASPK.
42 C H -- Appropriate step size for this step.
43 C WT -- Vector of weights for error criterion.
44 C JSTART -- Indicates first call to this routine.
45 C If JSTART = 0, then this is the first call,
46 C otherwise it is not.
47 C IDID -- Completion flag, output by DNEDK.
48 C See IDID description in DDASPK prologue.
49 C RPAR,IPAR -- Real and integer arrays used for communication
50 C between the calling program and external user
51 C routines. They are not altered within DASPK.
52 C PHI -- Array of divided differences used by
53 C DNEDK. The length is NEQ*(K+1), where
54 C K is the maximum order.
55 C GAMMA -- Array used to predict Y and YPRIME. The length
56 C is K+1, where K is the maximum order.
57 C SAVR -- Work vector for DNEDK of length NEQ.
58 C DELTA -- Work vector for DNEDK of length NEQ.
59 C E -- Error accumulation vector for DNEDK of length NEQ.
60 C WM,IWM -- Real and integer arrays storing
61 C matrix information for linear system
62 C solvers, and various other information.
63 C CJ -- Parameter always proportional to 1/H.
64 C CJOLD -- Saves the value of CJ as of the last call to DITMD.
65 C Accounts for changes in CJ needed to
66 C decide whether to call DITMD.
67 C CJLAST -- Previous value of CJ.
68 C S -- A scalar determined by the approximate rate
69 C of convergence of the Newton iteration and used
70 C in the convergence test for the Newton iteration.
71 C
72 C If RATE is defined to be an estimate of the
73 C rate of convergence of the Newton iteration,
74 C then S = RATE/(1.D0-RATE).
75 C
76 C The closer RATE is to 0., the faster the Newton
77 C iteration is converging; the closer RATE is to 1.,
78 C the slower the Newton iteration is converging.
79 C
80 C On the first Newton iteration with an up-dated
81 C preconditioner S = 100.D0, Thus the initial
82 C RATE of convergence is approximately 1.
83 C
84 C S is preserved from call to call so that the rate
85 C estimate from a previous step can be applied to
86 C the current step.
87 C UROUND -- Unit roundoff.
88 C EPLI -- convergence test constant.
89 C See DDASPK prologue for more details.
90 C SQRTN -- Square root of NEQ.
91 C RSQRTN -- reciprical of square root of NEQ.
92 C EPCON -- Tolerance to test for convergence of the Newton
93 C iteration.
94 C JCALC -- Flag used to determine when to update
95 C the Jacobian matrix. In general:
96 C
97 C JCALC = -1 ==> Call the DITMD routine to update
98 C the Jacobian matrix.
99 C JCALC = 0 ==> Jacobian matrix is up-to-date.
100 C JCALC = 1 ==> Jacobian matrix is out-dated,
101 C but DITMD will not be called unless
102 C JCALC is set to -1.
103 C JFLG -- Flag showing whether a Jacobian routine is supplied.
104 C KP1 -- The current order + 1; updated across calls.
105 C NONNEG -- Flag to determine nonnegativity constraints.
106 C NTYPE -- Identification code for the DNEDK routine.
107 C 1 ==> modified Newton; iterative linear solver.
108 C 2 ==> modified Newton; user-supplied linear solver.
109 C IERNLS -- Error flag for nonlinear solver.
110 C 0 ==> nonlinear solver converged.
111 C 1 ==> recoverable error inside non-linear solver.
112 C -1 ==> unrecoverable error inside non-linear solver.
113 C
114 C The following group of variables are passed as arguments to
115 C the Newton iteration solver. They are explained in greater detail
116 C in DNSK:
117 C TOLNEW, MULDEL, MAXIT, IERNEW
118 C
119 C IERTYP -- Flag which tells whether this subroutine is correct.
120 C 0 ==> correct subroutine.
121 C 1 ==> incorrect subroutine.
122 C
123 C-----------------------------------------------------------------------
124 C***ROUTINES CALLED
125 C RES, JACK, DDWNRM, DNSK
126 C
127 C***END PROLOGUE DNEDK
128 C
129 C
130  IMPLICIT DOUBLE PRECISION(a-h,o-z)
131  dimension y(*),yprime(*),wt(*)
132  dimension phi(neq,*),savr(*),delta(*),e(*)
133  dimension wm(*),iwm(*)
134  dimension gamma(*),rpar(*),ipar(*)
135  EXTERNAL res, jack, psol
136 C
137  parameter(lnre=12, lnje=13, llocwp=29, llciwp=30)
138 C
139  SAVE muldel, maxit, xrate
140  DATA muldel/0/, maxit/4/, xrate/0.25d0/
141 C
142 C Verify that this is the correct subroutine.
143 C
144  iertyp = 0
145  IF (ntype .NE. 1) THEN
146  iertyp = 1
147  GO TO 380
148  ENDIF
149 C
150 C If this is the first step, perform initializations.
151 C
152  IF (jstart .EQ. 0) THEN
153  cjold = cj
154  jcalc = -1
155  s = 100.d0
156  ENDIF
157 C
158 C Perform all other initializations.
159 C
160  iernls = 0
161  lwp = iwm(llocwp)
162  liwp = iwm(llciwp)
163 C
164 C Decide whether to update the preconditioner.
165 C
166  IF (jflg .NE. 0) THEN
167  temp1 = (1.0d0 - xrate)/(1.0d0 + xrate)
168  temp2 = 1.0d0/temp1
169  IF (cj/cjold .LT. temp1 .OR. cj/cjold .GT. temp2) jcalc = -1
170  IF (cj .NE. cjlast) s = 100.d0
171  ELSE
172  jcalc = 0
173  ENDIF
174 C
175 C Looping point for updating preconditioner with current stepsize.
176 C
177 300 CONTINUE
178 C
179 C Initialize all error flags to zero.
180 C
181  ierpj = 0
182  ires = 0
183  iersl = 0
184  iernew = 0
185 C
186 C Predict the solution and derivative and compute the tolerance
187 C for the Newton iteration.
188 C
189  DO 310 i=1,neq
190  y(i)=phi(i,1)
191 310 yprime(i)=0.0d0
192  DO 330 j=2,kp1
193  DO 320 i=1,neq
194  y(i)=y(i)+phi(i,j)
195 320 yprime(i)=yprime(i)+gamma(j)*phi(i,j)
196 330 CONTINUE
197  eplin = epli*epcon
198  tolnew = eplin
199 C
200 C Call RES to initialize DELTA.
201 C
202  iwm(lnre)=iwm(lnre)+1
203  CALL res(x,y,yprime,cj,delta,ires,rpar,ipar)
204  IF (ires .LT. 0) GO TO 380
205 C
206 C
207 C If indicated, update the preconditioner.
208 C Set JCALC to 0 as an indicator that this has been done.
209 C
210  IF(jcalc .EQ. -1)THEN
211  iwm(lnje) = iwm(lnje) + 1
212  jcalc=0
213  CALL jack (res, ires, neq, x, y, yprime, wt, delta, e, h, cj,
214  * wm(lwp), iwm(liwp), ierpj, rpar, ipar)
215  cjold=cj
216  s = 100.d0
217  IF (ires .LT. 0) GO TO 380
218  IF (ierpj .NE. 0) GO TO 380
219  ENDIF
220 C
221 C Call the nonlinear Newton solver.
222 C
223  CALL dnsk(x,y,yprime,neq,res,psol,wt,rpar,ipar,savr,
224  * delta,e,wm,iwm,cj,sqrtn,rsqrtn,eplin,epcon,
225  * s,temp1,tolnew,muldel,maxit,ires,iersl,iernew)
226 C
227  IF (iernew .GT. 0 .AND. jcalc .NE. 0) THEN
228 C
229 C The Newton iteration had a recoverable failure with an old
230 C preconditioner. Retry the step with a new preconditioner.
231 C
232  jcalc = -1
233  GO TO 300
234  ENDIF
235 C
236  IF (iernew .NE. 0) GO TO 380
237 C
238 C The Newton iteration has converged. If nonnegativity of
239 C solution is required, set the solution nonnegative, if the
240 C perturbation to do it is small enough. If the change is too
241 C large, then consider the corrector iteration to have failed.
242 C
243  IF(nonneg .EQ. 0) GO TO 390
244  DO 360 i = 1,neq
245  360 delta(i) = min(y(i),0.0d0)
246  delnrm = ddwnrm(neq,delta,wt,rpar,ipar)
247  IF(delnrm .GT. epcon) GO TO 380
248  DO 370 i = 1,neq
249  370 e(i) = e(i) - delta(i)
250  GO TO 390
251 C
252 C
253 C Exits from nonlinear solver.
254 C No convergence with current preconditioner.
255 C Compute IERNLS and IDID accordingly.
256 C
257 380 CONTINUE
258  IF (ires .LE. -2 .OR. iersl .LT. 0 .OR. iertyp .NE. 0) THEN
259  iernls = -1
260  IF (ires .LE. -2) idid = -11
261  IF (iersl .LT. 0) idid = -13
262  IF (iertyp .NE. 0) idid = -15
263  ELSE
264  iernls = 1
265  IF (ires .EQ. -1) idid = -10
266  IF (ierpj .NE. 0) idid = -5
267  IF (iersl .GT. 0) idid = -14
268  ENDIF
269 C
270 C
271 390 jcalc = 1
272  RETURN
273 C
274 C------END OF SUBROUTINE DNEDK------------------------------------------
275  END
OCTAVE_EXPORT octave_value_list etc The functions then dimension(columns)
charNDArray min(char d, const charNDArray &m)
Definition: chNDArray.cc:204