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)
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
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)
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)
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to
OCTAVE_EXPORT octave_value_list etc The functions then dimension(columns)
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
charNDArray min(char d, const charNDArray &m)