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