New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 9817 for branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c – NEMO

Ignore:
Timestamp:
2018-06-21T11:58:42+02:00 (6 years ago)
Author:
dancopsey
Message:

Merged in GO6 package branch up to revision 8356.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c

    r9816 r9817  
    4545 
    4646/******************************************************************************/ 
    47 /*                             writeheadnewsub_0                              */ 
    48 /******************************************************************************/ 
    49 /* Firstpass 0                                                                */ 
     47/*                           WriteBeginof_SubLoop                             */ 
     48/******************************************************************************/ 
    5049/* We should write the head of the subroutine sub_loop_<subroutinename>       */ 
    5150/******************************************************************************/ 
    5251/*                                                                            */ 
    5352/******************************************************************************/ 
    54 void writeheadnewsub_0() 
    55 { 
    56    char ligne[LONG_C]; 
    57  
    58    if ( firstpass == 0 && IsTabvarsUseInArgument_0() == 1 ) 
    59    { 
    60       if ( todebug == 1 ) printf("Enter in writeheadnewsub_0\n"); 
     53void WriteBeginof_SubLoop() 
     54{ 
     55   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename); 
     56   if ( IsTabvarsUseInArgument_0() == 1 ) 
     57   { 
     58      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n"); 
    6159      /* we should add the use agrif_uti l if it is necessary                 */ 
    6260      WriteHeadofSubroutineLoop(); 
    6361      WriteUsemoduleDeclaration(subroutinename); 
    64       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    65                                                        "      IMPLICIT NONE\n"); 
    66       WriteIncludeDeclaration(); 
     62      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     63      WriteIncludeDeclaration(fortran_out); 
    6764      /*                                                                      */ 
    6865      /* We should write once the declaration of tables (extract              */ 
    6966      /*    from pointer) in the new subroutine                               */ 
    70       if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n"); 
    71  
    72       if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(); 
    73       if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n"); 
    74  
    75       sprintf(ligne,"\n#include \"ParamFile%s.h\" \n",subroutinename); 
    76       tofich(fortranout,ligne,1); 
    77  
    78       WriteArgumentDeclaration_Sort(); 
    79  
    80       if ( mark == 1 ) fprintf(fortranout,"!!! 222222222222222 \n"); 
    81       writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortranout); 
    82       if ( mark == 1 ) fprintf(fortranout,"!!! 333333333333333 \n"); 
    83       writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,paramout); 
    84       if ( mark == 1 ) fprintf(fortranout,"!!! 444444444444444 \n"); 
    85       /* now we should write the function declaration                         */ 
    86       /*    case if it is the                                                 */ 
    87       WriteFunctionDeclaration(1); 
    88       if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n"); 
    89  
    90 //      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1); 
    91    
    92       if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n"); 
    93       if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n"); 
    94    } 
    95    else if ( firstpass == 0 ) 
    96    { 
    97       AddUseAgrifUtil_0(fortranout); 
     67      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out); 
     68 
     69      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out); 
     70      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out); 
     71      WriteArgumentDeclaration_Sort(fortran_out); 
     72      WriteFunctionDeclaration(fortran_out, 1); 
     73   } 
     74   else 
     75   { 
     76      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n"); 
     77      AddUseAgrifUtil_0(fortran_out); 
    9878      WriteUsemoduleDeclaration(subroutinename); 
    99       WriteIncludeDeclaration(); 
    100       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    101                                                        "      IMPLICIT NONE\n"); 
    102       if ( mark == 1 ) fprintf(fortranout,"!!! aaaaaaaaaaaaaaa \n"); 
    103       WriteLocalParamDeclaration(); 
    104       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n");    
     79      WriteIncludeDeclaration(fortran_out); 
     80      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     81      WriteLocalParamDeclaration(fortran_out); 
    10582      WriteArgumentDeclaration_beforecall(); 
    106       if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n"); 
    107       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 
    108 /*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout); 
    109       writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortranout);*/ 
    110       if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n"); 
    111       if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n"); 
    112 //      WriteSubroutineDeclaration(1); 
    113       if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n"); 
    114    } 
    115 } 
    116  
     83      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1); 
     84/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out); 
     85      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/ 
     86   } 
     87   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n"); 
     88   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename); 
     89} 
    11790 
    11891/******************************************************************************/ 
    … …  
    129102/*                                                                            */ 
    130103/******************************************************************************/ 
    131 void WriteVariablelist_subloop(FILE *outputfile,char *ligne) 
     104void WriteVariablelist_subloop(char *ligne) 
    132105{ 
    133106   listvar *parcours; 
    134    int compteur; 
    135  
    136    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop\n"); 
     107 
     108   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n"); 
    137109   parcours = List_SubroutineArgument_Var; 
    138110   didvariableadded = 0; 
    139    compteur = 0 ; 
    140111 
    141112   while ( parcours ) 
    142113   { 
    143  
    144114      /* if the readed variable is a variable of the subroutine               */ 
    145115      /*    subroutinename we should write the name of this variable          */ 
    … …  
    147117      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    148118      { 
    149          if ( didvariableadded == 1 ) 
    150          { 
    151             strcat(ligne,","); 
    152          } 
     119         if ( didvariableadded == 1 )   strcat(ligne,","); 
    153120         strcat(ligne,parcours->var->v_nomvar); 
    154121         didvariableadded = 1; 
    155             } 
     122      } 
    156123      parcours = parcours -> suiv; 
    157124   } 
    … …  
    161128      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 
    162129      { 
    163          if ( didvariableadded == 1 ) 
    164          { 
    165             strcat(ligne,","); 
    166          } 
     130         if ( didvariableadded == 1 )   strcat(ligne,","); 
    167131         strcat(ligne,parcours->var->v_nomvar); 
    168132         didvariableadded = 1; 
    169             } 
     133      } 
    170134      parcours = parcours -> suiv; 
    171135   } 
    172    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n"); 
     136   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n"); 
    173137} 
    174138 
    … …  
    188152/*                                                                            */ 
    189153/******************************************************************************/ 
    190 void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne) 
     154void WriteVariablelist_subloop_Call(char **ligne, size_t line_length) 
    191155{ 
    192156   listvar *parcours; 
    193    char ligne2[10]; 
     157   char ligne2[LONG_M]; 
    194158   int i; 
    195    int compteur ; 
    196  
    197    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n"); 
     159   size_t cur_length; 
     160 
     161   cur_length = line_length; 
     162 
     163   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n"); 
    198164   parcours = List_UsedInSubroutine_Var; 
    199    compteur = 0 ; 
     165 
    200166   while ( parcours ) 
    201167   { 
    … …  
    207173         ) 
    208174      { 
    209          if ( didvariableadded == 1 ) 
     175         if ( didvariableadded == 1 )   strcat(*ligne,","); 
     176         const char *vres = vargridcurgridtabvars(parcours->var, 0); 
     177         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length ) 
    210178         { 
    211             strcat(ligne," , "); 
     179            cur_length += LONG_M; 
     180            *ligne = realloc( *ligne, cur_length*sizeof(char) ); 
    212181         } 
    213          strcat(ligne,vargridcurgridtabvars(parcours->var,0)); 
     182         strcat(*ligne, vres); 
    214183         /* if it is asked in the call of the conv we should give             */ 
    215184         /* scalar in argument, so we should put (1,1,1) after the            */ 
    … …  
    223192             while ( i <=  parcours->var->v_nbdim ) 
    224193             { 
    225                 if ( i == 1 ) strcat(ligne,"( "); 
     194                if ( i == 1 ) strcat(*ligne,"( "); 
    226195                if ( SubloopScalar == 2 ) 
    227196                { 
    228                    strcat(ligne,":"); 
    229                    if ( i != parcours->var->v_nbdim ) strcat(ligne,","); 
     197                   strcat(*ligne,":"); 
     198                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,","); 
    230199                } 
    231200                else 
    232201                { 
    233                    strcat(ligne," lbound( "); 
    234                    strcat(ligne,vargridcurgridtabvars(parcours->var,0)); 
    235                    strcat(ligne,","); 
    236                    strcpy(ligne2,""); 
    237                    sprintf(ligne2,"%d",i); 
    238                    strcat(ligne,ligne2); 
    239                    if ( i != parcours->var->v_nbdim ) strcat(ligne,"),"); 
     202                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i); 
     203                   strcat(*ligne,ligne2); 
     204                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),"); 
    240205                } 
    241                 if ( i == parcours->var->v_nbdim ) strcat(ligne,"))"); 
     206                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))"); 
    242207                i++; 
    243208             } 
    244209         } 
    245210         didvariableadded = 1; 
    246          compteur = compteur +1 ; 
    247          /*if ( retour77 == 0 ) 
    248          { 
    249             strcat(ligne," &"); 
    250             fprintf(outputfile,"\n"); 
    251          } 
    252          else fprintf(outputfile,"\n     & ");*/ 
    253          /*tofich(outputfile,ligne,0);*/ 
    254211      } 
    255212      parcours = parcours -> suiv; 
    256213   } 
    257     
    258 //   Save_Length(ligne,41); 
    259 //   tofich(outputfile,ligne,0); 
    260    /* Now we should replace the last ", &" by " &"                            */ 
    261 /*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); 
    262    if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    263    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Call\n"); 
     214   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n"); 
    264215} 
    265216 
    … …  
    280231/*                                                                            */ 
    281232/******************************************************************************/ 
    282 void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne) 
     233void WriteVariablelist_subloop_Def(char *ligne) 
    283234{ 
    284235   listvar *parcours; 
    285 /*   char ligne[LONG_40M];*/ 
    286    int compteur; 
    287  
    288    if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n"); 
     236 
     237   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n"); 
    289238   parcours = List_UsedInSubroutine_Var; 
    290    compteur = 0 ; 
     239 
    291240   while ( parcours ) 
    292241   { 
    … …  
    295244      /*    in the output file                                                */ 
    296245      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  && 
    297            (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 
    298          ) 
     246           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) ) 
    299247      { 
    300          if ( didvariableadded == 1 ) 
    301          { 
    302             strcat(ligne,","); 
    303          } 
     248         if ( didvariableadded == 1 )   strcat(ligne,","); 
    304249         strcat(ligne,parcours->var->v_nomvar); 
    305250         didvariableadded = 1; 
    306             } 
     251      } 
    307252      parcours = parcours -> suiv; 
    308253   } 
    309  /*  if ( compteur != 3 && compteur != 0 ) 
    310    { 
    311       if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne); 
    312       else fprintf(outputfile,"\n     & %s",ligne); 
    313    }*/ 
    314254   Save_Length(ligne,41); 
    315  //  tofich(outputfile,ligne,0); 
    316  
    317    /* Now we should replace the last ", &" by " &"                            */ 
    318   /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); 
    319    if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 
    320    if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n"); 
    321     
    322 } 
    323  
    324  
     255   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n"); 
     256} 
    325257 
    326258/******************************************************************************/ 
    … …  
    340272void WriteHeadofSubroutineLoop() 
    341273{ 
    342    char ligne[LONG_40M]; 
     274   char ligne[LONG_M]; 
    343275   FILE * subloop; 
    344276 
    345    if ( todebug == 1 ) printf("Enter in WriteHeadofSubroutineLoop\n"); 
    346    tofich(fortranout,"\n",1); 
     277   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n"); 
     278   tofich(fortran_out,"\n",1); 
    347279   /* Open this newfile                                                       */ 
    348280   sprintf(ligne,"Sub_Loop_%s.h",subroutinename); 
    349    subloop = associate(ligne); 
     281   subloop = open_for_write(ligne); 
    350282   /*                                                                         */ 
    351    if (isrecursive)  
    352    { 
    353    sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename); 
    354    } 
    355    else 
    356    { 
    357    sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename); 
    358    } 
     283   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename); 
     284   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename); 
    359285   /*                                                                         */ 
    360    WriteVariablelist_subloop(subloop,ligne); 
    361    WriteVariablelist_subloop_Def(subloop,ligne); 
     286   WriteVariablelist_subloop(ligne); 
     287   WriteVariablelist_subloop_Def(ligne); 
    362288   /*                                                                         */ 
    363      strcat(ligne,")"); 
     289   strcat(ligne,")"); 
    364290   tofich(subloop,ligne,1); 
    365291   /* if USE agrif_Uti l should be add                                        */ 
    366292   AddUseAgrifUtil_0(subloop); 
    367293   /*                                                                         */ 
    368    oldfortranout = fortranout; 
    369    fortranout = subloop; 
    370    if ( todebug == 1 ) printf("Out of WriteHeadofSubroutineLoop\n"); 
     294   oldfortran_out = fortran_out; 
     295   fortran_out = subloop; 
     296   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n"); 
    371297} 
    372298 
    … …  
    386312void closeandcallsubloopandincludeit_0(int suborfun) 
    387313{ 
    388    char ligne[LONG_40M]; 
    389  
    390    if ( firstpass == 0 ) 
    391    { 
    392  
    393    if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 
     314   char *ligne; 
     315 
     316   if ( firstpass == 1 )    return; 
     317   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n"); 
     318 
     319   ligne = (char*) calloc(LONG_M, sizeof(char)); 
     320 
    394321   if ( IsTabvarsUseInArgument_0() == 1 ) 
    395322   { 
    396323      /* We should remove the key word end subroutine                         */ 
    397       RemoveWordCUR_0(fortranout,(long)(-(pos_cur-pos_endsubroutine)), 
    398                                           pos_cur-pos_endsubroutine); 
     324      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine); 
    399325      /* We should close the loop subroutine                                  */ 
    400       sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename); 
    401       tofich(fortranout,ligne,1); 
    402       fclose(fortranout); 
    403       fortranout = oldfortranout; 
    404  
    405  
    406       AddUseAgrifUtilBeforeCall_0(fortranout); 
     326      tofich(fortran_out,"\n",1); 
     327      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); 
     328      tofich(fortran_out,ligne,1); 
     329      fclose(fortran_out); 
     330      fortran_out = oldfortran_out; 
     331 
     332      AddUseAgrifUtilBeforeCall_0(fortran_out); 
    407333      WriteArgumentDeclaration_beforecall(); 
    408       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
     334      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
    409335      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
    410                      fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n"); 
     336            fprintf(fortran_out,"      call Agrif_Init_Grids()\n"); 
    411337      /* Now we add the call af the new subroutine                            */ 
    412       sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
     338      tofich(fortran_out,"\n",1); 
     339      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename); 
    413340      /* Write the list of the local variables used in this new subroutine    */ 
    414       WriteVariablelist_subloop(fortranout,ligne); 
     341      WriteVariablelist_subloop(ligne); 
    415342      /* Write the list of the global tables used in this new subroutine      */ 
    416343      /*    in doloop                                                         */ 
    417       WriteVariablelist_subloop_Call(fortranout,ligne); 
     344      WriteVariablelist_subloop_Call(&ligne, LONG_M); 
    418345      /* Close the parenthesis of the new subroutine called                   */ 
    419        strcat(ligne,")"); 
    420        
    421       tofich(fortranout,ligne,1); 
     346      strcat(ligne,")\n"); 
     347      tofich(fortran_out,ligne,1); 
     348      /* we should include the above file in the original code                */ 
    422349 
    423350      /* We should close the original subroutine                              */ 
    424       if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s" 
    425                                                                ,subroutinename); 
    426       if ( suborfun == 2 ) sprintf(ligne,"\n      end"); 
    427       if ( suborfun == 1 ) sprintf(ligne,"\n      end subroutine %s" 
    428                                                                ,subroutinename); 
    429       if ( suborfun == 0 ) sprintf(ligne,"\n      end function %s" 
    430                                                                ,subroutinename); 
    431       tofich(fortranout,ligne,1); 
    432       /* we should include the above file in the original code                */ 
    433       sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename); 
    434       tofich(fortranout,ligne,1); 
    435       } 
    436     oldfortranout = (FILE *)NULL;       
    437    if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    438    } 
    439     
    440 } 
    441  
    442  
    443  
     351      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename); 
     352      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n"); 
     353      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename); 
     354      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename); 
     355 
     356      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename); 
     357    } 
     358    oldfortran_out = (FILE *)NULL; 
     359    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n"); 
     360} 
    444361 
    445362void closeandcallsubloop_contains_0() 
    446363{ 
    447    char ligne[LONG_40M]; 
    448  
    449    if ( firstpass == 0 ) 
    450    { 
    451    if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 
     364   char *ligne; 
     365 
     366   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n"); 
    452367   if ( IsTabvarsUseInArgument_0() == 1 ) 
    453368   { 
    454       Remove_Word_Contains_0(); 
    455       sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename); 
    456       tofich(fortranout,ligne,1); 
    457       fclose(fortranout); 
    458       fortranout = oldfortranout; 
    459  
    460       AddUseAgrifUtilBeforeCall_0(fortranout); 
    461       if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 
    462                                                        "      IMPLICIT NONE\n"); 
    463       WriteLocalParamDeclaration(); 
     369      ligne = (char*) calloc(LONG_M, sizeof(char)); 
     370      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains' 
     371      tofich(fortran_out,"\n",1); 
     372      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); 
     373      tofich(fortran_out,ligne,1); 
     374      fclose(fortran_out); 
     375      fortran_out = oldfortran_out; 
     376 
     377      AddUseAgrifUtilBeforeCall_0(fortran_out); 
     378 
     379      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
     380      WriteLocalParamDeclaration(fortran_out); 
    464381      WriteArgumentDeclaration_beforecall(); 
    465       if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0); 
    466       WriteSubroutineDeclaration(0); 
     382      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
     383/*      WriteSubroutineDeclaration(0);*/ 
    467384      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
    468                      fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n"); 
     385          fprintf(fortran_out,"      call Agrif_Init_Grids()\n"); 
    469386      /* Now we add the call af the new subroutine                            */ 
    470       if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &" 
    471                                                                ,subroutinename); 
    472       else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename); 
    473       fprintf(fortranout,ligne); 
     387      tofich(fortran_out,"\n",1); 
     388      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename); 
    474389      /* Write the list of the local variables used in this new subroutine    */ 
    475       WriteVariablelist_subloop(fortranout,ligne); 
     390      WriteVariablelist_subloop(ligne); 
    476391      /* Write the list of the global tables used in this new subroutine      */ 
    477392      /*    in doloop                                                         */ 
    478       WriteVariablelist_subloop_Call(fortranout,ligne); 
     393      WriteVariablelist_subloop_Call(&ligne, LONG_M); 
    479394      /* Close the parenthesis of the new subroutine called                   */ 
    480       sprintf(ligne,")"); 
    481       tofich(fortranout,ligne,1); 
     395      strcat(ligne,")\n"); 
     396      tofich(fortran_out,ligne,1); 
    482397      /* We should close the original subroutine                              */ 
    483       sprintf(ligne,"\n      contains"); 
    484       tofich(fortranout,ligne,1); 
     398      fprintf(fortran_out, "      contains\n"); 
    485399      /* we should include the above file in the original code                */ 
    486       sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename); 
    487       tofich(fortranout,ligne,1); 
     400      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename); 
    488401      } 
    489    oldfortranout = (FILE *)NULL; 
    490    if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n"); 
    491    } 
    492 } 
     402   oldfortran_out = (FILE *)NULL; 
     403   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n"); 
     404} 
Note: See TracChangeset for help on using the changeset viewer.