5 SUBROUTINE dnedd(X,Y,YPRIME,NEQ,RES,JACD,PDUM,H,WT,
6 * jstart,idid,rpar,ipar,phi,
gamma,dumsvr,delta,e,
7 * wm,iwm,cj,cjold,cjlast,s,uround,dume,dums,dumr,
8 * epcon,jcalc,jfdum,kp1,nonneg,ntype,iernls)
132 IMPLICIT DOUBLE PRECISION(a-h,o-z)
139 parameter(lnre=12, lnje=13)
141 SAVE muldel, maxit, xrate
142 DATA muldel/1/, maxit/4/, xrate/0.25d0/
147 IF (ntype .NE. 0)
THEN
154 IF (jstart .EQ. 0)
THEN
165 temp1 = (1.0d0 - xrate)/(1.0d0 + xrate)
167 IF (cj/cjold .LT. temp1 .OR. cj/cjold .GT. temp2) jcalc = -1
168 IF (cj .NE. cjlast) s = 100.d0
191 320 yprime(i)=yprime(i)+
gamma(j)*phi(i,j)
193 pnorm =
ddwnrm(neq,y,wt,rpar,ipar)
194 tolnew = 100.d0*uround*pnorm
198 iwm(lnre)=iwm(lnre)+1
199 CALL res(
x,y,yprime,cj,delta,ires,rpar,ipar)
200 IF (ires .LT. 0) go to 380
206 IF(jcalc .EQ. -1)
THEN
207 iwm(lnje)=iwm(lnje)+1
209 CALL
dmatd(neq,
x,y,yprime,delta,cj,h,ierj,wt,e,wm,iwm,
210 * res,ires,uround,jacd,rpar,ipar)
213 IF (ires .LT. 0) go to 380
214 IF(ierj .NE. 0)go to 380
219 temp1 = 2.0d0/(1.0d0 + cj/cjold)
220 CALL
dnsd(
x,y,yprime,neq,res,pdum,wt,rpar,ipar,dumsvr,
221 * delta,e,wm,iwm,cj,dums,dumr,dume,epcon,s,temp1,
222 * tolnew,muldel,maxit,ires,idum,iernew)
224 IF (iernew .GT. 0 .AND. jcalc .NE. 0)
THEN
233 IF (iernew .NE. 0) go to 380
240 375
IF(nonneg .EQ. 0) go to 390
242 377 delta(i) =
min(y(i),0.0d0)
243 delnrm =
ddwnrm(neq,delta,wt,rpar,ipar)
244 IF(delnrm .GT. epcon) go to 380
246 378 e(i) = e(i) - delta(i)
256 IF (ires .LE. -2 .OR. iertyp .NE. 0)
THEN
258 IF (ires .LE. -2) idid = -11
259 IF (iertyp .NE. 0) idid = -15
262 IF (ires .LT. 0) idid = -10
263 IF (ierj .NE. 0) idid = -8