1 SUBROUTINE ddaini (X, Y, YPRIME, NEQ, RES, JAC, H, WT, IDID, RPAR,
2 + IPAR, PHI, DELTA, E, WM, IWM, HMIN, UROUND, NONNEG, NTEMP)
55 INTEGER NEQ, IDID, IPAR(*), IWM(*), NONNEG, NTEMP
57 * x, y(*), yprime(*), h, wt(*), rpar(*), phi(neq,*), delta(*),
58 * e(*), wm(*), hmin, uround
61 EXTERNAL ddajac, ddanrm, ddaslv
62 DOUBLE PRECISION DDANRM
64 INTEGER I, IER, IRES, JCALC, LNJE, LNRE, M, MAXIT, MJAC, NCF,
67 * cj, damp, delnrm, err, oldnrm, r, rate, s, xold, ynorm
73 DATA maxit/10/,mjac/5/
88 ynorm=ddanrm(neq,y,wt,rpar,ipar)
93 100 phi(i,2)=yprime(i)
107 250 y(i)=y(i)+h*yprime(i)
115 300 iwm(lnre)=iwm(lnre)+1
118 CALL res(x,y,yprime,delta,ires,rpar,ipar)
119 IF (ires.LT.0)
GO TO 430
123 IF (jcalc.NE.-1)
GO TO 310
124 iwm(lnje)=iwm(lnje)+1
126 CALL ddajac(neq,x,y,yprime,delta,cj,h,
127 * ier,wt,e,wm,iwm,res,ires,
128 * uround,jac,rpar,ipar,ntemp)
131 IF (ires.LT.0)
GO TO 430
132 IF (ier.NE.0)
GO TO 430
140 320 delta(i)=delta(i)*damp
145 CALL ddaslv(neq,delta,wm,iwm)
150 330 yprime(i)=yprime(i)-cj*delta(i)
154 delnrm=ddanrm(neq,delta,wt,rpar,ipar)
155 IF (delnrm.LE.100.d0*uround*ynorm)
158 IF (m.GT.0)
GO TO 340
162 340 rate=(delnrm/oldnrm)**(1.0d0/m)
163 IF (rate.GT.0.90d0)
GO TO 430
166 350
IF (s*delnrm .LE. 0.33d0)
GO TO 400
176 IF (m.GE.maxit)
GO TO 430
178 IF ((m/mjac)*mjac.EQ.m) jcalc=-1
184 400
IF (nonneg.EQ.0)
GO TO 450
186 410 delta(i)=
min(y(i),0.0d0)
188 delnrm=ddanrm(neq,delta,wt,rpar,ipar)
189 IF (delnrm.GT.0.33d0)
GO TO 430
193 420 yprime(i)=yprime(i)-cj*delta(i)
199 450
IF (.NOT.convgd)
GO TO 600
210 510 e(i)=y(i)-phi(i,1)
211 err=ddanrm(neq,e,wt,rpar,ipar)
213 IF (err.LE.1.0d0)
RETURN 229 610 yprime(i)=phi(i,2)
231 IF (convgd)
GO TO 640
232 IF (ier.EQ.0)
GO TO 620
235 IF (nsf.LT.3.AND.
abs(h).GE.hmin)
GO TO 690
238 620
IF (ires.GT.-2)
GO TO 630
243 IF (ncf.LT.10.AND.
abs(h).GE.hmin)
GO TO 690
248 r=0.90d0/(2.0d0*err+0.0001d0)
251 IF (
abs(h).GE.hmin.AND.nef.LT.10)
GO TO 690
charNDArray max(char d, const charNDArray &m)
charNDArray min(char d, const charNDArray &m)