5 SUBROUTINE dlinsd (NEQ, Y, T, YPRIME, CJ, P, PNRM, WT, LSOFF,
6 * stptol, iret, res, ires, wm, iwm,
7 * fnrm, icopt, id, r, ynew, ypnew, icnflg,
8 * icnstr, rlx, rpar, ipar)
73 IMPLICIT DOUBLE PRECISION(a-
h,o-z)
75 dimension y(*), yprime(*), wt(*), r(*), id(*)
77 dimension ynew(*), ypnew(*), p(*), icnstr(*)
81 parameter(lnre=12, lkprin=31)
84 DATA alpha/1.0
d-4/, one/1.0d0/, two/2.0d0/
88 f1nrm = (fnrm*fnrm)/two
90 IF (kprin .GE. 2)
THEN
91 msg =
'------ IN ROUTINE DLINSD-- PNRM = (R1) )'
92 CALL
xerrwd(msg, 40, 901, 0, 0, 0, 0, 1, pnrm, 0.0d0)
102 IF (icnflg .NE. 0)
THEN
104 CALL
dyypnw(neq,y,yprime,cj,rl,p,icopt,id,ynew,ypnew)
105 CALL
dcnstr(neq, y, ynew, icnstr,
tau, rlx, iret, ivar)
106 IF (iret .EQ. 1)
THEN
111 20 p(i) = p(i)*ratio1
113 IF (kprin .GE. 2)
THEN
114 msg =
'------ CONSTRAINT VIOL., PNRM = (R1), INDEX = (I1)'
115 CALL
xerrwd(msg, 50, 902, 0, 1, ivar, 0, 1, pnrm, 0.0d0)
117 IF (pnrm .LE. stptol)
THEN
125 slpi = (-two*f1nrm)*ratio
127 IF (lsoff .EQ. 0 .AND. kprin .GE. 2)
THEN
128 msg =
'------ MIN. LAMBDA = (R1)'
129 CALL
xerrwd(msg, 25, 903, 0, 0, 0, 0, 1, rlmin, 0.0d0)
136 CALL
dyypnw(neq,y,yprime,cj,rl,p,icopt,id,ynew,ypnew)
137 CALL
dfnrmd(neq, ynew, t, ypnew, r, cj, wt, res, ires,
138 * fnrmp, wm, iwm, rpar, ipar)
139 iwm(lnre) = iwm(lnre) + 1
140 IF (ires .NE. 0)
THEN
144 IF (lsoff .EQ. 1) go
to 150
146 f1nrmp = fnrmp*fnrmp/two
147 IF (kprin .GE. 2)
THEN
148 msg =
'------ LAMBDA = (R1)'
149 CALL
xerrwd(msg, 20, 904, 0, 0, 0, 0, 1, rl, 0.0d0)
150 msg =
'------ NORM(F1) = (R1), NORM(F1NEW) = (R2)'
151 CALL
xerrwd(msg, 43, 905, 0, 0, 0, 0, 2, f1nrm, f1nrmp)
153 IF (f1nrmp .GT. f1nrm +
alpha*slpi*rl) go
to 200
159 CALL dcopy(neq, ynew, 1, y, 1)
160 CALL dcopy(neq, ypnew, 1, yprime, 1)
162 IF (kprin .GE. 1)
THEN
163 msg =
'------ LEAVING ROUTINE DLINSD, FNRM = (R1)'
164 CALL
xerrwd(msg, 42, 906, 0, 0, 0, 0, 1, fnrm, 0.0d0)
173 IF (rl .LT. rlmin)
THEN
subroutine xerrwd(MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_REAL const F77_REAL F77_REAL &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T F77_DBLE &F77_RET_T F77_REAL &F77_RET_T F77_REAL &F77_RET_T F77_DBLE &F77_RET_T const F77_DBLE F77_DBLE &F77_RET_T const F77_REAL F77_REAL &F77_RET_T F77_REAL F77_REAL &F77_RET_T F77_DBLE F77_DBLE &F77_RET_T const F77_DBLE const F77_DBLE F77_DBLE * d
void tau(int code, int p, int q)
subroutine dyypnw(NEQ, Y, YPRIME, CJ, RL, P, ICOPT, ID, YNEW, YPNEW)
subroutine dcnstr(NEQ, Y, YNEW, ICNSTR, TAU, RLX, IRET, IVAR)
subroutine dlinsd(NEQ, Y, T, YPRIME, CJ, P, PNRM, WT, LSOFF, STPTOL, IRET, RES, IRES, WM, IWM, FNRM, ICOPT, ID, R, YNEW, YPNEW, ICNFLG, ICNSTR, RLX, RPAR, IPAR)
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)
subroutine dfnrmd(NEQ, Y, T, YPRIME, R, CJ, WT, RES, IRES, FNORM, WM, IWM, RPAR, IPAR)