Changeset 2671 for vendors/AGRIF/current/LIB/SubLoopCreation.c

Timestamp:

2011-03-08T15:08:49+01:00 (13 years ago)

Author:

rblod

Message:

Load working_directory into vendors/AGRIF/current.

File:

• vendors/AGRIF/current/LIB/SubLoopCreation.c (modified) (21 diffs)

vendors/AGRIF/current/LIB/SubLoopCreation.c

@@ -61 +61 @@
       /* we should add the use agrif_uti l if it is necessary                 */
       WriteHeadofSubroutineLoop();
-      WriteUsemoduleDeclaration();
+      WriteUsemoduleDeclaration(subroutinename);
       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
                                                        "      IMPLICIT NONE\n");
@@ -69 +69 @@
       /*    from pointer) in the new subroutine                               */
       if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n");
+
       if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration();
       if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n");
@@ -95 +96 @@
    {
       AddUseAgrifUtil_0(fortranout);
-      WriteUsemoduleDeclaration();
+      WriteUsemoduleDeclaration(subroutinename);
       WriteIncludeDeclaration();
       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
@@ -103 +104 @@
       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n");
       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1);
+      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");      
       WriteArgumentDeclaration_beforecall();
 /*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout);
@@ -127 +129 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop(FILE *outputfile)
+void WriteVariablelist_subloop(FILE *outputfile,char *ligne)
 {
    listvar *parcours;
-   char ligne[LONG_C];
    int compteur;
 
@@ -146 +147 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 0 )
-         {
-            strcpy(ligne,"");
-         }
-         else
-         {
-            if ( compteur == 0 ) strcpy(ligne,"");
+         if ( didvariableadded == 1 )
+         {
             strcat(ligne,",");
          }
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-         compteur = compteur + 1;
-         if ( compteur == 3 )
-         {
-            if ( retour77 == 0 )
-            {
-               strcat(ligne," &");
-               fprintf(outputfile,"\n      %s",ligne);
-            }
-            else fprintf(outputfile,"\n     & %s",ligne);
-            compteur = 0;
-         }
       }
       parcours = parcours -> suiv;
@@ -176 +161 @@
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
       {
-         if ( didvariableadded == 0 )
-         {
-            strcpy(ligne,"");
-         }
-         else
-         {
-            if ( compteur == 0 ) strcpy(ligne,"");
+         if ( didvariableadded == 1 )
+         {
             strcat(ligne,",");
          }
          strcat(ligne,parcours->var->v_nomvar);
          didvariableadded = 1;
-         compteur = compteur + 1;
-         if ( compteur == 3 )
-         {
-            if ( retour77 == 0 )
-            {
-               strcat(ligne," &");
-               fprintf(outputfile,"\n      %s",ligne);
-            }
-            else fprintf(outputfile,"\n     & %s",ligne);
-            compteur = 0;
-         }
       }
       parcours = parcours -> suiv;
-   }
-   if ( compteur != 3 && compteur != 0 )
-   {
-      if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne);
-      else fprintf(outputfile,"\n     & %s ",ligne);
    }
    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n");
@@ -224 +188 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Call(FILE *outputfile)
+void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne)
 {
    listvar *parcours;
-   char ligne[LONG_40M];
    char ligne2[10];
    int i;
    int compteur ;
 
-   strcpy(ligne,"");
-   
    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n");
    parcours = List_UsedInSubroutine_Var;
@@ -243 +204 @@
       /*    in the output file                                                */
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
-          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      &&
-           parcours->var->v_pointerdeclare == 0
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
          )
       {
-         if ( didvariableadded == 0 )
-         {
-            if ( retour77 == 1 ) strcpy(ligne,"\n     & ");
-            else strcpy(ligne,"\n      ");
-         }
-         else
-         {
-            if ( compteur == 0 )
-            {
-               if ( retour77 == 1 ) strcpy(ligne,"\n     & ");
-               else strcpy(ligne,"\n      ");
-            }
+         if ( didvariableadded == 1 )
+         {
             strcat(ligne," , ");
          }
@@ -266 +216 @@
          /* the name of the variable                                          */
          if (  SubloopScalar != 0 &&
-               (IsVarAllocatable_0(parcours->var->v_nomvar) == 0 &&
-               parcours->var->v_pointerdeclare == 0 ) &&
+               (
+               (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) &&
                parcours->var->v_nbdim != 0 )
          {
@@ -306 +256 @@
    }
    
-   Save_Length(ligne,41);
-   tofich(outputfile,ligne,0);
+//   Save_Length(ligne,41);
+//   tofich(outputfile,ligne,0);
    /* Now we should replace the last ", &" by " &"                            */
 /*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
@@ -330 +280 @@
 /*                                                                            */
 /******************************************************************************/
-void WriteVariablelist_subloop_Def(FILE *outputfile)
+void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne)
 {
    listvar *parcours;
 /*   char ligne[LONG_40M];*/
-   char *ligne;
    int compteur;
 
-/*   strcpy(ligne," ");*/
-
-   ligne=(char *)malloc(LONG_40M*sizeof(char));
-   
    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n");
    parcours = List_UsedInSubroutine_Var;
@@ -350 +295 @@
       /*    in the output file                                                */
       if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
-          (parcours->var->v_allocatable == 0  || !strcasecmp(parcours->var->v_typevar,"type"))      &&
-           parcours->var->v_pointerdeclare == 0
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
          )
       {
-         if ( didvariableadded == 0 )
-         {
-            if ( retour77 == 1 ) strcpy(ligne,"\n     &");
-            else strcpy(ligne,"\n      ");
-         }
-         else
-         {
-            if ( compteur == 0 )
-            {
-               if ( retour77 == 1 ) strcpy(ligne,"\n     & ");
-               else strcpy(ligne,"\n      ");
-            }
+         if ( didvariableadded == 1 )
+         {
             strcat(ligne,",");
          }
          strcat(ligne,parcours->var->v_nomvar);
-         compteur = compteur + 1;
          didvariableadded = 1;
-/*         if ( compteur == 3 )
-         {
-            if ( retour77 == 0 )
-            {
-               strcat(ligne," &");
-               fprintf(outputfile,"\n      %s",ligne);
-            }
-            else fprintf(outputfile,"\n     & %s",ligne);
-            compteur = 0;
-         }*/
       }
       parcours = parcours -> suiv;
@@ -390 +313 @@
    }*/
    Save_Length(ligne,41);
-   tofich(outputfile,ligne,0);
+ //  tofich(outputfile,ligne,0);
 
    /* Now we should replace the last ", &" by " &"                            */
@@ -396 +319 @@
    if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n");
-   strcpy(ligne,"");
    
-   free(ligne);
 }
 
@@ -419 +340 @@
 void WriteHeadofSubroutineLoop()
 {
-   char ligne[LONG_C];
+   char ligne[LONG_40M];
    FILE * subloop;
 
@@ -428 +349 @@
    subloop = associate(ligne);
    /*                                                                         */
-   if ( retour77 == 0 ) sprintf(ligne,"      subroutine Sub_Loop_%s( &"
-                                                               ,subroutinename);
-   else sprintf(ligne,"      subroutine Sub_Loop_%s( ",subroutinename);
-   fprintf(subloop,ligne);
+   if (isrecursive) 
+   {
+   sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename);
+   }
+   else
+   {
+   sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename);
+   }
    /*                                                                         */
-   WriteVariablelist_subloop(subloop);
-   WriteVariablelist_subloop_Def(subloop);
+   WriteVariablelist_subloop(subloop,ligne);
+   WriteVariablelist_subloop_Def(subloop,ligne);
    /*                                                                         */
-   sprintf(ligne,")");
-   fprintf(subloop,ligne);
+     strcat(ligne,")");
+   tofich(subloop,ligne,1);
    /* if USE agrif_Uti l should be add                                        */
    AddUseAgrifUtil_0(subloop);
@@ -461 +386 @@
 void closeandcallsubloopandincludeit_0(int suborfun)
 {
-   char ligne[LONG_C];
+   char ligne[LONG_40M];
 
    if ( firstpass == 0 )
    {
+
    if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
    if ( IsTabvarsUseInArgument_0() == 1 )
@@ -484 +410 @@
                      fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
       /* Now we add the call af the new subroutine                            */
-      if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &"
-                                                               ,subroutinename);
-      else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
-      fprintf(fortranout,ligne);
+      sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout);
+      WriteVariablelist_subloop(fortranout,ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout);
+      WriteVariablelist_subloop_Call(fortranout,ligne);
       /* Close the parenthesis of the new subroutine called                   */
-      sprintf(ligne,")");
-      fprintf(fortranout,ligne);
+       strcat(ligne,")");
+      
+      tofich(fortranout,ligne,1);
+
       /* We should close the original subroutine                              */
       if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s"
@@ -520 +445 @@
 void closeandcallsubloop_contains_0()
 {
-   char ligne[LONG_C];
+   char ligne[LONG_40M];
 
    if ( firstpass == 0 )
@@ -548 +473 @@
       fprintf(fortranout,ligne);
       /* Write the list of the local variables used in this new subroutine    */
-      WriteVariablelist_subloop(fortranout);
+      WriteVariablelist_subloop(fortranout,ligne);
       /* Write the list of the global tables used in this new subroutine      */
       /*    in doloop                                                         */
-      WriteVariablelist_subloop_Call(fortranout);
+      WriteVariablelist_subloop_Call(fortranout,ligne);
       /* Close the parenthesis of the new subroutine called                   */
       sprintf(ligne,")");