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)
133 dimension y(*),yprime(*),wt(*)
134 dimension delta(*),e(*)
135 dimension wm(*),iwm(*), rpar(*),ipar(*)
136 dimension phi(neq,*),
gamma(*)
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
charNDArray min(char d, const charNDArray &m)
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
subroutine dmatd(NEQ, X, Y, YPRIME, DELTA, CJ, H, IER, EWT, E, WM, IWM, RES, IRES, UROUND, JACD, RPAR, IPAR)
subroutine dnedd(X, Y, YPRIME, NEQ, RES, JACD, PDUM, H, WT, JSTART, IDID, RPAR, IPAR, PHI, GAMMA, DUMSVR, DELTA, E, WM, IWM, CJ, CJOLD, CJLAST, S, UROUND, DUME, DUMS, DUMR, EPCON, JCALC, JFDUM, KP1, NONNEG, NTYPE, IERNLS)
subroutine dnsd(X, Y, YPRIME, NEQ, RES, PDUM, WT, RPAR, IPAR, DUMSVR, DELTA, E, WM, IWM, CJ, DUMS, DUMR, DUME, EPCON, S, CONFAC, TOLNEW, MULDEL, MAXIT, IRES, IDUM, IERNEW)