Added FORTRAN_COMMON_NAME which maps the name of a common block.

Tom


git-svn-id: http://svn.cactuscode.org/flesh/trunk@113 17b73243-c579-4c4c-a9d2-2d5706c11dac

1 files changed, 90 insertions, 27 deletions

diff --git a/lib/make/configure.pl b/lib/make/configure.pl
index f1b59804..3836709c 100755
--- a/lib/make/configure.pl
+++ b/lib/make/configure.pl
@@ -4,7 +4,9 @@
 #  @date      Fri Jan  8 15:06:22 1999
 #  @author    Tom Goodale
 #  @desc 
-#  Prototype configure script for the CCTK
+#  Perl configuration script for the CCTK.
+#  Does extra work it would be awkward to do from within the normal
+#  autoconf stuff (or at least that I'm too lazy to do 8-)
 #  @enddesc 
 #@@*/
 
@@ -23,7 +25,10 @@ open(OUT, ">fname_test.f") || die "Cannot open fname_test.f\n";
 print OUT <<EOT;
       subroutine test_name(a)
       integer a
+      real b
+      common /test_common/b
       a = 1
+      b = 2.0
       return
       end
 
@@ -80,6 +85,38 @@ while(<IN>)
 	    $n_underscores = 2;
 	}
     }
+
+    if($line =~ m:(TEST_COMMON)(_*):i)
+    {
+	$common_name = $1;
+	$common_underscores = $2;
+
+	if($common_name =~ m:TEST_COMMON:)
+	{
+#	    print "Common: Uppercase - ";
+	    $common_case = 1;
+	}
+	if($common_name =~ m:test_common:)
+	{
+#	    print "Common: Lowercase - ";
+	    $common_case = 0;
+	}
+	if($common_underscores eq "")
+	{
+#	    print " No trailing underscore\n";
+	    $common_n_underscores = 0;
+	}
+	if($common_underscores eq "_")
+	{
+#	    print "One trailing underscore\n";
+	    $common_n_underscores = 1;
+	}
+	if($underscores eq "__")
+	{
+#	    print "Two trailing underscores\n";
+	    $common_n_underscores = 2;
+	}
+    }
     
 }
 
@@ -89,33 +126,9 @@ close IN;
 unlink <fname_test.*>;
 
 # Determine the case and number of underscores
-if($n_underscores == 0)
-{
-    $normal_suffix = "";
-    $underscore_suffix = "";
-}
-
-if($n_underscores == 1)
-{
-    $normal_suffix = "_";
-    $underscore_suffix = "_";
-}
-
-if($n_underscores == 2)
-{
-    $normal_suffix = "_";
-    $underscore_suffix = "__";
-}
-
-if($case = 0)
-{
-    $case_prefix = "\\L";
-}
-if($case = 1)
-{
-    $case_prefix = "\\L";
-}
+($underscore_suffix, $normal_suffix, $case_prefix) = &determine_transformation($n_underscores, $case);
 
+($common_underscore_suffix, $common_normal_suffix, $common_case_prefix) = &determine_transformation($common_n_underscores, $common_case);
 
 # Create the perl module to map the fortran names.
 open(OUT, ">$tmphome/fortran_name.pl") || die "Cannot create fortran_name.pl\n";
@@ -141,11 +154,61 @@ sub fortran_name
     return \$new_name;
 }
 
+sub fortran_common_name
+{
+    local(\$old_name) = \@_;
+    local(\$new_name);
+
+    \$new_name = "$common_case_prefix\$old_name\\E";
+
+    if(\$new_name =~ m:_: ) 
+    {
+	\$new_name = \$new_name."$common_underscore_suffix";
+    }
+    else
+    {
+	\$new_name = \$new_name."$common_normal_suffix";
+    }
+
+    return \$new_name;
+}
+
 1;
     
 EOT
 
 close OUT;
 
+sub determine_transformation
+{
+  local ($n_underscores, $case) = @_;
+
+  if($n_underscores == 0)
+  {
+    $normal_suffix = "";
+    $underscore_suffix = "";
+  }
+
+  if($n_underscores == 1)
+  {
+    $normal_suffix = "_";
+    $underscore_suffix = "_";
+  }
+
+  if($n_underscores == 2)
+  {
+    $normal_suffix = "_";
+    $underscore_suffix = "__";
+  }
 
+  if($case = 0)
+  {
+    $case_prefix = "\\L";
+  }
+  if($case = 1)
+  {
+    $case_prefix = "\\L";
+  }
 
+  return ($underscore_suffix, $normal_suffix, $case_prefix);
+}