Changeset 8139 for branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c

Timestamp:

2017-06-05T12:05:17+02:00 (7 years ago)

Author:

timgraham

Message:

Updates to conv library as received from Laurent - required for vertical refinement

File:

• branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c (modified) (25 diffs)

branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c

@@ -66 +66 @@
   /* We should give the precision of the variable if it has been given        */
   precision_given = 0;
+  
   if ( strcasecmp(v->v_precision,"") )
   {
@@ -128 +129 @@
     {
         strcat(line," = ");
-        strcat(line, v->v_initialvalue);
+        strcat(line, v->v_initialvalue->n_name);
     }
     Save_Length(line, 45);
@@ -173 +174 @@
     {
         strcat(ligne," = ");
-        strcat(ligne,v->v_initialvalue);
+        strcat(ligne,v->v_initialvalue->n_name);
     }
     Save_Length(ligne,45);
@@ -206 +207 @@
         WriteTableDeclaration(v, ligne, value);
 
-     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     if ( v->v_VariableIsParameter != 1 && v->v_initialvalue)
      {
         strcat(ligne," = ");
-        strcat(ligne,v->v_initialvalue);
+        strcat(ligne,v->v_initialvalue->n_name);
      }
      tofich(filecommon, ligne, 1);
@@ -241 +242 @@
     while ( parcours )
     {
+    if (!strcmp(parcours->var->v_typevar, ""))
+    {
+     /* Default type*/
+          if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                         strcpy(parcours->var->v_typevar,"REAL");
+          else strcpy(parcours->var->v_typevar,"INTEGER");
+     }
         if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
               strcasecmp(parcours->var->v_typevar, "") )
@@ -261 +269 @@
         if ( !strcasecmp(v->v_subroutinename, subroutinename)   &&
              (v->v_save == 0)                                   &&
-             (v->v_pointerdeclare == 0)                         &&
              (v->v_VariableIsParameter == 0)                    &&
              (v->v_common == 0) )
@@ -285 +292 @@
     listvar *parcours;
     variable *v;
-    char ligne[LONG_M];
-
+    char *ligne;
+    size_t line_length;
+    int res;
+    int global_check;
+
+    ligne = (char*) calloc(LONG_M, sizeof(char));
+    line_length = LONG_M;
+    
+    global_check = 0;
+   
+   
     fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename);
 
@@ -303 +319 @@
             position++;
             WriteVarDeclaration(v, fortran_out, 0, 1);
-            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
-                                    v, v->v_subroutinename, neededparameter, subroutinename);
+            res = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
+                                    v, v->v_subroutinename, &neededparameter, subroutinename, global_check);
             parcours = List_SubroutineArgument_Var;
         }
         else parcours = parcours -> suiv;
     }
-    Save_Length(ligne,45);
 
     // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module
@@ -317 +332 @@
         if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename);
         else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename);
-        WriteVariablelist_subloop(ligne);
-        WriteVariablelist_subloop_Def(ligne);
+        WriteVariablelist_subloop(&ligne,&line_length);
+        WriteVariablelist_subloop_Def(&ligne,&line_length);
         strcat(ligne,")");
-        Save_Length(ligne,45);
+
         tofich(paramtoamr,ligne,1);
 
@@ -353 +368 @@
 
     parcours = List_SubroutineArgument_Var;
+    
     while ( parcours )
     {
@@ -399 +415 @@
 /*                                                                            */
 /******************************************************************************/
-listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+int writedeclarationintoamr (listvar * deb_common, FILE *fileout,
                               variable *var , const char *commonname,
-                           listnom *neededparameter, const char *name_common)
+                           listnom **neededparameter, const char *name_common, int global_check)
 {
   listvar *newvar;
@@ -410 +426 @@
   int writeit;
   listnom *parcours;
+  listname *parcours_name_array;
+  int res;
+  
+  res = 0;
 
   /* we should list the needed parameter                                      */
+
   if ( !strcasecmp(name_common,commonname) )
-     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter);
+     {
+     *neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,*neededparameter);
+     parcours_name_array = var->v_initialvalue_array;
+     while (parcours_name_array)
+     {
+     *neededparameter = DecomposeTheNameinlistnom(parcours_name_array->n_name,*neededparameter);
+     parcours_name_array=parcours_name_array->suiv;
+     }
+     }
+
   /*                                                                          */
-  parcours = neededparameter;
+  parcours = *neededparameter;
+
   while (parcours)
   {
@@ -423 +454 @@
      while ( newvar && out == 0 )
      {
-
-        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
            out=1;
         /* add the name to the list of needed parameter                       */
-           neededparameter = DecomposeTheNameinlistnom(
-                 newvar->var->v_initialvalue,
-                 neededparameter );
+           *neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue->n_name,
+                 *neededparameter );
+        }
+        else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           *neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue->n_name,
+                 *neededparameter );
         }
         else newvar=newvar->suiv;
@@ -437 +475 @@
    }
   /*                                                                          */
-  parcours = neededparameter;
+  parcours = *neededparameter;
+  
   while (parcours)
   {
@@ -444 +483 @@
      while ( newvar && out == 0 )
      {
-        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
         {
            out=1;
         /* add the name to the list of needed parameter                       */
-           neededparameter = DecomposeTheNameinlistnom(
-                 newvar->var->v_initialvalue,
-                 neededparameter );
+           *neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue->n_name,
+                 *neededparameter );
+        }
+        else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           *neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue->n_name,
+                 *neededparameter );
         }
         else newvar=newvar->suiv;
@@ -456 +503 @@
      parcours=parcours->suiv;
    }
-  parcours = neededparameter;
+  parcours = *neededparameter;
   while (parcours)
   {
@@ -463 +510 @@
      while ( newvar && writeit == 0 )
      {
-        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&
+        if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&
             !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename) && parcours->o_val == 0 )
+        {
+           writeit=1;
+           parcours->o_val = 1;
+        }
+        else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&
+            !strcasecmp(var->v_modulename,newvar->var->v_modulename) && parcours->o_val == 0 )
         {
            writeit=1;
@@ -490 +543 @@
            v->v_allocatable = 1;
         }
+        res = 1;
      }
      else
@@ -503 +557 @@
   }
   Save_Length(ligne,45);
-  return neededparameter;
+  return res;
 }
 
@@ -532 +586 @@
      if ( newvar->var->v_nbdim == 0 &&
           !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
-           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
+           (newvar->var->v_pointerdeclare >= 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
      {
         v = newvar->var;
-
         WriteBeginDeclaration(v,ligne,1);
         WriteScalarDeclaration(v,ligne);
@@ -570 +623 @@
 //  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
      if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) &&
-          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )
+          (v->v_pointerdeclare >= 0 || !strcasecmp(v->v_typevar,"type")) )
      {
         changeval = 0;
@@ -596 +649 @@
      newvar = newvar->suiv;
   }
+
   Save_Length(ligne,45);
 }
@@ -619 +673 @@
             if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)
             {
+            
+            /* The type may has not been given if the variable was only declared with dimension */
+
+            if ( !strcasecmp(v->v_typevar,"") )
+            {
+                  if ( IsVariableReal(v->v_nomvar) == 1 )
+                                        strcpy(v->v_typevar,"REAL");
+                  else strcpy(v->v_typevar,"INTEGER");
+                  v->v_catvar = get_cat_var(v);
+             }
+             
                 WriteVarDeclaration(v, fortran_out, 1, 1);
             }
@@ -639 +704 @@
     char ligne[LONG_M];
     char initialvalue[LONG_M];
-
+    listname *parcours_name;
+    
     if (insubroutinedeclare == 1)
     {
@@ -651 +717 @@
             if (out)   break;
 
-            if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+            strcpy(initialvalue,"");
+            parcours_name = parcours->var->v_initialvalue;
+            while (parcours_name)
             {
-                strcpy(initialvalue,parcours->var->v_initialvalue);
+            if (strncasecmp(parcours_name->n_name,"(/",2))
+            {
+                strcat(initialvalue,parcours_name->n_name);
+                if (parcours_name->suiv)
+                {
+                strcat(initialvalue,",");
+                }
             }
             else
             {
-                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
-                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+            printf("A TRAITER DANS REWRITEDATA STATEMETN ");
+            exit(1);
+                strncpy(initialvalue,&parcours_name->n_name[2],strlen(parcours_name->n_name)-4);
+                strcpy(&initialvalue[strlen(parcours_name->n_name)-4],"\0");
+            }
+            parcours_name=parcours_name->suiv;
             }
             sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
             tofich(filout,ligne,1);
-
+            
             parcours = parcours->suiv;
         }