xref: /petsc/src/mat/impls/baij/seq/dgefa.c (revision 70d8d27c0c8a665b79be2909c201b24b4c33566d)
1be1d678aSKris Buschelman 
2a97b7df5SSatish Balay /*
39fd41dd0SBarry Smith        This routine was converted by f2c from Linpack source
49fd41dd0SBarry Smith              linpack. this version dated 08/14/78
59fd41dd0SBarry Smith       cleve moler, university of new mexico, argonne national lab.
659539b86SBarry Smith 
759539b86SBarry Smith         Does an LU factorization with partial pivoting of a dense
89d8b60e5SBarry Smith      n by n matrix.
99d8b60e5SBarry Smith 
109d8b60e5SBarry Smith        Used by the sparse factorization routines in
11dd882469SBarry Smith      src/mat/impls/baij/seq
1259539b86SBarry Smith 
139fd41dd0SBarry Smith */
14c6db04a5SJed Brown #include <petscsys.h>
159fd41dd0SBarry Smith 
164a2ae208SSatish Balay #undef __FUNCT__
1796b95a6bSBarry Smith #define __FUNCT__ "PetscLINPACKgefa"
18db87b0f2SBarry Smith PETSC_INTERN PetscErrorCode PetscLINPACKgefa(MatScalar *a,PetscInt n,PetscInt *ipvt,PetscBool allowzeropivot,PetscBool *zeropivotdetected)
199fd41dd0SBarry Smith {
20690b6cddSBarry Smith   PetscInt  i__2,i__3,kp1,nm1,j,k,l,ll,kn,knp1,jn1;
213f1db9ecSBarry Smith   MatScalar t,*ax,*ay,*aa;
22329f5518SBarry Smith   MatReal   tmp,max;
239fd41dd0SBarry Smith 
243a40ed3dSBarry Smith   PetscFunctionBegin;
255f8bbccaSHong Zhang   if (zeropivotdetected) *zeropivotdetected = PETSC_FALSE;
265f8bbccaSHong Zhang 
279fd41dd0SBarry Smith   /* Parameter adjustments */
289fd41dd0SBarry Smith   --ipvt;
2939d66777SBarry Smith   a -= n + 1;
309fd41dd0SBarry Smith 
319fd41dd0SBarry Smith   /* Function Body */
329fd41dd0SBarry Smith   nm1 = n - 1;
3339d66777SBarry Smith   for (k = 1; k <= nm1; ++k) {
349fd41dd0SBarry Smith     kp1  = k + 1;
3539d66777SBarry Smith     kn   = k*n;
3639d66777SBarry Smith     knp1 = k*n + k;
379fd41dd0SBarry Smith 
389fd41dd0SBarry Smith     /* find l = pivot index */
399fd41dd0SBarry Smith 
409fd41dd0SBarry Smith     i__2 = n - k + 1;
4139d66777SBarry Smith     aa   = &a[knp1];
429fd41dd0SBarry Smith     max  = PetscAbsScalar(aa[0]);
439fd41dd0SBarry Smith     l    = 1;
449fd41dd0SBarry Smith     for (ll=1; ll<i__2; ll++) {
459fd41dd0SBarry Smith       tmp = PetscAbsScalar(aa[ll]);
469fd41dd0SBarry Smith       if (tmp > max) { max = tmp; l = ll+1;}
479fd41dd0SBarry Smith     }
489fd41dd0SBarry Smith     l      += k - 1;
499fd41dd0SBarry Smith     ipvt[k] = l;
509fd41dd0SBarry Smith 
515f8bbccaSHong Zhang     if (a[l + kn] == 0.0) {
525f8bbccaSHong Zhang       if (allowzeropivot) {
535f8bbccaSHong Zhang         PetscErrorCode ierr;
545f8bbccaSHong Zhang         ierr = PetscInfo1(NULL,"Zero pivot, row %D\n",k-1);CHKERRQ(ierr);
55*70d8d27cSBarry Smith         if (zeropivotdetected) *zeropivotdetected = PETSC_TRUE;
565f8bbccaSHong Zhang       } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot, row %D",k-1);
575f8bbccaSHong Zhang     }
589fd41dd0SBarry Smith 
599fd41dd0SBarry Smith     /* interchange if necessary */
609fd41dd0SBarry Smith     if (l != k) {
6139d66777SBarry Smith       t         = a[l + kn];
6239d66777SBarry Smith       a[l + kn] = a[knp1];
6339d66777SBarry Smith       a[knp1]   = t;
649fd41dd0SBarry Smith     }
659fd41dd0SBarry Smith 
669fd41dd0SBarry Smith     /* compute multipliers */
6739d66777SBarry Smith     t    = -1. / a[knp1];
689fd41dd0SBarry Smith     i__2 = n - k;
6939d66777SBarry Smith     aa   = &a[1 + knp1];
7026fbe8dcSKarl Rupp     for (ll=0; ll<i__2; ll++) aa[ll] *= t;
719fd41dd0SBarry Smith 
729fd41dd0SBarry Smith     /* row elimination with column indexing */
7339d66777SBarry Smith     ax = aa;
749fd41dd0SBarry Smith     for (j = kp1; j <= n; ++j) {
758d3e6ddaSBarry Smith       jn1 = j*n;
768d3e6ddaSBarry Smith       t   = a[l + jn1];
779fd41dd0SBarry Smith       if (l != k) {
788d3e6ddaSBarry Smith         a[l + jn1] = a[k + jn1];
798d3e6ddaSBarry Smith         a[k + jn1] = t;
809fd41dd0SBarry Smith       }
819fd41dd0SBarry Smith 
829fd41dd0SBarry Smith       i__3 = n - k;
838d3e6ddaSBarry Smith       ay   = &a[1+k+jn1];
8426fbe8dcSKarl Rupp       for (ll=0; ll<i__3; ll++) ay[ll] += t*ax[ll];
859fd41dd0SBarry Smith     }
869fd41dd0SBarry Smith   }
879fd41dd0SBarry Smith   ipvt[n] = n;
885f8bbccaSHong Zhang   if (a[n + n * n] == 0.0) {
895f8bbccaSHong Zhang     if (allowzeropivot) {
905f8bbccaSHong Zhang       PetscErrorCode ierr;
915f8bbccaSHong Zhang       ierr = PetscInfo1(NULL,"Zero pivot, row %D\n",n-1);CHKERRQ(ierr);
92*70d8d27cSBarry Smith       if (zeropivotdetected) *zeropivotdetected = PETSC_TRUE;
935f8bbccaSHong Zhang     } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot, row %D",n-1);
945f8bbccaSHong Zhang   }
953a40ed3dSBarry Smith   PetscFunctionReturn(0);
969fd41dd0SBarry Smith }
979fd41dd0SBarry Smith 
98