[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 <stdlib.h> |
---|
| 36 | #include <stdio.h> |
---|
| 37 | #include <string.h> |
---|
| 38 | #include "decl.h" |
---|
| 39 | char lvargridname[LONG_4C]; |
---|
| 40 | char lvargridname2[LONG_4C]; |
---|
| 41 | |
---|
| 42 | |
---|
| 43 | /******************************************************************************/ |
---|
| 44 | /* variablenameroottabvars */ |
---|
| 45 | /******************************************************************************/ |
---|
| 46 | /* This subroutine is used to create the string */ |
---|
| 47 | /******************************************************************************/ |
---|
| 48 | /* */ |
---|
| 49 | /* -----------> Agrif_Mygrid % tabvars (i) % var */ |
---|
| 50 | /* */ |
---|
| 51 | /******************************************************************************/ |
---|
| 52 | char *variablenameroottabvars (variable * var) |
---|
| 53 | { |
---|
| 54 | char *ligne; |
---|
| 55 | |
---|
| 56 | ligne = (char *) malloc (LONG_C * sizeof (char)); |
---|
| 57 | sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var ", var->v_indicetabvars); |
---|
| 58 | return ligne; |
---|
| 59 | } |
---|
| 60 | |
---|
| 61 | |
---|
| 62 | /******************************************************************************/ |
---|
| 63 | /* variablenametabvars */ |
---|
| 64 | /******************************************************************************/ |
---|
| 65 | /* This subroutine is used to create the string */ |
---|
| 66 | /******************************************************************************/ |
---|
| 67 | /* */ |
---|
| 68 | /* if iorindice = 0 ----------> Agrif_Gr % tabvars (i) % var */ |
---|
| 69 | /* */ |
---|
| 70 | /* if iorindice = 1 ----------> Agrif_Gr % tabvars (12) % var */ |
---|
| 71 | /* */ |
---|
| 72 | /******************************************************************************/ |
---|
| 73 | char *variablenametabvars (variable * var, int iorindice) |
---|
| 74 | { |
---|
| 75 | char *ligne; |
---|
| 76 | |
---|
| 77 | ligne = (char *) malloc (LONG_C * sizeof (char)); |
---|
| 78 | if ( iorindice == 0 ) sprintf (ligne, " Agrif_Gr %% tabvars(%d)%% var", |
---|
| 79 | var->v_indicetabvars); |
---|
| 80 | else sprintf (ligne, " Agrif_Gr %% tabvars(i)%% var"); |
---|
| 81 | return ligne; |
---|
| 82 | } |
---|
| 83 | |
---|
| 84 | /******************************************************************************/ |
---|
| 85 | /* variablecurgridtabvars */ |
---|
| 86 | /******************************************************************************/ |
---|
| 87 | /* This subroutine is used to create the string */ |
---|
| 88 | /******************************************************************************/ |
---|
| 89 | /* */ |
---|
| 90 | /* -----------> Agrif_Curgrid % tabvars (i) % var */ |
---|
| 91 | /* */ |
---|
| 92 | /******************************************************************************/ |
---|
| 93 | char *variablecurgridtabvars (variable * var,int ParentOrCurgrid) |
---|
| 94 | { |
---|
| 95 | char *ligne; |
---|
| 96 | |
---|
| 97 | ligne = (char *) malloc (LONG_C * sizeof (char)); |
---|
| 98 | if ( ParentOrCurgrid == 0 ) sprintf (ligne, " Agrif_tabvars(%d) %% var", |
---|
| 99 | var->v_indicetabvars); |
---|
| 100 | else if ( ParentOrCurgrid == 1 ) sprintf (ligne, |
---|
| 101 | " Agrif_tabvars(%d) %% parent_var %% var", |
---|
| 102 | var->v_indicetabvars); |
---|
| 103 | else if ( ParentOrCurgrid == 2 ) sprintf (ligne, |
---|
| 104 | " Agrif_Mygrid %% tabvars(%d) %% var", |
---|
| 105 | var->v_indicetabvars); |
---|
| 106 | else if ( ParentOrCurgrid == 3 ) sprintf (ligne, |
---|
| 107 | " Agrif_Curgrid %% tabvars(%d) %% var", |
---|
| 108 | var->v_indicetabvars); |
---|
| 109 | else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var", |
---|
| 110 | var->v_indicetabvars); |
---|
| 111 | return ligne; |
---|
| 112 | } |
---|
| 113 | |
---|
| 114 | void WARNING_CharSize(variable *var) |
---|
| 115 | { |
---|
| 116 | if ( var->v_nbdim == 0 ) |
---|
| 117 | { |
---|
| 118 | if ( convert2int(var->v_dimchar) > 2050 ) |
---|
| 119 | { |
---|
| 120 | printf("WARNING : The dimension of the character %s \n", |
---|
| 121 | var->v_nomvar); |
---|
| 122 | printf(" is upper than 2050. You must change \n"); |
---|
| 123 | printf(" the dimension of carray0 \n"); |
---|
| 124 | printf(" in the file AGRIF/AGRIF_FILES/modtypes.F \n"); |
---|
| 125 | printf(" line 247. Replace 300 with %d. \n", |
---|
| 126 | convert2int(var->v_dimchar)+100); |
---|
| 127 | } |
---|
| 128 | Save_Length_int(convert2int(var->v_dimchar),1); |
---|
| 129 | } |
---|
| 130 | else if ( var->v_nbdim == 1 ) |
---|
| 131 | { |
---|
| 132 | if ( convert2int(var->v_dimchar) > 300 ) |
---|
| 133 | { |
---|
| 134 | printf("WARNING : The dimension of the character %s \n", |
---|
| 135 | var->v_nomvar); |
---|
| 136 | printf(" is upper than 300. You must change \n"); |
---|
| 137 | printf(" the dimension of carray1 \n"); |
---|
| 138 | printf(" in the file AGRIF/AGRIF_FILES/modtypes.F \n"); |
---|
| 139 | printf(" line 247. Replace 300 with %d. \n", |
---|
| 140 | convert2int(var->v_dimchar)+100); |
---|
| 141 | } |
---|
| 142 | Save_Length_int(convert2int(var->v_dimchar),2); |
---|
| 143 | } |
---|
| 144 | else if ( var->v_nbdim == 2 ) |
---|
| 145 | { |
---|
| 146 | if ( convert2int(var->v_dimchar) > 300 ) |
---|
| 147 | { |
---|
| 148 | printf("WARNING : The dimension of the character %s \n", |
---|
| 149 | var->v_nomvar); |
---|
| 150 | printf(" is upper than 300. You must change \n"); |
---|
| 151 | printf(" the dimension of carray2 \n"); |
---|
| 152 | printf(" in the file AGRIF/AGRIF_FILES/modtypes.F \n"); |
---|
| 153 | printf(" line 247. Replace 300 with %d. \n", |
---|
| 154 | convert2int(var->v_dimchar)+100); |
---|
| 155 | } |
---|
| 156 | Save_Length_int(convert2int(var->v_dimchar),3); |
---|
| 157 | } |
---|
| 158 | else if ( var->v_nbdim == 3 ) |
---|
| 159 | { |
---|
| 160 | if ( convert2int(var->v_dimchar) > 300 ) |
---|
| 161 | { |
---|
| 162 | printf("WARNING : The dimension of the character %s \n", |
---|
| 163 | var->v_nomvar); |
---|
| 164 | printf(" is upper than 300. You must change \n"); |
---|
| 165 | printf(" the dimension of carray3 \n"); |
---|
| 166 | printf(" in the file AGRIF/AGRIF_FILES/modtypes.F \n"); |
---|
| 167 | printf(" line 247. Replace 300 with %d. \n", |
---|
| 168 | convert2int(var->v_dimchar)+100); |
---|
| 169 | } |
---|
| 170 | Save_Length_int(convert2int(var->v_dimchar),4); |
---|
| 171 | } |
---|
| 172 | } |
---|
| 173 | /******************************************************************************/ |
---|
| 174 | /* vargridnametabvars */ |
---|
| 175 | /******************************************************************************/ |
---|
| 176 | /* This subroutine is used to create the string */ |
---|
| 177 | /******************************************************************************/ |
---|
| 178 | /* */ |
---|
| 179 | /* if iorindice == 0 -----------> Agrif_Gr % tabvars (i) % var % array1 */ |
---|
| 180 | /* */ |
---|
| 181 | /* if iorindice == 1 -----------> Agrif_Gr % tabvars (12) % var % array1 */ |
---|
| 182 | /* */ |
---|
| 183 | /******************************************************************************/ |
---|
| 184 | char *vargridnametabvars (variable * var,int iorindice) |
---|
| 185 | { |
---|
| 186 | char *tmp; |
---|
| 187 | char tmp1[LONG_C]; |
---|
| 188 | |
---|
| 189 | tmp = variablenametabvars (var,iorindice); |
---|
| 190 | strcpy(tmp1,tmp); |
---|
| 191 | if ( todebugfree == 1 ) free(tmp); |
---|
| 192 | |
---|
| 193 | sprintf (lvargridname, "%s", tmp1); |
---|
| 194 | if (!strcasecmp (var->v_typevar, "REAL")) |
---|
| 195 | { |
---|
| 196 | if ( !strcasecmp(var->v_nameinttypename,"8") ) |
---|
| 197 | sprintf (lvargridname2, "%% darray%d", var->v_nbdim); |
---|
| 198 | else if ( !strcasecmp(var->v_nameinttypename,"4") ) |
---|
| 199 | sprintf (lvargridname2, "%% sarray%d", var->v_nbdim); |
---|
| 200 | else sprintf (lvargridname2, "%% array%d", var->v_nbdim); |
---|
| 201 | } |
---|
| 202 | else if (!strcasecmp (var->v_typevar, "INTEGER")) |
---|
| 203 | { |
---|
| 204 | sprintf (lvargridname2, "%% iarray%d", var->v_nbdim); |
---|
| 205 | } |
---|
| 206 | else if (!strcasecmp (var->v_typevar, "LOGICAL")) |
---|
| 207 | { |
---|
| 208 | sprintf (lvargridname2, "%% larray%d", var->v_nbdim); |
---|
| 209 | } |
---|
| 210 | else if (!strcasecmp (var->v_typevar, "CHARACTER")) |
---|
| 211 | { |
---|
| 212 | WARNING_CharSize(var); |
---|
| 213 | sprintf (lvargridname2, "%% carray%d", var->v_nbdim); |
---|
| 214 | } |
---|
| 215 | |
---|
| 216 | strcat (lvargridname, lvargridname2); |
---|
| 217 | |
---|
| 218 | Save_Length(lvargridname,42); |
---|
| 219 | Save_Length(lvargridname2,42); |
---|
| 220 | return lvargridname; |
---|
| 221 | } |
---|
| 222 | |
---|
| 223 | /******************************************************************************/ |
---|
| 224 | /* vargridcurgridtabvars */ |
---|
| 225 | /******************************************************************************/ |
---|
| 226 | /* This subroutine is used to create the string */ |
---|
| 227 | /******************************************************************************/ |
---|
| 228 | /* */ |
---|
| 229 | /* if ParentOrCurgrid == 0 --> Agrif_Curgrid % tabvars (i) % var % array1 */ |
---|
| 230 | /* */ |
---|
| 231 | /* if ParentOrCurgrid == 1 --> Agrif_tabvars (i) % parent_var %var % array1 */ |
---|
| 232 | /* */ |
---|
| 233 | /* if ParentOrCurgrid == 2 --> Agrif_Gr % tabvars (i) % var % array1 */ |
---|
| 234 | /* */ |
---|
| 235 | /******************************************************************************/ |
---|
| 236 | char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid) |
---|
| 237 | { |
---|
| 238 | char *tmp; |
---|
| 239 | char tmp1[LONG_C]; |
---|
| 240 | |
---|
| 241 | if (!strcasecmp(var->v_typevar,"type")) |
---|
| 242 | { |
---|
| 243 | strcpy(lvargridname2,""); |
---|
| 244 | sprintf(lvargridname,"Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s",var->v_modulename,var->v_nomvar); |
---|
[2715] | 245 | printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename); |
---|
[1901] | 246 | } |
---|
| 247 | else |
---|
| 248 | { |
---|
| 249 | tmp = variablecurgridtabvars (var,ParentOrCurgrid); |
---|
| 250 | strcpy(tmp1,tmp); |
---|
| 251 | if ( todebugfree == 1 ) free(tmp); |
---|
| 252 | |
---|
| 253 | sprintf (lvargridname, "%s", tmp1); |
---|
| 254 | if (!strcasecmp (var->v_typevar, "REAL")) |
---|
| 255 | { |
---|
| 256 | if ( !strcasecmp(var->v_nameinttypename,"8") ) |
---|
| 257 | sprintf (lvargridname2, "%% darray%d", var->v_nbdim); |
---|
| 258 | else if ( !strcasecmp(var->v_nameinttypename,"4") ) |
---|
| 259 | sprintf (lvargridname2, "%% sarray%d", var->v_nbdim); |
---|
| 260 | else sprintf (lvargridname2, "%% array%d", var->v_nbdim); |
---|
| 261 | } |
---|
| 262 | else if (!strcasecmp (var->v_typevar, "INTEGER")) |
---|
| 263 | { |
---|
| 264 | sprintf (lvargridname2, "%% iarray%d", var->v_nbdim); |
---|
| 265 | } |
---|
| 266 | else if (!strcasecmp (var->v_typevar, "LOGICAL")) |
---|
| 267 | { |
---|
| 268 | sprintf (lvargridname2, "%% larray%d", var->v_nbdim); |
---|
| 269 | } |
---|
| 270 | else if (!strcasecmp (var->v_typevar, "CHARACTER")) |
---|
| 271 | { |
---|
| 272 | WARNING_CharSize(var); |
---|
| 273 | sprintf (lvargridname2, "%% carray%d", var->v_nbdim); |
---|
| 274 | } |
---|
| 275 | } |
---|
| 276 | |
---|
| 277 | strcat (lvargridname, lvargridname2); |
---|
| 278 | |
---|
| 279 | Save_Length(lvargridname,42); |
---|
| 280 | Save_Length(lvargridname2,42); |
---|
| 281 | return lvargridname; |
---|
| 282 | } |
---|
| 283 | |
---|
| 284 | /******************************************************************************/ |
---|
| 285 | /* vargridcurgridtabvarswithoutAgrif_Gr */ |
---|
| 286 | /******************************************************************************/ |
---|
| 287 | /* This subroutine is used to create the string */ |
---|
| 288 | /******************************************************************************/ |
---|
| 289 | /* */ |
---|
| 290 | /******************************************************************************/ |
---|
| 291 | char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var) |
---|
| 292 | { |
---|
| 293 | |
---|
| 294 | sprintf (lvargridname, "(%d) %% var", var->v_indicetabvars); |
---|
| 295 | |
---|
| 296 | if (!strcasecmp (var->v_typevar, "REAL")) |
---|
| 297 | { |
---|
| 298 | if ( !strcasecmp(var->v_nameinttypename,"8") ) |
---|
| 299 | sprintf (lvargridname2, "%% darray%d", var->v_nbdim); |
---|
| 300 | else if ( !strcasecmp(var->v_nameinttypename,"4") ) |
---|
| 301 | sprintf (lvargridname2, "%% sarray%d", var->v_nbdim); |
---|
| 302 | else sprintf (lvargridname2, "%% array%d", var->v_nbdim); |
---|
| 303 | } |
---|
| 304 | else if (!strcasecmp (var->v_typevar, "INTEGER")) |
---|
| 305 | { |
---|
| 306 | sprintf (lvargridname2, "%% iarray%d", var->v_nbdim); |
---|
| 307 | } |
---|
| 308 | else if (!strcasecmp (var->v_typevar, "LOGICAL")) |
---|
| 309 | { |
---|
| 310 | sprintf (lvargridname2, "%% larray%d", var->v_nbdim); |
---|
| 311 | } |
---|
| 312 | else if (!strcasecmp (var->v_typevar, "CHARACTER")) |
---|
| 313 | { |
---|
| 314 | WARNING_CharSize(var); |
---|
| 315 | sprintf (lvargridname2, "%% carray%d", var->v_nbdim); |
---|
| 316 | } |
---|
| 317 | |
---|
| 318 | strcat (lvargridname, lvargridname2); |
---|
| 319 | |
---|
| 320 | Save_Length(lvargridname,42); |
---|
| 321 | Save_Length(lvargridname2,42); |
---|
| 322 | return lvargridname; |
---|
| 323 | } |
---|
| 324 | |
---|
| 325 | /******************************************************************************/ |
---|
| 326 | /* vargridparam */ |
---|
| 327 | /******************************************************************************/ |
---|
| 328 | /* This subroutine is used to create the string which contains */ |
---|
| 329 | /* dimension list */ |
---|
| 330 | /******************************************************************************/ |
---|
| 331 | /* */ |
---|
| 332 | /* DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj" */ |
---|
| 333 | /* */ |
---|
| 334 | /******************************************************************************/ |
---|
| 335 | char *vargridparam (variable * v, int whichone) |
---|
| 336 | { |
---|
| 337 | typedim dim; |
---|
| 338 | listdim *newdim; |
---|
| 339 | char newname[LONG_4C]; |
---|
| 340 | |
---|
| 341 | newdim = v->v_dimension; |
---|
| 342 | if (!newdim) return ""; |
---|
| 343 | |
---|
| 344 | strcpy (tmpvargridname, "("); |
---|
| 345 | while (newdim) |
---|
| 346 | { |
---|
| 347 | dim = newdim->dim; |
---|
| 348 | |
---|
| 349 | strcpy(newname,""); |
---|
| 350 | strcpy(newname, |
---|
| 351 | ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var, |
---|
| 352 | whichone)); |
---|
| 353 | |
---|
| 354 | strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, |
---|
| 355 | List_Common_Var,whichone)); |
---|
| 356 | |
---|
| 357 | strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, |
---|
| 358 | List_ModuleUsed_Var,whichone)); |
---|
| 359 | |
---|
| 360 | strcat (tmpvargridname, newname); |
---|
| 361 | strcat (tmpvargridname, " : "); |
---|
| 362 | |
---|
| 363 | strcpy(newname,""); |
---|
| 364 | strcpy(newname,ChangeTheInitalvaluebyTabvarsName |
---|
| 365 | (dim.last,List_Global_Var,whichone)); |
---|
| 366 | |
---|
| 367 | strcpy(newname,ChangeTheInitalvaluebyTabvarsName |
---|
| 368 | (newname, List_Common_Var,whichone)); |
---|
| 369 | |
---|
| 370 | strcpy(newname,ChangeTheInitalvaluebyTabvarsName |
---|
| 371 | (newname, List_ModuleUsed_Var,whichone)); |
---|
| 372 | |
---|
| 373 | Save_Length(tmpvargridname,46); |
---|
| 374 | strcat (tmpvargridname, newname); |
---|
| 375 | newdim = newdim->suiv; |
---|
| 376 | if (newdim) strcat (tmpvargridname, ","); |
---|
| 377 | } |
---|
| 378 | strcat (tmpvargridname, ")"); |
---|
| 379 | strcat (tmpvargridname, "\0"); |
---|
| 380 | Save_Length(tmpvargridname,40); |
---|
| 381 | return tmpvargridname; |
---|
| 382 | } |
---|
| 383 | |
---|
| 384 | /******************************************************************************/ |
---|
| 385 | /* write_probdimagrif_file */ |
---|
| 386 | /******************************************************************************/ |
---|
| 387 | /* This subroutine is used to create the file probdim_agrif.h */ |
---|
| 388 | /******************************************************************************/ |
---|
| 389 | /* */ |
---|
| 390 | /* probdim_agrif.h */ |
---|
| 391 | /* */ |
---|
| 392 | /* Agrif_probdim = <number> */ |
---|
| 393 | /* */ |
---|
| 394 | /******************************************************************************/ |
---|
| 395 | void write_probdimagrif_file() |
---|
| 396 | { |
---|
| 397 | FILE *probdim; |
---|
| 398 | char ligne[LONG_C]; |
---|
| 399 | |
---|
| 400 | probdim = associate("probdim_agrif.h"); |
---|
| 401 | sprintf (ligne, "Agrif_Probdim = %d", dimprob); |
---|
| 402 | tofich (probdim, ligne,1); |
---|
| 403 | fclose (probdim); |
---|
| 404 | } |
---|
| 405 | |
---|
| 406 | /******************************************************************************/ |
---|
| 407 | /* write_keysagrif_file */ |
---|
| 408 | /******************************************************************************/ |
---|
| 409 | /* This subroutine is used to create the file keys_agrif.h */ |
---|
| 410 | /******************************************************************************/ |
---|
| 411 | /* */ |
---|
| 412 | /* keys_agrif.h */ |
---|
| 413 | /* */ |
---|
| 414 | /* AGRIF_USE_FIXED_GRIDS = 0 */ |
---|
| 415 | /* AGRIF_USE_ONLY_FIXED_GRIDS = 0 */ |
---|
| 416 | /* AGRIF_USE_(ONLY)_FIXED_GRIDS = 1 */ |
---|
| 417 | /* */ |
---|
| 418 | /******************************************************************************/ |
---|
| 419 | void write_keysagrif_file() |
---|
| 420 | { |
---|
| 421 | FILE *keys; |
---|
| 422 | |
---|
| 423 | keys = associate ("keys_agrif.h"); |
---|
| 424 | fprintf(keys," AGRIF_USE_FIXED_GRIDS = 0\n"); |
---|
| 425 | fprintf(keys," AGRIF_USE_ONLY_FIXED_GRIDS = 0\n"); |
---|
| 426 | if (fixedgrids == 1) fprintf(keys," AGRIF_USE_FIXED_GRIDS = 1\n"); |
---|
| 427 | if (onlyfixedgrids == 1) |
---|
| 428 | fprintf(keys," AGRIF_USE_ONLY_FIXED_GRIDS = 1\n"); |
---|
| 429 | |
---|
| 430 | fclose(keys); |
---|
| 431 | } |
---|
| 432 | |
---|
| 433 | /******************************************************************************/ |
---|
| 434 | /* write_modtypeagrif_file */ |
---|
| 435 | /******************************************************************************/ |
---|
| 436 | /* This subroutine is used to create the file typedata */ |
---|
| 437 | /******************************************************************************/ |
---|
| 438 | /* */ |
---|
| 439 | /* modtype_agrif.h */ |
---|
| 440 | /* */ |
---|
| 441 | /* Agrif_NbVariables = */ |
---|
| 442 | /* */ |
---|
| 443 | /******************************************************************************/ |
---|
| 444 | void write_modtypeagrif_file() |
---|
| 445 | { |
---|
| 446 | char ligne[LONG_C]; |
---|
| 447 | FILE *typedata; |
---|
| 448 | |
---|
| 449 | typedata = associate ("modtype_agrif.h"); |
---|
| 450 | /* AGRIF_NbVariables : number of variables */ |
---|
| 451 | sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars); |
---|
| 452 | tofich(typedata,ligne,1); |
---|
| 453 | fclose (typedata); |
---|
| 454 | } |
---|
| 455 | |
---|
| 456 | /******************************************************************************/ |
---|
| 457 | /* write_createvarnameagrif_file */ |
---|
| 458 | /******************************************************************************/ |
---|
| 459 | /* This subroutine is used to create the file createvarname */ |
---|
| 460 | /******************************************************************************/ |
---|
| 461 | /* */ |
---|
| 462 | /* Agrif_Gr % tabvars (i) % var % namevar = "variable" */ |
---|
| 463 | /* */ |
---|
| 464 | /******************************************************************************/ |
---|
| 465 | void write_createvarnameagrif_file(variable *v,FILE *createvarname, |
---|
| 466 | int *InitEmpty) |
---|
| 467 | { |
---|
| 468 | char ligne[LONG_C]; |
---|
| 469 | char *tmp; |
---|
| 470 | char temp1[LONG_C]; |
---|
| 471 | |
---|
| 472 | tmp = variablenametabvars(v,0); |
---|
| 473 | strcpy (temp1, tmp); |
---|
| 474 | if ( todebugfree == 1 ) free(tmp); |
---|
| 475 | |
---|
| 476 | *InitEmpty = 0 ; |
---|
| 477 | sprintf(ligne, "%s %% namevar = \"%s\"",temp1,v->v_nomvar); |
---|
| 478 | tofich(createvarname,ligne,1); |
---|
| 479 | } |
---|
| 480 | |
---|
| 481 | /******************************************************************************/ |
---|
| 482 | /* write_Setnumberofcells_file */ |
---|
| 483 | /******************************************************************************/ |
---|
| 484 | /* This subroutine is used to create the file setnumberofcells */ |
---|
| 485 | /******************************************************************************/ |
---|
| 486 | /* */ |
---|
| 487 | /* Agrif_Gr % n(i) = nbmailles */ |
---|
| 488 | /* */ |
---|
| 489 | /******************************************************************************/ |
---|
| 490 | void write_Setnumberofcells_file(char *name) |
---|
| 491 | { |
---|
| 492 | char ligne[LONG_C]; |
---|
| 493 | FILE *setnumberofcells; |
---|
| 494 | |
---|
| 495 | if ( IndicenbmaillesX != 0 ) |
---|
| 496 | { |
---|
| 497 | setnumberofcells=associate(name); |
---|
| 498 | |
---|
| 499 | if (onlyfixedgrids != 1 ) |
---|
| 500 | { |
---|
| 501 | sprintf (ligne, |
---|
| 502 | "Agrif_Gr %% nb(1) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", |
---|
| 503 | IndicenbmaillesX); |
---|
| 504 | } |
---|
| 505 | else |
---|
| 506 | { |
---|
| 507 | sprintf (ligne, |
---|
| 508 | "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", |
---|
| 509 | IndicenbmaillesX); |
---|
| 510 | } |
---|
| 511 | tofich (setnumberofcells, ligne,1); |
---|
| 512 | if (dimprob > 1) |
---|
| 513 | { |
---|
| 514 | if (onlyfixedgrids != 1 ) |
---|
| 515 | { |
---|
| 516 | sprintf (ligne, |
---|
| 517 | "Agrif_Gr %% nb(2) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", |
---|
| 518 | IndicenbmaillesY); |
---|
| 519 | } |
---|
| 520 | else |
---|
| 521 | { |
---|
| 522 | sprintf (ligne, |
---|
| 523 | "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", |
---|
| 524 | IndicenbmaillesY); |
---|
| 525 | } |
---|
| 526 | |
---|
| 527 | tofich (setnumberofcells, ligne,1); |
---|
| 528 | } |
---|
| 529 | if (dimprob > 2) |
---|
| 530 | { |
---|
| 531 | if (onlyfixedgrids != 1 ) |
---|
| 532 | { |
---|
| 533 | sprintf (ligne, |
---|
| 534 | "Agrif_Gr %% nb(3) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", |
---|
| 535 | IndicenbmaillesZ); |
---|
| 536 | } |
---|
| 537 | else |
---|
| 538 | { |
---|
| 539 | sprintf (ligne, |
---|
| 540 | "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", |
---|
| 541 | IndicenbmaillesZ); |
---|
| 542 | } |
---|
| 543 | tofich (setnumberofcells, ligne,1); |
---|
| 544 | } |
---|
| 545 | |
---|
| 546 | fclose (setnumberofcells); |
---|
| 547 | } |
---|
| 548 | } |
---|
| 549 | |
---|
| 550 | /******************************************************************************/ |
---|
| 551 | /* write_Getnumberofcells_file */ |
---|
| 552 | /******************************************************************************/ |
---|
| 553 | /* This subroutine is used to create the file getnumberofcells */ |
---|
| 554 | /******************************************************************************/ |
---|
| 555 | /* */ |
---|
| 556 | /* nbmailles = Agrif_Gr % n(i) */ |
---|
| 557 | /* */ |
---|
| 558 | /******************************************************************************/ |
---|
| 559 | void write_Getnumberofcells_file(char *name) |
---|
| 560 | { |
---|
| 561 | char ligne[LONG_C]; |
---|
| 562 | FILE *getnumberofcells; |
---|
| 563 | |
---|
| 564 | if ( IndicenbmaillesX != 0 ) |
---|
| 565 | { |
---|
| 566 | getnumberofcells=associate(name); |
---|
| 567 | sprintf (ligne, |
---|
| 568 | "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(1)", |
---|
| 569 | IndicenbmaillesX); |
---|
| 570 | tofich (getnumberofcells, ligne,1); |
---|
| 571 | if (dimprob > 1) |
---|
| 572 | { |
---|
| 573 | sprintf (ligne, |
---|
| 574 | "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(2)", |
---|
| 575 | IndicenbmaillesY); |
---|
| 576 | tofich (getnumberofcells, ligne,1); |
---|
| 577 | } |
---|
| 578 | if (dimprob > 2) |
---|
| 579 | { |
---|
| 580 | sprintf (ligne, |
---|
| 581 | "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(3)", |
---|
| 582 | IndicenbmaillesZ); |
---|
| 583 | tofich (getnumberofcells, ligne,1); |
---|
| 584 | } |
---|
| 585 | fclose (getnumberofcells); |
---|
| 586 | } |
---|
| 587 | } |
---|
| 588 | |
---|
| 589 | |
---|
| 590 | /******************************************************************************/ |
---|
| 591 | /* write_initialisationsagrif_file */ |
---|
| 592 | /******************************************************************************/ |
---|
| 593 | /* This subroutine is used to create the file initproc */ |
---|
| 594 | /******************************************************************************/ |
---|
| 595 | /* */ |
---|
| 596 | /* ! variable */ |
---|
| 597 | /* Agrif_Gr % tabvars(i) % var % nbdim = 1 */ |
---|
| 598 | /* */ |
---|
| 599 | /******************************************************************************/ |
---|
| 600 | void write_initialisationsagrif_file(variable *v,FILE *initproc, |
---|
| 601 | int *VarnameEmpty) |
---|
| 602 | { |
---|
| 603 | char ligne[LONG_C]; |
---|
| 604 | char temp1[LONG_C]; |
---|
| 605 | char *tmp; |
---|
| 606 | |
---|
| 607 | tmp = variablenameroottabvars (v); |
---|
| 608 | strcpy (temp1, tmp); |
---|
| 609 | if ( todebugfree == 1 ) free(tmp); |
---|
| 610 | |
---|
| 611 | if ( v->v_nbdim != 0 ) |
---|
| 612 | { |
---|
| 613 | *VarnameEmpty = 0 ; |
---|
| 614 | sprintf (ligne, "%s %% nbdim = %d", temp1, v->v_nbdim); |
---|
| 615 | tofich (initproc, ligne,1); |
---|
| 616 | } |
---|
| 617 | } |
---|
| 618 | |
---|
| 619 | |
---|
| 620 | void Write_Alloc_Agrif_Files() |
---|
| 621 | { |
---|
| 622 | listnom *parcours; |
---|
| 623 | FILE *alloccalls; |
---|
| 624 | FILE *AllocUSE; |
---|
| 625 | |
---|
| 626 | AllocUSE= associate("include_use_Alloc_agrif.h"); |
---|
| 627 | alloccalls = associate("allocations_calls_agrif.h"); |
---|
| 628 | |
---|
| 629 | parcours = List_Subroutine_For_Alloc; |
---|
| 630 | while ( parcours ) |
---|
| 631 | { |
---|
| 632 | fprintf(AllocUSE," USE %s\n", parcours -> o_nom ); |
---|
| 633 | fprintf (alloccalls," Call Alloc_agrif_%s(Agrif_Gr)\n", |
---|
| 634 | parcours -> o_nom ); |
---|
| 635 | parcours = parcours -> suiv; |
---|
| 636 | } |
---|
| 637 | |
---|
| 638 | fclose (AllocUSE); |
---|
| 639 | fclose (alloccalls); |
---|
| 640 | } |
---|
| 641 | |
---|
| 642 | int IndiceInlist(int indic, listindice *listin) |
---|
| 643 | { |
---|
| 644 | listindice *parcoursindic; |
---|
| 645 | int out; |
---|
| 646 | |
---|
| 647 | out = 0 ; |
---|
| 648 | |
---|
| 649 | parcoursindic = listin; |
---|
| 650 | while ( parcoursindic && out == 0 ) |
---|
| 651 | { |
---|
| 652 | if ( parcoursindic->i_indice == indic ) out = 1; |
---|
| 653 | else parcoursindic = parcoursindic -> suiv; |
---|
| 654 | } |
---|
| 655 | |
---|
| 656 | return out; |
---|
| 657 | } |
---|
| 658 | void write_allocation_Common_0() |
---|
| 659 | { |
---|
| 660 | listnom *parcours_nom; |
---|
| 661 | listnom *neededparameter; |
---|
| 662 | listvar *parcours; |
---|
| 663 | listvar *parcoursprec; |
---|
| 664 | listvar *parcours1; |
---|
| 665 | FILE *allocationagrif; |
---|
| 666 | FILE *paramtoamr; |
---|
| 667 | char ligne[LONGNOM]; |
---|
[2715] | 668 | char ligne2[LONGNOM]; |
---|
[1901] | 669 | variable *v; |
---|
| 670 | int IndiceMax; |
---|
| 671 | int IndiceMin; |
---|
| 672 | int compteur; |
---|
| 673 | int out; |
---|
| 674 | int indiceprec; |
---|
| 675 | int ValeurMax; |
---|
| 676 | char initialvalue[LONG_4C]; |
---|
| 677 | listindice *list_indic; |
---|
| 678 | listindice *parcoursindic; |
---|
| 679 | int i; |
---|
| 680 | |
---|
| 681 | parcoursprec = (listvar *)NULL; |
---|
| 682 | parcours_nom = List_NameOfCommon; |
---|
| 683 | ValeurMax = 2; |
---|
| 684 | while ( parcours_nom ) |
---|
| 685 | { |
---|
| 686 | /* */ |
---|
| 687 | if ( parcours_nom->o_val == 1 ) |
---|
| 688 | { |
---|
| 689 | /* Open the file to create the Alloc_agrif subroutine */ |
---|
| 690 | sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); |
---|
| 691 | allocationagrif = associate (ligne); |
---|
| 692 | /* */ |
---|
| 693 | fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", |
---|
| 694 | parcours_nom->o_nom); |
---|
| 695 | /* */ |
---|
| 696 | sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom); |
---|
| 697 | paramtoamr = associate (ligne); |
---|
| 698 | neededparameter = (listnom * )NULL; |
---|
| 699 | /* */ |
---|
| 700 | list_indic = (listindice *)NULL; |
---|
| 701 | /* */ |
---|
| 702 | shouldincludempif = 1 ; |
---|
| 703 | parcours = List_Common_Var; |
---|
| 704 | while ( parcours ) |
---|
| 705 | { |
---|
| 706 | if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) && |
---|
| 707 | IndiceInlist(parcours->var->v_indicetabvars,list_indic) == 0 |
---|
| 708 | ) |
---|
| 709 | { |
---|
| 710 | /***************************************************************/ |
---|
| 711 | /***************************************************************/ |
---|
| 712 | /***************************************************************/ |
---|
| 713 | v = parcours->var; |
---|
| 714 | IndiceMax = 0; |
---|
| 715 | IndiceMin = indicemaxtabvars; |
---|
| 716 | /* body of the file */ |
---|
| 717 | if ( !strcasecmp(v->v_commoninfile,mainfile) ) |
---|
| 718 | { |
---|
| 719 | if (onlyfixedgrids != 1 && v->v_nbdim!=0) |
---|
| 720 | { |
---|
| 721 | strcpy (ligne, "If (.not. associated("); |
---|
| 722 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 723 | strcat (ligne, ")) then"); |
---|
| 724 | Save_Length(ligne,48); |
---|
| 725 | tofich (allocationagrif, ligne,1); |
---|
| 726 | } |
---|
| 727 | if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) ) |
---|
| 728 | { |
---|
| 729 | /* ALLOCATION */ |
---|
| 730 | if ( v->v_dimension != 0 ) |
---|
| 731 | { |
---|
| 732 | if ( v->v_indicetabvars < IndiceMin || |
---|
| 733 | v->v_indicetabvars > IndiceMax ) |
---|
| 734 | { |
---|
| 735 | parcours1 = parcours; |
---|
| 736 | compteur = -1; |
---|
| 737 | out = 0; |
---|
| 738 | indiceprec = parcours->var->v_indicetabvars -1 ; |
---|
| 739 | while ( parcours1 && out == 0 && |
---|
| 740 | !strcasecmp( parcours->var->v_readedlistdimension, |
---|
| 741 | parcours1->var->v_readedlistdimension) && |
---|
| 742 | !strcasecmp( parcours->var->v_typevar, |
---|
| 743 | parcours1->var->v_typevar) && |
---|
| 744 | ( parcours1->var->v_indicetabvars == indiceprec+1 ) |
---|
| 745 | ) |
---|
| 746 | { |
---|
| 747 | |
---|
| 748 | if ( !strcasecmp(parcours1->var->v_modulename, |
---|
| 749 | parcours_nom->o_nom) || |
---|
| 750 | !strcasecmp(parcours1->var->v_commonname, |
---|
| 751 | parcours_nom->o_nom) ) |
---|
| 752 | { |
---|
| 753 | compteur = compteur +1 ; |
---|
| 754 | indiceprec = parcours1->var->v_indicetabvars; |
---|
| 755 | parcoursprec = parcours1; |
---|
| 756 | parcours1 = parcours1->suiv; |
---|
| 757 | } |
---|
| 758 | else out = 1; |
---|
| 759 | } |
---|
| 760 | |
---|
| 761 | if ( compteur > ValeurMax ) |
---|
| 762 | { |
---|
| 763 | fprintf(allocationagrif," DO i = %d , %d\n", |
---|
| 764 | parcours->var->v_indicetabvars, |
---|
| 765 | parcours->var->v_indicetabvars+compteur); |
---|
| 766 | IndiceMin = parcours->var->v_indicetabvars; |
---|
| 767 | IndiceMax = parcours->var->v_indicetabvars+compteur; |
---|
| 768 | strcpy (ligne, "allocate "); |
---|
| 769 | strcat (ligne, "("); |
---|
| 770 | strcat (ligne, vargridnametabvars(v,1)); |
---|
| 771 | strcat (ligne, vargridparam(v,0)); |
---|
| 772 | strcat (ligne, ")"); |
---|
| 773 | Save_Length(ligne,48); |
---|
| 774 | tofich (allocationagrif, ligne,1); |
---|
| 775 | fprintf(allocationagrif," end do\n"); |
---|
| 776 | i=parcours->var->v_indicetabvars; |
---|
| 777 | do |
---|
| 778 | { |
---|
| 779 | parcoursindic = (listindice *)malloc(sizeof(listindice)); |
---|
| 780 | parcoursindic -> i_indice = i; |
---|
| 781 | parcoursindic -> suiv = list_indic; |
---|
| 782 | list_indic = parcoursindic; |
---|
| 783 | i = i + 1; |
---|
| 784 | } while ( i <= parcours->var->v_indicetabvars+compteur ); |
---|
| 785 | parcours = parcoursprec; |
---|
| 786 | /* */ |
---|
| 787 | } |
---|
| 788 | else |
---|
| 789 | { |
---|
| 790 | strcpy (ligne, "allocate "); |
---|
| 791 | strcat (ligne, "("); |
---|
| 792 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 793 | strcat (ligne, vargridparam(v,0)); |
---|
| 794 | strcat (ligne, ")"); |
---|
| 795 | Save_Length(ligne,48); |
---|
| 796 | tofich (allocationagrif, ligne,1); |
---|
| 797 | /* */ |
---|
| 798 | parcoursindic = (listindice *)malloc(sizeof(listindice)); |
---|
| 799 | parcoursindic -> i_indice = parcours->var->v_indicetabvars; |
---|
| 800 | parcoursindic -> suiv = list_indic; |
---|
| 801 | list_indic = parcoursindic; |
---|
| 802 | } |
---|
| 803 | neededparameter = writedeclarationintoamr(List_Parameter_Var, |
---|
| 804 | paramtoamr,v,parcours_nom->o_nom,neededparameter, |
---|
| 805 | v->v_commonname); |
---|
| 806 | /* */ |
---|
| 807 | } |
---|
| 808 | } /* end of the allocation part */ |
---|
| 809 | /* INITIALISATION */ |
---|
| 810 | if ( strcasecmp(v->v_initialvalue,"") ) |
---|
| 811 | { |
---|
| 812 | strcpy (ligne, ""); |
---|
| 813 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 814 | /* We should modify the initialvalue in the case of variable has */ |
---|
| 815 | /* been defined with others variables */ |
---|
| 816 | |
---|
| 817 | strcpy(initialvalue, |
---|
| 818 | ChangeTheInitalvaluebyTabvarsName |
---|
| 819 | (v->v_initialvalue,List_Global_Var,0)); |
---|
| 820 | if ( !strcasecmp(initialvalue,v->v_initialvalue) ) |
---|
| 821 | { |
---|
| 822 | strcpy(initialvalue,""); |
---|
| 823 | strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName |
---|
| 824 | (v->v_initialvalue,List_Common_Var,0)); |
---|
| 825 | } |
---|
| 826 | if ( !strcasecmp(initialvalue,v->v_initialvalue) ) |
---|
| 827 | { |
---|
| 828 | strcpy(initialvalue,""); |
---|
| 829 | strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName |
---|
| 830 | (v->v_initialvalue,List_ModuleUsed_Var,0)); |
---|
| 831 | } |
---|
| 832 | strcat (ligne," = "); |
---|
[2715] | 833 | |
---|
| 834 | if (v->v_nbdim == 0) |
---|
| 835 | { |
---|
| 836 | strcpy(ligne2,initialvalue); |
---|
| 837 | } |
---|
| 838 | else |
---|
| 839 | { |
---|
| 840 | sprintf(ligne2,"RESHAPE(%s,SHAPE(%s))",initialvalue,vargridnametabvars(v,0)); |
---|
| 841 | } |
---|
| 842 | strcat (ligne,ligne2); |
---|
[1901] | 843 | /* */ |
---|
| 844 | Save_Length(ligne,48); |
---|
| 845 | tofich (allocationagrif, ligne,1); |
---|
| 846 | } |
---|
| 847 | } |
---|
| 848 | if (onlyfixedgrids != 1 && v->v_nbdim!=0) |
---|
| 849 | { |
---|
| 850 | strcpy (ligne, " End if"); |
---|
| 851 | tofich (allocationagrif, ligne,1); |
---|
| 852 | } |
---|
| 853 | } |
---|
| 854 | /***************************************************************/ |
---|
| 855 | /***************************************************************/ |
---|
| 856 | /***************************************************************/ |
---|
| 857 | } |
---|
| 858 | parcours = parcours -> suiv; |
---|
| 859 | } |
---|
| 860 | /* Close the file Alloc_agrif */ |
---|
| 861 | fclose(allocationagrif); |
---|
| 862 | fclose(paramtoamr); |
---|
| 863 | } |
---|
| 864 | /* */ |
---|
| 865 | parcours_nom = parcours_nom -> suiv; |
---|
| 866 | } |
---|
| 867 | |
---|
| 868 | } |
---|
| 869 | |
---|
| 870 | |
---|
| 871 | |
---|
| 872 | void write_allocation_Global_0() |
---|
| 873 | { |
---|
| 874 | listnom *parcours_nom; |
---|
| 875 | listvar *parcours; |
---|
| 876 | listvar *parcoursprec; |
---|
| 877 | listvar *parcours1; |
---|
| 878 | FILE *allocationagrif; |
---|
| 879 | char ligne[LONGNOM]; |
---|
| 880 | variable *v; |
---|
| 881 | int IndiceMax; |
---|
| 882 | int IndiceMin; |
---|
| 883 | int compteur; |
---|
| 884 | int out; |
---|
| 885 | int indiceprec; |
---|
| 886 | int ValeurMax; |
---|
| 887 | char initialvalue[LONG_4C]; |
---|
| 888 | int typeiswritten ; |
---|
| 889 | |
---|
| 890 | parcoursprec = (listvar *)NULL; |
---|
| 891 | parcours_nom = List_NameOfModule; |
---|
| 892 | ValeurMax = 2; |
---|
| 893 | while ( parcours_nom ) |
---|
| 894 | { |
---|
| 895 | /* */ |
---|
| 896 | if ( parcours_nom->o_val == 1 ) |
---|
| 897 | { |
---|
| 898 | IndiceMax = 0; |
---|
| 899 | IndiceMin = indicemaxtabvars; |
---|
| 900 | /* Open the file to create the Alloc_agrif subroutine */ |
---|
| 901 | sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); |
---|
| 902 | allocationagrif = associate (ligne); |
---|
| 903 | /* */ |
---|
| 904 | if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) |
---|
| 905 | { |
---|
| 906 | /* add the call to initworkspace */ |
---|
| 907 | tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1); |
---|
| 908 | fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n"); |
---|
| 909 | tofich(allocationagrif,"else ",1); |
---|
| 910 | fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n"); |
---|
| 911 | tofich(allocationagrif,"endif ",1); |
---|
| 912 | tofich(allocationagrif,"Call Agrif_InitWorkspace ",1); |
---|
| 913 | } |
---|
| 914 | |
---|
| 915 | typeiswritten = 0; |
---|
| 916 | |
---|
| 917 | parcours = List_Global_Var; |
---|
| 918 | while ( parcours ) |
---|
| 919 | { |
---|
| 920 | if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) && |
---|
| 921 | parcours->var->v_VariableIsParameter == 0 && |
---|
| 922 | parcours->var->v_notgrid == 0 && |
---|
| 923 | !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) ) |
---|
| 924 | { |
---|
| 925 | /***************************************************************/ |
---|
| 926 | /***************************************************************/ |
---|
| 927 | /***************************************************************/ |
---|
| 928 | v = parcours->var; |
---|
| 929 | IndiceMax = 0; |
---|
| 930 | IndiceMin = indicemaxtabvars; |
---|
| 931 | /* body of the file */ |
---|
| 932 | if ( !strcasecmp(v->v_commoninfile,mainfile) ) |
---|
| 933 | { |
---|
| 934 | if (onlyfixedgrids != 1 && v->v_nbdim!=0) |
---|
| 935 | { |
---|
| 936 | strcpy (ligne, "If (.not. associated("); |
---|
| 937 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 938 | strcat (ligne, ")) then"); |
---|
| 939 | Save_Length(ligne,48); |
---|
| 940 | tofich (allocationagrif, ligne,1); |
---|
| 941 | } |
---|
| 942 | if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) ) |
---|
| 943 | { |
---|
| 944 | /* ALLOCATION */ |
---|
| 945 | if ( v->v_dimension != 0 ) |
---|
| 946 | { |
---|
| 947 | if ( v->v_indicetabvars < IndiceMin || |
---|
| 948 | v->v_indicetabvars > IndiceMax ) |
---|
| 949 | { |
---|
| 950 | parcours1 = parcours; |
---|
| 951 | compteur = -1; |
---|
| 952 | out = 0; |
---|
| 953 | indiceprec = parcours->var->v_indicetabvars -1 ; |
---|
| 954 | while ( parcours1 && out == 0 && |
---|
| 955 | !strcasecmp( parcours->var->v_readedlistdimension, |
---|
| 956 | parcours1->var->v_readedlistdimension) && |
---|
| 957 | !strcasecmp( parcours->var->v_typevar, |
---|
| 958 | parcours1->var->v_typevar) && |
---|
| 959 | ( parcours1->var->v_indicetabvars == indiceprec+1 ) |
---|
| 960 | ) |
---|
| 961 | { |
---|
| 962 | |
---|
| 963 | if ( !strcasecmp(parcours1->var->v_modulename, |
---|
| 964 | parcours_nom->o_nom) || |
---|
| 965 | !strcasecmp(parcours1->var->v_commonname, |
---|
| 966 | parcours_nom->o_nom) ) |
---|
| 967 | { |
---|
| 968 | compteur = compteur +1 ; |
---|
| 969 | indiceprec = parcours1->var->v_indicetabvars; |
---|
| 970 | parcoursprec = parcours1; |
---|
| 971 | parcours1 = parcours1->suiv; |
---|
| 972 | } |
---|
| 973 | else out = 1; |
---|
| 974 | } |
---|
| 975 | if ( compteur > ValeurMax ) |
---|
| 976 | { |
---|
| 977 | fprintf(allocationagrif," DO i = %d , %d\n", |
---|
| 978 | parcours->var->v_indicetabvars, |
---|
| 979 | parcours->var->v_indicetabvars+compteur); |
---|
| 980 | IndiceMin = parcours->var->v_indicetabvars; |
---|
| 981 | IndiceMax = parcours->var->v_indicetabvars+compteur; |
---|
| 982 | strcpy (ligne, "allocate "); |
---|
| 983 | strcat (ligne, "("); |
---|
| 984 | strcat (ligne, vargridnametabvars(v,1)); |
---|
| 985 | strcat (ligne, vargridparam(v,0)); |
---|
| 986 | strcat (ligne, ")"); |
---|
| 987 | Save_Length(ligne,48); |
---|
| 988 | tofich (allocationagrif, ligne,1); |
---|
| 989 | fprintf(allocationagrif," end do\n"); |
---|
| 990 | parcours = parcoursprec; |
---|
| 991 | } |
---|
| 992 | else |
---|
| 993 | { |
---|
| 994 | strcpy (ligne, "allocate "); |
---|
| 995 | strcat (ligne, "("); |
---|
| 996 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 997 | strcat (ligne, vargridparam(v,0)); |
---|
| 998 | strcat (ligne, ")"); |
---|
| 999 | Save_Length(ligne,48); |
---|
| 1000 | tofich (allocationagrif, ligne,1); |
---|
| 1001 | } |
---|
| 1002 | } |
---|
| 1003 | } /* end of the allocation part */ |
---|
| 1004 | |
---|
| 1005 | /* INITIALISATION */ |
---|
| 1006 | if ( strcasecmp(v->v_initialvalue,"") ) |
---|
| 1007 | { |
---|
| 1008 | strcpy (ligne, ""); |
---|
| 1009 | strcat (ligne, vargridnametabvars(v,0)); |
---|
| 1010 | /* We should modify the initialvalue in the case of variable has */ |
---|
| 1011 | /* been defined with others variables */ |
---|
| 1012 | |
---|
| 1013 | strcpy(initialvalue, |
---|
| 1014 | ChangeTheInitalvaluebyTabvarsName |
---|
| 1015 | (v->v_initialvalue,List_Global_Var,0)); |
---|
| 1016 | if ( !strcasecmp(initialvalue,v->v_initialvalue) ) |
---|
| 1017 | { |
---|
| 1018 | strcpy(initialvalue,""); |
---|
| 1019 | strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName |
---|
| 1020 | (v->v_initialvalue,List_Common_Var,0)); |
---|
| 1021 | } |
---|
| 1022 | if ( !strcasecmp(initialvalue,v->v_initialvalue) ) |
---|
| 1023 | { |
---|
| 1024 | strcpy(initialvalue,""); |
---|
| 1025 | strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName |
---|
| 1026 | (v->v_initialvalue,List_ModuleUsed_Var,0)); |
---|
| 1027 | } |
---|
| 1028 | strcat (ligne," = "); |
---|
| 1029 | strcat (ligne,initialvalue); |
---|
| 1030 | /* */ |
---|
| 1031 | Save_Length(ligne,48); |
---|
| 1032 | tofich (allocationagrif, ligne,1); |
---|
| 1033 | } |
---|
| 1034 | } |
---|
| 1035 | /* Case of structure types */ |
---|
| 1036 | if ((typeiswritten == 0) && !strcasecmp(v->v_typevar,"type")) |
---|
| 1037 | { |
---|
| 1038 | sprintf(ligne,"If (.Not.Allocated(Agrif_%s_var)) Then",v->v_modulename); |
---|
| 1039 | tofich(allocationagrif, ligne, 1); |
---|
| 1040 | sprintf(ligne,"Allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename); |
---|
| 1041 | tofich(allocationagrif, ligne, 1); |
---|
| 1042 | strcpy(ligne,"End If"); |
---|
| 1043 | tofich(allocationagrif, ligne, 1); |
---|
| 1044 | typeiswritten = 1; |
---|
| 1045 | } |
---|
| 1046 | if (onlyfixedgrids != 1 && v->v_nbdim!=0) |
---|
| 1047 | { |
---|
| 1048 | strcpy (ligne, " End if"); |
---|
| 1049 | tofich (allocationagrif, ligne,1); |
---|
| 1050 | } |
---|
| 1051 | } |
---|
| 1052 | /***************************************************************/ |
---|
| 1053 | /***************************************************************/ |
---|
| 1054 | /***************************************************************/ |
---|
| 1055 | } |
---|
| 1056 | parcours = parcours -> suiv; |
---|
| 1057 | } |
---|
| 1058 | /* */ |
---|
| 1059 | if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) |
---|
| 1060 | { |
---|
| 1061 | /* add the call to initworkspace */ |
---|
| 1062 | tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1); |
---|
| 1063 | fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n"); |
---|
| 1064 | tofich(allocationagrif,"else ",1); |
---|
| 1065 | fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n"); |
---|
| 1066 | tofich(allocationagrif,"endif ",1); |
---|
| 1067 | tofich(allocationagrif,"Call Agrif_InitWorkspace ",1); |
---|
| 1068 | } |
---|
| 1069 | /* Close the file Alloc_agrif */ |
---|
| 1070 | fclose(allocationagrif); |
---|
| 1071 | } /* end parcours_nom == 1 */ |
---|
| 1072 | /* */ |
---|
| 1073 | parcours_nom = parcours_nom -> suiv; |
---|
| 1074 | } |
---|
| 1075 | } |
---|
| 1076 | |
---|
| 1077 | /******************************************************************************/ |
---|
| 1078 | /* creefichieramr */ |
---|
| 1079 | /******************************************************************************/ |
---|
| 1080 | /* This subroutine is the main one to create AGRIF_INC files */ |
---|
| 1081 | /******************************************************************************/ |
---|
| 1082 | /* */ |
---|
| 1083 | /******************************************************************************/ |
---|
| 1084 | void creefichieramr (char *NameTampon) |
---|
| 1085 | { |
---|
| 1086 | listvar *newvar; |
---|
| 1087 | variable *v; |
---|
| 1088 | int erreur; |
---|
| 1089 | char filefich[LONG_C]; |
---|
| 1090 | char ligne[LONG_C]; |
---|
| 1091 | int IndiceMax; |
---|
| 1092 | int IndiceMin; |
---|
| 1093 | int InitEmpty; |
---|
| 1094 | int VarnameEmpty; |
---|
| 1095 | int donotwrite; |
---|
| 1096 | |
---|
| 1097 | FILE *initproc; |
---|
| 1098 | FILE *initglobal; |
---|
| 1099 | FILE *createvarname; |
---|
| 1100 | FILE *createvarnameglobal; |
---|
| 1101 | |
---|
| 1102 | if ( todebug == 1 ) printf("Enter in creefichieramr\n"); |
---|
| 1103 | strcpy (filefich, "cd "); |
---|
| 1104 | strcat (filefich, nomdir); |
---|
| 1105 | erreur = system (filefich); |
---|
| 1106 | if (erreur) |
---|
| 1107 | { |
---|
| 1108 | strcpy (filefich, "mkdir "); |
---|
| 1109 | strcat (filefich, nomdir); |
---|
| 1110 | system (filefich); |
---|
| 1111 | printf ("%s: Directory created\n", nomdir); |
---|
| 1112 | } |
---|
| 1113 | |
---|
| 1114 | /******************************************************************************/ |
---|
| 1115 | /******************** Creation of AGRIF_INC files *****************************/ |
---|
| 1116 | /******************************************************************************/ |
---|
| 1117 | |
---|
| 1118 | /*----------------------------------------------------------------------------*/ |
---|
| 1119 | if ( todebug == 1 ) |
---|
| 1120 | { |
---|
| 1121 | strcpy(ligne,"initialisations_agrif_"); |
---|
| 1122 | strcat(ligne,NameTampon); |
---|
| 1123 | strcat(ligne,".h"); |
---|
| 1124 | initproc = associate (ligne); |
---|
| 1125 | /*----------------------------------------------------------------------------*/ |
---|
| 1126 | strcpy(ligne,"createvarname_agrif_"); |
---|
| 1127 | strcat(ligne,NameTampon); |
---|
| 1128 | strcat(ligne,".h"); |
---|
| 1129 | createvarname = associate (ligne); |
---|
| 1130 | /*----------------------------------------------------------------------------*/ |
---|
| 1131 | InitEmpty = 1 ; |
---|
| 1132 | VarnameEmpty = 1 ; |
---|
| 1133 | |
---|
| 1134 | newvar = List_Global_Var; |
---|
| 1135 | while ( newvar && todebug == 1 ) |
---|
| 1136 | { |
---|
| 1137 | donotwrite = 0; |
---|
| 1138 | v = newvar->var; |
---|
| 1139 | |
---|
| 1140 | if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 ) |
---|
| 1141 | { |
---|
| 1142 | write_createvarnameagrif_file(v,createvarname,&VarnameEmpty); |
---|
| 1143 | write_initialisationsagrif_file(v,initproc,&InitEmpty); |
---|
| 1144 | } |
---|
| 1145 | newvar = newvar->suiv; |
---|
| 1146 | } |
---|
| 1147 | /* */ |
---|
| 1148 | fclose (createvarname); |
---|
| 1149 | fclose (initproc); |
---|
| 1150 | /*--------------------------------------------------------------------------*/ |
---|
| 1151 | if ( Did_filetoparse_readed(curmodulename) == 0 ) |
---|
| 1152 | { |
---|
| 1153 | if ( InitEmpty != 1 ) |
---|
| 1154 | { |
---|
| 1155 | initglobal = associateaplus("initialisations_agrif.h"); |
---|
| 1156 | strcpy(ligne,"#include \"initialisations_agrif_"); |
---|
| 1157 | strcat(ligne,NameTampon); |
---|
| 1158 | strcat(ligne,".h\"\n"); |
---|
| 1159 | fprintf(initglobal,ligne); |
---|
| 1160 | fclose(initglobal); |
---|
| 1161 | } |
---|
| 1162 | /*--------------------------------------------------------------------------*/ |
---|
| 1163 | if ( VarnameEmpty != 1 ) |
---|
| 1164 | { |
---|
| 1165 | createvarnameglobal= associateaplus("createvarname_agrif.h"); |
---|
| 1166 | strcpy(ligne,"#include \"createvarname_agrif_"); |
---|
| 1167 | strcat(ligne,NameTampon); |
---|
| 1168 | strcat(ligne,".h\"\n"); |
---|
| 1169 | fprintf(createvarnameglobal,ligne); |
---|
| 1170 | fclose(createvarnameglobal); |
---|
| 1171 | } |
---|
| 1172 | } |
---|
| 1173 | } |
---|
| 1174 | /*----------------------------------------------------------------------------*/ |
---|
| 1175 | /*----------------------------------------------------------------------------*/ |
---|
| 1176 | /*----------------------------------------------------------------------------*/ |
---|
| 1177 | /*----------------------------------------------------------------------------*/ |
---|
| 1178 | /*----------------------------------------------------------------------------*/ |
---|
| 1179 | IndiceMax = 0; |
---|
| 1180 | IndiceMin = 0; |
---|
| 1181 | |
---|
| 1182 | write_allocation_Common_0(); |
---|
| 1183 | write_allocation_Global_0(); |
---|
| 1184 | |
---|
| 1185 | Write_Alloc_Agrif_Files(); |
---|
| 1186 | write_probdimagrif_file(); |
---|
| 1187 | write_keysagrif_file(); |
---|
| 1188 | write_modtypeagrif_file(); |
---|
| 1189 | if ( NbMailleXDefined == 1 ) |
---|
| 1190 | write_Setnumberofcells_file("SetNumberofcells.h"); |
---|
| 1191 | if ( NbMailleXDefined == 1 ) |
---|
| 1192 | write_Getnumberofcells_file("GetNumberofcells.h"); |
---|
| 1193 | retour77 = 0; |
---|
| 1194 | if ( NbMailleXDefined == 1 ) |
---|
| 1195 | write_Setnumberofcells_file("SetNumberofcellsFree.h"); |
---|
| 1196 | if ( NbMailleXDefined == 1 ) |
---|
| 1197 | write_Getnumberofcells_file("GetNumberofcellsFree.h"); |
---|
| 1198 | retour77 = 1; |
---|
| 1199 | if ( NbMailleXDefined == 1 ) |
---|
| 1200 | write_Setnumberofcells_file("SetNumberofcellsFixed.h"); |
---|
| 1201 | if ( NbMailleXDefined == 1 ) |
---|
| 1202 | write_Getnumberofcells_file("GetNumberofcellsFixed.h"); |
---|
| 1203 | if ( todebug == 1 ) printf("Out of creefichieramr\n"); |
---|
| 1204 | } |
---|