Creates all c and fortran structures.

        c subroutines to initialise the structure.
        fortran subroutines to initialise the structure

Split config_parser into three parts - the fortran bit, the c bit,
and the non-language-specific stuff.


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

1 files changed, 339 insertions, 0 deletions

diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl
new file mode 100644
index 00000000..329b4eaa
--- /dev/null
+++ b/lib/sbin/create_fortran_stuff.pl
@@ -0,0 +1,339 @@
+#! /usr/bin/perl
+
+sub create_fortran_module_file
+{
+  local($n_implementations, @indata) = @_;
+  local(@implementations);
+  local(%parameter_database);
+  local(@module_file);
+  local($line);
+  local(@data);
+
+  @implementations = @indata[0..$n_implementations-1];
+  %parameter_database = @indata[$n_implementations..$#indata];
+
+  push(@module_file, &create_cctk_param_types_module($n_implementations, @indata));
+
+
+  $line = "";
+  push(@module_file, $line);
+
+  foreach $implementation (@implementations)
+  {
+    $line = "";
+    push(@module_file, $line);
+
+    push(@module_file, &create_fortran_param_module($implementation, %parameter_database));
+
+    $line = "";
+    push(@module_file, $line);
+  }
+
+  $line = "SUBROUTINE CCTK_PARAMS_INIT(cctk_parameters)";
+  push(@module_file, $line);
+
+
+  $line = "  USE CCTK_PARAM_TYPES";
+  push(@module_file, $line);
+
+  $line = "  TYPE (CCTK_PARAMS) :: cctk_parameters";
+  push(@module_file, $line);
+  
+
+  foreach $implementation (@implementations)
+  {
+    $line = "";
+    push(@module_file, $line);
+
+    $line = "  CALL CCTK_\U$implementation\E_PARAMS_INIT(cctk_parameters)";
+    push(@module_file, $line);
+
+    $line = "";
+    push(@module_file, $line);
+  }
+
+  $line = "END SUBROUTINE CCTK_PARAMS_INIT";
+  push(@module_file, $line);
+
+  $line = "";
+  push(@module_file, $line);
+  
+  foreach $implementation (@implementations)
+  {
+    $line = "";
+    push(@module_file, $line);
+
+    push(@module_file, &create_fortran_param_init_subroutine($implementation, %parameter_database));
+
+    $line = "";
+    push(@module_file, $line);
+  }
+  
+  return @module_file;
+
+}
+    
+
+sub create_fortran_param_init_subroutine
+{
+  local($implementation,%parameter_database) = @_;
+  local(@subroutine);
+  local($line);
+  local($friend, $block, $parameter);
+  local(%public_parameters);
+
+  $line = "SUBROUTINE CCTK_\U$implementation\E_PARAMS_INIT(cctk_parameters)";
+  push(@subroutine, $line);
+
+  $line = "  USE CCTK_PARAM_TYPES";
+  push(@subroutine, $line);
+
+  $line = "  USE CCTK_\U$implementation\E_PARAMS";
+  push(@subroutine, $line);
+  
+  $line = "  TYPE (CCTK_PARAMS) :: cctk_parameters";
+  push(@subroutine, $line);
+  
+
+  # Deal with variables defined in this thorn. 
+  foreach $block ("PUBLIC", "PRIVATE", "PROTECTED")
+  {
+    $entry = "\U$implementation $block\E variables";
+    foreach $parameter (split(/ /, $parameter_database{$entry}))
+    {
+      
+      $line = "  $parameter" . 
+	" = cctk_parameters%" . "\U$implementation\E%\L$parameter\E";
+      push(@subroutine, $line);
+    }
+  }
+
+  # Deal with friend variables. 
+  foreach $friend (split(/ /,$parameter_database{"\U$implementation\E FRIEND implementations"}))
+  {
+    $other_implementation = "\U$friend\E";
+    $entry = "\U$implementation FRIEND $friend\E variables";
+    foreach $parameter (split(/ /, $parameter_database{$entry}))
+    {
+      $line = "  $parameter" . 
+	" = cctk_parameters%" . "\U$other_implementation\E%\L$parameter\E";
+      push(@subroutine, $line);
+    }
+  }	  
+  # Deal with all public parameters not declared in this implementation.
+  %public_parameters = &get_public_parameters(%parameter_database);
+
+  foreach $parameter (keys %public_parameters)
+  {
+    $other_implementation = "\U$public_parameters{$parameter}\E";
+    if($other_implementation ne "\U$implementation\E")
+    {
+      $line = "  $parameter" . 
+	" = cctk_parameters%" . "\U$other_implementation\E%\L$parameter\E";
+      push(@subroutine, $line);
+    }
+  }
+  
+  $line = "END SUBROUTINE CCTK_\U$implementation\E_PARAMS_INIT";
+  push(@subroutine, $line);
+
+  return @subroutine;
+}
+
+
+
+sub create_fortran_param_module
+{
+  local($implementation,%parameter_database) = @_;
+  local(@declarations);
+  local(@module);
+  local($line);
+
+  $line = "MODULE CCTK_\U$implementation\E_PARAMS";
+  push(@module, $line);
+
+  @declarations = &create_fortran_parameter_declarations($implementation,%parameter_database);
+  
+  foreach $line (@declarations)
+  {
+    $line = "  " . $line;
+    push(@module, $line);
+  }
+  
+  $line = "END MODULE CCTK_\U$implementation\E_PARAMS";
+  push(@module, $line);
+
+  return @module;
+}
+    
+
+sub create_cctk_param_types_module
+{
+  local(@module);
+
+  push(@module, "MODULE CCTK_PARAM_TYPES");
+  push(@module, &create_fortran_parameter_structures(@_));
+  push(@module, "END MODULE CCTK_PARAM_TYPES");
+
+  return @module;
+}
+
+
+
+sub create_fortran_parameter_declarations
+{
+  local($implementation,%parameter_database) = @_;
+  local(@declarations);
+  local($line);
+  local($type, $type_string, $friend, $block, $parameter);
+  local(%public_parameters);
+
+  # Deal with variables defined in this thorn. 
+  foreach $block ("PUBLIC", "PRIVATE", "PROTECTED")
+  {
+    $entry = "\U$implementation $block\E variables";
+    foreach $parameter (split(/ /, $parameter_database{$entry}))
+    {
+      $type = @parameter_database{"\U$implementation $parameter\E type"};
+      
+      $type_string = &get_fortran_type_string($type);
+      
+      $line = $type_string .", save :: " .$parameter ;
+      push(@declarations, $line);
+    }
+  }
+
+  # Deal with friend variables. 
+  foreach $friend (split(/ /,$parameter_database{"\U$implementation\E FRIEND implementations"}))
+  {
+    $other_implementation = "\U$friend\E";
+    $entry = "\U$implementation FRIEND $friend\E variables";
+    foreach $parameter (split(/ /, $parameter_database{$entry}))
+    {
+      $type = @parameter_database{"\U$other_implementation $parameter\E type"};
+      
+      $type_string = &get_fortran_type_string($type);
+      
+      $line = $type_string .", save :: " .$parameter ;
+      push(@declarations, $line);
+    }
+  }
+	  
+  # Deal with all public parameters not declared in this implementation.
+  %public_parameters = &get_public_parameters(%parameter_database);
+
+  foreach $parameter (keys %public_parameters)
+  {
+    $other_implementation = "\U$public_parameters{$parameter}\E";
+
+    if($other_implementation ne "\U$implementation\E")
+    {
+      $type = @parameter_database{"\U$other_implementation $parameter\E type"};
+    
+      $type_string = &get_fortran_type_string($type);
+    
+      $line = $type_string .", save :: " .$parameter ;
+      push(@declarations, $line);
+    }
+  }
+  return @declarations;
+}
+
+
+sub create_fortran_parameter_structures
+{
+  local($n_implementations, @indata) = @_;
+  local(@implementations);
+  local(%parameter_database);
+  local(@structures);
+  local(@data);
+  local($line, $entry, $thorn, $parameter, $type_string);
+
+  @implementations = @indata[0..$n_implementations-1];
+  %parameter_database = @indata[$n_implementations..$#indata];
+
+  # Create types for each implementation
+  foreach $implementation (@implementations)
+  {
+    push(@structures, &create_fortran_parameter_type_declaration($implementation, %parameter_database));
+    push(@strucures,"");
+  }
+
+  $line = "TYPE CCTK_PARAMS ";
+  push(@structures, $line);
+
+  foreach $implementation (@implementations)
+  {
+    $line = "TYPE (CCTK_\U$implementation\E_PARAM_TYPE) :: \U$implementation\E";
+    push(@structures, $line);
+  }
+
+  $line = "END TYPE CCTK_PARAMS";
+  push(@structures, $line);
+  
+  return @structures;
+}
+
+sub create_fortran_parameter_type_declaration
+{
+  local($implementation,%parameter_database) = @_;
+  local(@type_declaration);
+  local($line);
+  local($type, $type_string, $friend, $block, $parameter);
+  
+  $line = "TYPE CCTK_\U$implementation\E_PARAM_TYPE";
+  push(@type_declaration, $line);
+ 
+  # Deal with variables defined in this thorn. 
+  foreach $block ("PUBLIC", "PRIVATE", "PROTECTED")
+  {
+    $entry = "\U$implementation $block\E variables";
+    foreach $parameter (split(/ /, $parameter_database{$entry}))
+    {
+      $type = @parameter_database{"\U$implementation $parameter\E type"};
+      
+      $type_string = &get_fortran_type_string($type);
+      
+      $line = $type_string ." :: " .$parameter ;
+      push(@type_declaration, $line);
+    }
+  }
+
+
+  $line = "END TYPE CCTK_\U$implementation\E_PARAM_TYPE";
+  push(@type_declaration, $line);
+
+  return @type_declaration;
+}
+
+sub get_fortran_type_string
+{
+  local($type) = @_;
+  local($type_string);
+
+
+  if($type eq "KEYWORD" ||
+     $type eq "STRING"  ||
+     $type eq "SENTENCE")
+  {
+    $type_string = "CACTUS_STRING ";
+  }
+  elsif($type eq "LOGICAL" ||
+	$type eq "INTEGER")
+  {
+    $type_string = "INTEGER ";
+  }
+  elsif($type eq "REAL")
+  {
+    $type_string = "REAL ";
+  }
+  else
+  {
+    die("Unknown parameter type '$type'");
+  }
+
+  return $type_string;
+
+}
+
+1;