Changeset 7731 for branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
- Timestamp:
- 2017-02-23T14:23:32+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
r7730 r7731 37 37 #include <string.h> 38 38 #include "decl.h" 39 char lvargridname[LONG_4C]; 40 char lvargridname2[LONG_4C]; 41 42 43 /******************************************************************************/ 44 /* variablenameroottabvars */ 39 40 const char * tabvarsname(const variable *var) 41 { 42 static char * tname[5] = { 43 "tabvars", // v_catvar == 0 44 "tabvars_c", // v_catvar == 1 45 "tabvars_r", // v_catvar == 2 46 "tabvars_l", // v_catvar == 3 47 "tabvars_i" // v_catvar == 4 48 }; 49 return tname[var->v_catvar]; // v_catvar should never be ouside the range [0:4]. 50 } 51 52 /******************************************************************************/ 53 /* variablecurgridtabvars */ 45 54 /******************************************************************************/ 46 55 /* This subroutine is used to create the string */ 47 56 /******************************************************************************/ 48 57 /* */ 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 */ 58 /* -----------> Agrif_Curgrid % tabvars (i) */ 59 /* */ 60 /******************************************************************************/ 61 const char * variablecurgridtabvars(int which_grid) 62 { 63 static char * varname[4] = { 64 " Agrif_%s(%d)", // which_grid == 0 65 " Agrif_%s(%d) %% parent_var", // which_grid == 1 66 " Agrif_Mygrid %% %s(%d)", // which_grid == 2 67 " Agrif_Curgrid %% %s(%d)", // which_grid == 3 68 }; 69 70 return varname[which_grid]; 71 } 72 73 void WARNING_CharSize(const variable *var) 74 { 75 if ( var->v_nbdim == 0 ) 76 { 77 if ( convert2int(var->v_dimchar) > 2400 ) 78 { 79 printf("WARNING : The dimension of the character %s \n", var->v_nomvar); 80 printf(" is upper than 2400. You must change \n"); 81 printf(" the dimension of carray0 \n"); 82 printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); 83 printf(" line 161. Replace 2400 with %d. \n", convert2int(var->v_dimchar)+100); 84 } 85 Save_Length_int(convert2int(var->v_dimchar),1); 86 } 87 else if ( var->v_nbdim == 1 ) 88 { 89 if ( convert2int(var->v_dimchar) > 200 ) 90 { 91 printf("WARNING : The dimension of the character %s \n", var->v_nomvar); 92 printf(" is upper than 200. You must change \n"); 93 printf(" the dimension of carray1 \n"); 94 printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); 95 printf(" line 162. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); 96 } 97 Save_Length_int(convert2int(var->v_dimchar),2); 98 } 99 else if ( var->v_nbdim == 2 ) 100 { 101 if ( convert2int(var->v_dimchar) > 200 ) 102 { 103 printf("WARNING : The dimension of the character %s \n", var->v_nomvar); 104 printf(" is upper than 200. You must change \n"); 105 printf(" the dimension of carray2 \n"); 106 printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); 107 printf(" line 163. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); 108 } 109 Save_Length_int(convert2int(var->v_dimchar),3); 110 } 111 else if ( var->v_nbdim == 3 ) 112 { 113 if ( convert2int(var->v_dimchar) > 200 ) 114 { 115 printf("WARNING : The dimension of the character %s \n", var->v_nomvar); 116 printf(" is upper than 200. You must change \n"); 117 printf(" the dimension of carray3 \n"); 118 printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); 119 printf(" line 164. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); 120 } 121 Save_Length_int(convert2int(var->v_dimchar),4); 122 } 123 } 124 /******************************************************************************/ 125 /* vargridnametabvars */ 64 126 /******************************************************************************/ 65 127 /* This subroutine is used to create the string */ 66 128 /******************************************************************************/ 67 129 /* */ 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 */ 130 /* if iorindice == 0 -----------> Agrif_Gr % tabvars (i) % array1 */ 131 /* */ 132 /* if iorindice == 1 -----------> Agrif_Gr % tabvars (12) % array1 */ 133 /* */ 134 /******************************************************************************/ 135 const char *vargridnametabvars (const variable * var, int iorindice) 136 { 137 static char tname_1[LONG_C]; 138 static char tname_2[LONG_C]; 139 140 if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars); 141 else sprintf(tname_1, "Agrif_Gr %% %s(i)", tabvarsname(var)); 142 143 if (!strcasecmp(var->v_typevar, "REAL")) 144 { 145 if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 146 else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 147 else sprintf(tname_2, "%% array%d", var->v_nbdim); 148 } 149 else if (!strcasecmp(var->v_typevar, "integer")) 150 { 151 sprintf(tname_2, "%% iarray%d", var->v_nbdim); 152 } 153 else if (!strcasecmp(var->v_typevar, "logical")) 154 { 155 sprintf(tname_2, "%% larray%d", var->v_nbdim); 156 } 157 else if (!strcasecmp(var->v_typevar, "character")) 158 { 159 WARNING_CharSize(var); 160 sprintf (tname_2, "%% carray%d", var->v_nbdim); 161 } 162 163 strcat(tname_1, tname_2); 164 Save_Length(tname_1, 46); 165 166 return tname_1; 167 } 168 169 /******************************************************************************/ 170 /* vargridcurgridtabvars */ 86 171 /******************************************************************************/ 87 172 /* This subroutine is used to create the string */ 88 173 /******************************************************************************/ 89 174 /* */ 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 /* if which_grid == 0 --> Agrif_Curgrid % tabvars (i) % array1 */ 176 /* */ 177 /* if which_grid == 1 --> Agrif_tabvars (i) % parent_var % array1 */ 178 /* */ 179 /* if which_grid == 2 --> Agrif_Gr % tabvars (i) % array1 */ 180 /* */ 181 /******************************************************************************/ 182 const char *vargridcurgridtabvars(const variable *var, int which_grid) 183 { 184 static char tname_1[LONG_C]; 185 static char tname_2[LONG_C]; 186 187 if (!strcasecmp(var->v_typevar,"type")) 188 { 189 sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar); 190 } 191 else 192 { 193 sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars); 194 195 if (!strcasecmp(var->v_typevar, "REAL")) 196 { 197 if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 198 else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 199 else sprintf(tname_2, "%% array%d", var->v_nbdim); 200 } 201 else if (!strcasecmp(var->v_typevar, "INTEGER")) 202 { 203 sprintf(tname_2, "%% iarray%d", var->v_nbdim); 204 } 205 else if (!strcasecmp(var->v_typevar, "LOGICAL")) 206 { 207 sprintf(tname_2, "%% larray%d", var->v_nbdim); 208 } 209 else if (!strcasecmp(var->v_typevar, "CHARACTER")) 210 { 211 WARNING_CharSize(var); 212 sprintf(tname_2, "%% carray%d", var->v_nbdim); 213 } 214 strcat(tname_1, tname_2); 215 } 216 Save_Length(tname_1, 46); 217 218 return tname_1; 219 } 220 221 /******************************************************************************/ 222 /* vargridcurgridtabvarswithoutAgrif_Gr */ 175 223 /******************************************************************************/ 176 224 /* This subroutine is used to create the string */ 177 225 /******************************************************************************/ 178 226 /* */ 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); 245 printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename); 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; 227 /******************************************************************************/ 228 const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var) 229 { 230 static char tname_1[LONG_C]; 231 static char tname_2[LONG_C]; 232 233 sprintf(tname_1, "(%d)", var->v_indicetabvars); 234 235 if (!strcasecmp (var->v_typevar, "REAL")) 236 { 237 if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 238 else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 239 else sprintf(tname_2, "%% array%d", var->v_nbdim); 240 } 241 else if (!strcasecmp(var->v_typevar, "INTEGER")) 242 { 243 sprintf(tname_2, "%% iarray%d", var->v_nbdim); 244 } 245 else if (!strcasecmp(var->v_typevar, "LOGICAL")) 246 { 247 sprintf(tname_2, "%% larray%d", var->v_nbdim); 248 } 249 else if (!strcasecmp(var->v_typevar, "CHARACTER")) 250 { 251 WARNING_CharSize(var); 252 sprintf(tname_2, "%% carray%d", var->v_nbdim); 253 } 254 255 strcat(tname_1, tname_2); 256 Save_Length(tname_1, 46); 257 258 return tname_1; 323 259 } 324 260 … … 333 269 /* */ 334 270 /******************************************************************************/ 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; 271 const char * vargridparam(const variable *var) 272 { 273 typedim dim; 274 listdim *newdim; 275 char newname[LONG_M]; 276 277 newdim = var->v_dimension; 278 if (!newdim) return ""; 279 280 strcpy (tmpvargridname, "("); 281 while (newdim) 282 { 283 dim = newdim->dim; 284 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var)); 285 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var)); 286 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var)); 287 strcat(tmpvargridname, newname); 288 strcat(tmpvargridname, " : "); 289 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var)); 290 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var)); 291 strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var)); 292 strcat(tmpvargridname, newname); 293 newdim = newdim->suiv; 294 if (newdim) strcat(tmpvargridname, ","); 295 } 296 strcat(tmpvargridname, ")\0"); 297 Save_Length(tmpvargridname,40); 298 return tmpvargridname; 382 299 } 383 300 … … 396 313 { 397 314 FILE *probdim; 398 char ligne[LONG_ C];399 400 probdim = associate("probdim_agrif.h");315 char ligne[LONG_M]; 316 317 probdim = open_for_write("probdim_agrif.h"); 401 318 sprintf (ligne, "Agrif_Probdim = %d", dimprob); 402 319 tofich (probdim, ligne,1); … … 421 338 FILE *keys; 422 339 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 340 keys = open_for_write("keys_agrif.h"); 341 fprintf(keys," AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids); 342 fprintf(keys," AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids); 430 343 fclose(keys); 431 344 } … … 444 357 void write_modtypeagrif_file() 445 358 { 446 char ligne[LONG_ C];359 char ligne[LONG_M]; 447 360 FILE *typedata; 448 449 typedata = associate ("modtype_agrif.h"); 361 int i; 362 363 typedata = open_for_write("modtype_agrif.h"); 450 364 /* AGRIF_NbVariables : number of variables */ 451 sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars); 452 tofich(typedata,ligne,1); 365 for (i=0;i<NB_CAT_VARIABLES;i++) 366 { 367 sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]); 368 tofich(typedata,ligne,1); 369 } 453 370 fclose (typedata); 454 371 } … … 460 377 /******************************************************************************/ 461 378 /* */ 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); 379 /* Agrif_Gr % tabvars (i) % namevar = "variable" */ 380 /* */ 381 /******************************************************************************/ 382 void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty) 383 { 384 char ligne[LONG_M]; 385 386 *InitEmpty = 0 ; 387 sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar); 388 tofich(createvarname,ligne,1); 479 389 } 480 390 … … 488 398 /* */ 489 399 /******************************************************************************/ 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 } 400 void write_Setnumberofcells_file() 401 { 402 char ligne[LONG_VNAME]; 403 char cformat[LONG_VNAME]; 404 FILE *setnumberofcells; 405 406 if ( IndicenbmaillesX == 0 ) return; 407 408 setnumberofcells = open_for_write("SetNumberofcells.h"); 409 410 if ( onlyfixedgrids == 1 ) 411 strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0"); 412 else 413 strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0"); 414 415 sprintf(ligne, cformat, 1, IndicenbmaillesX); 416 tofich(setnumberofcells, ligne, 1); 417 418 if ( dimprob > 1 ) 419 { 420 sprintf(ligne, cformat, 2, IndicenbmaillesY); 421 tofich(setnumberofcells, ligne, 1); 422 } 423 if ( dimprob > 2 ) 424 { 425 sprintf(ligne, cformat, 3, IndicenbmaillesZ); 426 tofich(setnumberofcells, ligne, 1); 427 } 428 fclose(setnumberofcells); 548 429 } 549 430 … … 557 438 /* */ 558 439 /******************************************************************************/ 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 } 440 void write_Getnumberofcells_file() 441 { 442 char ligne[LONG_VNAME]; 443 char cformat[LONG_VNAME]; 444 FILE *getnumberofcells; 445 446 if ( IndicenbmaillesX == 0 ) return; 447 448 strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)"); 449 450 getnumberofcells = open_for_write("GetNumberofcells.h"); 451 452 sprintf(ligne, cformat, IndicenbmaillesX, 1); 453 tofich(getnumberofcells, ligne, 1); 454 455 if (dimprob > 1) 456 { 457 sprintf(ligne, cformat, IndicenbmaillesY, 2); 458 tofich(getnumberofcells, ligne,1); 459 } 460 if (dimprob > 2) 461 { 462 sprintf(ligne, cformat, IndicenbmaillesZ, 3); 463 tofich(getnumberofcells, ligne,1); 464 } 465 fclose(getnumberofcells); 587 466 } 588 467 … … 595 474 /* */ 596 475 /* ! 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 } 476 /* Agrif_Gr % tabvars(i) % nbdim = 1 */ 477 /* */ 478 /******************************************************************************/ 479 void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty) 480 { 481 char ligne[LONG_M]; 482 483 if ( v->v_nbdim != 0 ) 484 { 485 *VarnameEmpty = 0 ; 486 sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim); 487 tofich (initproc, ligne,1); 488 } 617 489 } 618 490 … … 624 496 FILE *AllocUSE; 625 497 626 AllocUSE= associate("include_use_Alloc_agrif.h");627 alloccalls = associate("allocations_calls_agrif.h");498 AllocUSE= open_for_write("include_use_Alloc_agrif.h"); 499 alloccalls = open_for_write("allocations_calls_agrif.h"); 628 500 629 501 parcours = List_Subroutine_For_Alloc; 630 502 while ( parcours ) 631 503 { 632 fprintf(AllocUSE," USE %s\n", parcours -> o_nom ); 633 fprintf (alloccalls," Call Alloc_agrif_%s(Agrif_Gr)\n", 634 parcours -> o_nom ); 504 fprintf(AllocUSE," use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom ); 505 fprintf (alloccalls," call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom ); 635 506 parcours = parcours -> suiv; 636 507 } … … 656 527 return out; 657 528 } 529 658 530 void write_allocation_Common_0() 659 531 { 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]; 668 char ligne2[LONGNOM]; 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 ) 532 listnom *parcours_nom; 533 listnom *neededparameter; 534 listvar *parcours; 535 listvar *parcoursprec; 536 listvar *parcours1; 537 FILE *allocationagrif; 538 FILE *paramtoamr; 539 char ligne[LONG_M]; 540 char ligne2[LONG_M]; 541 variable *v; 542 int IndiceMax; 543 int IndiceMin; 544 int compteur; 545 int out; 546 int indiceprec; 547 int ValeurMax; 548 char initialvalue[LONG_M]; 549 listindice **list_indic; 550 listindice *parcoursindic; 551 int i; 552 553 parcoursprec = (listvar *) NULL; 554 parcours_nom = List_NameOfCommon; 555 ValeurMax = 2; 556 while ( parcours_nom ) 557 { 558 if ( parcours_nom->o_val == 1 ) 559 { 560 /* Open the file to create the Alloc_agrif subroutine */ 561 sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); 562 allocationagrif = open_for_write(ligne); 563 fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom); 564 565 sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom); 566 paramtoamr = open_for_write(ligne); 567 neededparameter = (listnom *) NULL; 568 list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); 569 570 // shouldincludempif = 1 ; 571 parcours = List_Common_Var; 572 while ( parcours ) 709 573 { 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," = "); 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); 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 /***************************************************************/ 574 if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) && 575 IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 ) 576 { 577 v = parcours->var; 578 IndiceMax = 0; 579 IndiceMin = indicemaxtabvars[v->v_catvar]; 580 /* body of the file */ 581 if ( !strcasecmp(v->v_commoninfile,cur_filename) ) 582 { 583 if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) 584 { 585 sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0)); 586 tofich(allocationagrif,ligne,1); 587 } 588 if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) ) 589 { 590 /* ALLOCATION */ 591 if ( v->v_dimension != 0 ) 592 { 593 if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax ) 594 { 595 parcours1 = parcours; 596 compteur = -1; 597 out = 0; 598 indiceprec = parcours->var->v_indicetabvars -1 ; 599 while ( parcours1 && out == 0 600 && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension) 601 && !strcasecmp(parcours->var->v_typevar, parcours1->var->v_typevar) 602 && (parcours1->var->v_indicetabvars == indiceprec+1) ) 603 { 604 if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) || 605 !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) ) 606 { 607 compteur = compteur +1 ; 608 indiceprec = parcours1->var->v_indicetabvars; 609 parcoursprec = parcours1; 610 parcours1 = parcours1->suiv; 611 } 612 else out = 1; 613 } 614 sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar); 615 tofich(allocationagrif,ligne,1); 616 if ( compteur > ValeurMax ) 617 { 618 sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars, 619 parcours->var->v_indicetabvars+compteur); 620 tofich(allocationagrif,ligne,1); 621 IndiceMin = parcours->var->v_indicetabvars; 622 IndiceMax = parcours->var->v_indicetabvars+compteur; 623 sprintf(ligne," allocate(%s", vargridnametabvars(v,1)); 624 sprintf(ligne2,"%s)", vargridparam(v)); 625 strcat(ligne,ligne2); 626 tofich(allocationagrif,ligne,1); 627 tofich(allocationagrif,"enddo",1); 628 i = parcours->var->v_indicetabvars; 629 do 630 { 631 parcoursindic = (listindice *)calloc(1,sizeof(listindice)); 632 parcoursindic -> i_indice = i; 633 parcoursindic -> suiv = list_indic[parcours->var->v_catvar]; 634 list_indic[parcours->var->v_catvar] = parcoursindic; 635 i = i + 1; 636 } while ( i <= parcours->var->v_indicetabvars+compteur ); 637 parcours = parcoursprec; 638 } 639 else 640 { 641 sprintf(ligne,"allocate(%s", vargridnametabvars(v,0)); 642 sprintf(ligne2,"%s)", vargridparam(v)); 643 strcat(ligne,ligne2); 644 tofich(allocationagrif,ligne,1); 645 parcoursindic = (listindice *) calloc(1,sizeof(listindice)); 646 parcoursindic -> i_indice = parcours->var->v_indicetabvars; 647 parcoursindic -> suiv = list_indic[parcours->var->v_catvar]; 648 list_indic[parcours->var->v_catvar] = parcoursindic; 649 } 650 neededparameter = writedeclarationintoamr(List_Parameter_Var, 651 paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname); 652 } 653 } /* end of the allocation part */ 654 /* INITIALISATION */ 655 if ( strcasecmp(v->v_initialvalue,"") ) 656 { 657 strcpy(ligne, vargridnametabvars(v,0)); 658 /* We should modify the initialvalue in the case of variable has been defined with others variables */ 659 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var)); 660 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 661 { 662 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var)); 663 } 664 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 665 { 666 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var)); 667 } 668 strcat (ligne," = "); 669 670 if (v->v_nbdim == 0) 671 { 672 strcpy(ligne2,initialvalue); 673 } 674 else 675 { 676 sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0)); 677 } 678 strcat(ligne,ligne2); 679 tofich(allocationagrif,ligne,1); 680 } 681 } 682 if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) 683 { 684 tofich(allocationagrif,"endif",1); 685 } 686 } 687 } 688 parcours = parcours -> suiv; 857 689 } 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 690 /* Close the file Alloc_agrif */ 691 fclose(allocationagrif); 692 fclose(paramtoamr); 693 } 694 parcours_nom = parcours_nom -> suiv; 695 } 696 } 871 697 872 698 void write_allocation_Global_0() 873 699 { 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) ) 700 listnom *parcours_nom; 701 listvar *parcours; 702 listvar *parcoursprec; 703 listvar *parcours1; 704 FILE *allocationagrif; 705 char ligne[LONG_M]; 706 char ligne2[LONG_M]; 707 variable *v; 708 int IndiceMax; 709 int IndiceMin; 710 int compteur; 711 int out; 712 int indiceprec; 713 int ValeurMax; 714 char initialvalue[LONG_M]; 715 int typeiswritten ; 716 717 parcoursprec = (listvar *) NULL; 718 parcours_nom = List_NameOfModule; 719 ValeurMax = 2; 720 721 while ( parcours_nom ) 722 { 723 if ( parcours_nom->o_val == 1 ) 724 { 725 IndiceMax = 0; 726 IndiceMin = indicemaxtabvars[0]; 727 /* Open the file to create the Alloc_agrif subroutine */ 728 sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); 729 allocationagrif = open_for_write(ligne); 730 731 // if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) 732 // { 733 // /* add the call to initworkspace */ 734 // tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1); 735 // tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0); 736 // tofich(allocationagrif,"else",1); 737 // tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0); 738 // tofich(allocationagrif,"endif",1); 739 // tofich(allocationagrif,"call Agrif_InitWorkspace",1); 740 // } 741 742 typeiswritten = 0; 743 parcours = List_Global_Var; 744 while ( parcours ) 924 745 { 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 /***************************************************************/ 746 if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) && 747 parcours->var->v_VariableIsParameter == 0 && 748 parcours->var->v_notgrid == 0 ) 749 { 750 v = parcours->var; 751 IndiceMax = 0; 752 IndiceMin = indicemaxtabvars[v->v_catvar]; 753 /* body of the file */ 754 if ( !strcasecmp(v->v_commoninfile,cur_filename) ) 755 { 756 if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) 757 { 758 sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0)); 759 tofich(allocationagrif,ligne,1); 760 } 761 if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) ) 762 { 763 /* ALLOCATION */ 764 if ( v->v_dimension != 0 ) 765 { 766 if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax ) 767 { 768 parcours1 = parcours; 769 compteur = -1; 770 out = 0; 771 indiceprec = parcours->var->v_indicetabvars -1 ; 772 while ( parcours1 && out == 0 773 && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension) 774 && !strcasecmp(parcours->var->v_typevar, parcours1->var->v_typevar) 775 && (parcours1->var->v_indicetabvars == indiceprec+1) ) 776 { 777 if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) || 778 !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) ) 779 { 780 compteur = compteur +1 ; 781 indiceprec = parcours1->var->v_indicetabvars; 782 parcoursprec = parcours1; 783 parcours1 = parcours1->suiv; 784 } 785 else out = 1; 786 } 787 sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar); 788 tofich(allocationagrif,ligne,1); 789 if ( compteur > ValeurMax ) 790 { 791 sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars, 792 parcours->var->v_indicetabvars+compteur); 793 tofich(allocationagrif,ligne,1); 794 IndiceMin = parcours->var->v_indicetabvars; 795 IndiceMax = parcours->var->v_indicetabvars+compteur; 796 sprintf(ligne," allocate(%s", vargridnametabvars(v,1)); 797 sprintf(ligne2,"%s)", vargridparam(v)); 798 strcat(ligne,ligne2); 799 tofich(allocationagrif,ligne,1); 800 tofich(allocationagrif,"enddo",1); 801 parcours = parcoursprec; 802 } 803 else 804 { 805 sprintf(ligne,"allocate(%s", vargridnametabvars(v,0)); 806 sprintf(ligne2,"%s)", vargridparam(v)); 807 strcat(ligne,ligne2); 808 tofich(allocationagrif,ligne,1); 809 } 810 } 811 } /* end of the allocation part */ 812 /* INITIALISATION */ 813 if ( strcasecmp(v->v_initialvalue,"") ) 814 { 815 strcpy(ligne, vargridnametabvars(v,0)); 816 /* We should modify the initialvalue in the case of variable has been defined with others variables */ 817 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var)); 818 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 819 { 820 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var)); 821 } 822 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 823 { 824 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var)); 825 } 826 strcat (ligne," = "); 827 strcat (ligne,initialvalue); 828 Save_Length(ligne,48); 829 tofich(allocationagrif,ligne,1); 830 } 831 } 832 /* Case of structure types */ 833 if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") ) 834 { 835 sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename); 836 tofich(allocationagrif, ligne, 1); 837 sprintf(ligne," allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename); 838 tofich(allocationagrif, ligne, 1); 839 tofich(allocationagrif, "endif", 1); 840 typeiswritten = 1; 841 } 842 if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) 843 { 844 tofich(allocationagrif,"endif",1); 845 } 846 } 847 } 848 parcours = parcours -> suiv; 1055 849 } 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 } 850 if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) 851 { 852 fprintf(allocationagrif, " if ( .not.Agrif_Root() ) then\n"); 853 fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n"); 854 fprintf(allocationagrif, " else\n"); 855 fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n"); 856 fprintf(allocationagrif, " endif\n"); 857 fprintf(allocationagrif, " call Agrif_InitWorkspace\n"); 858 } 859 fclose(allocationagrif); 860 } 861 parcours_nom = parcours_nom -> suiv; 862 } 1075 863 } 1076 864 … … 1082 870 /* */ 1083 871 /******************************************************************************/ 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 } 872 void creefichieramr () 873 { 874 listvar *newvar; 875 variable *v; 876 int erreur; 877 char filefich[LONG_M]; 878 879 int InitEmpty; 880 int VarnameEmpty; 881 int donotwrite; 882 883 FILE *initproc; 884 FILE *initglobal; 885 FILE *createvarname; 886 FILE *createvarnameglobal; 887 888 if ( todebug == 1 ) printf("Enter in creefichieramr\n"); 889 890 sprintf(filefich, "cd %s", include_dir); 891 erreur = system (filefich); 892 if (erreur) 893 { 894 sprintf(filefich, "mkdir -p %s", include_dir); 895 system(filefich); 896 printf("%s: Directory created\n", include_dir); 897 } 1113 898 1114 899 /******************************************************************************/ … … 1116 901 /******************************************************************************/ 1117 902 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 } 903 if ( todebug == 1 ) 904 { 905 const char *NameTampon = "toto"; 906 sprintf(filefich,"initialisations_agrif_%s.h", NameTampon); 907 initproc = open_for_write(filefich); 908 909 sprintf(filefich,"createvarname_agrif_%s.h", NameTampon); 910 createvarname = open_for_write(filefich); 911 912 InitEmpty = 1 ; 913 VarnameEmpty = 1 ; 914 915 newvar = List_Global_Var; 916 while ( newvar ) 917 { 918 donotwrite = 0; 919 v = newvar->var; 920 921 if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 ) 922 { 923 write_createvarnameagrif_file(v,createvarname,&VarnameEmpty); 924 write_initialisationsagrif_file(v,initproc,&InitEmpty); 925 } 926 newvar = newvar->suiv; 927 } 928 fclose (createvarname); 929 fclose (initproc); 930 931 if ( is_dependfile_created(curmodulename) == 0 ) 932 { 933 if ( InitEmpty != 1 ) 934 { 935 initglobal = open_for_append("initialisations_agrif.h"); 936 fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon); 937 fclose(initglobal); 938 } 939 if ( VarnameEmpty != 1 ) 940 { 941 createvarnameglobal= open_for_append("createvarname_agrif.h"); 942 fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon); 943 fclose(createvarnameglobal); 944 } 945 } 946 } 947 write_allocation_Common_0(); 948 write_allocation_Global_0(); 949 950 Write_Alloc_Agrif_Files(); 951 write_probdimagrif_file(); 952 write_keysagrif_file(); 953 write_modtypeagrif_file(); 954 955 if ( NbMailleXDefined == 1 ) 956 { 957 write_Setnumberofcells_file(); 958 write_Getnumberofcells_file(); 959 } 960 961 if ( todebug == 1 ) printf("Out of creefichieramr\n"); 962 }
Note: See TracChangeset
for help on using the changeset viewer.
