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: }