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