5 SUBROUTINE dspigm (NEQ, TN, Y, YPRIME, SAVR, R, WGHT, MAXL,
6 * maxlp1, kmp, eplin, cj, res, ires, nre, psol, npsl, z, v,
7 * hes, q, lgmr, wp, iwp, wk, dl, rhok, iflag, irst, nrsts,
129 INTEGER NEQ,MAXL,MAXLP1,KMP,IRES,NRE,NPSL,LGMR,IWP,
130 1 iflag,irst,nrsts,ipar
131 DOUBLE PRECISION TN,Y,YPRIME,SAVR,R,WGHT,EPLIN,CJ,Z,V,HES,Q,WP,WK,
133 dimension y(*), yprime(*), savr(*), r(*), wght(*), z(*),
134 1 v(neq,*), hes(maxlp1,*), q(*), wp(*), iwp(*), wk(*), dl(*),
136 INTEGER I, IER, INFO, IP1, I2, J, K, LL, LLP1
137 DOUBLE PRECISION RNRM,C,DLNRM,PROD,RHO,S,SNORMW,DNRM2,TEM
155 IF (nrsts .EQ. 0)
THEN
156 CALL psol(neq, tn, y, yprime, savr, wk, cj, wght, wp, iwp,
157 1 r, eplin, ier, rpar, ipar)
159 IF (ier .NE. 0) go to 300
161 30 v(i,1) = r(i)*wght(i)
171 rnrm = dnrm2(neq, v, 1)
172 IF (rnrm .LE. eplin)
THEN
177 CALL dscal(neq, tem, v(1,1), 1)
198 CALL
datv(neq, y, tn, yprime, savr, v(1,ll), wght, z,
199 1 res, ires, psol, v(1,ll+1), wk, wp, iwp, cj, eplin,
200 1 ier, nre, npsl, rpar, ipar)
201 IF (ires .LT. 0)
RETURN
202 IF (ier .NE. 0) go to 300
203 CALL
dorth(v(1,ll+1), v, hes, neq, ll, maxlp1, kmp, snormw)
204 hes(ll+1,ll) = snormw
205 CALL
dheqr(hes, maxlp1, ll, q, info, ll)
206 IF (info .EQ. ll) go to 120
215 IF ((ll.GT.kmp) .AND. (kmp.LT.maxl))
THEN
216 IF (ll .EQ. kmp+1)
THEN
217 CALL dcopy(neq, v(1,1), 1, dl, 1)
224 70 dl(k) = s*dl(k) + c*v(k,ip1)
231 80 dl(k) = s*dl(k) + c*v(k,llp1)
232 dlnrm = dnrm2(neq, dl, 1)
239 IF (rho .LE. eplin) go to 200
240 IF (ll .EQ. maxl) go to 100
245 CALL dscal(neq, tem, v(1,ll+1), 1)
248 IF (rho .LT. rnrm) go to 150
261 IF (irst .GT. 0)
THEN
262 IF (kmp .EQ. maxl)
THEN
266 CALL dcopy(neq, v(1,1), 1, dl, 1)
274 170 dl(k) = s*dl(k) + c*v(k,ip1)
277 c = q(2*maxl-1)/snormw
279 180 dl(k) = s*dl(k) + c*v(k,maxlp1)
285 CALL dscal(neq, tem, dl, 1)
298 CALL
dhels(hes, maxlp1, ll, q, r)
302 CALL daxpy(neq, r(i), v(1,i), 1, z, 1)
305 240 z(i) = z(i)/wght(i)
313 IF (ier .LT. 0) iflag = -1
314 IF (ier .GT. 0) iflag = 3
subroutine dorth(VNEW, V, HES, N, LL, LDHES, KMP, SNORMW)
std::string dimension(void) const
subroutine dhels(A, LDA, N, Q, B)
subroutine dheqr(A, LDA, N, Q, INFO, IJOB)
subroutine dspigm(NEQ, TN, Y, YPRIME, SAVR, R, WGHT, MAXL, MAXLP1, KMP, EPLIN, CJ, RES, IRES, NRE, PSOL, NPSL, Z, V, HES, Q, LGMR, WP, IWP, WK, DL, RHOK, IFLAG, IRST, NRSTS, RPAR, IPAR)
subroutine datv(NEQ, Y, TN, YPRIME, SAVR, V, WGHT, YPTEM, RES, IRES, PSOL, Z, VTEM, WP, IWP, CJ, EPLIN, IER, NRE, NPSL, RPAR, IPAR)