1 SUBROUTINE sprepj (NEQ, Y, YH, NYH, EWT, FTEM, SAVF, WM, IWM,
58 REAL Y, YH, EWT, FTEM, SAVF, WM
59 dimension neq(*), y(*), yh(nyh,*), ewt(*), ftem(*), savf(*),
62 1 icf, ierpj, iersl, jcur, jstart, kflag, l,
63 2 lyh, lewt, lacor, lsavf, lwm, liwm, meth, miter,
64 3 maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
66 1 ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround
67 COMMON /sls001/ rowns(209),
68 1 ccmax, el0, h, hmin, hmxi, hu, rc, tn, uround,
70 3 icf, ierpj, iersl, jcur, jstart, kflag, l,
71 4 lyh, lewt, lacor, lsavf, lwm, liwm, meth, miter,
72 5 maxord, maxcor, msbp, mxncf, n, nq, nst, nfe, nje, nqu
73 INTEGER I, I1, I2, IER, II, J, J1, JJ, LENP,
74 1 mba, mband, meb1, meband, ml, ml3, mu, np1
75 REAL CON, DI, FAC, HL0, R, R0, SRUR, YI, YJ, YJJ,
83 go to(100, 200, 300, 400, 500), miter
88 CALL jac(neq, tn, y, 0, 0, wm(3), n)
91 120 wm(i+2) = wm(i+2)*con
94 200 fac = svnorm(n, savf, ewt)
95 r0 = 1000.0e0*
abs(h)*uround*n*fac
96 IF (r0 .EQ. 0.0e0) r0 = 1.0e0
101 r =
max(srur*
abs(yj),r0/ewt(j))
104 CALL
f(neq, tn, y, ftem)
106 220 wm(i+j1) = (ftem(i) - savf(i))*fac
115 wm(j) = wm(j) + 1.0e0
118 CALL sgetrf(n, n, wm(3), n, iwm(21), ier)
119 IF (ier .NE. 0) ierpj = 1
125 310 y(i) = y(i) + r*(h*savf(i) - yh(i,2))
126 CALL
f(neq, tn, y, wm(3))
129 r0 = h*savf(i) - yh(i,2)
130 di = 0.1e0*r0 - h*(wm(i+2) - savf(i))
132 IF (
abs(r0) .LT. uround/ewt(i)) go to 320
133 IF (
abs(di) .EQ. 0.0e0) go to 330
134 wm(i+2) = 0.1e0*r0/di
148 CALL jac(neq, tn, y, ml, mu, wm(ml3), meband)
151 420 wm(i+2) = wm(i+2)*con
161 fac = svnorm(n, savf, ewt)
162 r0 = 1000.0e0*
abs(h)*uround*n*fac
163 IF (r0 .EQ. 0.0e0) r0 = 1.0e0
167 r =
max(srur*
abs(yi),r0/ewt(i))
169 CALL
f(neq, tn, y, ftem)
170 DO 550 jj = j,n,mband
173 r =
max(srur*
abs(yjj),r0/ewt(jj))
177 ii = jj*meb1 - ml + 2
179 540 wm(ii+i) = (ftem(i) - savf(i))*fac
186 wm(ii) = wm(ii) + 1.0e0
189 CALL sgbtrf( n, n, ml, mu, wm(3), meband, iwm(21), ier)
190 IF (ier .NE. 0) ierpj = 1
std::string dimension(void) const
F77_RET_T const double const double * f
charNDArray max(char d, const charNDArray &m)
subroutine sprepj(NEQ, Y, YH, NYH, EWT, FTEM, SAVF, WM, IWM, F, JAC)
charNDArray min(char d, const charNDArray &m)