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)
132 dimension phi(neq,*),savr(*),delta(*),e(*)
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