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

Stephane Popinet s.popinet at niwa.co.nz
Fri May 15 02:51:56 UTC 2009


The following commit has been merged in the upstream branch:
commit fff8edc0660f5fd0eb5edc6bcd73598412b6ebbc
Author: Stephane Popinet <s.popinet at niwa.co.nz>
Date:   Fri Jun 10 15:04:31 2005 +1000

    GfsFunction now knows about "derived variables"
    
    This is the first step toward removing old-style derived variables
    altogether.
    
    darcs-hash:20050610050431-fbd8f-9c09c6bba19503cefa5921b2c21f8a0c38f55c7a.gz

diff --git a/src/adaptive.c b/src/adaptive.c
index 4653bf9..76d3b62 100644
--- a/src/adaptive.c
+++ b/src/adaptive.c
@@ -352,8 +352,7 @@ static gdouble cost_vorticity (FttCell * cell, GfsAdaptVorticity * a)
 {
   if (a->maxa <= 0.)
     return 0.;
-  return fabs (gfs_vorticity_value (cell, &GFS_DOMAIN (gfs_object_simulation (a))->lambda))*
-    ftt_cell_size (cell)/a->maxa;
+  return fabs (gfs_vorticity (cell))*ftt_cell_size (cell)/a->maxa;
 }
 
 static void gfs_adapt_vorticity_init (GfsAdaptVorticity * object)
diff --git a/src/fluid.c b/src/fluid.c
index dbfdbe8..19865bf 100644
--- a/src/fluid.c
+++ b/src/fluid.c
@@ -1624,33 +1624,29 @@ void gfs_normal_divergence_2D (FttCell * cell)
 /**
  * gfs_divergence:
  * @cell: a #FttCell.
- * @v: a #GfsVariable.
  *
- * Fills variable @v of @cell with the divergence of the
- * (centered) velocity field in this cell.  
+ * Returns: the divergence of the (centered) velocity field in @cell.
  */
-void gfs_divergence (FttCell * cell, GfsVariable * v)
+gdouble gfs_divergence (FttCell * cell)
 {
   FttComponent c;
   gdouble div = 0.;
 
-  g_return_if_fail (cell != NULL);
-  g_return_if_fail (v != NULL);
+  g_return_val_if_fail (cell != NULL, 0.);
 
   for (c = 0; c < FTT_DIMENSION; c++)
     div += gfs_center_gradient (cell, c, GFS_VELOCITY_INDEX (c));
-  GFS_VARIABLE (cell, v->i) = div/ftt_cell_size (cell);
+  return div/ftt_cell_size (cell);
 }
 
 /**
- * gfs_vorticity_value:
+ * gfs_vorticity:
  * @cell: a #FttCell.
- * @lambda: the dimensions of the domain containing @cell.
  *
  * Returns: the vorticity (norm of the vorticity vector in 3D) of the
- * velocity field in this cell.
+ * velocity field in @cell.
  */
-gdouble gfs_vorticity_value (FttCell * cell, FttVector * lambda)
+gdouble gfs_vorticity (FttCell * cell)
 {
   gdouble size;
 #if (!FTT_2D)
@@ -1658,109 +1654,78 @@ gdouble gfs_vorticity_value (FttCell * cell, FttVector * lambda)
 #endif /* FTT_3D */
 
   g_return_val_if_fail (cell != NULL, 0.);
-  g_return_val_if_fail (lambda != NULL, 0.);
 
   size = ftt_cell_size (cell);
 #if FTT_2D
-  return (lambda->x*gfs_center_gradient (cell, FTT_X, GFS_V)/lambda->y -
-	  lambda->y*gfs_center_gradient (cell, FTT_Y, GFS_U)/lambda->x)/size;
+  return (gfs_center_gradient (cell, FTT_X, GFS_V) -
+	  gfs_center_gradient (cell, FTT_Y, GFS_U))/size;
 #else  /* FTT_3D */
-  vort.x = (lambda->y*gfs_center_gradient (cell, FTT_Y, GFS_W)/lambda->z -
-	    lambda->z*gfs_center_gradient (cell, FTT_Z, GFS_V)/lambda->y)/size;
-  vort.y = (lambda->z*gfs_center_gradient (cell, FTT_Z, GFS_U)/lambda->x -
-	    lambda->x*gfs_center_gradient (cell, FTT_X, GFS_W)/lambda->z)/size;
-  vort.z = (lambda->x*gfs_center_gradient (cell, FTT_X, GFS_V)/lambda->y -
-	    lambda->y*gfs_center_gradient (cell, FTT_Y, GFS_U)/lambda->x)/size;
+  vort.x = (gfs_center_gradient (cell, FTT_Y, GFS_W) -
+	    gfs_center_gradient (cell, FTT_Z, GFS_V))/size;
+  vort.y = (gfs_center_gradient (cell, FTT_Z, GFS_U) -
+	    gfs_center_gradient (cell, FTT_X, GFS_W))/size;
+  vort.z = (gfs_center_gradient (cell, FTT_X, GFS_V) -
+	    gfs_center_gradient (cell, FTT_Y, GFS_U))/size;
   return sqrt (vort.x*vort.x + vort.y*vort.y + vort.z*vort.z);
 #endif /* FTT_3D */
 }
 
 /**
- * gfs_vorticity:
- * @cell: a #FttCell.
- * @v: a #GfsVariable.
- *
- * Fills variable @v of @cell with the vorticity (norm of the
- * vorticity vector in 3D) of the velocity field in this cell.  
- */
-void gfs_vorticity (FttCell * cell,
-		    GfsVariable * v)
-{
-  g_return_if_fail (cell != NULL);
-  g_return_if_fail (v != NULL);
-
-  GFS_VARIABLE (cell, v->i) = gfs_vorticity_value (cell, 
-			&GFS_DOMAIN (gfs_variable_parent (v))->lambda);
-}
-
-/**
  * gfs_velocity_norm:
  * @cell: a #FttCell.
- * @v: a #GfsVariable.
  *
- * Fills variable @v of @cell with the norm of the velocity field in
- * this cell.
+ * Returns: the norm of the velocity field in @cell.
  */
-void gfs_velocity_norm (FttCell * cell,
-			GfsVariable * v)
+gdouble gfs_velocity_norm (FttCell * cell)
 {
   GfsStateVector * s;
   
-  g_return_if_fail (cell != NULL);
-  g_return_if_fail (v != NULL);
+  g_return_val_if_fail (cell != NULL, 0.);
 
   s = GFS_STATE (cell);
 #if FTT_2D
-  GFS_VARIABLE (cell, v->i) = sqrt (s->u*s->u + s->v*s->v);
+  return sqrt (s->u*s->u + s->v*s->v);
 #else  /* FTT_3D */
-  GFS_VARIABLE (cell, v->i) = sqrt (s->u*s->u + s->v*s->v + s->w*s->w);
+  return sqrt (s->u*s->u + s->v*s->v + s->w*s->w);
 #endif /* FTT_3D */
 }
 
 /**
  * gfs_velocity_norm2:
  * @cell: a #FttCell.
- * @v: a #GfsVariable.
  *
- * Fills variable @v of @cell with the squared norm of the velocity field in
- * this cell.
+ * Returns: the squared norm of the velocity field in @cell.
  */
-void gfs_velocity_norm2 (FttCell * cell,
-			 GfsVariable * v)
+gdouble gfs_velocity_norm2 (FttCell * cell)
 {
   GfsStateVector * s;
 
-  g_return_if_fail (cell != NULL);
-  g_return_if_fail (v != NULL);
+  g_return_val_if_fail (cell != NULL, 0.);
 
   s = GFS_STATE (cell);
 #if FTT_2D
-  GFS_VARIABLE (cell, v->i) = s->u*s->u + s->v*s->v;
+  return s->u*s->u + s->v*s->v;
 #else  /* FTT_3D */
-  GFS_VARIABLE (cell, v->i) = s->u*s->u + s->v*s->v + s->w*s->w;
+  return s->u*s->u + s->v*s->v + s->w*s->w;
 #endif /* FTT_3D */
 }
 
 /**
  * gfs_velocity_lambda2:
  * @cell: a #FttCell.
- * @v: a #GfsVariable.
- *
- * Fills variable @v of @cell with the lambda2 eigenvalue used by
- * Jeong and Hussain as vortex criterion (JFM 285, 69-94, 1995).
  *
- * The value is normalized by the square of the size of the cell.
+ * Returns: The value of the lambda2 eigenvalue used by Jeong and
+ * Hussain as vortex criterion (JFM 285, 69-94, 1995), normalized by
+ * the square of the size of the cell.
  */
-void gfs_velocity_lambda2 (FttCell * cell,
-			   GfsVariable * v)
+gdouble gfs_velocity_lambda2 (FttCell * cell)
 {
   gdouble J[FTT_DIMENSION][FTT_DIMENSION];
   gdouble S2O2[FTT_DIMENSION][FTT_DIMENSION];
   gdouble lambda[FTT_DIMENSION], ev[FTT_DIMENSION][FTT_DIMENSION];
   guint i, j, k;
 
-  g_return_if_fail (cell != NULL);
-  g_return_if_fail (v != NULL);
+  g_return_val_if_fail (cell != NULL, 0.);
 
   for (i = 0; i < FTT_DIMENSION; i++)
     for (j = 0; j < FTT_DIMENSION; j++)
@@ -1772,7 +1737,7 @@ void gfs_velocity_lambda2 (FttCell * cell,
 	S2O2[i][j] += J[i][k]*J[k][j] + J[k][i]*J[j][k];
     }
   gfs_eigenvalues (S2O2, lambda, ev);
-  GFS_VARIABLE (cell, v->i) = lambda[1]/2.;
+  return lambda[1]/2.;
 }
 
 /**
diff --git a/src/fluid.h b/src/fluid.h
index 0f16562..c02f6f0 100644
--- a/src/fluid.h
+++ b/src/fluid.h
@@ -189,18 +189,11 @@ void                  gfs_face_gradient_flux_centered(const FttCellFace * face,
 
 void                  gfs_normal_divergence          (FttCell * cell);
 void                  gfs_normal_divergence_2D       (FttCell * cell);
-void                  gfs_divergence                 (FttCell * cell,
-						      GfsVariable * v);
-gdouble               gfs_vorticity_value            (FttCell * cell,
-						      FttVector * lambda);
-void                  gfs_vorticity                  (FttCell * cell,
-						      GfsVariable * v);
-void                  gfs_velocity_norm              (FttCell * cell,
-						      GfsVariable * v);
-void                  gfs_velocity_norm2             (FttCell * cell,
-						      GfsVariable * v);
-void                  gfs_velocity_lambda2           (FttCell * cell,
-						      GfsVariable * v);
+gdouble               gfs_divergence                 (FttCell * cell);
+gdouble               gfs_vorticity                  (FttCell * cell);
+gdouble               gfs_velocity_norm              (FttCell * cell);
+gdouble               gfs_velocity_norm2             (FttCell * cell);
+gdouble               gfs_velocity_lambda2           (FttCell * cell);
 void                  gfs_pressure_force             (FttCell * cell,
 						      FttVector * f);
 GtsRange              gfs_stats_variable             (FttCell * root, 
diff --git a/src/init.c b/src/init.c
index 86b9e21..b6d399f 100644
--- a/src/init.c
+++ b/src/init.c
@@ -78,6 +78,21 @@ static void gfs_log (const gchar * log_domain,
 	   log_domain, stype[type], pe, message); 
 }
 
+static void cell_vorticity (FttCell * cell, GfsVariable * v)
+{
+  GFS_VARIABLE (cell, v->i) = gfs_vorticity (cell);
+}
+
+static void cell_velocity_norm (FttCell * cell, GfsVariable * v)
+{
+  GFS_VARIABLE (cell, v->i) = gfs_velocity_norm (cell);
+}
+
+static void cell_velocity_norm2 (FttCell * cell, GfsVariable * v)
+{
+  GFS_VARIABLE (cell, v->i) = gfs_velocity_norm2 (cell);
+}
+
 static void cell_level (FttCell * cell, GfsVariable * v)
 {
   GFS_VARIABLE (cell, v->i) = ftt_cell_level (cell);
@@ -91,8 +106,7 @@ static void cell_fraction (FttCell * cell, GfsVariable * v)
 static void cell_lambda2 (FttCell * cell, GfsVariable * v)
 {
   gdouble size = ftt_cell_size (cell);
-  gfs_velocity_lambda2 (cell, v);
-  GFS_VARIABLE (cell, v->i) /= size*size;
+  GFS_VARIABLE (cell, v->i) /= gfs_velocity_lambda2 (cell)/(size*size);
 }
 
 static void cell_curvature (FttCell * cell, GfsVariable * v)
@@ -189,13 +203,13 @@ void gfs_init (int * argc, char *** argv)
   /* Initializes derived variables */
   gfs_derived_first = v = 
     gfs_variable_new (gfs_variable_class (), NULL, "Vorticity", FALSE, GFS_DIV);
-  v->derived = gfs_vorticity;
+  v->derived = cell_vorticity;
   v = v->next = gfs_variable_new (gfs_variable_class (), NULL, "Divergence", FALSE, GFS_DIV);
   v->derived = (GfsVariableDerivedFunc) gfs_divergence;
   v = v->next = gfs_variable_new (gfs_variable_class (), NULL, "Velocity", FALSE, GFS_DIV);
-  v->derived = gfs_velocity_norm;
+  v->derived = cell_velocity_norm;
   v = v->next = gfs_variable_new (gfs_variable_class (), NULL, "Velocity2", FALSE, GFS_DIV);
-  v->derived = gfs_velocity_norm2;
+  v->derived = cell_velocity_norm2;
   v = v->next = gfs_variable_new (gfs_variable_class (), NULL, "Level", FALSE, GFS_DIV);
   v->derived = cell_level;
   v = v->next = gfs_variable_new (gfs_variable_class (), NULL, "A", FALSE, GFS_DIV);
diff --git a/src/output.c b/src/output.c
index 35a1dad..a5ffb3d 100644
--- a/src/output.c
+++ b/src/output.c
@@ -218,14 +218,6 @@ static void gfs_output_write (GtsObject * o, FILE * fp)
     fprintf (fp, " %s", output->format);
 }
 
-static gboolean char_in_string (char c, const char * s)
-{
-  while (*s != '\0')
-    if (*(s++) == c)
-      return TRUE;
-  return FALSE;
-}
-
 static void gfs_output_read (GtsObject ** o, GtsFile * fp)
 {
   GfsOutput * output;
@@ -300,7 +292,7 @@ static void gfs_output_read (GtsObject ** o, GtsFile * fp)
 	
 	len = 1;
 	c++;
-	while (*c != '\0' && !char_in_string (*c, "diouxXeEfFgGaAcsCSpn%")) {
+	while (*c != '\0' && !gfs_char_in_string (*c, "diouxXeEfFgGaAcsCSpn%")) {
 	  prev = c;
 	  c++;
 	  len++;
@@ -309,7 +301,7 @@ static void gfs_output_read (GtsObject ** o, GtsFile * fp)
 	if (*c == '%')
 	  output->formats = g_slist_prepend (output->formats,
 					     format_new ("%", 1, NONE));
-	else if (char_in_string (*c, "diouxXc")) {
+	else if (gfs_char_in_string (*c, "diouxXc")) {
 	  if (*prev == 'l') {
 	    output->formats = g_slist_prepend (output->formats,
 					       format_new (startf, len, ITER));
@@ -319,7 +311,7 @@ static void gfs_output_read (GtsObject ** o, GtsFile * fp)
 	    output->formats = g_slist_prepend (output->formats,
 					       format_new (startf, len, PID));
 	}
-	else if (char_in_string (*c, "eEfFgGaA")) {
+	else if (gfs_char_in_string (*c, "eEfFgGaA")) {
 	  output->formats = g_slist_prepend (output->formats,
 					     format_new (startf, len, TIME));
 	  output->dynamic = TRUE;
diff --git a/src/utils.c b/src/utils.c
index 1cbfa5b..cbddcfa 100644
--- a/src/utils.c
+++ b/src/utils.c
@@ -27,20 +27,73 @@
 #include "solid.h"
 #include "simulation.h"
 
+/**
+ * @c: a character.
+ * @s: a string.
+ *
+ * Returns: %TRUE if @c belongs to @s, %FALSE otherwise.
+ */
+gboolean gfs_char_in_string (char c, const char * s)
+{
+  if (s == NULL)
+    return FALSE;
+  while (*s != '\0')
+    if (*(s++) == c)
+      return TRUE;
+  return FALSE;
+}
+
+/* Derived variables */
+
+typedef gdouble (* GfsFunctionFunc) (const FttCell * cell, 
+				     gdouble x, gdouble y, gdouble z, 
+				     gdouble t);
+
+static gdouble cell_level (FttCell * cell)
+{
+  return ftt_cell_level (cell);
+}
+
+static gdouble cell_fraction (FttCell * cell)
+{
+  return GFS_IS_MIXED (cell) ? GFS_STATE (cell)->solid->a : 1.;
+}
+
+GfsDerivedVariable gfs_derived_variable[] = {
+  { "Vorticity ", gfs_vorticity },
+  { "Divergence", gfs_divergence },
+  { "Velocity",   gfs_velocity_norm },
+  { "Velocity2",  gfs_velocity_norm2 },
+  { "Level",      cell_level },
+  { "A",          cell_fraction },
+  { "Lambda2",    gfs_velocity_lambda2 },
+  { "Curvature",  gfs_streamline_curvature },
+  { NULL, NULL}
+};
+
+static GfsFunctionFunc lookup_derived_variable (const gchar * name)
+{
+  GfsDerivedVariable * v = gfs_derived_variable;
+
+  while (v->name) {
+    if (!strcmp (v->name, name))
+      return (GfsFunctionFunc) v->func;
+    v++;
+  }
+  return NULL;
+}
+
 /* GfsFunction: Object */
 
 struct _GfsFunction {
-  /*< private >*/
   GtsObject parent;
   GString * expr;
   GModule * module;
-  gdouble (* f) (FttCell *, gdouble x, gdouble y, gdouble z, gdouble t);
+  GfsFunctionFunc f;
   gchar * sname;
   GtsSurface * s;
   GfsVariable * v;
   gdouble val;
-
-  /*< public >*/
 };
 
 static GtsSurface * read_surface (gchar * name, GtsFile * fp)
@@ -87,6 +140,121 @@ static gboolean load_module (GfsFunction * f, GtsFile * fp, gchar * mname)
   return TRUE;
 }
 
+static gboolean expr_or_func (GtsFile * fp, GfsFunction * f)
+{
+  GtsTokenType type = fp->type;
+  gint c, scope;
+  
+  if (type == '(' || type == GTS_STRING) {
+    f->expr = g_string_new (fp->token->str);
+    if (type == '(' || fp->next_token != '\0') {
+      scope = type == '(' ? 1 : 0;
+      if (fp->next_token != '\0')
+	g_string_append_c (f->expr, fp->next_token);
+      c = gts_file_getc (fp);
+      while (c != EOF && (scope > 0 || (c != ' ' && c != '\n'))) {
+	if (c == '(') scope++;
+	if (c == ')') scope--;
+	g_string_append_c (f->expr, c);
+	c = gts_file_getc (fp);
+      }
+    }
+    return TRUE;
+  }
+  else {
+    f->expr = g_string_new ("{");
+    scope = fp->scope_max;
+    c = gts_file_getc (fp);
+    while (c != EOF && fp->scope > scope) {
+      g_string_append_c (f->expr, c);
+      c = gts_file_getc (fp);
+    }
+    g_string_append_c (f->expr, '}');
+    if (fp->scope != scope)
+      gts_file_error (fp, "parse error");
+    return FALSE;
+  }
+}
+
+static gint compile (GtsFile * fp, GfsFunction * f, const gchar * finname)
+{
+  gchar foutname[] = "/tmp/gfsXXXXXX";
+  gchar ferrname[] = "/tmp/gfsXXXXXX";
+  gchar ftmpname[] = "/tmp/gfsXXXXXX";
+  gint foutd, ferrd, ftmpd;
+  gchar * cc;
+  gint status;
+#if FTT_2D
+  gchar cccommand[] = "gcc `pkg-config gerris2D --cflags --libs` -O -fPIC -shared -x c";
+#elif FTT_2D3
+  gchar cccommand[] = "gcc `pkg-config gerris2D3 --cflags --libs` -O -fPIC -shared -x c";
+#else /* 3D */
+  gchar cccommand[] = "gcc `pkg-config gerris3D --cflags --libs` -O -fPIC -shared -x c";
+#endif 
+  
+  foutd = mkstemp (foutname);
+  ferrd = mkstemp (ferrname);
+  ftmpd = mkstemp (ftmpname);
+  if (foutd < 0 || ferrd < 0 || ftmpd < 0) {
+    gts_file_error (fp, "cannot create temporary file");
+    return SIGABRT;
+  }
+  cc = g_strjoin (" ",
+		  cccommand, ftmpname, 
+		  "-o", foutname,
+		  "`awk '{"
+		  "   if ($1 == \"#\" && $2 == \"link\") {"
+		  "     for (i = 3; i <= NF; i++) printf (\"%s \", $i);"
+		  "     print \"\" > \"/dev/stderr\";"
+		  "   }"
+		  "   else if ($1 == \"#link\") {"
+		  "     for (i = 2; i <= NF; i++) printf (\"%s \", $i);"
+		  "     print \"\" > \"/dev/stderr\";"
+		  "   } else print $0 > \"/dev/stderr\";"
+		  "}' <", finname, "2>", ftmpname, "` 2>",
+		  ferrname, NULL);
+  status = system (cc);
+  g_free (cc);
+  close (ftmpd);
+  remove (ftmpname);
+  if (WIFSIGNALED (status) && (WTERMSIG (status) == SIGINT || WTERMSIG (status) == SIGQUIT))
+    status = SIGQUIT;
+  else if (status == -1 || WEXITSTATUS (status) != 0) {
+    GString * msg = g_string_new ("");
+    FILE * ferr = fdopen (ferrd, "r");
+    gint c;
+
+    while ((c = fgetc (ferr)) != EOF)
+      g_string_append_c (msg, c);
+    fclose (ferr);
+    gts_file_error (fp, "error compiling expression\n%s", msg->str);
+    g_string_free (msg, TRUE);
+    status = SIGABRT;
+  }
+  else {
+    if (load_module (f, fp, foutname))
+      status = SIGCONT;
+    else
+      status = SIGABRT;
+  }
+  close (foutd);
+  remove (foutname);
+  close (ferrd);
+  remove (ferrname);
+  return status;
+}
+
+static gchar * find_identifier (const gchar * s, const gchar * i)
+{
+  gchar * f = strstr (s, i);
+  static gchar allowed[] = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_";
+
+  if (!f || gfs_char_in_string (f[strlen(i)], allowed) ||
+      (f > s && gfs_char_in_string (f[-1], allowed)))
+    return NULL;
+  return f;
+}
+
 static void function_read (GtsObject ** o, GtsFile * fp)
 {
   GfsFunction * f = GFS_FUNCTION (*o);
@@ -116,6 +284,10 @@ static void function_read (GtsObject ** o, GtsFile * fp)
     }
     else if ((f->v = gfs_variable_from_name (domain->variables, fp->token->str)))
       break;
+    else if ((f->f = lookup_derived_variable (fp->token->str))) {
+      f->expr = g_string_new (fp->token->str);
+      break;
+    }
     /* fall through */
 
     /* compile C expression */
@@ -125,23 +297,18 @@ static void function_read (GtsObject ** o, GtsFile * fp)
       return;
     }
     else {
-#if FTT_2D
-      gchar cccommand[] = "gcc `pkg-config gerris2D --cflags --libs` -O -fPIC -shared -x c";
-#elif FTT_2D3
-      gchar cccommand[] = "gcc `pkg-config gerris2D3 --cflags --libs` -O -fPIC -shared -x c";
-#else /* 3D */
-      gchar cccommand[] = "gcc `pkg-config gerris3D --cflags --libs` -O -fPIC -shared -x c";
-#endif 
+      gboolean isexpr;
       gchar finname[] = "/tmp/gfsXXXXXX";
-      gchar foutname[] = "/tmp/gfsXXXXXX";
-      gchar ferrname[] = "/tmp/gfsXXXXXX";
-      gchar ftmpname[] = "/tmp/gfsXXXXXX";
-      gint find, foutd, ferrd, ftmpd;
+      gint find, status;
       FILE * fin;
       GfsVariable * v;
-      gchar * cc;
-      gint c, status;
+      GfsDerivedVariable * dv;
+      GSList * lv = NULL, * ldv = NULL;
+      guint n = 0;
 
+      isexpr = expr_or_func (fp, f);
+      if (fp->type == GTS_ERROR)
+	return;
       find = mkstemp (finname);
       if (find < 0) {
 	gts_file_error (fp, "cannot create temporary file");
@@ -154,117 +321,68 @@ static void function_read (GtsObject ** o, GtsFile * fp)
 	     "#include <gfs.h>\n"
 	     "static double Dirichlet = 1.;\n"
 	     "static double Neumann = 0.;\n"
-	     "double f (FttCell * cell, double x, double y, double z, double t) {\n"
-	     "  double ",
+	     "double f (FttCell * cell, double x, double y, double z, double t) {\n",
 	     fin);
       v = domain->variables;
-      fprintf (fin, "%s", v->name);
-      while ((v = v->next)) {
-	if (v->name)
-	  fprintf (fin, ", %s", v->name);
-      }
-      fputs (";\n  if (cell) {\n", fin);
-      v = domain->variables;
       while (v) {
-	if (v->name)
-	  fprintf (fin, "    %s = GFS_VARIABLE (cell, %d);\n", v->name, v->i);
+	if (v->name && find_identifier (f->expr->str, v->name))
+	  lv = g_slist_prepend (lv, v);
 	v = v->next;
       }
-      fprintf (fin, "  }\n#line %d \"GfsFunction\"\n", fp->line);
-
-      if (type == '(' || type == GTS_STRING) {
-	f->expr = g_string_new (fp->token->str);
-	if (type == '(' || fp->next_token != '\0') {
-	  gint c, scope = type == '(' ? 1 : 0;
-	  if (fp->next_token != '\0')
-	    g_string_append_c (f->expr, fp->next_token);
-	  c = gts_file_getc (fp);
-	  while (c != EOF && (scope > 0 || (c != ' ' && c != '\n'))) {
-	    if (c == '(') scope++;
-	    if (c == ')') scope--;
-	    g_string_append_c (f->expr, c);
-	    c = gts_file_getc (fp);
-	  }
-	}
-	fprintf (fin, "return %s;\n", f->expr->str);
-	fputs ("}\n", fin);
-	fclose (fin);
+      dv = gfs_derived_variable;
+      while (dv->name) {
+	if (find_identifier (f->expr->str, dv->name))
+	  ldv = g_slist_prepend (ldv, GUINT_TO_POINTER (n));
+	dv++; n++;
       }
-      else {
-	guint scope;
+      if (lv || ldv) {
+	GSList * i = lv;
 
-	f->expr = g_string_new ("{");
-	scope = fp->scope_max;
-	c = gts_file_getc (fp);
-	while (c != EOF && fp->scope > scope) {
-	  fputc (c, fin);
-	  g_string_append_c (f->expr, c);
-	  c = gts_file_getc (fp);
+	while (i) {
+	  GfsVariable * v = i->data;
+	  fprintf (fin, "  double %s;\n", v->name);
+	  i = i->next;
+	}
+	i = ldv;
+	while (i) {
+	  guint n = GPOINTER_TO_UINT (i->data);
+	  fprintf (fin, "  double %s;\n", gfs_derived_variable[n].name);
+	  i = i->next;
 	}
-	fputs ("}\n", fin);
-	g_string_append_c (f->expr, '}');
-	fclose (fin);      
-	if (fp->scope != scope) {
-	  gts_file_error (fp, "parse error");
-	  close (find);
-	  remove (finname);
-	  return;
+	fputs ("  if (cell) {\n", fin);
+	i = lv;
+	while (i) {
+	  GfsVariable * v = i->data;
+	  fprintf (fin, "    %s = GFS_VARIABLE (cell, %d);\n", v->name, v->i);
+	  i = i->next;
+	}
+	g_slist_free (lv);
+	i = ldv;
+	while (i) {
+	  guint n = GPOINTER_TO_UINT (i->data);
+	  fprintf (fin, "    %s = (* gfs_derived_variable[%d].func) (cell);\n", 
+		   gfs_derived_variable[n].name, n);
+	  i = i->next;
 	}
+	g_slist_free (ldv);
+	fputs ("  }\n", fin);
       }
+      fprintf (fin, "#line %d \"GfsFunction\"\n", fp->line);
 
-      foutd = mkstemp (foutname);
-      ferrd = mkstemp (ferrname);
-      ftmpd = mkstemp (ftmpname);
-      if (foutd < 0 || ferrd < 0 || ftmpd < 0) {
-	gts_file_error (fp, "cannot create temporary file");
-	return;
-      }
-      cc = g_strjoin (" ",
-		      cccommand, ftmpname, 
-		      "-o", foutname,
-		      "`awk '{"
-                      "   if ($1 == \"#\" && $2 == \"link\") {"
-		      "     for (i = 3; i <= NF; i++) printf (\"%s \", $i);"
-		      "     print \"\" > \"/dev/stderr\";"
-                      "   }"
-                      "   else if ($1 == \"#link\") {"
-		      "     for (i = 2; i <= NF; i++) printf (\"%s \", $i);"
-		      "     print \"\" > \"/dev/stderr\";"
-		      "   } else print $0 > \"/dev/stderr\";"
-		      "}' <", finname, "2>", ftmpname, "` 2>",
-		      ferrname, NULL);
-      status = system (cc);
-      g_free (cc);
+      if (isexpr)
+	fprintf (fin, "return %s;\n}\n", f->expr->str);
+      else
+	fprintf (fin, "%s\n}\n", f->expr->str);
+      fclose (fin);
       close (find);
+
+      status = compile (fp, f, finname);
       remove (finname);
-      close (ftmpd);
-      remove (ftmpname);
-      if (WIFSIGNALED (status) && (WTERMSIG (status) == SIGINT || WTERMSIG (status) == SIGQUIT)) {
-	close (foutd);
-	remove (foutname);
-	close (ferrd);
-	remove (ferrname);
-	exit (0);
-      }
-      if (status == -1 || WEXITSTATUS (status) != 0) {
-	GString * msg = g_string_new ("");
-	FILE * ferr = fdopen (ferrd, "r");
-
-	while ((c = fgetc (ferr)) != EOF)
-	  g_string_append_c (msg, c);
-	fclose (ferr);
-	gts_file_error (fp, "error compiling expression\n%s", msg->str);
-	g_string_free (msg, TRUE);
-	close (foutd);
-	remove (foutname);
-	remove (ferrname);
-	return;
+      switch (status) {
+      case SIGQUIT: exit (0);
+      case SIGABRT: return;
       }
-      load_module (f, fp, foutname);
-      close (foutd);
-      remove (foutname);
-      close (ferrd);
-      remove (ferrname);
+
       if ((type == '(' || type == GTS_STRING) && fp->next_token != '\0')
       	gts_file_next_token (fp);
     }
diff --git a/src/utils.h b/src/utils.h
index 81af0a2..e23325c 100644
--- a/src/utils.h
+++ b/src/utils.h
@@ -29,6 +29,17 @@ extern "C" {
 
 #define GFS_DOUBLE_TO_POINTER(d)     (*((gpointer *) &(d)))
 
+gboolean gfs_char_in_string (char c, const char * s);
+
+/* Derived variables */
+
+typedef struct {
+  gchar * name;
+  gdouble (* func) (FttCell *);
+} GfsDerivedVariable;
+
+GTS_C_VAR GfsDerivedVariable gfs_derived_variable[];
+
 /* GfsFunction: Header */
 
 typedef struct _GfsFunction         GfsFunction;

-- 
Gerris Flow Solver



More information about the debian-science-commits mailing list