subroutine prja (neq, y, yh, nyh, ewt, ftem, savf, wm, iwm,
1 f, jac)
clll. optimize
+
+ include 'stack.h'
+
external f, jac
integer neq, nyh, iwm
integer iownd, iowns,
1 vmnorm, fnorm, bnorm
dimension neq(*), y(*), yh(nyh,*), ewt(*), ftem(*), savf(*),
1 wm(*), iwm(*)
- integer iero
- common /ierode/ iero
common /ls0001/ rownd, rowns(209),
2 ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
3 iownd(14), iowns(6),
do 110 i = 1,lenp
110 wm(i+2) = 0.0d+0
call jac (neq, tn, y, 0, 0, wm(3), n)
- if(iero.gt.0) return
+ if(ierror.gt.0) return
con = -hl0
do 120 i = 1,lenp
120 wm(i+2) = wm(i+2)*con
y(j) = y(j) + r
fac = -hl0/r
call f (neq, tn, y, ftem)
- if(iero.gt.0) return
+ if(ierror.gt.0) return
do 220 i = 1,n
220 wm(i+j1) = (ftem(i) - savf(i))*fac
y(j) = yj
do 410 i = 1,lenp
410 wm(i+2) = 0.0d+0
call jac (neq, tn, y, ml, mu, wm(ml3), meband)
- if(iero.gt.0) return
+ if(ierror.gt.0) return
con = -hl0
do 420 i = 1,lenp
420 wm(i+2) = wm(i+2)*con
r = max(srur*abs(yi),r0/ewt(i))
530 y(i) = y(i) + r
call f (neq, tn, y, ftem)
- if(iero.gt.0) return
+ if(ierror.gt.0) return
do 550 jj = j,n,mband
y(jj) = yh(jj,1)
yjj = y(jj)