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)
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
137 parameter(lnre=12, lnje=13, llocwp=29, llciwp=30)
139 SAVE muldel, maxit, xrate
140 DATA muldel/0/, maxit/4/, xrate/0.25d0/
145 IF (ntype .NE. 1)
THEN
152 IF (jstart .EQ. 0)
THEN
166 IF (jflg .NE. 0)
THEN
167 temp1 = (1.0d0 - xrate)/(1.0d0 + xrate)
169 IF (cj/cjold .LT. temp1 .OR. cj/cjold .GT. temp2) jcalc = -1
170 IF (cj .NE. cjlast) s = 100.d0
195 320 yprime(i)=yprime(i)+
gamma(j)*phi(i,j)
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
210 IF(jcalc .EQ. -1)
THEN
211 iwm(lnje) = iwm(lnje) + 1
213 CALL jack (res, ires, neq, x, y, yprime, wt, delta, e, h, cj,
214 * wm(lwp), iwm(liwp), ierpj, rpar, ipar)
217 IF (ires .LT. 0)
GO TO 380
218 IF (ierpj .NE. 0)
GO TO 380
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)
227 IF (iernew .GT. 0 .AND. jcalc .NE. 0)
THEN
236 IF (iernew .NE. 0)
GO TO 380
243 IF(nonneg .EQ. 0)
GO TO 390
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
249 370 e(i) = e(i) - delta(i)
258 IF (ires .LE. -2 .OR. iersl .LT. 0 .OR. iertyp .NE. 0)
THEN
260 IF (ires .LE. -2) idid = -11
261 IF (iersl .LT. 0) idid = -13
262 IF (iertyp .NE. 0) idid = -15
265 IF (ires .EQ. -1) idid = -10
266 IF (ierpj .NE. 0) idid = -5
267 IF (iersl .GT. 0) idid = -14
charNDArray min(char d, const charNDArray &m)
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
subroutine dnedk(X, Y, YPRIME, NEQ, RES, JACK, PSOL, H, WT, JSTART, IDID, RPAR, IPAR, PHI, GAMMA, SAVR, DELTA, E, WM, IWM, CJ, CJOLD, CJLAST, S, UROUND, EPLI, SQRTN, RSQRTN, EPCON, JCALC, JFLG, KP1, NONNEG, NTYPE, IERNLS)
subroutine dnsk(X, Y, YPRIME, NEQ, RES, PSOL, WT, RPAR, IPAR, SAVR, DELTA, E, WM, IWM, CJ, SQRTN, RSQRTN, EPLIN, EPCON, S, CONFAC, TOLNEW, MULDEL, MAXIT, IRES, IERSL, IERNEW)