Esempio n. 1
0
/*
   ---------------------------------------
   purpose -- solve (A^T + I) X = B, where 
     (1) A is strictly upper triangular
     (2) X overwrites B
     (B) B has mode SUBMTX_DENSE_COLUMNS

   created -- 98may01, cca
   ---------------------------------------
*/
static void
solveDenseSubcolumns (
   SubMtx   *mtxA,
   SubMtx   *mtxB
) {
double   ai, ar, bi0, bi1, bi2, br0, br1, br2, 
         isum0, isum1, isum2, rsum0, rsum1, rsum2 ;
double   *colB0, *colB1, *colB2, *entriesA, *entriesB ;
int      first, ii, iloc, inc1, inc2, irowA, jcolB, kk, last, 
         ncolB, nentA, nrowA, nrowB, rloc ;
int      *firstlocsA, *sizesA ;
/*
   ----------------------------------------------------
   extract the pointer and dimensions from two matrices
   ----------------------------------------------------
*/
SubMtx_denseSubcolumnsInfo(mtxA, &nrowA, &nentA, 
                         &firstlocsA, &sizesA, &entriesA) ;
SubMtx_denseInfo(mtxB, &nrowB, &ncolB, &inc1, &inc2, &entriesB) ;
#if MYDEBUG > 0
   fprintf(stdout, "\n nentA = %d", nentA) ;
   fflush(stdout) ;
#endif
colB0 = entriesB ;
for ( jcolB = 0 ; jcolB < ncolB - 2 ; jcolB += 3 ) {
   colB1 = colB0 + 2*nrowB ;
   colB2 = colB1 + 2*nrowB ;
#if MYDEBUG > 0
   fprintf(stdout, "\n %% jcolB = %d", jcolB) ;
   fflush(stdout) ;
#endif
   for ( irowA = kk = 0 ; irowA < nrowA ; irowA++ ) {
#if MYDEBUG > 0
      fprintf(stdout, "\n %% irowA %d, size %d", irowA, sizesA[irowA]) ;
      fflush(stdout) ;
#endif
      if ( sizesA[irowA] > 0 ) {
         first = firstlocsA[irowA] ;
         last  = first + sizesA[irowA] - 1 ;
#if MYDEBUG > 0
         fprintf(stdout, ", first %d, last %d", first, last) ;
         fflush(stdout) ;
#endif
         rsum0 = isum0 = 0.0 ;
         rsum1 = isum1 = 0.0 ;
         rsum2 = isum2 = 0.0 ;
         for ( ii = first ; ii <= last ; ii++, kk++ ) {
            ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ;
#if MYDEBUG > 0
            fprintf(stdout, "\n %%   A(%d,%d) = (%12.4e,%12.4e)", 
                    irowA+1, ii+1, ar, ai) ;
            fflush(stdout) ;
#endif
            rloc = 2*ii ; iloc = rloc + 1 ;
            br0 = colB0[rloc] ; bi0 = colB0[iloc] ;
            br1 = colB1[rloc] ; bi1 = colB1[iloc] ;
            br2 = colB2[rloc] ; bi2 = colB2[iloc] ;
            rsum0 += ar*br0 + ai*bi0 ; isum0 += ar*bi0 - ai*br0 ;
            rsum1 += ar*br1 + ai*bi1 ; isum1 += ar*bi1 - ai*br1 ;
            rsum2 += ar*br2 + ai*bi2 ; isum2 += ar*bi2 - ai*br2 ;
         }
         rloc = 2*irowA ; iloc = rloc + 1 ;
         colB0[rloc] -= rsum0 ; colB0[iloc] -= isum0 ;
         colB1[rloc] -= rsum1 ; colB1[iloc] -= isum1 ;
         colB2[rloc] -= rsum2 ; colB2[iloc] -= isum2 ;
      }
   }
#if MYDEBUG > 0
   fprintf(stdout, "\n %% kk = %d", kk) ;
   fflush(stdout) ;
#endif
   colB0 = colB2 + 2*nrowB ;
}
if ( jcolB == ncolB - 2 ) {
   colB1 = colB0 + 2*nrowB ;
   for ( irowA = kk = 0 ; irowA < nrowA ; irowA++ ) {
#if MYDEBUG > 0
      fprintf(stdout, "\n %% irowA %d, size %d", irowA, sizesA[irowA]) ;
      fflush(stdout) ;
#endif
      if ( sizesA[irowA] > 0 ) {
         first = firstlocsA[irowA] ;
         last  = first + sizesA[irowA] - 1 ;
#if MYDEBUG > 0
         fprintf(stdout, ", first %d, last %d", first, last) ;
         fflush(stdout) ;
#endif
         rsum0 = isum0 = 0.0 ;
         rsum1 = isum1 = 0.0 ;
         for ( ii = first ; ii <= last ; ii++, kk++ ) {
            ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ;
#if MYDEBUG > 0
            fprintf(stdout, "\n %%   A(%d,%d) = (%12.4e,%12.4e)", 
                    irowA+1, ii+1, ar, ai) ;
            fflush(stdout) ;
#endif
            rloc = 2*ii ; iloc = rloc + 1 ;
            br0 = colB0[rloc] ; bi0 = colB0[iloc] ;
            br1 = colB1[rloc] ; bi1 = colB1[iloc] ;
            rsum0 += ar*br0 + ai*bi0 ; isum0 += ar*bi0 - ai*br0 ;
            rsum1 += ar*br1 + ai*bi1 ; isum1 += ar*bi1 - ai*br1 ;
         }
         rloc = 2*irowA ; iloc = rloc + 1 ;
         colB0[rloc] -= rsum0 ; colB0[iloc] -= isum0 ;
         colB1[rloc] -= rsum1 ; colB1[iloc] -= isum1 ;
      }
#if MYDEBUG > 0
      fprintf(stdout, "\n %% kk = %d", kk) ;
      fflush(stdout) ;
#endif
   }
} else if ( jcolB == ncolB - 1 ) {
   for ( irowA = kk = 0 ; irowA < nrowA ; irowA++ ) {
#if MYDEBUG > 0
      fprintf(stdout, "\n %% irowA %d, size %d", irowA, sizesA[irowA]) ;
      fflush(stdout) ;
#endif
      if ( sizesA[irowA] > 0 ) {
         first = firstlocsA[irowA] ;
         last  = first + sizesA[irowA] - 1 ;
#if MYDEBUG > 0
         fprintf(stdout, ", first %d, last %d", first, last) ;
         fflush(stdout) ;
#endif
         rsum0 = isum0 = 0.0 ;
         for ( ii = first ; ii <= last ; ii++, kk++ ) {
            ar = entriesA[2*kk] ; ai = entriesA[2*kk+1] ;
#if MYDEBUG > 0
            fprintf(stdout, "\n %%   A(%d,%d) = (%12.4e,%12.4e)", 
                    irowA+1, ii+1, ar, ai) ;
            fflush(stdout) ;
#endif
            rloc = 2*ii ; iloc = rloc + 1 ;
            br0 = colB0[rloc] ; bi0 = colB0[iloc] ;
            rsum0 += ar*br0 + ai*bi0 ; isum0 += ar*bi0 - ai*br0 ;
         }
         rloc = 2*irowA ; iloc = rloc + 1 ;
         colB0[rloc] -= rsum0 ; colB0[iloc] -= isum0 ;
      }
#if MYDEBUG > 0
      fprintf(stdout, "\n %% kk = %d", kk) ;
      fflush(stdout) ;
#endif
   }
}
return ; }
Esempio n. 2
0
/*
   -------------------------------------------------
   purpose -- to return a pointer to the location of
               matrix entry (irow,jcol) if present.

   if entry (irow,jcol) is not present then
      *ppValue is NULL
   else entry (irow,jcol) is present then
      *ppValue is the location of the matrix entry
   endif

   created -- 98may01, cca
   -------------------------------------------------
*/
void
SubMtx_locationOfRealEntry (
   SubMtx   *mtx,
   int      irow,
   int      jcol,
   double   **ppValue
) {
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL || irow < 0 || irow >= mtx->nrow || jcol < 0 
   || jcol >= mtx->ncol || ppValue == NULL ) {
   fprintf(stderr, 
       "\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
           "\n bad input\n", mtx, irow, jcol, ppValue) ;
   exit(-1) ;
}
if ( ! SUBMTX_IS_REAL(mtx) ) {
   fprintf(stderr, 
       "\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
           "\n bad type %d, must be SPOOLES_REAL\n", 
           mtx, irow, jcol, ppValue, mtx->type) ;
   exit(-1) ;
}
*ppValue = NULL ;
switch ( mtx->mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS : {
   double   *entries ;
   int      inc1, inc2, ncol, nrow, offset ;

   SubMtx_denseInfo(mtx, &nrow, &ncol, &inc1, &inc2, &entries) ;
   if ( irow >= 0 && irow < nrow && jcol >= 0 && jcol < ncol ) {
      offset = irow*inc1 + jcol*inc2 ;
      *ppValue = entries + offset ;
   }
   } break ;
case SUBMTX_SPARSE_ROWS : {
   double   *entries ;
   int      ii, jj, nent, nrow, offset, *indices, *sizes ;

   SubMtx_sparseRowsInfo(mtx, &nrow, &nent, &sizes, &indices, &entries);
   if ( irow >= 0 && irow < nrow ) {
      for ( ii = offset = 0 ; ii < irow ; ii++ ) {
         offset += sizes[ii] ;
      }
      for ( ii = 0, jj = offset ; ii < sizes[irow] ; ii++, jj++ ) {
         if ( indices[jj] == jcol ) {
            *ppValue = entries + jj ;
            break ;
         }
      }
   }
   } break ;
case SUBMTX_SPARSE_COLUMNS : {
   double   *entries ;
   int      ii, jj, nent, ncol, offset, *indices, *sizes ;

   SubMtx_sparseColumnsInfo(mtx, &ncol, &nent, 
                          &sizes, &indices, &entries) ;
   if ( jcol >= 0 && jcol < ncol ) {
      for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
         offset += sizes[ii] ;
      }
      for ( ii = 0, jj = offset ; ii < sizes[jcol] ; ii++, jj++ ) {
         if ( indices[jj] == irow ) {
            *ppValue = entries + jj ;
            break ;
         }
      }
   }
   } break ;
case SUBMTX_SPARSE_TRIPLES : {
   double   *entries ;
   int      ii, nent, *colids, *rowids ;

   SubMtx_sparseTriplesInfo(mtx, &nent, &rowids, &colids, &entries) ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( irow == rowids[ii] && jcol == colids[ii] ) {
         *ppValue = entries + ii ;
         break ;
      }
   }
   } break ;
case SUBMTX_DENSE_SUBROWS : {
   double   *entries ;
   int      ii, joff, nent, nrow, offset, *firstlocs, *sizes ;

   SubMtx_denseSubrowsInfo(mtx, &nrow, &nent, 
                         &firstlocs, &sizes, &entries) ;
   if ( irow >= 0 && irow < nrow && sizes[irow] != 0 ) { 
      for ( ii = offset = 0 ; ii < irow ; ii++ ) {
         offset += sizes[ii] ;
      }
      if ( 0 <= (joff = jcol - firstlocs[irow]) 
           && joff < sizes[irow] ) {
         offset += joff ;
         *ppValue = entries + offset ;
         break ;
      }
   }
   } break ;
case SUBMTX_DENSE_SUBCOLUMNS : {
   double   *entries ;
   int      ii, ioff, nent, ncol, offset, *firstlocs, *sizes ;

   SubMtx_denseSubcolumnsInfo(mtx, &ncol, &nent, 
                            &firstlocs, &sizes, &entries) ;
   if ( jcol >= 0 && jcol < ncol && sizes[jcol] != 0 ) { 
      for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
         offset += sizes[jcol] ;
      }
      if (  0 <= (ioff = irow - firstlocs[jcol]) 
         && ioff < sizes[jcol] ) {
         offset += ioff ;
         *ppValue = entries + offset ;
         break ;
      }
   }
   } break ;
case SUBMTX_DIAGONAL : {
   double   *entries ;
   int      ncol ;

   if ( irow >= 0 && jcol >= 0 && irow == jcol ) {
      SubMtx_diagonalInfo(mtx, &ncol, &entries) ;
      if ( irow < ncol && jcol < ncol ) { 
         *ppValue = entries + irow ;
      }
   }
   } break ;
case SUBMTX_BLOCK_DIAGONAL_SYM :
case SUBMTX_BLOCK_DIAGONAL_HERM : {
   double   *entries ;
   int      ii, ipivot, jrow, kk, m, ncol, nent, size ;
   int      *pivotsizes ;

   if ( irow >= 0 && jcol >= 0 ) {
      SubMtx_blockDiagonalInfo(mtx, &ncol, &nent, 
                               &pivotsizes, &entries) ;
      if ( irow < ncol && jcol < ncol ) { 
         for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
            size = m = pivotsizes[ipivot] ;
            for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
               if ( jrow == irow ) {
                  if ( jrow - irow > m - ii ) {
                     kk = -1 ;
                  } else {
                     kk += jrow - irow ;
                  }
               } else {
                  kk += size-- ;
               }
            }
         }
         if ( kk != -1 ) {
            *ppValue = entries + kk ;
         }
      }
   }
   } break ;
default :
   fprintf(stderr, 
       "\n fatal error in SubMtx_locationOfRealEntry(%p,%d,%d,%p)"
       "\n bad mode %d", mtx, irow, jcol, ppValue, mtx->mode) ;
   exit(-1) ;
   break ;
}
return ; }
Esempio n. 3
0
/*
   -------------------------------------------------------
   purpose -- to find matrix entry (irow,jcol) if present.

   return value --
     if entry (irow,jcol) is not present then
        *pReal and *pImag are 0.0
        return value is -1
     else entry (irow,jcol) is present then
        (*pReal,*pImag) is the matrix entry
        return value is offset into entries array 
     endif

   created -- 98may01, cca
   -------------------------------------------------------
*/
int
SubMtx_complexEntry (
   SubMtx   *mtx,
   int      irow,
   int      jcol,
   double   *pReal,
   double   *pImag
) {
/*
   ---------------
   check the input
   ---------------
*/
if (  mtx == NULL || irow < 0 || irow >= mtx->nrow || jcol < 0 
   || jcol >= mtx->ncol || pReal == NULL || pImag == NULL ) {
   fprintf(stderr, 
           "\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
           "\n bad input\n", mtx, irow, jcol, pReal, pImag) ;
   exit(-1) ;
}
if ( ! SUBMTX_IS_COMPLEX(mtx) ) {
   fprintf(stderr, 
           "\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
           "\n bad type %d, must be SPOOLES_COMPLEX\n", 
           mtx, irow, jcol, pReal, pImag, mtx->type) ;
   exit(-1) ;
}
*pReal = *pImag = 0 ;
switch ( mtx->mode ) {
case SUBMTX_DENSE_ROWS :
case SUBMTX_DENSE_COLUMNS : {
   double   *entries ;
   int      inc1, inc2, ncol, nrow, offset ;

   SubMtx_denseInfo(mtx, &nrow, &ncol, &inc1, &inc2, &entries) ;
   if ( irow < 0 || irow >= nrow || jcol < 0 || jcol >= ncol ) {
      return(-1) ;
   }
   offset = irow*inc1 + jcol*inc2 ;
   *pReal = entries[2*offset] ;
   *pImag = entries[2*offset+1] ;
   return(offset) ;
   } break ;
case SUBMTX_SPARSE_ROWS : {
   double   *entries ;
   int      ii, jj, nent, nrow, offset, *indices, *sizes ;

   SubMtx_sparseRowsInfo(mtx, &nrow, &nent, &sizes, &indices, &entries) ;
   if ( irow < 0 || irow >= nrow ) {
      return(-1) ;
   }
   for ( ii = offset = 0 ; ii < irow ; ii++ ) {
      offset += sizes[ii] ;
   }
   for ( ii = 0, jj = offset ; ii < sizes[irow] ; ii++, jj++ ) {
      if ( indices[jj] == jcol ) {
         *pReal = entries[2*jj] ;
         *pImag = entries[2*jj+1] ;
         return(jj) ;
      }
   }
   return(-1) ;
   } break ;
case SUBMTX_SPARSE_COLUMNS : {
   double   *entries ;
   int      ii, jj, nent, ncol, offset, *indices, *sizes ;

   SubMtx_sparseColumnsInfo(mtx, &ncol, &nent, 
                          &sizes, &indices, &entries) ;
   if ( jcol < 0 || jcol >= ncol ) {
      return(-1) ;
   }
   for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
      offset += sizes[ii] ;
   }
   for ( ii = 0, jj = offset ; ii < sizes[jcol] ; ii++, jj++ ) {
      if ( indices[jj] == irow ) {
         *pReal = entries[2*jj] ;
         *pImag = entries[2*jj+1] ;
         return(jj) ;
      }
   }
   return(-1) ;
   } break ;
case SUBMTX_SPARSE_TRIPLES : {
   double   *entries ;
   int      ii, nent, *colids, *rowids ;

   SubMtx_sparseTriplesInfo(mtx, &nent, &rowids, &colids, &entries) ;
   for ( ii = 0 ; ii < nent ; ii++ ) {
      if ( irow == rowids[ii] && jcol == colids[ii] ) {
         *pReal = entries[2*ii] ;
         *pImag = entries[2*ii+1] ;
         return(ii) ;
      }
   }
   return(-1) ;
   } break ;
case SUBMTX_DENSE_SUBROWS : {
   double   *entries ;
   int      ii, joff, nent, nrow, offset, *firstlocs, *sizes ;

   SubMtx_denseSubrowsInfo(mtx, &nrow, &nent, 
                         &firstlocs, &sizes, &entries) ;
   if ( irow < 0 || irow >= nrow || sizes[irow] == 0 ) { 
      return(-1) ;
   }
   for ( ii = offset = 0 ; ii < irow ; ii++ ) {
      offset += sizes[ii] ;
   }
   if ( 0 <= (joff = jcol - firstlocs[irow]) && joff < sizes[irow] ) {
      offset += joff ;
      *pReal = entries[2*offset] ;
      *pImag = entries[2*offset+1] ;
      return(offset) ;
   }
   return(-1) ;       
   } break ;
case SUBMTX_DENSE_SUBCOLUMNS : {
   double   *entries ;
   int      ii, ioff, nent, ncol, offset, *firstlocs, *sizes ;

   SubMtx_denseSubcolumnsInfo(mtx, &ncol, &nent, 
                            &firstlocs, &sizes, &entries) ;
   if ( jcol < 0 || jcol >= ncol || sizes[jcol] == 0 ) { 
      return(-1) ;
   }
   for ( ii = offset = 0 ; ii < jcol ; ii++ ) {
      offset += sizes[ii] ;
   }
   if ( 0 <= (ioff = irow - firstlocs[jcol]) && ioff < sizes[jcol] ) {
      offset += ioff ;
      *pReal = entries[2*offset] ;
      *pImag = entries[2*offset+1] ;
      return(offset) ;
   }
   return(-1) ;       
   } break ;
case SUBMTX_DIAGONAL : {
   double   *entries ;
   int      ncol ;

   if ( irow < 0 || jcol < 0 || irow != jcol ) {
      return(-1) ;
   }
   SubMtx_diagonalInfo(mtx, &ncol, &entries) ;
   if ( irow >= ncol || jcol >= ncol ) { 
      return(-1) ;
   }
   *pReal = entries[2*irow] ;
   *pImag = entries[2*irow+1] ;
   return(irow) ;
   } break ;
case SUBMTX_BLOCK_DIAGONAL_SYM : {
   double   *entries ;
   int      ii, ipivot, jrow, kk, m, ncol, nent, size ;
   int      *pivotsizes ;

   if ( irow < 0 || jcol < 0 ) {
      return(-1) ;
   }
   if ( irow > jcol ) {
      ii   = irow ;
      irow = jcol ;
      jcol = ii   ;
   }
   SubMtx_blockDiagonalInfo(mtx, &ncol, &nent, &pivotsizes, &entries) ;
   if ( irow >= ncol || jcol >= ncol ) { 
      return(-1) ;
   }
   for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
      size = m = pivotsizes[ipivot] ;
      for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
         if ( jrow == irow ) {
            if ( jcol - irow > m - ii - 1 ) {
               return(-1) ;
            } else {
               kk += jcol - irow ;
               *pReal = entries[2*kk] ;
               *pImag = entries[2*kk+1] ;
               return(kk) ;
            }
         } else {
            kk += size-- ;
         }
      }
   }
   return(kk) ;
   } break ;
case SUBMTX_BLOCK_DIAGONAL_HERM : {
   double   sign ;
   double   *entries ;
   int      ii, ipivot, jrow, kk, m, ncol, nent, size ;
   int      *pivotsizes ;

   if ( irow < 0 || jcol < 0 ) {
      return(-1) ;
   }
   if ( irow > jcol ) {
      ii   = irow ;
      irow = jcol ;
      jcol = ii   ;
      sign = -1.0 ;
   } else {
      sign = 1.0 ;
   }
   SubMtx_blockDiagonalInfo(mtx, &ncol, &nent, &pivotsizes, &entries) ;
   if ( irow >= ncol || jcol >= ncol ) { 
      return(-1) ;
   }
   for ( jrow = ipivot = kk = 0 ; jrow <= irow ; ipivot++ ) {
      size = m = pivotsizes[ipivot] ;
      for ( ii = 0 ; ii < m ; ii++, jrow++ ) {
         if ( jrow == irow ) {
            if ( jcol - irow > m - ii - 1 ) {
               return(-1) ;
            } else {
               kk += jcol - irow ;
               *pReal = entries[2*kk] ;
               *pImag = sign*entries[2*kk+1] ;
               return(kk) ;
            }
         } else {
            kk += size-- ;
         }
      }
   }
   return(kk) ;
   } break ;
default :
   fprintf(stderr, 
           "\n fatal error in SubMtx_complexEntry(%p,%d,%d,%p,%p)"
           "\n bad mode %d", mtx, irow, jcol, pReal, pImag, mtx->mode) ;
   exit(-1) ;
   break ;
}
return(-1) ; }
Esempio n. 4
0
/*
   ----------------------------------------------------
   store the factor entries of the reduced front matrix

   created -- 98may25, cca
   ----------------------------------------------------
*/
void
FrontMtx_QR_storeFront (
   FrontMtx   *frontmtx,
   int        J,
   A2         *frontJ,
   int        msglvl,
   FILE       *msgFile
) {
A2       tempA2 ;
double   fac, ifac, imag, real, rfac ;
double   *entDJJ, *entUJJ, *entUJN, *row ;
int      inc1, inc2, irow, jcol, ncol, ncolJ, nD, nentD, nentUJJ, 
         nfront, nrow, nU ;
int      *colind, *colindJ, *firstlocs, *sizes ;
SubMtx   *mtx ;
/*
   ---------------
   check the input
   ---------------
*/
if (  frontmtx == NULL || frontJ == NULL
   || (msglvl > 0 && msgFile == NULL) ) {
   fprintf(stderr, "\n fatal error in FrontMtx_QR_storeFront()"
           "\n bad input\n") ;
   exit(-1) ;
}
nfront = FrontMtx_nfront(frontmtx) ;
FrontMtx_columnIndices(frontmtx, J, &ncolJ, &colindJ) ;
nrow   = A2_nrow(frontJ) ;
ncol   = A2_ncol(frontJ) ;
A2_setDefaultFields(&tempA2) ;
nD = FrontMtx_frontSize(frontmtx, J) ;
nU = ncol - nD ;
/*
   --------------------------------------
   scale the rows and square the diagonal
   --------------------------------------
*/
row = A2_entries(frontJ) ;
if ( A2_IS_REAL(frontJ) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      if ( row[irow] != 0.0 ) {
         fac = 1./row[irow] ;
         for ( jcol = irow + 1 ; jcol < ncol ; jcol++ ) {
            row[jcol] *= fac ;
         }
         row[irow] = row[irow] * row[irow] ;
      }
      row += ncol ;
   }
} else if ( A2_IS_COMPLEX(frontJ) ) {
   for ( irow = 0 ; irow < nD ; irow++ ) {
      real = row[2*irow] ; imag = row[2*irow+1] ;
      if (  real != 0.0 || imag != 0.0 ) {
         Zrecip(real, imag, &rfac, &ifac) ;
         ZVscale(ncol - irow - 1, & row[2*irow+2], rfac, ifac) ;
         row[2*irow]   = real*real + imag*imag ;
         row[2*irow+1] = 0.0 ;
      }
      row += 2*ncol ;
   }
}
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n after scaling rows of A") ;
   A2_writeForHumanEye(frontJ, msgFile) ;
   fflush(msgFile) ;
}
/*
   -------------------------
   copy the diagonal entries
   -------------------------
*/
mtx = FrontMtx_diagMtx(frontmtx, J) ;
SubMtx_diagonalInfo(mtx, &nentD, &entDJJ) ;
A2_subA2(&tempA2, frontJ, 0, nD-1, 0, nD-1) ;
A2_copyEntriesToVector(&tempA2, nentD, entDJJ, 
                       A2_DIAGONAL, A2_BY_ROWS) ;
SubMtx_columnIndices(mtx, &ncol, &colind) ;
IVcopy(nD, colind, colindJ) ;
if ( msglvl > 3 ) {
   fprintf(msgFile, "\n diagonal factor matrix") ;
   SubMtx_writeForHumanEye(mtx, msgFile) ;
   fflush(msgFile) ;
}
if ( (mtx = FrontMtx_upperMtx(frontmtx, J, J)) != NULL ) {
/*
   ------------------------
   copy the U_{J,J} entries
   ------------------------
*/
   SubMtx_denseSubcolumnsInfo(mtx, &nD, &nentUJJ, 
                           &firstlocs, &sizes, &entUJJ) ;
   A2_copyEntriesToVector(&tempA2, nentUJJ, entUJJ, 
                          A2_STRICT_UPPER, A2_BY_COLUMNS) ;
   SubMtx_columnIndices(mtx, &ncol, &colind) ;
   IVcopy(nD, colind, colindJ) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n UJJ factor matrix") ;
      SubMtx_writeForHumanEye(mtx, msgFile) ;
      fflush(msgFile) ;
   }
}
if ( ncolJ > nD ) {
/*
   -----------------------------
   copy the U_{J,bnd{J}} entries
   -----------------------------
*/
   mtx = FrontMtx_upperMtx(frontmtx, J, nfront) ;
   SubMtx_denseInfo(mtx, &nD, &nU, &inc1, &inc2, &entUJN) ;
   A2_subA2(&tempA2, frontJ, 0, nD-1, nD, ncolJ-1) ;
   A2_copyEntriesToVector(&tempA2, nD*nU, entUJN, 
                          A2_ALL_ENTRIES, A2_BY_COLUMNS) ;
   SubMtx_columnIndices(mtx, &ncol, &colind) ;
   IVcopy(nU, colind, colindJ + nD) ;
   if ( msglvl > 3 ) {
      fprintf(msgFile, "\n UJN factor matrix") ;
      SubMtx_writeForHumanEye(mtx, msgFile) ;
      fflush(msgFile) ;
   }
}
return ; }