Jspice3
sputils.c
Go to the documentation of this file.
1 /*
2  * MATRIX UTILITY MODULE
3  *
4  * Author: Advising professor:
5  * Kenneth S. Kundert Alberto Sangiovanni-Vincentelli
6  * UC Berkeley
7  *
8  * This file contains various optional utility routines.
9  *
10  * >>> User accessible functions contained in this file:
11  * spMNA_Preorder
12  * spScale
13  * spMultiply
14  * spConstMultiply
15  * spMultTransposed
16  * spDeterminant
17  * spStrip
18  * spDeleteRowAndCol
19  * spPseudoCondition
20  * spCondition
21  * spNorm
22  * spLargestElement
23  * spRoundoff
24  * spErrorMessage
25  *
26  * >>> Other functions contained in this file:
27  * CountTwins
28  * SwapCols
29  * ScaleComplexMatrix
30  * ComplexMatrixMultiply
31  * ComplexCondition
32  */
33 
34 
35 /*
36  * Revision and copyright information.
37  *
38  * Copyright (c) 1985,86,87,88,89,90
39  * by Kenneth S. Kundert and the University of California.
40  *
41  * Permission to use, copy, modify, and distribute this software and
42  * its documentation for any purpose and without fee is hereby granted,
43  * provided that the copyright notices appear in all copies and
44  * supporting documentation and that the authors and the University of
45  * California are properly credited. The authors and the University of
46  * California make no representations as to the suitability of this
47  * software for any purpose. It is provided `as is', without express
48  * or implied warranty.
49  */
50 
51 #ifdef notdef
52 static char copyright[] =
53  "Sparse1.3: Copyright (c) 1985,86,87,88,89,90 by Kenneth S. Kundert";
54 static char RCSid[] =
55  "@(#)$Header: spUtils.c,v 1.3 88/06/24 05:03:37 kundert Exp $";
56 #endif
57 
58 
59 
60 /*
61  * IMPORTS
62  *
63  * >>> Import descriptions:
64  * spConfig.h
65  * Macros that customize the sparse matrix routines.
66  * spMatrix.h
67  * Macros and declarations to be imported by the user.
68  * spDefs.h
69  * Matrix type and macro definitions for the sparse matrix routines.
70  */
71 
72 #define spINSIDE_SPARSE
73 #include "spconfig.h"
74 #include "spmatrix.h"
75 #include "spdefs.h"
76 
77 
78 
79 
80 
81 /*
82  * Function declarations
83  */
84 
85 #ifdef __STDC__
86 static int CountTwins( MatrixPtr, int, ElementPtr*, ElementPtr* );
87 static void SwapCols( MatrixPtr, ElementPtr, ElementPtr );
89 #if spSEPARATED_COMPLEX_VECTORS
94 #else
97 #endif
99 #else /* __STDC__ */
100 static int CountTwins();
101 static void SwapCols();
102 static void ScaleComplexMatrix();
103 static void ComplexMatrixMultiply();
104 static void ComplexTransposedMatrixMultiply();
106 #endif /* __STDC__ */
107 
108 
109 
110 
111 
112 
113 #if MODIFIED_NODAL
114 /*
115  * PREORDER MODIFIED NODE ADMITTANCE MATRIX TO REMOVE ZEROS FROM DIAGONAL
116  *
117  * This routine massages modified node admittance matrices to remove
118  * zeros from the diagonal. It takes advantage of the fact that the
119  * row and column associated with a zero diagonal usually have
120  * structural ones placed symmetricly. This routine should be used
121  * only on modified node admittance matrices and should be executed
122  * after the matrix has been built but before the factorization
123  * begins. It should be executed for the initial factorization only
124  * and should be executed before the rows have been linked. Thus it
125  * should be run before using spScale(), spMultiply(),
126  * spDeleteRowAndCol(), or spNorm().
127  *
128  * This routine exploits the fact that the structural ones are placed
129  * in the matrix in symmetric twins. For example, the stamps for
130  * grounded and a floating voltage sources are
131  * grounded: floating:
132  * [ x x 1 ] [ x x 1 ]
133  * [ x x ] [ x x -1 ]
134  * [ 1 ] [ 1 -1 ]
135  * Notice for the grounded source, there is one set of twins, and for
136  * the floating, there are two sets. We remove the zero from the diagonal
137  * by swapping the rows associated with a set of twins. For example:
138  * grounded: floating 1: floating 2:
139  * [ 1 ] [ 1 -1 ] [ x x 1 ]
140  * [ x x ] [ x x -1 ] [ 1 -1 ]
141  * [ x x 1 ] [ x x 1 ] [ x x -1 ]
142  *
143  * It is important to deal with any zero diagonals that only have one
144  * set of twins before dealing with those that have more than one because
145  * swapping row destroys the symmetry of any twins in the rows being
146  * swapped, which may limit future moves. Consider
147  * [ x x 1 ]
148  * [ x x -1 1 ]
149  * [ 1 -1 ]
150  * [ 1 ]
151  * There is one set of twins for diagonal 4 and two for diagonal 3.
152  * Dealing with diagonal 4 first requires swapping rows 2 and 4.
153  * [ x x 1 ]
154  * [ 1 ]
155  * [ 1 -1 ]
156  * [ x x -1 1 ]
157  * We can now deal with diagonal 3 by swapping rows 1 and 3.
158  * [ 1 -1 ]
159  * [ 1 ]
160  * [ x x 1 ]
161  * [ x x -1 1 ]
162  * And we are done, there are no zeros left on the diagonal. However, if
163  * we originally dealt with diagonal 3 first, we could swap rows 2 and 3
164  * [ x x 1 ]
165  * [ 1 -1 ]
166  * [ x x -1 1 ]
167  * [ 1 ]
168  * Diagonal 4 no longer has a symmetric twin and we cannot continue.
169  *
170  * So we always take care of lone twins first. When none remain, we
171  * choose arbitrarily a set of twins for a diagonal with more than one set
172  * and swap the rows corresponding to that twin. We then deal with any
173  * lone twins that were created and repeat the procedure until no
174  * zero diagonals with symmetric twins remain.
175  *
176  * In this particular implementation, columns are swapped rather than rows.
177  * The algorithm used in this function was developed by Ken Kundert and
178  * Tom Quarles.
179  *
180  * >>> Arguments:
181  * eMatrix <input> (char *)
182  * Pointer to the matrix to be preordered.
183  *
184  * >>> Local variables;
185  * J (int)
186  * Column with zero diagonal being currently considered.
187  * pTwin1 (ElementPtr)
188  * Pointer to the twin found in the column belonging to the zero diagonal.
189  * pTwin2 (ElementPtr)
190  * Pointer to the twin found in the row belonging to the zero diagonal.
191  * belonging to the zero diagonal.
192  * AnotherPassNeeded (BOOLEAN)
193  * Flag indicating that at least one zero diagonal with symmetric twins
194  * remain.
195  * StartAt (int)
196  * Column number of first zero diagonal with symmetric twins.
197  * Swapped (BOOLEAN)
198  * Flag indicating that columns were swapped on this pass.
199  * Twins (int)
200  * Number of symmetric twins corresponding to current zero diagonal.
201  */
202 
203 void
204 spMNA_Preorder( eMatrix )
205 
206 char *eMatrix;
207 {
208 MatrixPtr Matrix = (MatrixPtr)eMatrix;
209 register int J, Size;
210 ElementPtr pTwin1, pTwin2;
211 int Twins, StartAt = 1;
212 BOOLEAN Swapped, AnotherPassNeeded;
213 
214 /* Begin `spMNA_Preorder'. */
215  ASSERT( IS_VALID(Matrix) AND NOT Matrix->Factored );
216 
217  if (Matrix->RowsLinked) return;
218  Size = Matrix->Size;
219  Matrix->Reordered = YES;
220 
221  do
222  { AnotherPassNeeded = Swapped = NO;
223 
224 /* Search for zero diagonals with lone twins. */
225  for (J = StartAt; J <= Size; J++)
226  { if (Matrix->Diag[J] == NULL)
227  { Twins = CountTwins( Matrix, J, &pTwin1, &pTwin2 );
228  if (Twins == 1)
229  { /* Lone twins found, swap rows. */
230  SwapCols( Matrix, pTwin1, pTwin2 );
231  Swapped = YES;
232  }
233  else if ((Twins > 1) AND NOT AnotherPassNeeded)
234  { AnotherPassNeeded = YES;
235  StartAt = J;
236  }
237  }
238  }
239 
240 /* All lone twins are gone, look for zero diagonals with multiple twins. */
241  if (AnotherPassNeeded)
242  { for (J = StartAt; NOT Swapped AND (J <= Size); J++)
243  { if (Matrix->Diag[J] == NULL)
244  { Twins = CountTwins( Matrix, J, &pTwin1, &pTwin2 );
245  SwapCols( Matrix, pTwin1, pTwin2 );
246  Swapped = YES;
247  }
248  }
249  }
250  } while (AnotherPassNeeded);
251  return;
252 }
253 
254 
255 
256 
257 /*
258  * COUNT TWINS
259  *
260  * This function counts the number of symmetric twins associated with
261  * a zero diagonal and returns one set of twins if any exist. The
262  * count is terminated early at two.
263  */
264 
265 static int
266 CountTwins( Matrix, Col, ppTwin1, ppTwin2 )
267 
268 MatrixPtr Matrix;
269 int Col;
270 ElementPtr *ppTwin1, *ppTwin2;
271 {
272 int Row, Twins = 0;
273 ElementPtr pTwin1, pTwin2;
274 
275 /* Begin `CountTwins'. */
276 
277  pTwin1 = Matrix->FirstInCol[Col];
278  while (pTwin1 != NULL)
279  { if (ABS(pTwin1->Real) == 1.0)
280  { Row = pTwin1->Row;
281  pTwin2 = Matrix->FirstInCol[Row];
282  while ((pTwin2 != NULL) AND (pTwin2->Row != Col))
283  pTwin2 = pTwin2->NextInCol;
284  if ((pTwin2 != NULL) AND (ABS(pTwin2->Real) == 1.0))
285  { /* Found symmetric twins. */
286  if (++Twins >= 2) return Twins;
287  (*ppTwin1 = pTwin1)->Col = Col;
288  (*ppTwin2 = pTwin2)->Col = Row;
289  }
290  }
291  pTwin1 = pTwin1->NextInCol;
292  }
293  return Twins;
294 }
295 
296 
297 
298 
299 /*
300  * SWAP COLUMNS
301  *
302  * This function swaps two columns and is applicable before the rows are
303  * linked.
304  */
305 
306 static void
307 SwapCols( Matrix, pTwin1, pTwin2 )
308 
309 MatrixPtr Matrix;
310 ElementPtr pTwin1, pTwin2;
311 {
312 int Col1 = pTwin1->Col, Col2 = pTwin2->Col;
313 
314 /* Begin `SwapCols'. */
315 
316  SWAP (ElementPtr, Matrix->FirstInCol[Col1], Matrix->FirstInCol[Col2]);
317  SWAP (int, Matrix->IntToExtColMap[Col1], Matrix->IntToExtColMap[Col2]);
318 #if TRANSLATE
319  Matrix->ExtToIntColMap[Matrix->IntToExtColMap[Col2]]=Col2;
320  Matrix->ExtToIntColMap[Matrix->IntToExtColMap[Col1]]=Col1;
321 #endif
322 
323  Matrix->Diag[Col1] = pTwin2;
324  Matrix->Diag[Col2] = pTwin1;
325  Matrix->NumberOfInterchangesIsOdd = NOT Matrix->NumberOfInterchangesIsOdd;
326  return;
327 }
328 #endif /* MODIFIED_NODAL */
329 
330 
331 
332 
333 
334 
335 
336 
337 
338 #if SCALING
339 /*
340  * SCALE MATRIX
341  *
342  * This function scales the matrix to enhance the possibility of
343  * finding a good pivoting order. Note that scaling enhances accuracy
344  * of the solution only if it affects the pivoting order, so it makes
345  * no sense to scale the matrix before spFactor(). If scaling is
346  * desired it should be done before spOrderAndFactor(). There
347  * are several things to take into account when choosing the scale
348  * factors. First, the scale factors are directly multiplied against
349  * the elements in the matrix. To prevent roundoff, each scale factor
350  * should be equal to an integer power of the number base of the
351  * machine. Since most machines operate in base two, scale factors
352  * should be a power of two. Second, the matrix should be scaled such
353  * that the matrix of element uncertainties is equilibrated. Third,
354  * this function multiplies the scale factors by the elements, so if
355  * one row tends to have uncertainties 1000 times smaller than the
356  * other rows, then its scale factor should be 1024, not 1/1024.
357  * Fourth, to save time, this function does not scale rows or columns
358  * if their scale factors are equal to one. Thus, the scale factors
359  * should be normalized to the most common scale factor. Rows and
360  * columns should be normalized separately. For example, if the size
361  * of the matrix is 100 and 10 rows tend to have uncertainties near
362  * 1e-6 and the remaining 90 have uncertainties near 1e-12, then the
363  * scale factor for the 10 should be 1/1,048,576 and the scale factors
364  * for the remaining 90 should be 1. Fifth, since this routine
365  * directly operates on the matrix, it is necessary to apply the scale
366  * factors to the RHS and Solution vectors. It may be easier to
367  * simply use spOrderAndFactor() on a scaled matrix to choose the
368  * pivoting order, and then throw away the matrix. Subsequent
369  * factorizations, performed with spFactor(), will not need to have
370  * the RHS and Solution vectors descaled. Lastly, this function
371  * should not be executed before the function spMNA_Preorder.
372  *
373  * >>> Arguments:
374  * eMatrix <input> (char *)
375  * Pointer to the matrix to be scaled.
376  * SolutionScaleFactors <input> (RealVector)
377  * The array of Solution scale factors. These factors scale the columns.
378  * All scale factors are real valued.
379  * RHS_ScaleFactors <input> (RealVector)
380  * The array of RHS scale factors. These factors scale the rows.
381  * All scale factors are real valued.
382  *
383  * >>> Local variables:
384  * lSize (int)
385  * Local version of the size of the matrix.
386  * pElement (ElementPtr)
387  * Pointer to an element in the matrix.
388  * pExtOrder (int *)
389  * Pointer into either IntToExtRowMap or IntToExtColMap vector. Used to
390  * compensate for any row or column swaps that have been performed.
391  * ScaleFactor (RealNumber)
392  * The scale factor being used on the current row or column.
393  */
394 
395 void
396 spScale( eMatrix, RHS_ScaleFactors, SolutionScaleFactors )
397 
398 char *eMatrix;
399 register RealVector RHS_ScaleFactors, SolutionScaleFactors;
400 {
401 MatrixPtr Matrix = (MatrixPtr)eMatrix;
402 register ElementPtr pElement;
403 register int I, lSize, *pExtOrder;
404 RealNumber ScaleFactor;
405 void ScaleComplexMatrix();
406 
407 /* Begin `spScale'. */
408  ASSERT( IS_VALID(Matrix) AND NOT Matrix->Factored );
409  if (NOT Matrix->RowsLinked) spcLinkRows( Matrix );
410 
411 #if spCOMPLEX
412  if (Matrix->Complex)
413  { ScaleComplexMatrix( Matrix, RHS_ScaleFactors, SolutionScaleFactors );
414  return;
415  }
416 #endif
417 
418 #if REAL
419  lSize = Matrix->Size;
420 
421 /* Correct pointers to arrays for ARRAY_OFFSET */
422 #if NOT ARRAY_OFFSET
423  --RHS_ScaleFactors;
424  --SolutionScaleFactors;
425 #endif
426 
427 /* Scale Rows */
428  pExtOrder = &Matrix->IntToExtRowMap[1];
429  for (I = 1; I <= lSize; I++)
430  { if ((ScaleFactor = RHS_ScaleFactors[*(pExtOrder++)]) != 1.0)
431  { pElement = Matrix->FirstInRow[I];
432 
433  while (pElement != NULL)
434  { pElement->Real *= ScaleFactor;
435  pElement = pElement->NextInRow;
436  }
437  }
438  }
439 
440 /* Scale Columns */
441  pExtOrder = &Matrix->IntToExtColMap[1];
442  for (I = 1; I <= lSize; I++)
443  { if ((ScaleFactor = SolutionScaleFactors[*(pExtOrder++)]) != 1.0)
444  { pElement = Matrix->FirstInCol[I];
445 
446  while (pElement != NULL)
447  { pElement->Real *= ScaleFactor;
448  pElement = pElement->NextInCol;
449  }
450  }
451  }
452  return;
453 
454 #endif /* REAL */
455 }
456 #endif /* SCALING */
457 
458 
459 
460 
461 
462 
463 
464 
465 
466 #if spCOMPLEX AND SCALING
467 /*
468  * SCALE COMPLEX MATRIX
469  *
470  * This function scales the matrix to enhance the possibility of
471  * finding a good pivoting order. Note that scaling enhances accuracy
472  * of the solution only if it affects the pivoting order, so it makes
473  * no sense to scale the matrix before spFactor(). If scaling is
474  * desired it should be done before spOrderAndFactor(). There
475  * are several things to take into account when choosing the scale
476  * factors. First, the scale factors are directly multiplied against
477  * the elements in the matrix. To prevent roundoff, each scale factor
478  * should be equal to an integer power of the number base of the
479  * machine. Since most machines operate in base two, scale factors
480  * should be a power of two. Second, the matrix should be scaled such
481  * that the matrix of element uncertainties is equilibrated. Third,
482  * this function multiplies the scale factors by the elements, so if
483  * one row tends to have uncertainties 1000 times smaller than the
484  * other rows, then its scale factor should be 1024, not 1/1024.
485  * Fourth, to save time, this function does not scale rows or columns
486  * if their scale factors are equal to one. Thus, the scale factors
487  * should be normalized to the most common scale factor. Rows and
488  * columns should be normalized separately. For example, if the size
489  * of the matrix is 100 and 10 rows tend to have uncertainties near
490  * 1e-6 and the remaining 90 have uncertainties near 1e-12, then the
491  * scale factor for the 10 should be 1/1,048,576 and the scale factors
492  * for the remaining 90 should be 1. Fifth, since this routine
493  * directly operates on the matrix, it is necessary to apply the scale
494  * factors to the RHS and Solution vectors. It may be easier to
495  * simply use spOrderAndFactor() on a scaled matrix to choose the
496  * pivoting order, and then throw away the matrix. Subsequent
497  * factorizations, performed with spFactor(), will not need to have
498  * the RHS and Solution vectors descaled. Lastly, this function
499  * should not be executed before the function spMNA_Preorder.
500  *
501  * >>> Arguments:
502  * Matrix <input> (char *)
503  * Pointer to the matrix to be scaled.
504  * SolutionScaleFactors <input> (RealVector)
505  * The array of Solution scale factors. These factors scale the columns.
506  * All scale factors are real valued.
507  * RHS_ScaleFactors <input> (RealVector)
508  * The array of RHS scale factors. These factors scale the rows.
509  * All scale factors are real valued.
510  *
511  * >>> Local variables:
512  * lSize (int)
513  * Local version of the size of the matrix.
514  * pElement (ElementPtr)
515  * Pointer to an element in the matrix.
516  * pExtOrder (int *)
517  * Pointer into either IntToExtRowMap or IntToExtColMap vector. Used to
518  * compensate for any row or column swaps that have been performed.
519  * ScaleFactor (RealNumber)
520  * The scale factor being used on the current row or column.
521  */
522 
523 static void
524 ScaleComplexMatrix( Matrix, RHS_ScaleFactors, SolutionScaleFactors )
525 
526 MatrixPtr Matrix;
527 register RealVector RHS_ScaleFactors, SolutionScaleFactors;
528 {
529 register ElementPtr pElement;
530 register int I, lSize, *pExtOrder;
531 RealNumber ScaleFactor;
532 
533 /* Begin `ScaleComplexMatrix'. */
534  lSize = Matrix->Size;
535 
536 /* Correct pointers to arrays for ARRAY_OFFSET */
537 #if NOT ARRAY_OFFSET
538  --RHS_ScaleFactors;
539  --SolutionScaleFactors;
540 #endif
541 
542 /* Scale Rows */
543  pExtOrder = &Matrix->IntToExtRowMap[1];
544  for (I = 1; I <= lSize; I++)
545  { if ((ScaleFactor = RHS_ScaleFactors[*(pExtOrder++)]) != 1.0)
546  { pElement = Matrix->FirstInRow[I];
547 
548  while (pElement != NULL)
549  { pElement->Real *= ScaleFactor;
550  pElement->Imag *= ScaleFactor;
551  pElement = pElement->NextInRow;
552  }
553  }
554  }
555 
556 /* Scale Columns */
557  pExtOrder = &Matrix->IntToExtColMap[1];
558  for (I = 1; I <= lSize; I++)
559  { if ((ScaleFactor = SolutionScaleFactors[*(pExtOrder++)]) != 1.0)
560  { pElement = Matrix->FirstInCol[I];
561 
562  while (pElement != NULL)
563  { pElement->Real *= ScaleFactor;
564  pElement->Imag *= ScaleFactor;
565  pElement = pElement->NextInCol;
566  }
567  }
568  }
569  return;
570 }
571 #endif /* SCALING AND spCOMPLEX */
572 
573 
574 
575 
576 
577 
578 
579 
580 #if MULTIPLICATION
581 /*
582  * MATRIX MULTIPLICATION
583  *
584  * Multiplies matrix by solution vector to find source vector.
585  * Assumes matrix has not been factored. This routine can be used
586  * as a test to see if solutions are correct. It should not be used
587  * before spMNA_Preorder().
588  *
589  * >>> Arguments:
590  * eMatrix <input> (char *)
591  * Pointer to the matrix.
592  * RHS <output> (RealVector)
593  * RHS is the right hand side. This is what is being solved for.
594  * Solution <input> (RealVector)
595  * Solution is the vector being multiplied by the matrix.
596  * iRHS <output> (RealVector)
597  * iRHS is the imaginary portion of the right hand side. This is
598  * what is being solved for. This is only necessary if the matrix is
599  * complex and spSEPARATED_COMPLEX_VECTORS is true.
600  * iSolution <input> (RealVector)
601  * iSolution is the imaginary portion of the vector being multiplied
602  * by the matrix. This is only necessary if the matrix is
603  * complex and spSEPARATED_COMPLEX_VECTORS is true.
604  *
605  * >>> Obscure Macros
606  * IMAG_VECTORS
607  * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and
608  * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears
609  * without a trace.
610  */
611 
612 void
613 spMultiply( eMatrix, RHS, Solution IMAG_VECTORS )
614 
615 char *eMatrix;
616 RealVector RHS, Solution IMAG_VECTORS;
617 {
618 register ElementPtr pElement;
619 register RealVector Vector;
620 register RealNumber Sum;
621 register int I, *pExtOrder;
622 MatrixPtr Matrix = (MatrixPtr)eMatrix;
623 extern void ComplexMatrixMultiply();
624 
625 /* Begin `spMultiply'. */
626  ASSERT( IS_SPARSE( Matrix ) AND NOT Matrix->Factored );
627  if (NOT Matrix->RowsLinked)
628  spcLinkRows(Matrix);
629  if (NOT Matrix->InternalVectorsAllocated)
630  spcCreateInternalVectors( Matrix );
631 
632 #if spCOMPLEX
633  if (Matrix->Complex)
634  { ComplexMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS );
635  return;
636  }
637 #endif
638 
639 #if REAL
640 #if NOT ARRAY_OFFSET
641 /* Correct array pointers for ARRAY_OFFSET. */
642  --RHS;
643  --Solution;
644 #endif
645 
646 /* Initialize Intermediate vector with reordered Solution vector. */
647  Vector = Matrix->Intermediate;
648  pExtOrder = &Matrix->IntToExtColMap[Matrix->Size];
649  for (I = Matrix->Size; I > 0; I--)
650  Vector[I] = Solution[*(pExtOrder--)];
651 
652  pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size];
653  for (I = Matrix->Size; I > 0; I--)
654  { pElement = Matrix->FirstInRow[I];
655  Sum = 0.0;
656 
657  while (pElement != NULL)
658  { Sum += pElement->Real * Vector[pElement->Col];
659  pElement = pElement->NextInRow;
660  }
661  RHS[*pExtOrder--] = Sum;
662  }
663  return;
664 #endif /* REAL */
665 }
666 
667 
668 /* new for spice3f */
669 void
670 spConstMult(matrixP, constant)
671 
672 char *matrixP;
674 {
675  MatrixPtr matrix = (MatrixPtr)matrixP;
676  ElementPtr e;
677  int i;
678  int size = matrix->Size;
679 
680  for (i = 1; i <= size; i++) {
681  for (e = matrix->FirstInCol[i]; e; e = e->NextInCol) {
682  e->Real *= constant;
683  e->Imag *= constant;
684  }
685  }
686 
687 }
688 #endif /* MULTIPLICATION */
689 
690 
691 
692 
693 
694 
695 
696 #if spCOMPLEX AND MULTIPLICATION
697 /*
698  * COMPLEX MATRIX MULTIPLICATION
699  *
700  * Multiplies matrix by solution vector to find source vector.
701  * Assumes matrix has not been factored. This routine can be used
702  * as a test to see if solutions are correct.
703  *
704  * >>> Arguments:
705  * Matrix <input> (char *)
706  * Pointer to the matrix.
707  * RHS <output> (RealVector)
708  * RHS is the right hand side. This is what is being solved for.
709  * This is only the real portion of the right-hand side if the matrix
710  * is complex and spSEPARATED_COMPLEX_VECTORS is set true.
711  * Solution <input> (RealVector)
712  * Solution is the vector being multiplied by the matrix. This is only
713  * the real portion if the matrix is complex and
714  * spSEPARATED_COMPLEX_VECTORS is set true.
715  * iRHS <output> (RealVector)
716  * iRHS is the imaginary portion of the right hand side. This is
717  * what is being solved for. This is only necessary if the matrix is
718  * complex and spSEPARATED_COMPLEX_VECTORS is true.
719  * iSolution <input> (RealVector)
720  * iSolution is the imaginary portion of the vector being multiplied
721  * by the matrix. This is only necessary if the matrix is
722  * complex and spSEPARATED_COMPLEX_VECTORS is true.
723  *
724  * >>> Obscure Macros
725  * IMAG_VECTORS
726  * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and
727  * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears
728  * without a trace.
729  */
730 
731 static void
732 ComplexMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS )
733 
734 MatrixPtr Matrix;
735 RealVector RHS, Solution IMAG_VECTORS;
736 {
737 register ElementPtr pElement;
738 register ComplexVector Vector;
739 ComplexNumber Sum;
740 register int I, *pExtOrder;
741 
742 /* Begin `ComplexMatrixMultiply'. */
743 
744 /* Correct array pointers for ARRAY_OFFSET. */
745 #if NOT ARRAY_OFFSET
746 #if spSEPARATED_COMPLEX_VECTORS
747  --RHS; --iRHS;
748  --Solution; --iSolution;
749 #else
750  RHS -= 2; Solution -= 2;
751 #endif
752 #endif
753 
754 /* Initialize Intermediate vector with reordered Solution vector. */
755  Vector = (ComplexVector)Matrix->Intermediate;
756  pExtOrder = &Matrix->IntToExtColMap[Matrix->Size];
757 
759  for (I = Matrix->Size; I > 0; I--)
760  { Vector[I].Real = Solution[*pExtOrder];
761  Vector[I].Imag = iSolution[*(pExtOrder--)];
762  }
763 #else
764  for (I = Matrix->Size; I > 0; I--)
765  Vector[I] = ((ComplexVector)Solution)[*(pExtOrder--)];
766 #endif
767 
768  pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size];
769  for (I = Matrix->Size; I > 0; I--)
770  { pElement = Matrix->FirstInRow[I];
771  Sum.Real = Sum.Imag = 0.0;
772 
773  while (pElement != NULL)
774  { /* Cmplx expression : Sum += Element * Vector[Col] */
775  CMPLX_MULT_ADD_ASSIGN( Sum, *pElement, Vector[pElement->Col] );
776  pElement = pElement->NextInRow;
777  }
778 
779 #if spSEPARATED_COMPLEX_VECTORS
780  RHS[*pExtOrder] = Sum.Real;
781  iRHS[*pExtOrder--] = Sum.Imag;
782 #else
783  ((ComplexVector)RHS)[*pExtOrder--] = Sum;
784 #endif
785  }
786  return;
787 }
788 #endif /* spCOMPLEX AND MULTIPLICATION */
789 
790 
791 
792 
793 
794 
795 
796 
797 #if MULTIPLICATION AND TRANSPOSE
798 /*
799  * TRANSPOSED MATRIX MULTIPLICATION
800  *
801  * Multiplies transposed matrix by solution vector to find source vector.
802  * Assumes matrix has not been factored. This routine can be used
803  * as a test to see if solutions are correct. It should not be used
804  * before spMNA_Preorder().
805  *
806  * >>> Arguments:
807  * eMatrix <input> (char *)
808  * Pointer to the matrix.
809  * RHS <output> (RealVector)
810  * RHS is the right hand side. This is what is being solved for.
811  * Solution <input> (RealVector)
812  * Solution is the vector being multiplied by the matrix.
813  * iRHS <output> (RealVector)
814  * iRHS is the imaginary portion of the right hand side. This is
815  * what is being solved for. This is only necessary if the matrix is
816  * complex and spSEPARATED_COMPLEX_VECTORS is true.
817  * iSolution <input> (RealVector)
818  * iSolution is the imaginary portion of the vector being multiplied
819  * by the matrix. This is only necessary if the matrix is
820  * complex and spSEPARATED_COMPLEX_VECTORS is true.
821  *
822  * >>> Obscure Macros
823  * IMAG_VECTORS
824  * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and
825  * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears
826  * without a trace.
827  */
828 
829 void
830 spMultTransposed( eMatrix, RHS, Solution IMAG_VECTORS )
831 
832 char *eMatrix;
833 RealVector RHS, Solution IMAG_VECTORS;
834 {
835 register ElementPtr pElement;
836 register RealVector Vector;
837 register RealNumber Sum;
838 register int I, *pExtOrder;
839 MatrixPtr Matrix = (MatrixPtr)eMatrix;
840 extern void ComplexTransposedMatrixMultiply();
841 
842 /* Begin `spMultTransposed'. */
843  ASSERT( IS_SPARSE( Matrix ) AND NOT Matrix->Factored );
844  if (NOT Matrix->InternalVectorsAllocated)
845  spcCreateInternalVectors( Matrix );
846 
847 #if spCOMPLEX
848  if (Matrix->Complex)
849  { ComplexTransposedMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS );
850  return;
851  }
852 #endif
853 
854 #if REAL
855 #if NOT ARRAY_OFFSET
856 /* Correct array pointers for ARRAY_OFFSET. */
857  --RHS;
858  --Solution;
859 #endif
860 
861 /* Initialize Intermediate vector with reordered Solution vector. */
862  Vector = Matrix->Intermediate;
863  pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size];
864  for (I = Matrix->Size; I > 0; I--)
865  Vector[I] = Solution[*(pExtOrder--)];
866 
867  pExtOrder = &Matrix->IntToExtColMap[Matrix->Size];
868  for (I = Matrix->Size; I > 0; I--)
869  { pElement = Matrix->FirstInCol[I];
870  Sum = 0.0;
871 
872  while (pElement != NULL)
873  { Sum += pElement->Real * Vector[pElement->Row];
874  pElement = pElement->NextInCol;
875  }
876  RHS[*pExtOrder--] = Sum;
877  }
878  return;
879 #endif /* REAL */
880 }
881 #endif /* MULTIPLICATION AND TRANSPOSE */
882 
883 
884 
885 
886 
887 
888 
889 #if spCOMPLEX AND MULTIPLICATION AND TRANSPOSE
890 /*
891  * COMPLEX TRANSPOSED MATRIX MULTIPLICATION
892  *
893  * Multiplies transposed matrix by solution vector to find source vector.
894  * Assumes matrix has not been factored. This routine can be used
895  * as a test to see if solutions are correct.
896  *
897  * >>> Arguments:
898  * Matrix <input> (char *)
899  * Pointer to the matrix.
900  * RHS <output> (RealVector)
901  * RHS is the right hand side. This is what is being solved for.
902  * This is only the real portion of the right-hand side if the matrix
903  * is complex and spSEPARATED_COMPLEX_VECTORS is set true.
904  * Solution <input> (RealVector)
905  * Solution is the vector being multiplied by the matrix. This is only
906  * the real portion if the matrix is complex and
907  * spSEPARATED_COMPLEX_VECTORS is set true.
908  * iRHS <output> (RealVector)
909  * iRHS is the imaginary portion of the right hand side. This is
910  * what is being solved for. This is only necessary if the matrix is
911  * complex and spSEPARATED_COMPLEX_VECTORS is true.
912  * iSolution <input> (RealVector)
913  * iSolution is the imaginary portion of the vector being multiplied
914  * by the matrix. This is only necessary if the matrix is
915  * complex and spSEPARATED_COMPLEX_VECTORS is true.
916  *
917  * >>> Obscure Macros
918  * IMAG_VECTORS
919  * Replaces itself with `, iRHS, iSolution' if the options spCOMPLEX and
920  * spSEPARATED_COMPLEX_VECTORS are set, otherwise it disappears
921  * without a trace.
922  */
923 
924 static void
925 ComplexTransposedMatrixMultiply( Matrix, RHS, Solution IMAG_VECTORS )
926 
927 MatrixPtr Matrix;
928 RealVector RHS, Solution IMAG_VECTORS;
929 {
930 register ElementPtr pElement;
931 register ComplexVector Vector;
932 ComplexNumber Sum;
933 register int I, *pExtOrder;
934 
935 /* Begin `ComplexMatrixMultiply'. */
936 
937 /* Correct array pointers for ARRAY_OFFSET. */
938 #if NOT ARRAY_OFFSET
939 #if spSEPARATED_COMPLEX_VECTORS
940  --RHS; --iRHS;
941  --Solution; --iSolution;
942 #else
943  RHS -= 2; Solution -= 2;
944 #endif
945 #endif
946 
947 /* Initialize Intermediate vector with reordered Solution vector. */
948  Vector = (ComplexVector)Matrix->Intermediate;
949  pExtOrder = &Matrix->IntToExtRowMap[Matrix->Size];
950 
952  for (I = Matrix->Size; I > 0; I--)
953  { Vector[I].Real = Solution[*pExtOrder];
954  Vector[I].Imag = iSolution[*(pExtOrder--)];
955  }
956 #else
957  for (I = Matrix->Size; I > 0; I--)
958  Vector[I] = ((ComplexVector)Solution)[*(pExtOrder--)];
959 #endif
960 
961  pExtOrder = &Matrix->IntToExtColMap[Matrix->Size];
962  for (I = Matrix->Size; I > 0; I--)
963  { pElement = Matrix->FirstInCol[I];
964  Sum.Real = Sum.Imag = 0.0;
965 
966  while (pElement != NULL)
967  { /* Cmplx expression : Sum += Element * Vector[Row] */
968  CMPLX_MULT_ADD_ASSIGN( Sum, *pElement, Vector[pElement->Row] );
969  pElement = pElement->NextInCol;
970  }
971 
972 #if spSEPARATED_COMPLEX_VECTORS
973  RHS[*pExtOrder] = Sum.Real;
974  iRHS[*pExtOrder--] = Sum.Imag;
975 #else
976  ((ComplexVector)RHS)[*pExtOrder--] = Sum;
977 #endif
978  }
979  return;
980 }
981 #endif /* spCOMPLEX AND MULTIPLICATION AND TRANSPOSE */
982 
983 
984 
985 
986 
987 
988 
989 
990 #if DETERMINANT
991 /*
992  * CALCULATE DETERMINANT
993  *
994  * This routine in capable of calculating the determinant of the
995  * matrix once the LU factorization has been performed. Hence, only
996  * use this routine after spFactor() and before spClear().
997  * The determinant equals the product of all the diagonal elements of
998  * the lower triangular matrix L, except that this product may need
999  * negating. Whether the product or the negative product equals the
1000  * determinant is determined by the number of row and column
1001  * interchanges performed. Note that the determinants of matrices can
1002  * be very large or very small. On large matrices, the determinant
1003  * can be far larger or smaller than can be represented by a floating
1004  * point number. For this reason the determinant is scaled to a
1005  * reasonable value and the logarithm of the scale factor is returned.
1006  *
1007  * >>> Arguments:
1008  * eMatrix <input> (char *)
1009  * A pointer to the matrix for which the determinant is desired.
1010  * pExponent <output> (int *)
1011  * The logarithm base 10 of the scale factor for the determinant. To find
1012  * the actual determinant, Exponent should be added to the exponent of
1013  * Determinant.
1014  * pDeterminant <output> (RealNumber *)
1015  * The real portion of the determinant. This number is scaled to be
1016  * greater than or equal to 1.0 and less than 10.0.
1017  * piDeterminant <output> (RealNumber *)
1018  * The imaginary portion of the determinant. When the matrix is real
1019  * this pointer need not be supplied, nothing will be returned. This
1020  * number is scaled to be greater than or equal to 1.0 and less than 10.0.
1021  *
1022  * >>> Local variables:
1023  * Norm (RealNumber)
1024  * L-infinity norm of a complex number.
1025  * Size (int)
1026  * Local storage for Matrix->Size. Placed in a register for speed.
1027  * Temp (RealNumber)
1028  * Temporary storage for real portion of determinant.
1029  */
1030 
1031 #if spCOMPLEX
1032 void
1033 spDeterminant( eMatrix, pExponent, pDeterminant, piDeterminant )
1034 RealNumber *piDeterminant;
1035 #else
1036 void
1037 spDeterminant( eMatrix, pExponent, pDeterminant )
1038 #endif
1039 
1040 char *eMatrix;
1041 register RealNumber *pDeterminant;
1042 int *pExponent;
1043 {
1044 register MatrixPtr Matrix = (MatrixPtr)eMatrix;
1045 register int I, Size;
1046 RealNumber Norm, nr, ni;
1047 ComplexNumber Pivot, cDeterminant;
1048 
1049 #define NORM(a) (nr = ABS((a).Real), ni = ABS((a).Imag), MAX (nr,ni))
1050 
1051 /* Begin `spDeterminant'. */
1052  ASSERT( IS_SPARSE( Matrix ) AND IS_FACTORED(Matrix) );
1053  *pExponent = 0;
1054 
1055  if (Matrix->Error == spSINGULAR)
1056  { *pDeterminant = 0.0;
1057 #if spCOMPLEX
1058  if (Matrix->Complex) *piDeterminant = 0.0;
1059 #endif
1060  return;
1061  }
1062 
1063  Size = Matrix->Size;
1064  I = 0;
1065 
1066 #if spCOMPLEX
1067  if (Matrix->Complex) /* Complex Case. */
1068  { cDeterminant.Real = 1.0;
1069  cDeterminant.Imag = 0.0;
1070 
1071  while (++I <= Size)
1072  { CMPLX_RECIPROCAL( Pivot, *Matrix->Diag[I] );
1073  CMPLX_MULT_ASSIGN( cDeterminant, Pivot );
1074 
1075 /* Scale Determinant. */
1076  Norm = NORM( cDeterminant );
1077  if (Norm != 0.0)
1078  { while (Norm >= 1.0e12)
1079  { cDeterminant.Real *= 1.0e-12;
1080  cDeterminant.Imag *= 1.0e-12;
1081  *pExponent += 12;
1082  Norm = NORM( cDeterminant );
1083  }
1084  while (Norm < 1.0e-12)
1085  { cDeterminant.Real *= 1.0e12;
1086  cDeterminant.Imag *= 1.0e12;
1087  *pExponent -= 12;
1088  Norm = NORM( cDeterminant );
1089  }
1090  }
1091  }
1092 
1093 /* Scale Determinant again, this time to be between 1.0 <= x < 10.0. */
1094  Norm = NORM( cDeterminant );
1095  if (Norm != 0.0)
1096  { while (Norm >= 10.0)
1097  { cDeterminant.Real *= 0.1;
1098  cDeterminant.Imag *= 0.1;
1099  (*pExponent)++;
1100  Norm = NORM( cDeterminant );
1101  }
1102  while (Norm < 1.0)
1103  { cDeterminant.Real *= 10.0;
1104  cDeterminant.Imag *= 10.0;
1105  (*pExponent)--;
1106  Norm = NORM( cDeterminant );
1107  }
1108  }
1109  if (Matrix->NumberOfInterchangesIsOdd)
1110  CMPLX_NEGATE( cDeterminant );
1111 
1112  *pDeterminant = cDeterminant.Real;
1113  *piDeterminant = cDeterminant.Imag;
1114  }
1115 #endif /* spCOMPLEX */
1116 #if REAL AND spCOMPLEX
1117  else
1118 #endif
1119 #if REAL
1120  { /* Real Case. */
1121  *pDeterminant = 1.0;
1122 
1123  while (++I <= Size)
1124  { *pDeterminant /= Matrix->Diag[I]->Real;
1125 
1126 /* Scale Determinant. */
1127  if (*pDeterminant != 0.0)
1128  { while (ABS(*pDeterminant) >= 1.0e12)
1129  { *pDeterminant *= 1.0e-12;
1130  *pExponent += 12;
1131  }
1132  while (ABS(*pDeterminant) < 1.0e-12)
1133  { *pDeterminant *= 1.0e12;
1134  *pExponent -= 12;
1135  }
1136  }
1137  }
1138 
1139 /* Scale Determinant again, this time to be between 1.0 <= x < 10.0. */
1140  if (*pDeterminant != 0.0)
1141  { while (ABS(*pDeterminant) >= 10.0)
1142  { *pDeterminant *= 0.1;
1143  (*pExponent)++;
1144  }
1145  while (ABS(*pDeterminant) < 1.0)
1146  { *pDeterminant *= 10.0;
1147  (*pExponent)--;
1148  }
1149  }
1150  if (Matrix->NumberOfInterchangesIsOdd)
1151  *pDeterminant = -*pDeterminant;
1152  }
1153 #endif /* REAL */
1154 }
1155 #endif /* DETERMINANT */
1156 
1157 
1158 
1159 
1160 
1161 
1162 
1163 
1164 
1165 #if STRIP
1166 /*
1167  * STRIP FILL-INS FROM MATRIX
1168  *
1169  * Strips the matrix of all fill-ins.
1170  *
1171  * >>> Arguments:
1172  * Matrix <input> (char *)
1173  * Pointer to the matrix to be stripped.
1174  *
1175  * >>> Local variables:
1176  * pElement (ElementPtr)
1177  * Pointer that is used to step through the matrix.
1178  * ppElement (ElementPtr *)
1179  * Pointer to the location of an ElementPtr. This location will be
1180  * updated if a fill-in is stripped from the matrix.
1181  * pFillin (ElementPtr)
1182  * Pointer used to step through the lists of fill-ins while marking them.
1183  * pLastFillin (ElementPtr)
1184  * A pointer to the last fill-in in the list. Used to terminate a loop.
1185  * pListNode (struct FillinListNodeStruct *)
1186  * A pointer to a node in the FillinList linked-list.
1187  */
1188 
1189 void
1190 spStripFills( eMatrix )
1191 
1192 char *eMatrix;
1193 {
1194 MatrixPtr Matrix = (MatrixPtr)eMatrix;
1195 struct FillinListNodeStruct *pListNode;
1196 
1197 /* Begin `spStripFills'. */
1198  ASSERT( IS_SPARSE( Matrix ) );
1199  if (Matrix->Fillins == 0) return;
1200  Matrix->NeedsOrdering = YES;
1201  Matrix->Elements -= Matrix->Fillins;
1202  Matrix->Fillins = 0;
1203 
1204 /* Mark the fill-ins. */
1205  { register ElementPtr pFillin, pLastFillin;
1206 
1207  pListNode = Matrix->LastFillinListNode = Matrix->FirstFillinListNode;
1208  Matrix->FillinsRemaining = pListNode->NumberOfFillinsInList;
1209  Matrix->NextAvailFillin = pListNode->pFillinList;
1210 
1211  while (pListNode != NULL)
1212  { pFillin = pListNode->pFillinList;
1213  pLastFillin = &(pFillin[ pListNode->NumberOfFillinsInList - 1 ]);
1214  while (pFillin <= pLastFillin)
1215  (pFillin++)->Row = 0;
1216  pListNode = pListNode->Next;
1217  }
1218  }
1219 
1220 /* Unlink fill-ins by searching for elements marked with Row = 0. */
1221  { register ElementPtr pElement, *ppElement;
1222  register int I, Size = Matrix->Size;
1223 
1224 /* Unlink fill-ins in all columns. */
1225  for (I = 1; I <= Size; I++)
1226  { ppElement = &(Matrix->FirstInCol[I]);
1227  while ((pElement = *ppElement) != NULL)
1228  { if (pElement->Row == 0)
1229  { *ppElement = pElement->NextInCol; /* Unlink fill-in. */
1230  if (Matrix->Diag[pElement->Col] == pElement)
1231  Matrix->Diag[pElement->Col] = NULL;
1232  }
1233  else
1234  ppElement = &pElement->NextInCol; /* Skip element. */
1235  }
1236  }
1237 
1238 /* Unlink fill-ins in all rows. */
1239  for (I = 1; I <= Size; I++)
1240  { ppElement = &(Matrix->FirstInRow[I]);
1241  while ((pElement = *ppElement) != NULL)
1242  { if (pElement->Row == 0)
1243  *ppElement = pElement->NextInRow; /* Unlink fill-in. */
1244  else
1245  ppElement = &pElement->NextInRow; /* Skip element. */
1246  }
1247  }
1248  }
1249  return;
1250 }
1251 #endif
1252 
1253 
1254 
1255 
1256 
1257 
1258 
1259 #if TRANSLATE AND DELETE
1260 /*
1261  * DELETE A ROW AND COLUMN FROM THE MATRIX
1262  *
1263  * Deletes a row and a column from a matrix.
1264  *
1265  * Sparse will abort if an attempt is made to delete a row or column that
1266  * doesn't exist.
1267  *
1268  * >>> Arguments:
1269  * eMatrix <input> (char *)
1270  * Pointer to the matrix in which the row and column are to be deleted.
1271  * Row <input> (int)
1272  * Row to be deleted.
1273  * Col <input> (int)
1274  * Column to be deleted.
1275  *
1276  * >>> Local variables:
1277  * ExtCol (int)
1278  * The external column that is being deleted.
1279  * ExtRow (int)
1280  * The external row that is being deleted.
1281  * pElement (ElementPtr)
1282  * Pointer to an element in the matrix. Used when scanning rows and
1283  * columns in order to eliminate elements from the last row or column.
1284  * ppElement (ElementPtr *)
1285  * Pointer to the location of an ElementPtr. This location will be
1286  * filled with a NULL pointer if it is the new last element in its row
1287  * or column.
1288  * pElement (ElementPtr)
1289  * Pointer to an element in the last row or column of the matrix.
1290  * Size (int)
1291  * The local version Matrix->Size, the size of the matrix.
1292  */
1293 
1294 void
1295 spDeleteRowAndCol( eMatrix, Row, Col )
1296 
1297 char *eMatrix;
1298 int Row, Col;
1299 {
1300 MatrixPtr Matrix = (MatrixPtr)eMatrix;
1301 register ElementPtr pElement, *ppElement, pLastElement;
1302 int Size, ExtRow, ExtCol;
1304 
1305 /* Begin `spDeleteRowAndCol'. */
1306 
1307  ASSERT( IS_SPARSE(Matrix) AND Row > 0 AND Col > 0 );
1308  ASSERT( Row <= Matrix->ExtSize AND Col <= Matrix->ExtSize );
1309 
1310  Size = Matrix->Size;
1311  ExtRow = Row;
1312  ExtCol = Col;
1313  if (NOT Matrix->RowsLinked) spcLinkRows( Matrix );
1314 
1315  Row = Matrix->ExtToIntRowMap[Row];
1316  Col = Matrix->ExtToIntColMap[Col];
1317  ASSERT( Row > 0 AND Col > 0 );
1318 
1319 /* Move Row so that it is the last row in the matrix. */
1320  if (Row != Size) spcRowExchange( Matrix, Row, Size );
1321 
1322 /* Move Col so that it is the last column in the matrix. */
1323  if (Col != Size) spcColExchange( Matrix, Col, Size );
1324 
1325 /* Correct Diag pointers. */
1326  if (Row == Col)
1327  SWAP( ElementPtr, Matrix->Diag[Row], Matrix->Diag[Size] )
1328  else
1329  { Matrix->Diag[Row] = spcFindElementInCol( Matrix, Matrix->FirstInCol+Row,
1330  Row, Row, NO );
1331  Matrix->Diag[Col] = spcFindElementInCol( Matrix, Matrix->FirstInCol+Col,
1332  Col, Col, NO );
1333  }
1334 
1335 /*
1336  * Delete last row and column of the matrix.
1337  */
1338 /* Break the column links to every element in the last row. */
1339  pLastElement = Matrix->FirstInRow[ Size ];
1340  while (pLastElement != NULL)
1341  { ppElement = &(Matrix->FirstInCol[ pLastElement->Col ]);
1342  while ((pElement = *ppElement) != NULL)
1343  { if (pElement == pLastElement)
1344  *ppElement = NULL; /* Unlink last element in column. */
1345  else
1346  ppElement = &pElement->NextInCol; /* Skip element. */
1347  }
1348  pLastElement = pLastElement->NextInRow;
1349  }
1350 
1351 /* Break the row links to every element in the last column. */
1352  pLastElement = Matrix->FirstInCol[ Size ];
1353  while (pLastElement != NULL)
1354  { ppElement = &(Matrix->FirstInRow[ pLastElement->Row ]);
1355  while ((pElement = *ppElement) != NULL)
1356  { if (pElement == pLastElement)
1357  *ppElement = NULL; /* Unlink last element in row. */
1358  else
1359  ppElement = &pElement->NextInRow; /* Skip element. */
1360  }
1361  pLastElement = pLastElement->NextInCol;
1362  }
1363 
1364 /* Clean up some details. */
1365  Matrix->Size = Size - 1;
1366  Matrix->Diag[Size] = NULL;
1367  Matrix->FirstInRow[Size] = NULL;
1368  Matrix->FirstInCol[Size] = NULL;
1369  Matrix->CurrentSize--;
1370  Matrix->ExtToIntRowMap[ExtRow] = -1;
1371  Matrix->ExtToIntColMap[ExtCol] = -1;
1372  Matrix->NeedsOrdering = YES;
1373 
1374  return;
1375 }
1376 #endif
1377 
1378 
1379 
1380 
1381 
1382 
1383 
1384 
1385 #if PSEUDOCONDITION
1386 /*
1387  * CALCULATE PSEUDOCONDITION
1388  *
1389  * Computes the magnitude of the ratio of the largest to the smallest
1390  * pivots. This quantity is an indicator of ill-conditioning in the
1391  * matrix. If this ratio is large, and if the matrix is scaled such
1392  * that uncertainties in the RHS and the matrix entries are
1393  * equilibrated, then the matrix is ill-conditioned. However, a small
1394  * ratio does not necessarily imply that the matrix is
1395  * well-conditioned. This routine must only be used after a matrix has
1396  * been factored by spOrderAndFactor() or spFactor() and before it is
1397  * cleared by spClear() or spInitialize(). The pseudocondition is
1398  * faster to compute than the condition number calculated by
1399  * spCondition(), but is not as informative.
1400  *
1401  * >>> Returns:
1402  * The magnitude of the ratio of the largest to smallest pivot used during
1403  * previous factorization. If the matrix was singular, zero is returned.
1404  *
1405  * >>> Arguments:
1406  * eMatrix <input> (char *)
1407  * Pointer to the matrix.
1408  */
1409 
1410 RealNumber
1411 spPseudoCondition( eMatrix )
1412 
1413 char *eMatrix;
1414 {
1415 MatrixPtr Matrix = (MatrixPtr)eMatrix;
1416 register int I;
1417 register ArrayOfElementPtrs Diag;
1418 RealNumber MaxPivot, MinPivot, Mag;
1419 
1420 /* Begin `spPseudoCondition'. */
1421 
1422  ASSERT( IS_SPARSE(Matrix) AND IS_FACTORED(Matrix) );
1423  if (Matrix->Error == spSINGULAR OR Matrix->Error == spZERO_DIAG)
1424  return 0.0;
1425 
1426  Diag = Matrix->Diag;
1427  MaxPivot = MinPivot = ELEMENT_MAG( Diag[1] );
1428  for (I = 2; I <= Matrix->Size; I++)
1429  { Mag = ELEMENT_MAG( Diag[I] );
1430  if (Mag > MaxPivot)
1431  MaxPivot = Mag;
1432  else if (Mag < MinPivot)
1433  MinPivot = Mag;
1434  }
1435  ASSERT( MaxPivot > 0.0);
1436  return MaxPivot / MinPivot;
1437 }
1438 #endif
1439 
1440 
1441 
1442 
1443 
1444 
1445 
1446 
1447 #if CONDITION
1448 /*
1449  * ESTIMATE CONDITION NUMBER
1450  *
1451  * Computes an estimate of the condition number using a variation on
1452  * the LINPACK condition number estimation algorithm. This quantity is
1453  * an indicator of ill-conditioning in the matrix. To avoid problems
1454  * with overflow, the reciprocal of the condition number is returned.
1455  * If this number is small, and if the matrix is scaled such that
1456  * uncertainties in the RHS and the matrix entries are equilibrated,
1457  * then the matrix is ill-conditioned. If the this number is near
1458  * one, the matrix is well conditioned. This routine must only be
1459  * used after a matrix has been factored by spOrderAndFactor() or
1460  * spFactor() and before it is cleared by spClear() or spInitialize().
1461  *
1462  * Unlike the LINPACK condition number estimator, this routines
1463  * returns the L infinity condition number. This is an artifact of
1464  * Sparse placing ones on the diagonal of the upper triangular matrix
1465  * rather than the lower. This difference should be of no importance.
1466  *
1467  * References:
1468  * A.K. Cline, C.B. Moler, G.W. Stewart, J.H. Wilkinson. An estimate
1469  * for the condition number of a matrix. SIAM Journal on Numerical
1470  * Analysis. Vol. 16, No. 2, pages 368-375, April 1979.
1471  *
1472  * J.J. Dongarra, C.B. Moler, J.R. Bunch, G.W. Stewart. LINPACK
1473  * User's Guide. SIAM, 1979.
1474  *
1475  * Roger G. Grimes, John G. Lewis. Condition number estimation for
1476  * sparse matrices. SIAM Journal on Scientific and Statistical
1477  * Computing. Vol. 2, No. 4, pages 384-388, December 1981.
1478  *
1479  * Dianne Prost O'Leary. Estimating matrix condition numbers. SIAM
1480  * Journal on Scientific and Statistical Computing. Vol. 1, No. 2,
1481  * pages 205-209, June 1980.
1482  *
1483  * >>> Returns:
1484  * The reciprocal of the condition number. If the matrix was singular,
1485  * zero is returned.
1486  *
1487  * >>> Arguments:
1488  * eMatrix <input> (char *)
1489  * Pointer to the matrix.
1490  * NormOfMatrix <input> (RealNumber)
1491  * The L-infinity norm of the unfactored matrix as computed by
1492  * spNorm().
1493  * pError <output> (int *)
1494  * Used to return error code.
1495  *
1496  * >>> Possible errors:
1497  * spSINGULAR
1498  * spNO_MEMORY
1499  */
1500 
1501 RealNumber
1502 spCondition( eMatrix, NormOfMatrix, pError )
1503 
1504 char *eMatrix;
1505 RealNumber NormOfMatrix;
1506 int *pError;
1507 {
1508 MatrixPtr Matrix = (MatrixPtr)eMatrix;
1509 register ElementPtr pElement;
1510 register RealVector T, Tm;
1511 register int I, K, Row;
1513 int Size;
1514 RealNumber E, Em, Wp, Wm, ASp, ASm, ASw, ASy, ASv, ASz, MaxY, ScaleFactor;
1515 RealNumber Linpack, OLeary, InvNormOfInverse, ComplexCondition();
1516 #define SLACK 1e4
1517 
1518 /* Begin `spCondition'. */
1519 
1520  ASSERT( IS_SPARSE(Matrix) AND IS_FACTORED(Matrix) );
1521  *pError = Matrix->Error;
1522  if (Matrix->Error >= spFATAL) return 0.0;
1523  if (NormOfMatrix == 0.0)
1524  { *pError = spSINGULAR;
1525  return 0.0;
1526  }
1527 
1528 #if spCOMPLEX
1529  if (Matrix->Complex)
1530  return ComplexCondition( Matrix, NormOfMatrix, pError );
1531 #endif
1532 
1533 #if REAL
1534  Size = Matrix->Size;
1535  T = Matrix->Intermediate;
1536 #if spCOMPLEX
1537  Tm = Matrix->Intermediate + Size;
1538 #else
1539  Tm = ALLOC( RealNumber, Size+1 );
1540  if (Tm == NULL)
1541  { *pError = spNO_MEMORY;
1542  return 0.0;
1543  }
1544 #endif
1545  for (I = Size; I > 0; I--) T[I] = 0.0;
1546 
1547 /*
1548  * Part 1. Ay = e.
1549  * Solve Ay = LUy = e where e consists of +1 and -1 terms with the sign
1550  * chosen to maximize the size of w in Lw = e. Since the terms in w can
1551  * get very large, scaling is used to avoid overflow.
1552  */
1553 
1554 /* Forward elimination. Solves Lw = e while choosing e. */
1555  E = 1.0;
1556  for (I = 1; I <= Size; I++)
1557  { pPivot = Matrix->Diag[I];
1558  if (T[I] < 0.0) Em = -E; else Em = E;
1559  Wm = (Em + T[I]) * pPivot->Real;
1560  if (ABS(Wm) > SLACK)
1561  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(Wm) );
1562  for (K = Size; K > 0; K--) T[K] *= ScaleFactor;
1563  E *= ScaleFactor;
1564  Em *= ScaleFactor;
1565  Wm = (Em + T[I]) * pPivot->Real;
1566  }
1567  Wp = (T[I] - Em) * pPivot->Real;
1568  ASp = ABS(T[I] - Em);
1569  ASm = ABS(Em + T[I]);
1570 
1571 /* Update T for both values of W, minus value is placed in Tm. */
1572  pElement = pPivot->NextInCol;
1573  while (pElement != NULL)
1574  { Row = pElement->Row;
1575  Tm[Row] = T[Row] - (Wm * pElement->Real);
1576  T[Row] -= (Wp * pElement->Real);
1577  ASp += ABS(T[Row]);
1578  ASm += ABS(Tm[Row]);
1579  pElement = pElement->NextInCol;
1580  }
1581 
1582 /* If minus value causes more growth, overwrite T with its values. */
1583  if (ASm > ASp)
1584  { T[I] = Wm;
1585  pElement = pPivot->NextInCol;
1586  while (pElement != NULL)
1587  { T[pElement->Row] = Tm[pElement->Row];
1588  pElement = pElement->NextInCol;
1589  }
1590  }
1591  else T[I] = Wp;
1592  }
1593 
1594 /* Compute 1-norm of T, which now contains w, and scale ||T|| to 1/SLACK. */
1595  for (ASw = 0.0, I = Size; I > 0; I--) ASw += ABS(T[I]);
1596  ScaleFactor = 1.0 / (SLACK * ASw);
1597  if (ScaleFactor < 0.5)
1598  { for (I = Size; I > 0; I--) T[I] *= ScaleFactor;
1599  E *= ScaleFactor;
1600  }
1601 
1602 /* Backward Substitution. Solves Uy = w.*/
1603  for (I = Size; I >= 1; I--)
1604  { pElement = Matrix->Diag[I]->NextInRow;
1605  while (pElement != NULL)
1606  { T[I] -= pElement->Real * T[pElement->Col];
1607  pElement = pElement->NextInRow;
1608  }
1609  if (ABS(T[I]) > SLACK)
1610  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) );
1611  for (K = Size; K > 0; K--) T[K] *= ScaleFactor;
1612  E *= ScaleFactor;
1613  }
1614  }
1615 
1616 /* Compute 1-norm of T, which now contains y, and scale ||T|| to 1/SLACK. */
1617  for (ASy = 0.0, I = Size; I > 0; I--) ASy += ABS(T[I]);
1618  ScaleFactor = 1.0 / (SLACK * ASy);
1619  if (ScaleFactor < 0.5)
1620  { for (I = Size; I > 0; I--) T[I] *= ScaleFactor;
1621  ASy = 1.0 / SLACK;
1622  E *= ScaleFactor;
1623  }
1624 
1625 /* Compute infinity-norm of T for O'Leary's estimate. */
1626  for (MaxY = 0.0, I = Size; I > 0; I--)
1627  if (MaxY < ABS(T[I])) MaxY = ABS(T[I]);
1628 
1629 /*
1630  * Part 2. A* z = y where the * represents the transpose.
1631  * Recall that A = LU implies A* = U* L*.
1632  */
1633 
1634 /* Forward elimination, U* v = y. */
1635  for (I = 1; I <= Size; I++)
1636  { pElement = Matrix->Diag[I]->NextInRow;
1637  while (pElement != NULL)
1638  { T[pElement->Col] -= T[I] * pElement->Real;
1639  pElement = pElement->NextInRow;
1640  }
1641  if (ABS(T[I]) > SLACK)
1642  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) );
1643  for (K = Size; K > 0; K--) T[K] *= ScaleFactor;
1644  ASy *= ScaleFactor;
1645  }
1646  }
1647 
1648 /* Compute 1-norm of T, which now contains v, and scale ||T|| to 1/SLACK. */
1649  for (ASv = 0.0, I = Size; I > 0; I--) ASv += ABS(T[I]);
1650  ScaleFactor = 1.0 / (SLACK * ASv);
1651  if (ScaleFactor < 0.5)
1652  { for (I = Size; I > 0; I--) T[I] *= ScaleFactor;
1653  ASy *= ScaleFactor;
1654  }
1655 
1656 /* Backward Substitution, L* z = v. */
1657  for (I = Size; I >= 1; I--)
1658  { pPivot = Matrix->Diag[I];
1659  pElement = pPivot->NextInCol;
1660  while (pElement != NULL)
1661  { T[I] -= pElement->Real * T[pElement->Row];
1662  pElement = pElement->NextInCol;
1663  }
1664  T[I] *= pPivot->Real;
1665  if (ABS(T[I]) > SLACK)
1666  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), ABS(T[I]) );
1667  for (K = Size; K > 0; K--) T[K] *= ScaleFactor;
1668  ASy *= ScaleFactor;
1669  }
1670  }
1671 
1672 /* Compute 1-norm of T, which now contains z. */
1673  for (ASz = 0.0, I = Size; I > 0; I--) ASz += ABS(T[I]);
1674 
1675 #if NOT spCOMPLEX
1676  FREE( Tm );
1677 #endif
1678 
1679  Linpack = ASy / ASz;
1680  OLeary = E / MaxY;
1681  InvNormOfInverse = MIN( Linpack, OLeary );
1682  return InvNormOfInverse / NormOfMatrix;
1683 #endif /* REAL */
1684 }
1685 
1686 
1687 
1688 
1689 
1690 #if spCOMPLEX
1691 /*
1692  * ESTIMATE CONDITION NUMBER
1693  *
1694  * Complex version of spCondition().
1695  *
1696  * >>> Returns:
1697  * The reciprocal of the condition number.
1698  *
1699  * >>> Arguments:
1700  * Matrix <input> (MatrixPtr)
1701  * Pointer to the matrix.
1702  * NormOfMatrix <input> (RealNumber)
1703  * The L-infinity norm of the unfactored matrix as computed by
1704  * spNorm().
1705  * pError <output> (int *)
1706  * Used to return error code.
1707  *
1708  * >>> Possible errors:
1709  * spNO_MEMORY
1710  */
1711 
1712 static RealNumber
1713 ComplexCondition( Matrix, NormOfMatrix, pError )
1714 
1715 MatrixPtr Matrix;
1716 RealNumber NormOfMatrix;
1717 int *pError;
1718 {
1719 register ElementPtr pElement;
1720 register ComplexVector T, Tm;
1721 register int I, K, Row;
1723 int Size;
1724 RealNumber E, Em, ASp, ASm, ASw, ASy, ASv, ASz, MaxY, ScaleFactor;
1725 RealNumber Linpack, OLeary, InvNormOfInverse;
1726 ComplexNumber Wp, Wm;
1727 
1728 /* Begin `ComplexCondition'. */
1729 
1730  Size = Matrix->Size;
1731  T = (ComplexVector)Matrix->Intermediate;
1732  Tm = ALLOC( ComplexNumber, Size+1 );
1733  if (Tm == NULL)
1734  { *pError = spNO_MEMORY;
1735  return 0.0;
1736  }
1737  for (I = Size; I > 0; I--) T[I].Real = T[I].Imag = 0.0;
1738 
1739 /*
1740  * Part 1. Ay = e.
1741  * Solve Ay = LUy = e where e consists of +1 and -1 terms with the sign
1742  * chosen to maximize the size of w in Lw = e. Since the terms in w can
1743  * get very large, scaling is used to avoid overflow.
1744  */
1745 
1746 /* Forward elimination. Solves Lw = e while choosing e. */
1747  E = 1.0;
1748  for (I = 1; I <= Size; I++)
1749  { pPivot = Matrix->Diag[I];
1750  if (T[I].Real < 0.0) Em = -E; else Em = E;
1751  Wm = T[I];
1752  Wm.Real += Em;
1753  ASm = CMPLX_1_NORM( Wm );
1754  CMPLX_MULT_ASSIGN( Wm, *pPivot );
1755  if (CMPLX_1_NORM(Wm) > SLACK)
1756  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(Wm) );
1757  for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor );
1758  E *= ScaleFactor;
1759  Em *= ScaleFactor;
1760  ASm *= ScaleFactor;
1761  SCLR_MULT_ASSIGN( Wm, ScaleFactor );
1762  }
1763  Wp = T[I];
1764  Wp.Real -= Em;
1765  ASp = CMPLX_1_NORM( Wp );
1766  CMPLX_MULT_ASSIGN( Wp, *pPivot );
1767 
1768 /* Update T for both values of W, minus value is placed in Tm. */
1769  pElement = pPivot->NextInCol;
1770  while (pElement != NULL)
1771  { Row = pElement->Row;
1772  /* Cmplx expr: Tm[Row] = T[Row] - (Wp * *pElement). */
1773  CMPLX_MULT_SUBT( Tm[Row], Wm, *pElement, T[Row] );
1774  /* Cmplx expr: T[Row] -= Wp * *pElement. */
1775  CMPLX_MULT_SUBT_ASSIGN( T[Row], Wm, *pElement );
1776  ASp += CMPLX_1_NORM(T[Row]);
1777  ASm += CMPLX_1_NORM(Tm[Row]);
1778  pElement = pElement->NextInCol;
1779  }
1780 
1781 /* If minus value causes more growth, overwrite T with its values. */
1782  if (ASm > ASp)
1783  { T[I] = Wm;
1784  pElement = pPivot->NextInCol;
1785  while (pElement != NULL)
1786  { T[pElement->Row] = Tm[pElement->Row];
1787  pElement = pElement->NextInCol;
1788  }
1789  }
1790  else T[I] = Wp;
1791  }
1792 
1793 /* Compute 1-norm of T, which now contains w, and scale ||T|| to 1/SLACK. */
1794  for (ASw = 0.0, I = Size; I > 0; I--) ASw += CMPLX_1_NORM(T[I]);
1795  ScaleFactor = 1.0 / (SLACK * ASw);
1796  if (ScaleFactor < 0.5)
1797  { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor );
1798  E *= ScaleFactor;
1799  }
1800 
1801 /* Backward Substitution. Solves Uy = w.*/
1802  for (I = Size; I >= 1; I--)
1803  { pElement = Matrix->Diag[I]->NextInRow;
1804  while (pElement != NULL)
1805  { /* Cmplx expr: T[I] -= T[pElement->Col] * *pElement. */
1806  CMPLX_MULT_SUBT_ASSIGN( T[I], T[pElement->Col], *pElement );
1807  pElement = pElement->NextInRow;
1808  }
1809  if (CMPLX_1_NORM(T[I]) > SLACK)
1810  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) );
1811  for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor );
1812  E *= ScaleFactor;
1813  }
1814  }
1815 
1816 /* Compute 1-norm of T, which now contains y, and scale ||T|| to 1/SLACK. */
1817  for (ASy = 0.0, I = Size; I > 0; I--) ASy += CMPLX_1_NORM(T[I]);
1818  ScaleFactor = 1.0 / (SLACK * ASy);
1819  if (ScaleFactor < 0.5)
1820  { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor );
1821  ASy = 1.0 / SLACK;
1822  E *= ScaleFactor;
1823  }
1824 
1825 /* Compute infinity-norm of T for O'Leary's estimate. */
1826  for (MaxY = 0.0, I = Size; I > 0; I--)
1827  if (MaxY < CMPLX_1_NORM(T[I])) MaxY = CMPLX_1_NORM(T[I]);
1828 
1829 /*
1830  * Part 2. A* z = y where the * represents the transpose.
1831  * Recall that A = LU implies A* = U* L*.
1832  */
1833 
1834 /* Forward elimination, U* v = y. */
1835  for (I = 1; I <= Size; I++)
1836  { pElement = Matrix->Diag[I]->NextInRow;
1837  while (pElement != NULL)
1838  { /* Cmplx expr: T[pElement->Col] -= T[I] * *pElement. */
1839  CMPLX_MULT_SUBT_ASSIGN( T[pElement->Col], T[I], *pElement );
1840  pElement = pElement->NextInRow;
1841  }
1842  if (CMPLX_1_NORM(T[I]) > SLACK)
1843  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) );
1844  for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor );
1845  ASy *= ScaleFactor;
1846  }
1847  }
1848 
1849 /* Compute 1-norm of T, which now contains v, and scale ||T|| to 1/SLACK. */
1850  for (ASv = 0.0, I = Size; I > 0; I--) ASv += CMPLX_1_NORM(T[I]);
1851  ScaleFactor = 1.0 / (SLACK * ASv);
1852  if (ScaleFactor < 0.5)
1853  { for (I = Size; I > 0; I--) SCLR_MULT_ASSIGN( T[I], ScaleFactor );
1854  ASy *= ScaleFactor;
1855  }
1856 
1857 /* Backward Substitution, L* z = v. */
1858  for (I = Size; I >= 1; I--)
1859  { pPivot = Matrix->Diag[I];
1860  pElement = pPivot->NextInCol;
1861  while (pElement != NULL)
1862  { /* Cmplx expr: T[I] -= T[pElement->Row] * *pElement. */
1863  CMPLX_MULT_SUBT_ASSIGN( T[I], T[pElement->Row], *pElement );
1864  pElement = pElement->NextInCol;
1865  }
1866  CMPLX_MULT_ASSIGN( T[I], *pPivot );
1867  if (CMPLX_1_NORM(T[I]) > SLACK)
1868  { ScaleFactor = 1.0 / MAX( SQR( SLACK ), CMPLX_1_NORM(T[I]) );
1869  for (K = Size; K > 0; K--) SCLR_MULT_ASSIGN( T[K], ScaleFactor );
1870  ASy *= ScaleFactor;
1871  }
1872  }
1873 
1874 /* Compute 1-norm of T, which now contains z. */
1875  for (ASz = 0.0, I = Size; I > 0; I--) ASz += CMPLX_1_NORM(T[I]);
1876 
1877  FREE( Tm );
1878 
1879  Linpack = ASy / ASz;
1880  OLeary = E / MaxY;
1881  InvNormOfInverse = MIN( Linpack, OLeary );
1882  return InvNormOfInverse / NormOfMatrix;
1883 }
1884 #endif /* spCOMPLEX */
1885 
1886 
1887 
1888 
1889 
1890 /*
1891  * L-INFINITY MATRIX NORM
1892  *
1893  * Computes the L-infinity norm of an unfactored matrix. It is a fatal
1894  * error to pass this routine a factored matrix.
1895  *
1896  * One difficulty is that the rows may not be linked.
1897  *
1898  * >>> Returns:
1899  * The largest absolute row sum of matrix.
1900  *
1901  * >>> Arguments:
1902  * eMatrix <input> (char *)
1903  * Pointer to the matrix.
1904  */
1905 
1906 RealNumber
1907 spNorm( eMatrix )
1908 
1909 char *eMatrix;
1910 {
1911 MatrixPtr Matrix = (MatrixPtr)eMatrix;
1912 register ElementPtr pElement;
1913 register int I;
1914 RealNumber Max = 0.0, AbsRowSum;
1915 
1916 /* Begin `spNorm'. */
1917  ASSERT( IS_SPARSE(Matrix) AND NOT IS_FACTORED(Matrix) );
1918  if (NOT Matrix->RowsLinked) spcLinkRows( Matrix );
1919 
1920 /* Compute row sums. */
1921 #if REAL
1922  if (NOT Matrix->Complex)
1923  { for (I = Matrix->Size; I > 0; I--)
1924  { pElement = Matrix->FirstInRow[I];
1925  AbsRowSum = 0.0;
1926  while (pElement != NULL)
1927  { AbsRowSum += ABS( pElement->Real );
1928  pElement = pElement->NextInRow;
1929  }
1930  if (Max < AbsRowSum) Max = AbsRowSum;
1931  }
1932  }
1933 #endif
1934 #if spCOMPLEX
1935  if (Matrix->Complex)
1936  { for (I = Matrix->Size; I > 0; I--)
1937  { pElement = Matrix->FirstInRow[I];
1938  AbsRowSum = 0.0;
1939  while (pElement != NULL)
1940  { AbsRowSum += CMPLX_1_NORM( *pElement );
1941  pElement = pElement->NextInRow;
1942  }
1943  if (Max < AbsRowSum) Max = AbsRowSum;
1944  }
1945  }
1946 #endif
1947  return Max;
1948 }
1949 #endif /* CONDITION */
1950 
1951 
1952 
1953 
1954 
1955 
1956 #if STABILITY
1957 /*
1958  * STABILITY OF FACTORIZATION
1959  *
1960  * The following routines are used to gauge the stability of a
1961  * factorization. If the factorization is determined to be too unstable,
1962  * then the matrix should be reordered. The routines compute quantities
1963  * that are needed in the computation of a bound on the error attributed
1964  * to any one element in the matrix during the factorization. In other
1965  * words, there is a matrix E = [e_ij] of error terms such that A+E = LU.
1966  * This routine finds a bound on |e_ij|. Erisman & Reid [1] showed that
1967  * |e_ij| < 3.01 u rho m_ij, where u is the machine rounding unit,
1968  * rho = max a_ij where the max is taken over every row i, column j, and
1969  * step k, and m_ij is the number of multiplications required in the
1970  * computation of l_ij if i > j or u_ij otherwise. Barlow [2] showed that
1971  * rho < max_i || l_i ||_p max_j || u_j ||_q where 1/p + 1/q = 1.
1972  *
1973  * The first routine finds the magnitude on the largest element in the
1974  * matrix. If the matrix has not yet been factored, the largest
1975  * element is found by direct search. If the matrix is factored, a
1976  * bound on the largest element in any of the reduced submatrices is
1977  * computed using Barlow with p = oo and q = 1. The ratio of these
1978  * two numbers is the growth, which can be used to determine if the
1979  * pivoting order is adequate. A large growth implies that
1980  * considerable error has been made in the factorization and that it
1981  * is probably a good idea to reorder the matrix. If a large growth
1982  * in encountered after using spFactor(), reconstruct the matrix and
1983  * refactor using spOrderAndFactor(). If a large growth is
1984  * encountered after using spOrderAndFactor(), refactor using
1985  * spOrderAndFactor() with the pivot threshold increased, say to 0.1.
1986  *
1987  * Using only the size of the matrix as an upper bound on m_ij and
1988  * Barlow's bound, the user can estimate the size of the matrix error
1989  * terms e_ij using the bound of Erisman and Reid. The second routine
1990  * computes a tighter bound (with more work) based on work by Gear
1991  * [3], |e_ij| < 1.01 u rho (t c^3 + (1 + t)c^2) where t is the
1992  * threshold and c is the maximum number of off-diagonal elements in
1993  * any row of L. The expensive part of computing this bound is
1994  * determining the maximum number of off-diagonals in L, which changes
1995  * only when the order of the matrix changes. This number is computed
1996  * and saved, and only recomputed if the matrix is reordered.
1997  *
1998  * [1] A. M. Erisman, J. K. Reid. Monitoring the stability of the
1999  * triangular factorization of a sparse matrix. Numerische
2000  * Mathematik. Vol. 22, No. 3, 1974, pp 183-186.
2001  *
2002  * [2] J. L. Barlow. A note on monitoring the stability of triangular
2003  * decomposition of sparse matrices. "SIAM Journal of Scientific
2004  * and Statistical Computing." Vol. 7, No. 1, January 1986, pp 166-168.
2005  *
2006  * [3] I. S. Duff, A. M. Erisman, J. K. Reid. "Direct Methods for Sparse
2007  * Matrices." Oxford 1986. pp 99.
2008  */
2009 
2010 /*
2011  * LARGEST ELEMENT IN MATRIX
2012  *
2013  * >>> Returns:
2014  * If matrix is not factored, returns the magnitude of the largest element in
2015  * the matrix. If the matrix is factored, a bound on the magnitude of the
2016  * largest element in any of the reduced submatrices is returned.
2017  *
2018  * >>> Arguments:
2019  * eMatrix <input> (char *)
2020  * Pointer to the matrix.
2021  */
2022 
2023 RealNumber
2024 spLargestElement( eMatrix )
2025 
2026 char *eMatrix;
2027 {
2028 MatrixPtr Matrix = (MatrixPtr)eMatrix;
2029 register int I;
2030 RealNumber Mag, AbsColSum, Max = 0.0, MaxRow = 0.0, MaxCol = 0.0;
2031 RealNumber Pivot;
2032 ComplexNumber cPivot;
2033 register ElementPtr pElement, pDiag;
2034 
2035 /* Begin `spLargestElement'. */
2036  ASSERT( IS_SPARSE(Matrix) );
2037 
2038 #if REAL
2039  if (Matrix->Factored AND NOT Matrix->Complex)
2040  { if (Matrix->Error == spSINGULAR) return 0.0;
2041 
2042 /* Find the bound on the size of the largest element over all factorization. */
2043  for (I = 1; I <= Matrix->Size; I++)
2044  { pDiag = Matrix->Diag[I];
2045 
2046 /* Lower triangular matrix. */
2047  Pivot = 1.0 / pDiag->Real;
2048  Mag = ABS( Pivot );
2049  if (Mag > MaxRow) MaxRow = Mag;
2050  pElement = Matrix->FirstInRow[I];
2051  while (pElement != pDiag)
2052  { Mag = ABS( pElement->Real );
2053  if (Mag > MaxRow) MaxRow = Mag;
2054  pElement = pElement->NextInRow;
2055  }
2056 
2057 /* Upper triangular matrix. */
2058  pElement = Matrix->FirstInCol[I];
2059  AbsColSum = 1.0; /* Diagonal of U is unity. */
2060  while (pElement != pDiag)
2061  { AbsColSum += ABS( pElement->Real );
2062  pElement = pElement->NextInCol;
2063  }
2064  if (AbsColSum > MaxCol) MaxCol = AbsColSum;
2065  }
2066  }
2067  else if (NOT Matrix->Complex)
2068  { for (I = 1; I <= Matrix->Size; I++)
2069  { pElement = Matrix->FirstInCol[I];
2070  while (pElement != NULL)
2071  { Mag = ABS( pElement->Real );
2072  if (Mag > Max) Max = Mag;
2073  pElement = pElement->NextInCol;
2074  }
2075  }
2076  return Max;
2077  }
2078 #endif
2079 #if spCOMPLEX
2080  if (Matrix->Factored AND Matrix->Complex)
2081  { if (Matrix->Error == spSINGULAR) return 0.0;
2082 
2083 /* Find the bound on the size of the largest element over all factorization. */
2084  for (I = 1; I <= Matrix->Size; I++)
2085  { pDiag = Matrix->Diag[I];
2086 
2087 /* Lower triangular matrix. */
2088  CMPLX_RECIPROCAL( cPivot, *pDiag );
2089  Mag = CMPLX_1_NORM( cPivot );
2090  if (Mag > MaxRow) MaxRow = Mag;
2091  pElement = Matrix->FirstInRow[I];
2092  while (pElement != pDiag)
2093  { Mag = CMPLX_1_NORM( *pElement );
2094  if (Mag > MaxRow) MaxRow = Mag;
2095  pElement = pElement->NextInRow;
2096  }
2097 
2098 /* Upper triangular matrix. */
2099  pElement = Matrix->FirstInCol[I];
2100  AbsColSum = 1.0; /* Diagonal of U is unity. */
2101  while (pElement != pDiag)
2102  { AbsColSum += CMPLX_1_NORM( *pElement );
2103  pElement = pElement->NextInCol;
2104  }
2105  if (AbsColSum > MaxCol) MaxCol = AbsColSum;
2106  }
2107  }
2108  else if (Matrix->Complex)
2109  { for (I = 1; I <= Matrix->Size; I++)
2110  { pElement = Matrix->FirstInCol[I];
2111  while (pElement != NULL)
2112  { Mag = CMPLX_1_NORM( *pElement );
2113  if (Mag > Max) Max = Mag;
2114  pElement = pElement->NextInCol;
2115  }
2116  }
2117  return Max;
2118  }
2119 #endif
2120  return MaxRow * MaxCol;
2121 }
2122 
2123 
2124 
2125 
2126 /*
2127  * MATRIX ROUNDOFF ERROR
2128  *
2129  * >>> Returns:
2130  * Returns a bound on the magnitude of the largest element in E = A - LU.
2131  *
2132  * >>> Arguments:
2133  * eMatrix <input> (char *)
2134  * Pointer to the matrix.
2135  * Rho <input> (RealNumber)
2136  * The bound on the magnitude of the largest element in any of the
2137  * reduced submatrices. This is the number computed by the function
2138  * spLargestElement() when given a factored matrix. If this number is
2139  * negative, the bound will be computed automatically.
2140  */
2141 
2142 RealNumber
2143 spRoundoff( eMatrix, Rho )
2144 
2145 char *eMatrix;
2146 RealNumber Rho;
2147 {
2148 MatrixPtr Matrix = (MatrixPtr)eMatrix;
2149 register ElementPtr pElement;
2150 register int Count, I, MaxCount = 0;
2151 RealNumber Reid, Gear;
2152 
2153 /* Begin `spRoundoff'. */
2154  ASSERT( IS_SPARSE(Matrix) AND IS_FACTORED(Matrix) );
2155 
2156 /* Compute Barlow's bound if it is not given. */
2157  if (Rho < 0.0) Rho = spLargestElement( eMatrix );
2158 
2159 /* Find the maximum number of off-diagonals in L if not previously computed. */
2160  if (Matrix->MaxRowCountInLowerTri < 0)
2161  { for (I = Matrix->Size; I > 0; I--)
2162  { pElement = Matrix->FirstInRow[I];
2163  Count = 0;
2164  while (pElement->Col < I)
2165  { Count++;
2166  pElement = pElement->NextInRow;
2167  }
2168  if (Count > MaxCount) MaxCount = Count;
2169  }
2170  Matrix->MaxRowCountInLowerTri = MaxCount;
2171  }
2172  else MaxCount = Matrix->MaxRowCountInLowerTri;
2173 
2174 /* Compute error bound. */
2175  Gear = 1.01*((MaxCount + 1) * Matrix->RelThreshold + 1.0) * SQR(MaxCount);
2176  Reid = 3.01 * Matrix->Size;
2177 
2178  if (Gear < Reid)
2179  return (MACHINE_RESOLUTION * Rho * Gear);
2180  else
2181  return (MACHINE_RESOLUTION * Rho * Reid);
2182 }
2183 #endif
2184 
2185 
2186 
2187 
2188 
2189 
2190 
2191 
2192 #if DOCUMENTATION
2193 /*
2194  * SPARSE ERROR MESSAGE
2195  *
2196  * This routine prints a short message to a stream describing the error
2197  * error state of sparse. No message is produced if there is no error.
2198  *
2199  * >>> Arguments:
2200  * eMatrix <input> (char *)
2201  * Matrix for which the error message is to be printed.
2202  * Stream <input> (FILE *)
2203  * Stream to which the error message is to be printed.
2204  * Originator <input> (char *)
2205  * Name of originator of error message. If NULL, `sparse' is used.
2206  * If zero-length string, no originator is printed.
2207  */
2208 
2209 void
2210 spErrorMessage( eMatrix, Stream, Originator )
2211 
2212 char *eMatrix, *Originator;
2213 FILE *Stream;
2214 {
2215 int Row, Col, Error;
2216 
2217 /* Begin `spErrorMessage'. */
2218  if (eMatrix == NULL)
2219  Error = spNO_MEMORY;
2220  else
2221  { ASSERT(((MatrixPtr)eMatrix)->ID == SPARSE_ID);
2222  Error = ((MatrixPtr)eMatrix)->Error;
2223  }
2224 
2225  if (Error == spOKAY) return;
2226  if (Originator == NULL) Originator = "sparse";
2227  if (Originator[0] != '\0') fprintf( Stream, "%s: ", Originator);
2228  if (Error >= spFATAL)
2229  fprintf( Stream, "fatal error, ");
2230  else
2231  fprintf( Stream, "warning, ");
2232 /*
2233  * Print particular error message.
2234  * Do not use switch statement because error codes may not be unique.
2235  */
2236  if (Error == spPANIC)
2237  fprintf( Stream, "Sparse called improperly.\n");
2238  else if (Error == spNO_MEMORY)
2239  fprintf( Stream, "insufficient memory available.\n");
2240  else if (Error == spSINGULAR)
2241  { spWhereSingular( eMatrix, &Row, &Col );
2242  fprintf( Stream, "singular matrix detected at row %d and column %d.\n",
2243  Row, Col);
2244  }
2245  else if (Error == spZERO_DIAG)
2246  { spWhereSingular( eMatrix, &Row, &Col );
2247  fprintf( Stream, "zero diagonal detected at row %d and column %d.\n",
2248  Row, Col);
2249  }
2250  else if (Error == spSMALL_PIVOT)
2251  { fprintf( Stream,
2252  "unable to find a pivot that is larger than absolute threshold.\n");
2253  }
2254  else ABORT();
2255  return;
2256 }
2257 #endif /* DOCUMENTATION */
#define CMPLX_MULT_ASSIGN(to, from)
Definition: spdefs.h:241
#define ABORT()
Definition: spdefs.h:410
ElementPtr NextAvailFillin
Definition: spdefs.h:866
RealNumber RelThreshold
Definition: spdefs.h:853
#define ALLOC(type, number)
Definition: spdefs.h:433
spREAL spCondition()
void spMultTransposed()
#define CMPLX_MULT_SUBT(to, mult_a, mult_b, subt)
Definition: spdefs.h:269
ArrayOfElementPtrs FirstInRow
Definition: spdefs.h:836
#define IS_FACTORED(matrix)
Definition: spdefs.h:131
#define MAX(a, b)
Definition: spdefs.h:135
#define NO
Definition: spdefs.h:113
int Size
Definition: spdefs.h:859
register int * pExtOrder
Definition: spsolve.c:163
#define MIN(a, b)
Definition: spdefs.h:136
if(TDesc==NULL)
Definition: cd.c:1326
#define BOOLEAN
Definition: spdefs.h:112
#define spSEPARATED_COMPLEX_VECTORS
Definition: spconfig.h:285
int NumberOfFillinsInList
Definition: spdefs.h:617
#define Max(Dragon, Eagle)
Definition: cdmacs.h:17
#define spSINGULAR
Definition: spmatrix.h:104
#define spOKAY
Definition: spmatrix.h:101
spREAL spRoundoff()
static double e
Definition: vectors.c:17
struct FillinListNodeStruct * FirstFillinListNode
Definition: spdefs.h:868
#define spFATAL
Definition: spmatrix.h:108
void spStripFills()
RealNumber Real
Definition: spdefs.h:539
This document describes the JSPICE3 Josephson junction model I derivation of the model The expression for the junction current is J
Definition: model.doc:9
int * ExtToIntRowMap
Definition: spdefs.h:832
#define FREE(ptr)
Definition: spdefs.h:436
spREAL * RealVector
Definition: spdefs.h:458
struct ComplexNumber * ComplexVector
#define IS_SPARSE(matrix)
Definition: spdefs.h:125
RealVector Solution IMAG_VECTORS
Definition: spsolve.c:157
BOOLEAN NumberOfInterchangesIsOdd
Definition: spdefs.h:847
#define ELEMENT_MAG(ptr)
Definition: spdefs.h:161
#define CMPLX_MULT_SUBT_ASSIGN(to, from_a, from_b)
Definition: spdefs.h:297
void spcCreateInternalVectors()
#define CMPLX_NEGATE(a)
Definition: spdefs.h:182
struct MatrixElement * NextInCol
Definition: spdefs.h:547
BOOLEAN Factored
Definition: spdefs.h:833
BOOLEAN NeedsOrdering
Definition: spdefs.h:846
void spScale()
spREAL spNorm()
struct FillinListNodeStruct * LastFillinListNode
Definition: spdefs.h:869
ElementPtr pFillinList
Definition: spdefs.h:616
#define spSMALL_PIVOT
Definition: spmatrix.h:102
int FillinsRemaining
Definition: spdefs.h:867
void spDeterminant()
#define spPANIC
Definition: spmatrix.h:106
void spDeleteRowAndCol()
#define IS_VALID(matrix)
Definition: spdefs.h:127
ASSERT(IS_VALID(Matrix) AND IS_FACTORED(Matrix))
RealNumber Imag
Definition: spdefs.h:483
#define NULL
Definition: spdefs.h:121
#define OR
Definition: fteparse.h:93
register ElementPtr pElement
Definition: spsolve.c:158
#define CMPLX_MULT_ADD_ASSIGN(to, from_a, from_b)
Definition: spdefs.h:288
int * IntToExtColMap
Definition: spdefs.h:840
register int Size
Definition: spsolve.c:163
#define CMPLX_1_NORM(a)
Definition: spdefs.h:188
void spConstMult()
ElementPtr spcFindElementInCol()
static void ComplexMatrixMultiply()
int * IntToExtRowMap
Definition: spdefs.h:841
void spMultiply()
int Fillins
Definition: spdefs.h:834
#define spREAL
Definition: spmatrix.h:145
void spcLinkRows()
#define SPARSE_ID
Definition: spdefs.h:124
#define SCLR_MULT_ASSIGN(to, sclr)
Definition: spdefs.h:227
#define ABS(a)
Definition: spdefs.h:139
int Error
Definition: spdefs.h:829
int CurrentSize
Definition: spdefs.h:824
BOOLEAN Complex
Definition: spdefs.h:823
RealVector Intermediate
Definition: spdefs.h:838
#define SWAP(type, a, b)
Definition: spdefs.h:145
void spcColExchange()
spREAL spPseudoCondition()
BOOLEAN RowsLinked
Definition: spdefs.h:855
RealNumber Real
Definition: spdefs.h:482
static void ScaleComplexMatrix()
void spcRowExchange()
static void ComplexTransposedMatrixMultiply()
spREAL RealNumber
Definition: spdefs.h:458
spREAL spLargestElement()
#define YES
Definition: spdefs.h:114
BOOLEAN InternalVectorsAllocated
Definition: spdefs.h:839
RealVector RHS
Definition: spsolve.c:157
static void SwapCols()
int Elements
Definition: spdefs.h:828
struct MatrixElement * NextInRow
Definition: spdefs.h:546
ArrayOfElementPtrs Diag
Definition: spdefs.h:825
#define SQR(a)
Definition: spdefs.h:142
#define NOT
Definition: fteparse.h:94
int * ExtToIntColMap
Definition: spdefs.h:831
BOOLEAN Reordered
Definition: spdefs.h:854
register int I
Definition: spsolve.c:163
struct MatrixFrame * MatrixPtr
Definition: spdefs.h:871
struct FillinListNodeStruct * Next
Definition: spdefs.h:618
static RealNumber ComplexCondition()
int MaxRowCountInLowerTri
Definition: spdefs.h:845
void spWhereSingular()
static int CountTwins()
#define E
Definition: parse.c:443
ElementPtr pPivot
Definition: spsolve.c:164
#define spNO_MEMORY
Definition: spmatrix.h:105
ArrayOfElementPtrs FirstInCol
Definition: spdefs.h:835
#define spZERO_DIAG
Definition: spmatrix.h:103
void spMNA_Preorder()
#define CMPLX_RECIPROCAL(to, den)
Definition: spdefs.h:367
#define AND
Definition: fteparse.h:92