[1901] | 1 | /******************************************************************************/ |
---|
| 2 | /* */ |
---|
| 3 | /* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ |
---|
| 4 | /* */ |
---|
| 5 | /* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ |
---|
| 6 | /* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ |
---|
| 7 | /* This software is governed by the CeCILL-C license under French law and */ |
---|
| 8 | /* abiding by the rules of distribution of free software. You can use, */ |
---|
| 9 | /* modify and/ or redistribute the software under the terms of the CeCILL-C */ |
---|
| 10 | /* license as circulated by CEA, CNRS and INRIA at the following URL */ |
---|
| 11 | /* "http://www.cecill.info". */ |
---|
| 12 | /* */ |
---|
| 13 | /* As a counterpart to the access to the source code and rights to copy, */ |
---|
| 14 | /* modify and redistribute granted by the license, users are provided only */ |
---|
| 15 | /* with a limited warranty and the software's author, the holder of the */ |
---|
| 16 | /* economic rights, and the successive licensors have only limited */ |
---|
| 17 | /* liability. */ |
---|
| 18 | /* */ |
---|
| 19 | /* In this respect, the user's attention is drawn to the risks associated */ |
---|
| 20 | /* with loading, using, modifying and/or developing or reproducing the */ |
---|
| 21 | /* software by the user in light of its specific status of free software, */ |
---|
| 22 | /* that may mean that it is complicated to manipulate, and that also */ |
---|
| 23 | /* therefore means that it is reserved for developers and experienced */ |
---|
| 24 | /* professionals having in-depth computer knowledge. Users are therefore */ |
---|
| 25 | /* encouraged to load and test the software's suitability as regards their */ |
---|
| 26 | /* requirements in conditions enabling the security of their systems and/or */ |
---|
| 27 | /* data to be ensured and, more generally, to use and operate it in the */ |
---|
| 28 | /* same conditions as regards security. */ |
---|
| 29 | /* */ |
---|
| 30 | /* The fact that you are presently reading this means that you have had */ |
---|
| 31 | /* knowledge of the CeCILL-C license and that you accept its terms. */ |
---|
| 32 | /******************************************************************************/ |
---|
| 33 | /* version 1.7 */ |
---|
| 34 | /******************************************************************************/ |
---|
| 35 | #include <stdio.h> |
---|
| 36 | #include <stdlib.h> |
---|
| 37 | #include <string.h> |
---|
| 38 | #include "decl.h" |
---|
| 39 | |
---|
| 40 | |
---|
| 41 | /******************************************************************************/ |
---|
| 42 | /* preparation and write of the argument list of a subroutine */ |
---|
| 43 | /******************************************************************************/ |
---|
| 44 | |
---|
| 45 | |
---|
| 46 | /******************************************************************************/ |
---|
[5656] | 47 | /* WriteBeginof_SubLoop */ |
---|
[1901] | 48 | /******************************************************************************/ |
---|
| 49 | /* We should write the head of the subroutine sub_loop_<subroutinename> */ |
---|
| 50 | /******************************************************************************/ |
---|
| 51 | /* */ |
---|
| 52 | /******************************************************************************/ |
---|
[5656] | 53 | void WriteBeginof_SubLoop() |
---|
[1901] | 54 | { |
---|
[5656] | 55 | if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename); |
---|
| 56 | if ( IsTabvarsUseInArgument_0() == 1 ) |
---|
[1901] | 57 | { |
---|
[5656] | 58 | if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n"); |
---|
[1901] | 59 | /* we should add the use agrif_uti l if it is necessary */ |
---|
| 60 | WriteHeadofSubroutineLoop(); |
---|
[2715] | 61 | WriteUsemoduleDeclaration(subroutinename); |
---|
[5656] | 62 | if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); |
---|
| 63 | WriteIncludeDeclaration(fortran_out); |
---|
[1901] | 64 | /* */ |
---|
| 65 | /* We should write once the declaration of tables (extract */ |
---|
| 66 | /* from pointer) in the new subroutine */ |
---|
[5656] | 67 | if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out); |
---|
[2715] | 68 | |
---|
[5656] | 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); |
---|
[1901] | 73 | } |
---|
[5656] | 74 | else |
---|
[1901] | 75 | { |
---|
[5656] | 76 | if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n"); |
---|
| 77 | AddUseAgrifUtil_0(fortran_out); |
---|
[2715] | 78 | WriteUsemoduleDeclaration(subroutinename); |
---|
[5656] | 79 | WriteIncludeDeclaration(fortran_out); |
---|
| 80 | if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); |
---|
| 81 | WriteLocalParamDeclaration(fortran_out); |
---|
[4147] | 82 | WriteArgumentDeclaration_beforecall(); |
---|
[5656] | 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);*/ |
---|
[1901] | 86 | } |
---|
[5656] | 87 | if ( todebug == 1 ) printf("< out of WriteBeginof_SubLoop\n"); |
---|
| 88 | if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename); |
---|
[1901] | 89 | } |
---|
| 90 | |
---|
| 91 | /******************************************************************************/ |
---|
| 92 | /* WriteVariablelist_subloop */ |
---|
| 93 | /******************************************************************************/ |
---|
| 94 | /* This subroutine is used to write the list of the variable which */ |
---|
| 95 | /* should be called by the sub_loop_<name> subroutine */ |
---|
| 96 | /* The first part is composed by the list of the local variables */ |
---|
| 97 | /******************************************************************************/ |
---|
| 98 | /* */ |
---|
| 99 | /* List_SubroutineDeclaration_Var a,b,c, & */ |
---|
| 100 | /* d,e,f, & */ |
---|
| 101 | /* a,b,c,d,e,f,g,h ========> g,h */ |
---|
| 102 | /* */ |
---|
| 103 | /******************************************************************************/ |
---|
[5656] | 104 | void WriteVariablelist_subloop(char *ligne) |
---|
[1901] | 105 | { |
---|
| 106 | listvar *parcours; |
---|
| 107 | |
---|
[5656] | 108 | if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n"); |
---|
[1901] | 109 | parcours = List_SubroutineArgument_Var; |
---|
| 110 | didvariableadded = 0; |
---|
| 111 | |
---|
| 112 | while ( parcours ) |
---|
| 113 | { |
---|
| 114 | /* if the readed variable is a variable of the subroutine */ |
---|
| 115 | /* subroutinename we should write the name of this variable */ |
---|
| 116 | /* in the output file */ |
---|
| 117 | if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) |
---|
| 118 | { |
---|
[5656] | 119 | if ( didvariableadded == 1 ) strcat(ligne,","); |
---|
[1901] | 120 | strcat(ligne,parcours->var->v_nomvar); |
---|
| 121 | didvariableadded = 1; |
---|
[5656] | 122 | } |
---|
[1901] | 123 | parcours = parcours -> suiv; |
---|
| 124 | } |
---|
| 125 | parcours = List_FunctionType_Var; |
---|
| 126 | while ( parcours ) |
---|
| 127 | { |
---|
| 128 | if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) |
---|
| 129 | { |
---|
[5656] | 130 | if ( didvariableadded == 1 ) strcat(ligne,","); |
---|
[1901] | 131 | strcat(ligne,parcours->var->v_nomvar); |
---|
| 132 | didvariableadded = 1; |
---|
[5656] | 133 | } |
---|
[1901] | 134 | parcours = parcours -> suiv; |
---|
| 135 | } |
---|
[5656] | 136 | if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop\n"); |
---|
[1901] | 137 | } |
---|
| 138 | |
---|
| 139 | |
---|
| 140 | /******************************************************************************/ |
---|
| 141 | /* WriteVariablelist_subloop_Call */ |
---|
| 142 | /******************************************************************************/ |
---|
| 143 | /* This subroutine is used to write the list of the variable which */ |
---|
| 144 | /* should be called by the sub_loop_<name> subroutine into the called */ |
---|
| 145 | /* The second part is composed by the list of the global table */ |
---|
| 146 | /******************************************************************************/ |
---|
| 147 | /* */ |
---|
| 148 | /* List_UsedInSubroutine_Var SubloopScalar = 0 | SubloopScalar = 1 */ |
---|
| 149 | /* a,b,c, & | a,b(1,1),c, & */ |
---|
| 150 | /* a,b,c,d,e,f,g,h =====> d,e,f, & | d(1),e(1,1,1),f, & */ |
---|
| 151 | /* g,h | g,h(1,1) */ |
---|
| 152 | /* */ |
---|
| 153 | /******************************************************************************/ |
---|
[5656] | 154 | void WriteVariablelist_subloop_Call(char **ligne, size_t line_length) |
---|
[1901] | 155 | { |
---|
| 156 | listvar *parcours; |
---|
[5656] | 157 | char ligne2[LONG_M]; |
---|
[1901] | 158 | int i; |
---|
[5656] | 159 | size_t cur_length; |
---|
[1901] | 160 | |
---|
[5656] | 161 | cur_length = line_length; |
---|
| 162 | |
---|
| 163 | if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n"); |
---|
[1901] | 164 | parcours = List_UsedInSubroutine_Var; |
---|
[5656] | 165 | |
---|
[1901] | 166 | while ( parcours ) |
---|
| 167 | { |
---|
| 168 | /* if the readed variable is a variable of the subroutine */ |
---|
| 169 | /* subroutinename we should write the name of this variable */ |
---|
| 170 | /* in the output file */ |
---|
| 171 | if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && |
---|
[2715] | 172 | (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) |
---|
[1901] | 173 | ) |
---|
| 174 | { |
---|
[5656] | 175 | if ( didvariableadded == 1 ) strcat(*ligne,","); |
---|
| 176 | const char *vres = vargridcurgridtabvars(parcours->var, 0); |
---|
| 177 | if ( (strlen(*ligne)+strlen(vres)+100) > cur_length ) |
---|
[1901] | 178 | { |
---|
[5656] | 179 | cur_length += LONG_M; |
---|
| 180 | *ligne = realloc( *ligne, cur_length*sizeof(char) ); |
---|
[1901] | 181 | } |
---|
[5656] | 182 | strcat(*ligne, vres); |
---|
[1901] | 183 | /* if it is asked in the call of the conv we should give */ |
---|
| 184 | /* scalar in argument, so we should put (1,1,1) after the */ |
---|
| 185 | /* the name of the variable */ |
---|
| 186 | if ( SubloopScalar != 0 && |
---|
[2715] | 187 | ( |
---|
| 188 | (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) && |
---|
[1901] | 189 | parcours->var->v_nbdim != 0 ) |
---|
| 190 | { |
---|
| 191 | i = 1; |
---|
| 192 | while ( i <= parcours->var->v_nbdim ) |
---|
| 193 | { |
---|
[5656] | 194 | if ( i == 1 ) strcat(*ligne,"( "); |
---|
[1901] | 195 | if ( SubloopScalar == 2 ) |
---|
| 196 | { |
---|
[5656] | 197 | strcat(*ligne,":"); |
---|
| 198 | if ( i != parcours->var->v_nbdim ) strcat(*ligne,","); |
---|
[1901] | 199 | } |
---|
| 200 | else |
---|
| 201 | { |
---|
[5656] | 202 | sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i); |
---|
| 203 | strcat(*ligne,ligne2); |
---|
| 204 | if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),"); |
---|
[1901] | 205 | } |
---|
[5656] | 206 | if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))"); |
---|
[1901] | 207 | i++; |
---|
| 208 | } |
---|
| 209 | } |
---|
| 210 | didvariableadded = 1; |
---|
| 211 | } |
---|
| 212 | parcours = parcours -> suiv; |
---|
| 213 | } |
---|
[5656] | 214 | if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop_Call\n"); |
---|
[1901] | 215 | } |
---|
| 216 | |
---|
| 217 | |
---|
| 218 | /******************************************************************************/ |
---|
| 219 | /* WriteVariablelist_subloop_Def */ |
---|
| 220 | /******************************************************************************/ |
---|
| 221 | /* This subroutine is used to write the list of the variable which */ |
---|
| 222 | /* should be called by the sub_loop_<name> subroutine into the def */ |
---|
| 223 | /* The second part is composed by the list of the global table */ |
---|
| 224 | /* <name>_tmp */ |
---|
| 225 | /******************************************************************************/ |
---|
| 226 | /* */ |
---|
| 227 | /* List_UsedInSubroutine_Var */ |
---|
| 228 | /* a-tmp,b-tmp,c_tmp, & */ |
---|
| 229 | /* a,b,c,d,e,f,g,h =====> d_tmp,e_tmp,f_tmp, & */ |
---|
| 230 | /* g_tmp,h_tmp */ |
---|
| 231 | /* */ |
---|
| 232 | /******************************************************************************/ |
---|
[5656] | 233 | void WriteVariablelist_subloop_Def(char *ligne) |
---|
[1901] | 234 | { |
---|
| 235 | listvar *parcours; |
---|
| 236 | |
---|
[5656] | 237 | if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n"); |
---|
[1901] | 238 | parcours = List_UsedInSubroutine_Var; |
---|
[5656] | 239 | |
---|
[1901] | 240 | while ( parcours ) |
---|
| 241 | { |
---|
| 242 | /* if the readed variable is a variable of the subroutine */ |
---|
| 243 | /* subrotinename we should write the name of this variable */ |
---|
| 244 | /* in the output file */ |
---|
| 245 | if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && |
---|
[5656] | 246 | (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) ) |
---|
[1901] | 247 | { |
---|
[5656] | 248 | if ( didvariableadded == 1 ) strcat(ligne,","); |
---|
[1901] | 249 | strcat(ligne,parcours->var->v_nomvar); |
---|
| 250 | didvariableadded = 1; |
---|
[5656] | 251 | } |
---|
[1901] | 252 | parcours = parcours -> suiv; |
---|
| 253 | } |
---|
| 254 | Save_Length(ligne,41); |
---|
[5656] | 255 | if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop_Def\n"); |
---|
[1901] | 256 | } |
---|
| 257 | |
---|
| 258 | /******************************************************************************/ |
---|
| 259 | /* WriteHeadofSubroutineLoop */ |
---|
| 260 | /******************************************************************************/ |
---|
| 261 | /* This subroutine is used to write the head of the subroutine */ |
---|
| 262 | /* Sub_Loop_<name> */ |
---|
| 263 | /******************************************************************************/ |
---|
| 264 | /* Sub_loop_subroutine.h */ |
---|
| 265 | /* */ |
---|
| 266 | /* subroutine Sub_Loop_subroutine ( & */ |
---|
| 267 | /* a,b,c, & */ |
---|
| 268 | /* SubLoopScalar d,e(1,1),f(1,1,1), & */ |
---|
| 269 | /* g,h & */ |
---|
| 270 | /* ) */ |
---|
| 271 | /******************************************************************************/ |
---|
| 272 | void WriteHeadofSubroutineLoop() |
---|
| 273 | { |
---|
[5656] | 274 | char ligne[LONG_M]; |
---|
[1901] | 275 | FILE * subloop; |
---|
| 276 | |
---|
[5656] | 277 | if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n"); |
---|
| 278 | tofich(fortran_out,"\n",1); |
---|
[1901] | 279 | /* Open this newfile */ |
---|
| 280 | sprintf(ligne,"Sub_Loop_%s.h",subroutinename); |
---|
[5656] | 281 | subloop = open_for_write(ligne); |
---|
[1901] | 282 | /* */ |
---|
[5656] | 283 | if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename); |
---|
| 284 | else sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename); |
---|
[1901] | 285 | /* */ |
---|
[5656] | 286 | WriteVariablelist_subloop(ligne); |
---|
| 287 | WriteVariablelist_subloop_Def(ligne); |
---|
[1901] | 288 | /* */ |
---|
[5656] | 289 | strcat(ligne,")"); |
---|
[2715] | 290 | tofich(subloop,ligne,1); |
---|
[1901] | 291 | /* if USE agrif_Uti l should be add */ |
---|
| 292 | AddUseAgrifUtil_0(subloop); |
---|
| 293 | /* */ |
---|
[5656] | 294 | oldfortran_out = fortran_out; |
---|
| 295 | fortran_out = subloop; |
---|
| 296 | if ( todebug == 1 ) printf("< out of WriteHeadofSubroutineLoop\n"); |
---|
[1901] | 297 | } |
---|
| 298 | |
---|
| 299 | /******************************************************************************/ |
---|
| 300 | /* closeandcallsubloopandincludeit_0 */ |
---|
| 301 | /******************************************************************************/ |
---|
| 302 | /* Firstpass 0 */ |
---|
| 303 | /* We should close the sub_loop subroutine, call it and close the */ |
---|
| 304 | /* function (suborfun = 0) */ |
---|
| 305 | /* subroutine (suborfun = 1) */ |
---|
| 306 | /* end (suborfun = 2) */ |
---|
| 307 | /* end program (suborfun = 3) */ |
---|
| 308 | /* and include the sub_loop subroutine after */ |
---|
| 309 | /******************************************************************************/ |
---|
| 310 | /* */ |
---|
| 311 | /******************************************************************************/ |
---|
| 312 | void closeandcallsubloopandincludeit_0(int suborfun) |
---|
| 313 | { |
---|
[5656] | 314 | char *ligne; |
---|
[1901] | 315 | |
---|
[5656] | 316 | if ( firstpass == 1 ) return; |
---|
| 317 | if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n"); |
---|
[2715] | 318 | |
---|
[5656] | 319 | ligne = (char*) calloc(LONG_M, sizeof(char)); |
---|
| 320 | |
---|
[1901] | 321 | if ( IsTabvarsUseInArgument_0() == 1 ) |
---|
| 322 | { |
---|
| 323 | /* We should remove the key word end subroutine */ |
---|
[5656] | 324 | RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine); |
---|
[1901] | 325 | /* We should close the loop subroutine */ |
---|
[5656] | 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; |
---|
[1901] | 331 | |
---|
[5656] | 332 | AddUseAgrifUtilBeforeCall_0(fortran_out); |
---|
[4147] | 333 | WriteArgumentDeclaration_beforecall(); |
---|
[5656] | 334 | if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); |
---|
[1901] | 335 | if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) |
---|
[5656] | 336 | fprintf(fortran_out," call Agrif_Init_Grids()\n"); |
---|
[1901] | 337 | /* Now we add the call af the new subroutine */ |
---|
[5656] | 338 | tofich(fortran_out,"\n",1); |
---|
| 339 | sprintf(ligne," call Sub_Loop_%s(",subroutinename); |
---|
[1901] | 340 | /* Write the list of the local variables used in this new subroutine */ |
---|
[5656] | 341 | WriteVariablelist_subloop(ligne); |
---|
[1901] | 342 | /* Write the list of the global tables used in this new subroutine */ |
---|
| 343 | /* in doloop */ |
---|
[5656] | 344 | WriteVariablelist_subloop_Call(&ligne, LONG_M); |
---|
[1901] | 345 | /* Close the parenthesis of the new subroutine called */ |
---|
[5656] | 346 | strcat(ligne,")\n"); |
---|
| 347 | tofich(fortran_out,ligne,1); |
---|
| 348 | /* we should include the above file in the original code */ |
---|
[2715] | 349 | |
---|
[1901] | 350 | /* We should close the original subroutine */ |
---|
[5656] | 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"); |
---|
[1901] | 360 | } |
---|
| 361 | |
---|
| 362 | void closeandcallsubloop_contains_0() |
---|
| 363 | { |
---|
[5656] | 364 | char *ligne; |
---|
[1901] | 365 | |
---|
[5656] | 366 | if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n"); |
---|
[1901] | 367 | if ( IsTabvarsUseInArgument_0() == 1 ) |
---|
| 368 | { |
---|
[5656] | 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; |
---|
[1901] | 376 | |
---|
[5656] | 377 | AddUseAgrifUtilBeforeCall_0(fortran_out); |
---|
| 378 | |
---|
| 379 | if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); |
---|
| 380 | WriteLocalParamDeclaration(fortran_out); |
---|
[4147] | 381 | WriteArgumentDeclaration_beforecall(); |
---|
[5656] | 382 | if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); |
---|
| 383 | /* WriteSubroutineDeclaration(0);*/ |
---|
[1901] | 384 | if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) |
---|
[5656] | 385 | fprintf(fortran_out," call Agrif_Init_Grids()\n"); |
---|
[1901] | 386 | /* Now we add the call af the new subroutine */ |
---|
[5656] | 387 | tofich(fortran_out,"\n",1); |
---|
| 388 | sprintf(ligne," call Sub_Loop_%s(",subroutinename); |
---|
[1901] | 389 | /* Write the list of the local variables used in this new subroutine */ |
---|
[5656] | 390 | WriteVariablelist_subloop(ligne); |
---|
[1901] | 391 | /* Write the list of the global tables used in this new subroutine */ |
---|
| 392 | /* in doloop */ |
---|
[5656] | 393 | WriteVariablelist_subloop_Call(&ligne, LONG_M); |
---|
[1901] | 394 | /* Close the parenthesis of the new subroutine called */ |
---|
[5656] | 395 | strcat(ligne,")\n"); |
---|
| 396 | tofich(fortran_out,ligne,1); |
---|
[1901] | 397 | /* We should close the original subroutine */ |
---|
[5656] | 398 | fprintf(fortran_out, " contains\n"); |
---|
[1901] | 399 | /* we should include the above file in the original code */ |
---|
[5656] | 400 | fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename); |
---|
[1901] | 401 | } |
---|
[5656] | 402 | oldfortran_out = (FILE *)NULL; |
---|
| 403 | if ( todebug == 1 ) printf("< out of closeandcallsubloop_contains_0\n"); |
---|
[1901] | 404 | } |
---|