Changeset 1200 for trunk/AGRIF/LIB/UtilFortran.c

Timestamp:

2008-09-24T15:05:20+02:00 (16 years ago)

Author:

rblod

Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

File:

• trunk/AGRIF/LIB/UtilFortran.c (modified) (8 diffs)

trunk/AGRIF/LIB/UtilFortran.c

@@ -167 +167 @@
 /* This subroutine is to know if a variable is global                         */
 /******************************************************************************/
-void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout)
+void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse)
 {
   int Globalite;
@@ -175 +175 @@
   listvar *newvar2;
   int out;
+  char truename[LONG_C];  
 
   Globalite = 1;
@@ -181 +182 @@
   tempo = Readthedependfile(module,tempo);
   newvar = listin;
+
   while ( newvar )
   {
+     if (!strcmp(newvar->c_namepointedvar,"")) {
+       strcpy(truename,newvar->c_namevar);
+     }
+     else
+     {
+       strcpy(truename,newvar->c_namepointedvar);
+     }
+     
      out = 0;
      newvar2 = tempo;
      while ( newvar2 && out == 0 )
      {
-        if ( !strcasecmp(newvar2->var->v_nomvar,newvar->c_namevar) ) out = 1;
+        if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1;
         else newvar2 = newvar2 ->suiv;
      }
@@ -213 +223 @@
   if ( Globalite == 0 || !newvar)
   {
-     pos_end = setposcur();
-     RemoveWordSET_0(fileout,pos_curuse,
-                                pos_end-pos_curuse);
+     pos_end = setposcurname(fileout);
+     RemoveWordSET_0(fileout,oldposcuruse,
+                                pos_end-oldposcuruse);
+                                  
      newvar = listin;
      while ( newvar )
@@ -234 +245 @@
 }
 
-void Remove_Word_end_module_0()
-{
-   if ( firstpass == 0 )
-   {
-      RemoveWordCUR_0(fortranout,(long)(-strlen(curmodulename)-12),
-                                         strlen(curmodulename)+11);
+void Remove_Word_end_module_0(int modulenamelength)
+{
+   if ( firstpass == 0 )
+   {
+      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12),
+                                         modulenamelength+11);
    }
 }
@@ -470 +481 @@
          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
          {
-            writevardeclaration(parcours,module_declar,0);
+            writevardeclaration(parcours,module_declar,0,1);
          }
          parcours = parcours -> suiv;
       }
+   }
+}
+
+void Write_GlobalType_Declaration_0()
+{
+   listvar *parcours;
+   int out = 0;
+   int headtypewritten = 0;
+   char ligne[LONGNOM];
+   int changeval;
+
+   if ( firstpass == 0 )
+   {
+      parcours = List_Global_Var;
+      while( parcours )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+         {
+           if (!strcasecmp(parcours->var->v_typevar,"type"))
+           {
+            out = 1;
+            if (headtypewritten == 0)
+              {
+                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename);
+                tofich(module_declar,ligne,1);
+                headtypewritten = 1;
+              }
+            changeval = 0;
+            if (parcours->var->v_allocatable == 1)
+             {
+               changeval = 1;
+               parcours->var->v_allocatable = 0;
+               parcours->var->v_pointerdeclare = 1;
+             }
+            writevardeclaration(parcours,module_declar,0,0);
+            if (changeval == 1)
+              {
+               parcours->var->v_allocatable = 1;
+               parcours->var->v_pointerdeclare = 0;
+              }
+            }
+         }
+         parcours = parcours -> suiv;
+      }
+      if (out == 1)
+        {
+                sprintf(ligne,"END TYPE Agrif_%s",curmodulename);
+                tofich(module_declar,ligne,1);
+                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 
+                tofich(module_declar,ligne,1);
+        }
    }
 }
@@ -488 +550 @@
          if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
          {
-            writevardeclaration(parcours,fortranout,0);
+            writevardeclaration(parcours,fortranout,0,1);
          }
          parcours = parcours -> suiv;
@@ -648 +710 @@
 }
 
+/******************************************************************************/
+/*                          varistyped_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varistyped_0(char *ident)
+{
+   listvar *parcours;
+   int out;
+
+   out =0;
+   if ( firstpass == 0 )
+   {
+      parcours = List_Global_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
+             {
+             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
+             }
+         parcours = parcours->suiv;
+      }
+   }
+   return out;
+}
+
 
 /******************************************************************************/