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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
toamr.c in trunk/AGRIF/LIB – NEMO

source: trunk/AGRIF/LIB/toamr.c @ 774

Last change on this file since 774 was 774, checked in by rblod, 16 years ago

Update Agrif, see ticket:#39

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