[SCM] Gerris Flow Solver branch, upstream, updated. b3aa46814a06c9cb2912790b23916ffb44f1f203

Stephane Popinet popinet at users.sourceforge.net
Fri May 15 02:51:26 UTC 2009


The following commit has been merged in the upstream branch:
commit 7c5ac695da4ac0c94b5159849754c40b82a739d1
Author: Stephane Popinet <popinet at users.sourceforge.net>
Date:   Tue Nov 16 15:53:23 2004 +1100

    New utility function gfs_matrix_inverse() (gerris--ocean--0.7--patch-14)
    
    gerris--ocean--0.7--patch-14
    Keywords:
    
    darcs-hash:20041116045323-aabb8-2f65dfc5b343d8134a63adedf5a6bcba3e799982.gz

diff --git a/src/utils.c b/src/utils.c
index b099bfb..4c812cf 100644
--- a/src/utils.c
+++ b/src/utils.c
@@ -466,3 +466,76 @@ void gfs_eigenvalues (gdouble a[FTT_DIMENSION][FTT_DIMENSION],
   }
   g_assert_not_reached ();
 }
+
+/**
+ * gfs_matrix_inverse:
+ * @m: a square matrix.
+ * @n: size of the matrix.
+ *
+ * Replaces @m with its inverse.
+ *
+ * Returns: %FALSE if @m is non-invertible, %TRUE otherwise.
+ */
+gboolean gfs_matrix_inverse (gdouble ** m, guint n)
+{
+  gint * indxc, * indxr, * ipiv;
+  gint i, icol = 0, irow = 0, j, k, l, ll;
+  gdouble big, dum, pivinv, temp;
+
+  g_return_val_if_fail (m != NULL, FALSE);
+
+  indxc = g_malloc (sizeof (gint)*n);
+  indxr = g_malloc (sizeof (gint)*n);
+  ipiv = g_malloc (sizeof (gint)*n);
+  
+#define SWAP(a,b) {temp=(a);(a)=(b);(b)=temp;}
+
+  for (j = 0; j < n; j++)
+    ipiv[j] = -1;
+
+  for (i = 0; i < n; i++) {
+    big = 0.0;
+    for (j = 0; j < n; j++)
+      if (ipiv[j] != 0)
+	for (k = 0; k < n; k++) {
+	  if (ipiv[k] == -1) {
+	    if (fabs (m[j][k]) >= big) {
+	      big = fabs (m[j][k]);
+	      irow = j;
+	      icol = k;
+	    }
+	  }
+	}
+    ipiv[icol]++;
+    if (irow != icol)
+      for (l = 0; l < n; l++) 
+	SWAP (m[irow][l], m[icol][l]);
+    indxr[i] = irow;
+    indxc[i] = icol;
+    if (m[icol][icol] == 0.) {
+      g_free (indxc);
+      g_free (indxr);
+      g_free (ipiv);
+      return FALSE;
+    }
+    pivinv = 1.0/m[icol][icol];
+    m[icol][icol] = 1.0;
+    for (l = 0; l < n; l++) m[icol][l] *= pivinv;
+    for (ll = 0; ll < n; ll++)
+      if (ll != icol) {
+	dum = m[ll][icol];
+	m[ll][icol] = 0.0;
+	for (l = 0; l < n; l++)
+	  m[ll][l] -= m[icol][l]*dum;
+      }
+  }
+  for (l = n - 1; l >= 0; l--) {
+    if (indxr[l] != indxc[l])
+      for (k = 0; k < n; k++)
+	SWAP (m[k][indxr[l]], m[k][indxc[l]]);
+  }
+  g_free (indxc);
+  g_free (indxr);
+  g_free (ipiv);
+  return TRUE;
+}
diff --git a/src/utils.h b/src/utils.h
index f8a72e4..74f48dc 100644
--- a/src/utils.h
+++ b/src/utils.h
@@ -77,6 +77,8 @@ GtsObjectClass *   gfs_object_class_from_name (const gchar * name);
 void               gfs_eigenvalues          (gdouble a[FTT_DIMENSION][FTT_DIMENSION],
 					     gdouble d[FTT_DIMENSION],
 					     gdouble v[FTT_DIMENSION][FTT_DIMENSION]);
+gboolean           gfs_matrix_inverse       (gdouble ** m, 
+					     guint n);
 
 #ifdef __cplusplus
 }

-- 
Gerris Flow Solver



More information about the debian-science-commits mailing list