Actual source code: dgefa.c
1: /*
2: This routine was converted by f2c from Linpack source
3: linpack. this version dated 08/14/78
4: cleve moler, university of new mexico, argonne national lab.
6: Does an LU factorization with partial pivoting of a dense
7: n by n matrix.
9: Used by the sparse factorization routines in
10: src/mat/impls/baij/seq and src/mat/impls/bdiag/seq
12: See also src/inline/ilu.h
13: */
14: #include petsc.h
18: PetscErrorCode LINPACKdgefa(MatScalar *a,PetscInt n,PetscInt *ipvt)
19: {
20: PetscInt i__2,i__3,kp1,nm1,j,k,l,ll,kn,knp1,jn1;
21: MatScalar t,*ax,*ay,*aa;
22: MatReal tmp,max;
24: /* gaussian elimination with partial pivoting */
27: /* Parameter adjustments */
28: --ipvt;
29: a -= n + 1;
31: /* Function Body */
32: nm1 = n - 1;
33: for (k = 1; k <= nm1; ++k) {
34: kp1 = k + 1;
35: kn = k*n;
36: knp1 = k*n + k;
38: /* find l = pivot index */
40: i__2 = n - k + 1;
41: aa = &a[knp1];
42: max = PetscAbsScalar(aa[0]);
43: l = 1;
44: for (ll=1; ll<i__2; ll++) {
45: tmp = PetscAbsScalar(aa[ll]);
46: if (tmp > max) { max = tmp; l = ll+1;}
47: }
48: l += k - 1;
49: ipvt[k] = l;
51: if (a[l + kn] == 0.0) {
52: SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot, row %D",k-1);
53: }
55: /* interchange if necessary */
57: if (l != k) {
58: t = a[l + kn];
59: a[l + kn] = a[knp1];
60: a[knp1] = t;
61: }
63: /* compute multipliers */
65: t = -1. / a[knp1];
66: i__2 = n - k;
67: aa = &a[1 + knp1];
68: for (ll=0; ll<i__2; ll++) {
69: aa[ll] *= t;
70: }
72: /* row elimination with column indexing */
74: ax = aa;
75: for (j = kp1; j <= n; ++j) {
76: jn1 = j*n;
77: t = a[l + jn1];
78: if (l != k) {
79: a[l + jn1] = a[k + jn1];
80: a[k + jn1] = t;
81: }
83: i__3 = n - k;
84: ay = &a[1+k+jn1];
85: for (ll=0; ll<i__3; ll++) {
86: ay[ll] += t*ax[ll];
87: }
88: }
89: }
90: ipvt[n] = n;
91: if (a[n + n * n] == 0.0) {
92: SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot, row %D",n-1);
93: }
94: return(0);
95: }