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
std::string dimension(void) const
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)
double precision function ddwnrm(NEQ, V, RWT, RPAR, IPAR)
charNDArray min(char d, const charNDArray &m)