2 SUBROUTINE dgefa (A, LDA, N, IPVT, INFO)
60 INTEGER lda,n,ipvt(*),info
61 DOUBLE PRECISION a(lda,*)
64 INTEGER idamax,j,k,kp1,l,nm1
71 IF (nm1 .LT. 1)
GO TO 70
77 l = idamax(n-k+1,a(k,k),1) + k - 1
82 IF (a(l,k) .EQ. 0.0d0)
GO TO 40
86 IF (l .EQ. k)
GO TO 10
95 CALL dscal(n-k,t,a(k+1,k),1)
101 IF (l .EQ. k)
GO TO 20
105 CALL daxpy(n-k,t,a(k+1,k),1,a(k+1,j),1)
114 IF (a(n,n) .EQ. 0.0d0) info = n
118 SUBROUTINE dgesl (A, LDA, N, IPVT, B, JOB)
187 INTEGER lda,n,ipvt(*),job
188 DOUBLE PRECISION a(lda,*),b(*)
190 DOUBLE PRECISION ddot,t
194 IF (job .NE. 0)
GO TO 50
199 IF (nm1 .LT. 1)
GO TO 30
203 IF (l .EQ. k)
GO TO 10
207 CALL daxpy(n-k,t,a(k+1,k),1,b(k+1),1)
217 CALL daxpy(k-1,t,a(1,k),1,b(1),1)
226 t = ddot(k-1,a(1,k),1,b(1),1)
227 b(k) = (b(k) - t)/a(k,k)
232 IF (nm1 .LT. 1)
GO TO 90
235 b(k) = b(k) + ddot(n-k,a(k+1,k),1,b(k+1),1)
237 IF (l .EQ. k)
GO TO 70
248 SUBROUTINE dgbfa (ABD, LDA, N, ML, MU, IPVT, INFO)
342 INTEGER lda,n,ml,mu,ipvt(*),info
343 DOUBLE PRECISION abd(lda,*)
346 INTEGER i,idamax,i0,j,ju,jz,j0,j1,k,kp1,l,lm,m,mm,nm1
356 IF (j1 .LT. j0)
GO TO 30
370 IF (nm1 .LT. 1)
GO TO 130
377 IF (jz .GT. n)
GO TO 50
378 IF (ml .LT. 1)
GO TO 50
387 l = idamax(lm+1,abd(m,k),1) + m - 1
392 IF (abd(l,k) .EQ. 0.0d0)
GO TO 100
396 IF (l .EQ. m)
GO TO 60
405 CALL dscal(lm,t,abd(m+1,k),1)
409 ju = min(max(ju,mu+ipvt(k)),n)
411 IF (ju .LT. kp1)
GO TO 90
416 IF (l .EQ. mm)
GO TO 70
420 CALL daxpy(lm,t,abd(m+1,k),1,abd(mm+1,j),1)
430 IF (abd(m,n) .EQ. 0.0d0) info = n
434 SUBROUTINE dgbsl (ABD, LDA, N, ML, MU, IPVT, B, JOB)
510 INTEGER lda,n,ml,mu,ipvt(*),job
511 DOUBLE PRECISION abd(lda,*),b(*)
513 DOUBLE PRECISION ddot,t
514 INTEGER k,kb,l,la,lb,lm,m,nm1
518 IF (job .NE. 0)
GO TO 50
523 IF (ml .EQ. 0)
GO TO 30
524 IF (nm1 .LT. 1)
GO TO 30
529 IF (l .EQ. k)
GO TO 10
533 CALL daxpy(lm,t,abd(m+1,k),1,b(k+1),1)
546 CALL daxpy(lm,t,abd(la,k),1,b(lb),1)
558 t = ddot(lm,abd(la,k),1,b(lb),1)
559 b(k) = (b(k) - t)/abd(m,k)
564 IF (ml .EQ. 0)
GO TO 90
565 IF (nm1 .LT. 1)
GO TO 90
569 b(k) = b(k) + ddot(lm,abd(m+1,k),1,b(k+1),1)
571 IF (l .EQ. k)
GO TO 70
582 SUBROUTINE daxpy (N, DA, DX, INCX, DY, INCY)
627 DOUBLE PRECISION dx(*), dy(*), da
629 IF (n.LE.0 .OR. da.EQ.0.0d0)
RETURN 630 IF (incx .EQ. incy)
IF (incx-1) 5,20,60
636 IF (incx .LT. 0) ix = (-n+1)*incx + 1
637 IF (incy .LT. 0) iy = (-n+1)*incy + 1
639 dy(iy) = dy(iy) + da*dx(ix)
650 IF (m .EQ. 0)
GO TO 40
652 dy(i) = dy(i) + da*dx(i)
657 dy(i) = dy(i) + da*dx(i)
658 dy(i+1) = dy(i+1) + da*dx(i+1)
659 dy(i+2) = dy(i+2) + da*dx(i+2)
660 dy(i+3) = dy(i+3) + da*dx(i+3)
668 dy(i) = da*dx(i) + dy(i)
673 SUBROUTINE dcopy (N, DX, INCX, DY, INCY)
716 DOUBLE PRECISION dx(*), dy(*)
719 IF (incx .EQ. incy)
IF (incx-1) 5,20,60
725 IF (incx .LT. 0) ix = (-n+1)*incx + 1
726 IF (incy .LT. 0) iy = (-n+1)*incy + 1
739 IF (m .EQ. 0)
GO TO 40
765 DOUBLE PRECISION FUNCTION ddot (N, DX, INCX, DY, INCY)
808 DOUBLE PRECISION dx(*), dy(*)
812 IF (incx .EQ. incy)
IF (incx-1) 5,20,60
818 IF (incx .LT. 0) ix = (-n+1)*incx + 1
819 IF (incy .LT. 0) iy = (-n+1)*incy + 1
821 ddot = ddot + dx(ix)*dy(iy)
832 IF (m .EQ. 0)
GO TO 40
834 ddot = ddot + dx(i)*dy(i)
839 ddot = ddot + dx(i)*dy(i) + dx(i+1)*dy(i+1) + dx(i+2)*dy(i+2) +
840 1 dx(i+3)*dy(i+3) + dx(i+4)*dy(i+4)
848 ddot = ddot + dx(i)*dy(i)
853 DOUBLE PRECISION FUNCTION dnrm2 (N, DX, INCX)
927 DOUBLE PRECISION dx(*), cutlo, cuthi, hitest, sum, xmax, zero,
929 SAVE cutlo, cuthi, zero, one
930 DATA zero, one /0.0d0, 1.0d0/
932 DATA cutlo, cuthi /8.232d-11, 1.304d19/
934 IF (n .GT. 0)
GO TO 10
945 20
GO TO next,(30, 50, 70, 110)
946 30
IF (abs(dx(i)) .GT. cutlo)
GO TO 85
952 50
IF (dx(i) .EQ. zero)
GO TO 200
953 IF (abs(dx(i)) .GT. cutlo)
GO TO 85
964 sum = (sum / dx(i)) / dx(i)
965 105 xmax = abs(dx(i))
971 70
IF (abs(dx(i)) .GT. cutlo)
GO TO 75
976 110
IF (abs(dx(i)) .LE. xmax)
GO TO 115
977 sum = one + sum * (xmax / dx(i))**2
981 115 sum = sum + (dx(i)/xmax)**2
986 75 sum = (sum * xmax) * xmax
991 85 hitest = cuthi / n
996 IF (abs(dx(j)) .GE. hitest)
GO TO 100
997 95 sum = sum + dx(j)**2
1003 IF (i .LE. nn)
GO TO 20
1009 dnrm2 = xmax * sqrt(sum)
1014 SUBROUTINE dscal (N, DA, DX, INCX)
1056 DOUBLE PRECISION da, dx(*)
1057 INTEGER i, incx, ix, m, mp1, n
1059 IF (n .LE. 0)
RETURN 1060 IF (incx .EQ. 1)
GOTO 20
1065 IF (incx .LT. 0) ix = (-n+1)*incx + 1
1077 IF (m .EQ. 0)
GOTO 40
1081 IF (n .LT. 5)
RETURN 1085 dx(i+1) = da*dx(i+1)
1086 dx(i+2) = da*dx(i+2)
1087 dx(i+3) = da*dx(i+3)
1088 dx(i+4) = da*dx(i+4)
1093 INTEGER FUNCTION idamax (N, DX, INCX)
1135 DOUBLE PRECISION dx(*), dmax, xmag
1136 INTEGER i, incx, ix, n
1139 IF (n .LE. 0)
RETURN 1141 IF (n .EQ. 1)
RETURN 1143 IF (incx .EQ. 1)
GOTO 20
1148 IF (incx .LT. 0) ix = (-n+1)*incx + 1
1153 IF (xmag .GT. dmax)
THEN 1163 20 dmax = abs(dx(1))
1166 IF (xmag .GT. dmax)
THEN 1174 SUBROUTINE xerrwd (MSG, NMES, NERR, LEVEL, NI, I1, I2, NR, R1, R2)
1234 DOUBLE PRECISION r1, r2
1235 INTEGER nmes, nerr, level, ni, i1, i2, nr
1240 INTEGER lunit, ixsav, mesflg
1245 lunit = ixsav(1, 0, .false.)
1246 mesflg = ixsav(2, 0, .false.)
1247 IF (mesflg .EQ. 0)
GO TO 100
1251 WRITE (lunit,10) msg
1253 IF (ni .EQ. 1)
WRITE (lunit, 20) i1
1254 20
FORMAT(6x,
'In above message, I1 =',i10)
1255 IF (ni .EQ. 2)
WRITE (lunit, 30) i1,i2
1256 30
FORMAT(6x,
'In above message, I1 =',i10,3x,
'I2 =',i10)
1257 IF (nr .EQ. 1)
WRITE (lunit, 40) r1
1258 40
FORMAT(6x,
'In above message, R1 =',d21.13)
1259 IF (nr .EQ. 2)
WRITE (lunit, 50) r1,r2
1260 50
FORMAT(6x,
'In above, R1 =',d21.13,3x,
'R2 =',d21.13)
1264 100
IF (level .NE. 2)
RETURN 1269 SUBROUTINE xsetf (MFLAG)
1296 INTEGER mflag, junk, ixsav
1299 IF (mflag .EQ. 0 .OR. mflag .EQ. 1) junk = ixsav(2,mflag,.true.)
1304 SUBROUTINE xsetun (LUN)
1329 INTEGER lun, junk, ixsav
1332 IF (lun .GT. 0) junk = ixsav(1,lun,.true.)
1337 INTEGER FUNCTION ixsav (IPAR, IVALUE, ISET)
1384 INTEGER ipar, ivalue
1386 INTEGER iumach, lunit, mesflg
1392 DATA lunit/-1/, mesflg/1/
1395 IF (ipar .EQ. 1)
THEN 1396 IF (lunit .EQ. -1) lunit = iumach()
1398 IF (iset) lunit = ivalue
1401 IF (ipar .EQ. 2)
THEN 1403 IF (iset) mesflg = ivalue
1410 INTEGER FUNCTION iumach()