Actual source code: dgefa.c
1: /*$Id: dgefa.c,v 1.22 2001/03/23 23:22:07 balay Exp $*/
2: /*
3: This routine was converted by f2c from Linpack source
4: linpack. this version dated 08/14/78
5: cleve moler, university of new mexico, argonne national lab.
7: Does an LU factorization with partial pivoting of a dense
8: n by n matrix.
10: Used by the sparse factorization routines in
11: src/mat/impls/baij/seq and src/mat/impls/bdiag/seq
13: See also src/inline/ilu.h
14: */
15: #include petsc.h
17: int LINPACKdgefa(MatScalar *a,int n,int *ipvt)
18: {
19: int i__2,i__3,kp1,nm1,j,k,l,ll,kn,knp1,jn1;
20: MatScalar t,*ax,*ay,*aa;
21: MatReal tmp,max;
23: /* gaussian elimination with partial pivoting */
26: /* Parameter adjustments */
27: --ipvt;
28: a -= n + 1;
30: /* Function Body */
31: nm1 = n - 1;
32: for (k = 1; k <= nm1; ++k) {
33: kp1 = k + 1;
34: kn = k*n;
35: knp1 = k*n + k;
37: /* find l = pivot index */
39: i__2 = n - k + 1;
40: aa = &a[knp1];
41: max = PetscAbsScalar(aa[0]);
42: l = 1;
43: for (ll=1; ll<i__2; ll++) {
44: tmp = PetscAbsScalar(aa[ll]);
45: if (tmp > max) { max = tmp; l = ll+1;}
46: }
47: l += k - 1;
48: ipvt[k] = l;
50: if (a[l + kn] == 0.) {
51: SETERRQ(k,"Zero pivot");
52: }
54: /* interchange if necessary */
56: if (l != k) {
57: t = a[l + kn];
58: a[l + kn] = a[knp1];
59: a[knp1] = t;
60: }
62: /* compute multipliers */
64: t = -1. / a[knp1];
65: i__2 = n - k;
66: aa = &a[1 + knp1];
67: for (ll=0; ll<i__2; ll++) {
68: aa[ll] *= t;
69: }
71: /* row elimination with column indexing */
73: ax = aa;
74: for (j = kp1; j <= n; ++j) {
75: jn1 = j*n;
76: t = a[l + jn1];
77: if (l != k) {
78: a[l + jn1] = a[k + jn1];
79: a[k + jn1] = t;
80: }
82: i__3 = n - k;
83: ay = &a[1+k+jn1];
84: for (ll=0; ll<i__3; ll++) {
85: ay[ll] += t*ax[ll];
86: }
87: }
88: }
89: ipvt[n] = n;
90: if (a[n + n * n] == 0.) {
91: SETERRQ(n,"Zero pivot,final row");
92: }
93: return(0);
94: }