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 @ 396

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 42.8 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/*     Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)             */
6/*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */
7/*                                                                            */
8/*     This program is free software; you can redistribute it and/or modify   */
9/*    it                                                                      */
10/*                                                                            */
11/*    This program is distributed in the hope that it will be useful,         */
12/*     but WITHOUT ANY WARRANTY; without even the implied warranty of         */
13/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          */
14/*    GNU General Public License for more details.                            */
15/*                                                                            */
16/******************************************************************************/
17#include <stdlib.h>
18#include <stdio.h>
19#include <string.h>
20#include "decl.h"
21char lvargridname[LONGNOM];
22char lvargridname2[LONGNOM];
23
24
25/******************************************************************************/
26/*                       variablenameroottabvars                              */
27/******************************************************************************/
28/* This subroutine is used to create the string                               */
29/******************************************************************************/
30/*                                                                            */
31/*  ----------->  Agrif_Mygrid % tabvars (i) % var                            */
32/*                                                                            */
33/******************************************************************************/
34char *variablenameroottabvars (variable * var)
35{
36  char *ligne;
37
38  ligne = (char *) malloc (LONGLIGNE * sizeof (char));
39  sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var", var->indicetabvars);
40  return ligne;
41}
42
43
44/******************************************************************************/
45/*                        variablenametabvars                                 */
46/******************************************************************************/
47/* This subroutine is used to create the string                               */
48/******************************************************************************/
49/*                                                                            */
50/*  if iorindice = 0 ---------->  Agrif_Gr % tabvars (i) % var                */
51/*                                                                            */
52/*  if iorindice = 1 ---------->  Agrif_Gr % tabvars (12) % var               */
53/*                                                                            */
54/******************************************************************************/
55char *variablenametabvars (variable * var, int iorindice)
56{
57  char *ligne;
58
59  ligne = (char *) malloc (LONGLIGNE * sizeof (char));
60  if ( iorindice == 0 ) sprintf (ligne, " Agrif_Gr %% tabvars(%d)%% var",
61                                 var->indicetabvars);
62  else sprintf (ligne, " Agrif_Gr %% tabvars(i)%% var");
63  return ligne;
64}
65
66/******************************************************************************/
67/*                        variablecurgridtabvars                              */
68/******************************************************************************/
69/* This subroutine is used to create the string                               */
70/******************************************************************************/
71/*                                                                            */
72/*  ----------->  Agrif_Curgrid % tabvars (i) % var                           */
73/*                                                                            */
74/******************************************************************************/
75char *variablecurgridtabvars (variable * var,int ParentOrCurgrid)
76{
77  char *ligne;
78
79  ligne = (char *) malloc (LONGLIGNE * sizeof (char));
80  if ( ParentOrCurgrid == 0 ) sprintf (ligne, " Agrif_tabvars(%d) %% var",
81                              var->indicetabvars);
82  else if ( ParentOrCurgrid == 1 ) sprintf (ligne, 
83                              " Agrif_tabvars(%d) %% parent_var %% var",
84                               var->indicetabvars);
85  else if ( ParentOrCurgrid == 2 ) sprintf (ligne, 
86                              " Agrif_Gr %% tabvars(%d) %% var",
87                               var->indicetabvars);
88  else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var",
89                               var->indicetabvars);
90  return ligne;
91}
92
93/******************************************************************************/
94/*                           vargridnametabvars                               */
95/******************************************************************************/
96/* This subroutine is used to create the string                               */
97/******************************************************************************/
98/*                                                                            */
99/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % var % array1     */
100/*                                                                            */
101/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % var % array1    */
102/*                                                                            */
103/******************************************************************************/
104char *vargridnametabvars (variable * var,int iorindice)
105{
106  char *tmp;
107  char tmp1[LONGNOM];
108 
109  tmp = variablenametabvars (var,iorindice);
110  strcpy(tmp1,tmp);
111  free(tmp);
112 
113  sprintf (lvargridname, "%s", tmp1);
114  if (!strcasecmp (var->typevar, "REAL"))
115    {
116      sprintf (lvargridname2, "%% array%d", var->nbdim);
117    }
118  else if (!strcasecmp (var->typevar, "REAL*8"))
119    {
120      sprintf (lvargridname2, "%% darray%d", var->nbdim);
121    }
122  else if (!strcasecmp (var->typevar, "INTEGER"))
123    {
124      sprintf (lvargridname2, "%% iarray%d", var->nbdim);
125    }
126  else if (!strcasecmp (var->typevar, "LOGICAL"))
127    {
128      sprintf (lvargridname2, "%% larray%d", var->nbdim);
129    }
130  else if (!strcasecmp (var->typevar, "CHARACTER"))
131    {
132      sprintf (lvargridname2, "%% carray%d", var->nbdim);
133    }
134
135  strcat (lvargridname, lvargridname2);
136
137  return lvargridname;
138}
139
140/******************************************************************************/
141/*                           vargridcurgridtabvars                            */
142/******************************************************************************/
143/* This subroutine is used to create the string                               */
144/******************************************************************************/
145/*                                                                            */
146/* if ParentOrCurgrid == 0 -->  Agrif_Curgrid % tabvars (i) % var % array1    */
147/*                                                                            */
148/* if ParentOrCurgrid == 1 -->  Agrif_tabvars (i) % parent_var %var % array1  */
149/*                                                                            */
150/* if ParentOrCurgrid == 2 -->  Agrif_Gr % tabvars (i) % var % array1         */
151/*                                                                            */
152/******************************************************************************/
153char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid)
154{
155  char *tmp;
156  char tmp1[LONGNOM];
157 
158  tmp = variablecurgridtabvars (var,ParentOrCurgrid);
159  strcpy(tmp1,tmp);
160  free(tmp);
161 
162  sprintf (lvargridname, "%s", tmp1);
163  if (!strcasecmp (var->typevar, "REAL"))
164    {
165      sprintf (lvargridname2, "%%array%d", var->nbdim);
166    }
167  else if (!strcasecmp (var->typevar, "REAL*8"))
168    {
169      sprintf (lvargridname2, "%%darray%d", var->nbdim);
170    }
171  else if (!strcasecmp (var->typevar, "INTEGER"))
172    {
173      sprintf (lvargridname2, "%%iarray%d", var->nbdim);
174    }
175  else if (!strcasecmp (var->typevar, "LOGICAL"))
176    {
177      sprintf (lvargridname2, "%%larray%d", var->nbdim);
178    }
179  else if (!strcasecmp (var->typevar, "CHARACTER"))
180    {
181      sprintf (lvargridname2, "%%carray%d", var->nbdim);
182    }
183
184  strcat (lvargridname, lvargridname2);
185
186  return lvargridname;
187}
188
189/******************************************************************************/
190/*                               vargridparam                                 */
191/******************************************************************************/
192/* This subroutine is used to create the string which contains                */
193/* dimension list                                                             */
194/******************************************************************************/
195/*                                                                            */
196/*  DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj"                            */
197/*                                                                            */
198/******************************************************************************/
199char *vargridparam (variable * v, int whichone)
200{
201  typedim dim;
202  listdim *newdim;
203  char newname[LONGNOM];
204   
205  newdim = v->dimension;
206  if (!newdim) return "";
207
208  strcpy (tmpvargridname, "(");
209  while (newdim)
210  {
211     dim = newdim->dim;
212
213     strcpy(newname,"");
214     strcpy(newname, 
215            ChangeTheInitalvaluebyTabvarsName(dim.first,globliste,whichone));   
216     if ( !strcasecmp(newname,dim.first))
217     {
218        strcpy(newname,"");     
219        /* la liste des use de cette subroutine                               */
220        if ( !globalvarofusefile ) RecordUseModulesVariables();
221        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,
222                       globalvarofusefile,whichone));
223     }
224     strcat (tmpvargridname, newname);
225     strcat (tmpvargridname, " : ");
226     strcpy(newname,"");
227     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
228                        (dim.last,globliste,whichone));   
229     if ( !strcasecmp(newname,dim.last))
230     {
231        strcpy(newname,"");     
232        /* la liste des use de cette subroutine                               */
233        if ( !globalvarofusefile ) RecordUseModulesVariables();
234        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
235                       (dim.last, globalvarofusefile,whichone));
236     }
237     strcat (tmpvargridname, newname);
238     newdim = newdim->suiv;
239     if (newdim) strcat (tmpvargridname, ",");
240  }
241  strcat (tmpvargridname, ")");
242  strcat (tmpvargridname, "\0");
243  return tmpvargridname;
244}
245
246/******************************************************************************/
247/*                        write_probdimagrif_file                             */
248/******************************************************************************/
249/* This subroutine is used to create the file probdim_agrif.h                 */
250/******************************************************************************/
251/*                                                                            */
252/*               probdim_agrif.h                                              */
253/*                                                                            */
254/*               Agrif_probdim = <number>                                     */
255/*                                                                            */
256/******************************************************************************/
257void write_probdimagrif_file()
258{
259  FILE *probdim;
260  char ligne[LONGLIGNE*100];
261 
262  probdim = associate("probdim_agrif.h");
263  sprintf (ligne, "Agrif_Probdim = %d", dimprob);
264  tofich (probdim, ligne,1);
265  fclose (probdim);
266}
267
268/******************************************************************************/
269/*                            write_includeagrif_file                         */
270/******************************************************************************/
271/* This subroutine is used to create the file include_agrif.h                 */
272/******************************************************************************/
273/*                                                                            */
274/*               include_agrif.h                                              */
275/*                                                                            */
276/*               USE <name of module>                                         */
277/*               ...                                                          */
278/******************************************************************************/
279void write_includeagrif_file()
280{
281  FILE *inclproc;
282  char ligne[LONGLIGNE*100];
283  listnom *newnom;
284
285  inclproc = associate ("include_agrif.h");
286
287  if (strcasecmp(commonfile_main,"") )
288  {
289    strcpy (ligne, "include '");
290    strcat (ligne, commonfile_main);
291    strcat (ligne, "'");
292  }
293  else
294  {
295    if ( listofmodules ) 
296    {
297       newnom = listofmodules;
298       while(newnom)
299       {
300          strcpy (ligne, "USE ");
301          strcat (ligne, newnom->nom);
302          newnom=newnom->suiv;
303          tofich (inclproc, ligne,1);
304       }
305    }
306  }
307  fclose (inclproc);
308}
309
310/******************************************************************************/
311/*                             write_keysagrif_file                           */
312/******************************************************************************/
313/* This subroutine is used to create the file keys_agrif.h                    */
314/******************************************************************************/
315/*                                                                            */
316/*               keys_agrif.h                                                 */
317/*                                                                            */
318/*               AGRIF_USE_FIXED_GRIDS = 0                                    */
319/*               AGRIF_USE_ONLY_FIXED_GRIDS = 0                               */
320/*               AGRIF_USE_(ONLY)_FIXED_GRIDS = 1                             */
321/*                                                                            */
322/******************************************************************************/
323void write_keysagrif_file()
324{
325  FILE *keys;
326
327  keys = associate ("keys_agrif.h");
328  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 0\n");
329  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 0\n");
330  if (fixedgrids     == 1) fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 1\n");
331  if (onlyfixedgrids == 1) fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 1\n");
332
333  fclose(keys); 
334}
335
336/******************************************************************************/
337/*                       write_clusteringagrif_file                           */
338/******************************************************************************/
339/* This subroutine is used to create the file  clustering_agrif.h             */
340/******************************************************************************/
341/*                                                                            */
342/*               clustering_agrif                                             */
343/*                                                                            */
344/*               Agrif_regridding =                                           */
345/*               Agrif_Minwidth   =                                           */
346/*               Agrif_Efficiency =                                           */
347/*               Agrif_mind(1)    =                                           */
348/*               Agrif_mind(2)    =                                           */
349/*               Agrif_mind(3)    =                                           */
350/*                                                                            */
351/******************************************************************************/
352void write_clusteringagrif_file()
353{
354  FILE *clustering;
355  char ligne[LONGLIGNE*100];
356  int i;
357  float res;
358
359  clustering = associate ("clustering_agrif.h");
360
361  sprintf(ligne,"Agrif_Regridding = %d",regridding);
362  tofich(clustering,ligne,1);
363  sprintf(ligne,"Agrif_Minwidth = %d",minwidth);
364  tofich(clustering,ligne,1);
365  sprintf(ligne,"Agrif_Efficiency = %e",(float) (efficiency)/100.);
366  tofich(clustering,ligne,1);
367  res=1.;
368  for (i=1;i<rafmaxx;i++)
369    res=res*(float)coeffrafx;
370    if (res == 0.) res=1.;
371  sprintf(ligne,"Agrif_mind(1) = %e",1./res);
372  tofich(clustering,ligne,1);
373 
374  res=1.;
375  for (i=1;i<rafmaxy;i++)
376    res=res*(float)coeffrafy; 
377    if (res == 0.) res=1.;     
378  sprintf(ligne,"Agrif_mind(2) = %e",1./res);
379  tofich(clustering,ligne,1);
380
381  res=1.;
382  for (i=1;i<rafmaxz;i++) 
383    res=res*(float)coeffrafz; 
384    if (res == 0.) res=1.;   
385  sprintf(ligne,"Agrif_mind(3) = %e",1./res);
386  tofich(clustering,ligne,1);
387
388  fclose(clustering);
389}
390
391/******************************************************************************/
392/*                      write_modtypeagrif_file                               */
393/******************************************************************************/
394/* This subroutine is used to create the file typedata                        */
395/******************************************************************************/
396/*                                                                            */
397/*               modtype_agrif.h                                              */
398/*                                                                            */
399/*               Agrif_coeffref(i)  =                                         */
400/*               Agrif_coeffreft(i) =                                         */
401/*               Agrif_NbVariables =                                          */
402/*                                                                            */
403/******************************************************************************/
404void write_modtypeagrif_file()
405{
406  char ligne[LONGLIGNE*100];
407  FILE *typedata;
408
409  typedata = associate ("modtype_agrif.h");
410  /* AGRIF_coeffrefx : space refinement factor in the x-direction             */
411  if (coeffrafx == 0) coeffrafx = 1;
412  sprintf (ligne, "AGRIF_coeffref(1) = %d", coeffrafx);
413  tofich (typedata, ligne,1);
414  /* AGRIF_coeffrefy : space refinement factor in the y-direction             */
415  if (coeffrafy == 0) coeffrafy = 1;
416  sprintf (ligne, "AGRIF_coeffref(2) = %d", coeffrafy);
417  tofich (typedata, ligne,1);
418  /* AGRIF_coeffrefz : space refinement factor in the z-direction             */
419  if (coeffrafz == 0) coeffrafz = 1;
420  sprintf (ligne, "AGRIF_coeffref(3) = %d", coeffrafz);
421  tofich (typedata, ligne,1);
422  /* AGRIF_coeffreftx : time refinement factor in the x-direction             */
423  sprintf (ligne, "AGRIF_coeffreft(1) = %d", coeffraftx);
424  tofich (typedata, ligne,1);
425  /* AGRIF_coeffrefty : time refinement factor in the y-direction             */
426  sprintf (ligne, "AGRIF_coeffreft(2) = %d", coeffrafty);
427  tofich (typedata, ligne,1);
428  /* AGRIF_coeffreftz : time refinement factor in the z-direction             */
429  sprintf (ligne, "AGRIF_coeffreft(3) = %d", coeffraftz);
430  tofich (typedata, ligne,1);
431  /* AGRIF_NbVariables : number of variables                                  */
432  sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars);
433  tofich(typedata,ligne,1);
434  fclose (typedata);
435}
436
437/******************************************************************************/
438/*                   write_createvarnameagrif_file                            */
439/******************************************************************************/
440/* This subroutine is used to create the file  createvarname                  */
441/******************************************************************************/
442/*                                                                            */
443/*    Agrif_Gr % tabvars (i) % var % namevar = "variable"                     */
444/*                                                                            */
445/******************************************************************************/
446void write_createvarnameagrif_file(variable *v,FILE *createvarname,
447                                                       int *InitEmpty)
448{
449  char ligne[LONGLIGNE*100];
450  char *tmp;
451  char temp1[LONGLIGNE];
452 
453  tmp =  variablenametabvars(v,0);
454  strcpy (temp1, tmp);
455  free(tmp);
456
457  *InitEmpty = 0 ;
458  sprintf(ligne, "%s %% namevar = \"%s\"",temp1,v->nomvar);
459  tofich(createvarname,ligne,1);
460}
461
462/******************************************************************************/
463/*                        write_Setnumberofcells_file                         */
464/******************************************************************************/
465/* This subroutine is used to create the file  setnumberofcells               */
466/******************************************************************************/
467/*                                                                            */
468/*              Agrif_Gr % n(i) = nbmailles                                   */
469/*                                                                            */
470/******************************************************************************/
471void write_Setnumberofcells_file()
472{
473  char ligne[LONGLIGNE*100];
474  FILE *setnumberofcells;
475
476  setnumberofcells=associate("SetNumberofcells.h");
477 
478  sprintf (ligne, 
479           "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
480           IndicenbmaillesX);
481  tofich (setnumberofcells, ligne,1);
482  if (dimprob > 1)
483  {
484     sprintf (ligne, 
485           "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
486           IndicenbmaillesY);
487     tofich (setnumberofcells, ligne,1);
488  }
489  if (dimprob > 2)
490  {
491     sprintf (ligne, 
492           "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
493           IndicenbmaillesZ);
494     tofich (setnumberofcells, ligne,1);
495  }
496  fclose (setnumberofcells);
497}
498
499/******************************************************************************/
500/*                       write_Getnumberofcells_file                          */
501/******************************************************************************/
502/* This subroutine is used to create the file  getnumberofcells               */
503/******************************************************************************/
504/*                                                                            */
505/*              nbmailles = Agrif_Gr % n(i)                                   */
506/*                                                                            */
507/******************************************************************************/
508void write_Getnumberofcells_file()
509{
510  char ligne[LONGLIGNE*100];
511  FILE *getnumberofcells;
512
513  getnumberofcells=associate("GetNumberofcells.h");
514  sprintf (ligne, 
515           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(1)",
516           IndicenbmaillesX);
517  tofich (getnumberofcells, ligne,1);
518  if (dimprob > 1)
519    {
520      sprintf (ligne,
521           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(2)",
522           IndicenbmaillesY);
523      tofich (getnumberofcells, ligne,1);
524    }
525  if (dimprob > 2)
526    {
527      sprintf (ligne, 
528           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(3)",
529           IndicenbmaillesZ);
530      tofich (getnumberofcells, ligne,1);
531    }   
532  fclose (getnumberofcells);
533}
534
535/******************************************************************************/
536/*                      write_initialisationsagrif_file                       */
537/******************************************************************************/
538/* This subroutine is used to create the file initproc                        */
539/******************************************************************************/
540/*                                                                            */
541/*              ! variable                                                    */
542/*              Agrif_Gr % tabvars(i) % var % nbdim = 1                       */
543/*                                                                            */
544/******************************************************************************/
545void write_initialisationsagrif_file(variable *v,FILE *initproc,
546                                     int *VarnameEmpty)
547{
548  char ligne[LONGLIGNE*100];
549  char temp1[LONGLIGNE];
550  char *tmp;
551
552  tmp = variablenameroottabvars (v);
553  strcpy (temp1, tmp);
554  free(tmp);
555
556  if ( v->nbdim != 0 ) 
557  {
558     *VarnameEmpty = 0 ;
559     sprintf (ligne, "%s %% nbdim = %d", temp1, v->nbdim);
560     tofich (initproc, ligne,1);
561  }
562}
563
564/******************************************************************************/
565/*                        write_allocation                                    */
566/******************************************************************************/
567/* This subroutine is used to create the file allocationagrif                 */
568/******************************************************************************/
569/*                                                                            */
570/*                 allocations_calls_agrif.h                                  */
571/*                 Call Alloc_agrif_module (Agrif_Gr)                         */
572/*                                                                            */
573/*                 alloc_agrif_module.h                                       */
574/*                 Subroutine Alloc_agrif_module (Agrif_Gr)                   */
575/*                 allocate(Agrif_Gr%tabvars(i)%var%array1(jpi)               */
576/*                 variable =>Agrif_Gr%tabvars(i)%var%array1                  */
577/*                                                                            */
578/******************************************************************************/
579listnom *write_allocation(listvar *newvar,variable *v,
580                          listnom *listedesnoms,
581                          FILE *alloccalls,
582                          FILE *instanceUSE,
583                          FILE *modulealloc,
584                          int *IndiceMax)
585{
586  char ligne[LONGLIGNE*100];
587  char curname[LONGNOM];
588  char initialvalue[LONGNOM];
589  char name1[LONGNOM];
590  listvar *parcours;
591  listnom *parcoursnom;
592  int compteur;
593  int ValeurMax;
594  int donotwrite=0;
595  FILE *IntegerI;
596 
597  ValeurMax = 2;
598  if (v->common == 1) strcpy(curname,v->commonname);     
599  if (v->module == 1) strcpy(curname,v->modulename); 
600 
601  if ( strcasecmp(curname,Alloctreatedname) )
602  {
603     strcpy(Alloctreatedname,curname);     
604
605/******************************************************************************/
606/*                 alloc_agrif_module.h                                       */
607/*                 Subroutine Alloc_agrif_module (Agrif_Gr)                   */
608/******************************************************************************/
609     if ( v->common == 1 ) strcpy(name1,v->commonname);
610     else if ( v->module == 1 )  strcpy(name1,v->modulename);
611     else exit(1);
612
613     sprintf(ligne,"alloc_agrif_%s.h",name1);
614     allocationagrif = associate (ligne);
615
616     *IndiceMax = 0;
617     AllocEmpty = 1;
618     sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)", curname);
619     tofich(allocationagrif,ligne,1);
620     if ( ModuleIsDefineInInputFile(curname) == 1 )
621     {
622        strcpy(ligne,"Use Agrif_Util");
623        tofich(allocationagrif,ligne,1);
624     }
625     else
626     {
627        if ( fortran77 == 1 )
628        {
629           strcpy(ligne,"Use Agrif_Types, ONLY : Agrif_tabvars");
630           tofich(allocationagrif,ligne,1);
631           strcpy(ligne,"Use Agrif_Types, ONLY : Agrif_grid");
632           tofich(allocationagrif,ligne,1);
633        }
634     }
635     strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
636     tofich(allocationagrif,ligne,1);
637     sprintf (ligne, "#include \"IntegerI_%s.h\"\n",curname);
638     fprintf(allocationagrif,ligne);
639     if ( fortran77 == 1 )
640     {
641        writedeclarationintoamr(parameterlist,allocationagrif,newvar,curname);
642     }
643     if ( ModuleIsDefineInInputFile(curname) == 1 )
644     {
645         /* add the call to initworkspace                                     */
646         tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
647         fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
648         tofich(allocationagrif,"else ",1);
649         fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
650         tofich(allocationagrif,"endif ",1);
651         tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
652     }
653  }
654  /* body of the file                                                         */
655  if ( !strcasecmp(v->commonname,Alloctreatedname) ||
656       !strcasecmp(v->modulename,Alloctreatedname) )
657  {
658     if (onlyfixedgrids != 1 && v->nbdim!=0) 
659     {
660        strcpy (ligne, "If (.not. associated(");
661        strcat (ligne, vargridnametabvars(v,0));
662        strcat (ligne, "))                       then");
663        tofich (allocationagrif, ligne,1);
664        AllocEmpty = 0;
665     }
666     if ( v->allocatable != 1 && ( v->dimsempty != 1) )
667     {
668        /*                ALLOCATION                                          */
669        if ( v->dimension != 0  )
670        {
671           if ( v->indicetabvars > *IndiceMax )
672           {
673              parcours = newvar;
674              compteur = -1;
675              while ( parcours &&
676                      !strcasecmp(newvar->var->readedlistdimension,
677                                  parcours->var->readedlistdimension) &&
678                      !strcasecmp(newvar->var->typevar,parcours->var->typevar) )
679              {
680                 compteur = compteur +1 ;
681                 parcours=parcours->suiv;
682              }
683              if ( compteur > ValeurMax )
684              {
685                 fprintf(allocationagrif,"      DO i = %d , %d\n", 
686                                          newvar->var->indicetabvars,
687                                          newvar->var->indicetabvars+compteur);
688                *IndiceMax = newvar->var->indicetabvars+compteur;
689                 IntegerIShouldBeAdd = 1;
690                 strcpy (ligne, "allocate ");
691                 strcat (ligne, "(");
692                 strcat (ligne, vargridnametabvars(v,1));
693                 strcat (ligne, vargridparam(v,0));
694                 strcat (ligne, ")");
695                 tofich (allocationagrif, ligne,1);
696                 fprintf(allocationagrif,"      end do\n");           
697                 AllocEmpty = 0;
698              }
699              else
700              {
701                 strcpy (ligne, "allocate ");
702                 strcat (ligne, "(");
703                 strcat (ligne, vargridnametabvars(v,0));
704                 strcat (ligne, vargridparam(v,0));
705                 strcat (ligne, ")");
706                 tofich (allocationagrif, ligne,1); 
707                 AllocEmpty = 0;
708              }
709           }
710        } /* end of the allocation part                                       */
711        /*                INITIALISATION                                      */
712        if ( strcasecmp(v->initialvalue,"") ) 
713        {
714           strcpy (ligne, "");
715           strcat (ligne, vargridnametabvars(v,0));
716           /* We should modify the initialvalue in the case of variable has   */
717           /*    benn defined with others variables                           */
718           strcpy(initialvalue,
719                  ChangeTheInitalvaluebyTabvarsName
720                                      (v->initialvalue,globliste,0));
721           if ( !strcasecmp(initialvalue,v->initialvalue) )
722           {
723              strcpy(initialvalue,"");     
724              /* la liste des use de cette subroutine                         */
725              if ( !globalvarofusefile ) RecordUseModulesVariables();
726              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
727                                      (v->initialvalue,globalvarofusefile,0));
728           }
729           strcat (ligne," = "); 
730           strcat (ligne,initialvalue); 
731           /*                                                                 */
732           tofich (allocationagrif, ligne,1);
733           AllocEmpty = 0;
734        }
735     }
736     if (onlyfixedgrids != 1 && v->nbdim!=0) 
737     {
738        strcpy (ligne, "   End if");
739        tofich (allocationagrif, ligne,1);
740     }     
741  } 
742  /* closing of the file                                                      */
743  if ( newvar->suiv == NULL ||
744       ( v->common == 1 &&
745         strcasecmp(newvar->suiv->var->commonname,Alloctreatedname) ) ||
746       ( v->module == 1 &&
747         strcasecmp(newvar->suiv->var->modulename,Alloctreatedname) ) 
748     )
749  {
750     if ( ModuleIsDefineInInputFile(curname) == 1 )
751     {
752         /* add the call to initworkspace                                     */
753         tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
754         fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
755         tofich(allocationagrif,"else ",1);
756         fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
757         tofich(allocationagrif,"endif ",1);
758         tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
759     }
760     strcpy (ligne, "Return");
761     tofich(allocationagrif,ligne,1);
762     sprintf (ligne, "End Subroutine Alloc_agrif_%s",curname);
763     tofich(allocationagrif,ligne,1);
764     fclose(allocationagrif);
765     allocationagrif = (FILE *)NULL;
766     /* Add the declaration of I into the allocationagrif file                */
767     sprintf (ligne, "IntegerI_%s.h",curname);
768     IntegerI = associate(ligne);
769     if ( IntegerIShouldBeAdd == 1 )
770     {     
771        strcpy(ligne, "INTEGER :: i");
772        tofich (IntegerI, ligne,1);
773     }
774     fclose (IntegerI);
775/******************************************************************************/
776/*                 NewModule_module.h                                         */
777/*                 module <module> ETC ...                                    */
778/******************************************************************************/
779     if ( fortran77 == 1 )
780     {
781        donotwrite = 0 ;
782        if ( strcmp(v->commoninfile,mainfile)) donotwrite = 1 ;
783        else 
784        {
785           /* we should verify that this module has not been write in this fil*/
786           parcoursnom = listedesnoms;
787           sprintf(ligne,"USE %s",curname);
788           while ( parcoursnom && donotwrite == 0 )
789           {
790              if ( !strcasecmp(parcoursnom->nom,ligne) ) donotwrite = 1;
791              else parcoursnom = parcoursnom ->suiv;
792           }
793        }
794
795        if ( donotwrite == 0 ) 
796        {
797           if ( ModuleIsDefineInInputFile(curname) == 1 ) AllocEmpty = 0;
798           if ( AllocEmpty == 1 )
799           {
800            fprintf(modulealloc,"! empty module alloc %s \n",curname );
801           }
802           else
803           {
804/******************************************************************************/
805/*                 include_use_instance_agrif.h                               */
806/*                 USE mod                                                    */
807/******************************************************************************/
808            sprintf (ligne, "USE %s", curname);
809            tofich (instanceUSE, ligne,1);
810/******************************************************************************/
811/*                 allocations_calls_agrif.h                                  */
812/*                 Call Alloc_agrif_module (Agrif_Gr)                         */
813/******************************************************************************/
814            sprintf (ligne, "Call Alloc_agrif_%s(Agrif_Gr)", curname);
815            tofich (alloccalls, ligne,1);
816/******************************************************************************/
817/******************************************************************************/
818            fprintf(modulealloc,"      module %s \n",curname);
819            fprintf(modulealloc,"      IMPLICIT NONE \n");
820            fprintf(modulealloc,"      PUBLIC Alloc_agrif_%s \n",curname);
821            fprintf(modulealloc,"      CONTAINS \n");
822            fprintf(modulealloc,"#include \"alloc_agrif_%s.h\" \n",curname);
823            fprintf(modulealloc,"      end module %s \n",curname);
824/******************************************************************************/
825/******************************************************************************/
826            sprintf(ligne,"USE %s",curname);
827            listedesnoms = Addtolistnom(ligne,listedesnoms);
828           }
829        }
830     }
831        else
832        {
833           if ( Did_filetoparse_treated == 0 && AllocEmpty == 0 )
834           {
835/******************************************************************************/
836/*                 include_use_instance_agrif.h                               */
837/*                 USE mod                                                    */
838/******************************************************************************/
839              sprintf (ligne, "USE %s", curname);
840              tofich (instanceUSE, ligne,1);
841/******************************************************************************/
842/*                 allocations_calls_agrif.h                                  */
843/*                 Call Alloc_agrif_module (Agrif_Gr)                         */
844/******************************************************************************/
845              sprintf (ligne, "Call Alloc_agrif_%s(Agrif_Gr)", curname);
846              tofich (alloccalls, ligne,1);
847           }
848        }
849  }
850  return listedesnoms;
851}
852
853/******************************************************************************/
854/*                           creefichieramr                                   */
855/******************************************************************************/
856/* This subroutine is the main one to create AGRIF_INC files                  */
857/******************************************************************************/
858/*                                                                            */
859/******************************************************************************/
860void creefichieramr (char *NameTampon)
861{
862  listvar *newvar;
863  variable *v;
864  int erreur;
865  char filefich[LONGNOM];
866  char ligne[LONGNOM];
867  int IndiceMax;
868  int InitEmpty;
869  int VarnameEmpty;
870  int donotwrite;
871  listnom *listedesnoms;
872 
873  FILE *initproc;
874  FILE *initglobal;
875  FILE *createvarname;
876  FILE *createvarnameglobal;
877  FILE *alloccalls;
878  FILE *instanceUSE;
879  FILE *modulealloc;
880 
881  erreur = tests_entrees ();
882  if (erreur)
883    exit (0);
884  else
885
886  strcpy (filefich, "cd ");
887  strcat (filefich, nomdir);
888  erreur = system (filefich);
889  if (erreur)
890    {
891      strcpy (filefich, "mkdir ");
892      strcat (filefich, nomdir);
893      system (filefich);
894      printf ("%s: Directory created\n", nomdir);
895    }
896
897/******************************************************************************/
898/******************** Creation of AGRIF_INC files *****************************/
899/******************************************************************************/
900  write_probdimagrif_file();
901  write_keysagrif_file();
902  write_clusteringagrif_file();
903  write_includeagrif_file();
904  write_modtypeagrif_file();     
905  write_Setnumberofcells_file();
906  write_Getnumberofcells_file();     
907  /*--------------------------------------------------------------------------*/
908  /*   Record the list of module used in the file include_use_instance_agrif  */
909  listedesnoms = (listnom *)NULL;
910
911  strcpy(Alloctreatedname,"");     
912/*----------------------------------------------------------------------------*/
913/*----------------------------------------------------------------------------*/
914/*----------------------------------------------------------------------------*/
915/*----------------------------------------------------------------------------*/
916/*----------------------------------------------------------------------------*/
917  if ( todebug == 1 )
918  {
919     strcpy(ligne,"initialisations_agrif_");
920     strcat(ligne,NameTampon);
921     strcat(ligne,".h");
922     initproc = associate (ligne);
923/*----------------------------------------------------------------------------*/
924     strcpy(ligne,"createvarname_agrif_");
925     strcat(ligne,NameTampon);
926     strcat(ligne,".h");
927     createvarname = associate (ligne);
928/*----------------------------------------------------------------------------*/
929     InitEmpty = 1 ;
930     VarnameEmpty = 1 ;
931
932     newvar = globliste;
933     while ( newvar && todebug == 1 )
934     {
935        donotwrite = 0;
936        v = newvar->var;
937
938        if ( fortran77 == 1 )
939        {
940           if ( v->indicetabvars <= oldindicemaxtabvars ) donotwrite = 1;
941        }
942
943        if ( ( v->common == 1 || v->module == 1 ) && donotwrite == 0 )
944        {
945          write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
946          write_initialisationsagrif_file(v,initproc,&InitEmpty);
947        }
948        newvar = newvar->suiv;
949     }
950  /*                                                                          */
951     fclose (createvarname); 
952     fclose (initproc);
953  /*--------------------------------------------------------------------------*/
954     if ( Did_filetoparse_treated == 0 ) 
955     {
956        if ( InitEmpty != 1  )
957        {
958           initglobal = associateaplus("initialisations_agrif.h");
959           strcpy(ligne,"#include \"initialisations_agrif_");
960           strcat(ligne,NameTampon);
961           strcat(ligne,".h\"\n");
962           fprintf(initglobal,ligne);
963           fclose(initglobal);     
964        }
965  /*--------------------------------------------------------------------------*/
966        if ( VarnameEmpty != 1 )
967        {
968           createvarnameglobal= associateaplus("createvarname_agrif.h");
969           strcpy(ligne,"#include \"createvarname_agrif_");
970           strcat(ligne,NameTampon);
971           strcat(ligne,".h\"\n");
972           fprintf(createvarnameglobal,ligne);
973           fclose(createvarnameglobal);     
974        }
975     }
976  }
977/*----------------------------------------------------------------------------*/
978/*----------------------------------------------------------------------------*/
979/*----------------------------------------------------------------------------*/
980/*----------------------------------------------------------------------------*/
981/*----------------------------------------------------------------------------*/
982  instanceUSE= associateaplus("include_use_instance_agrif.h");
983  alloccalls = associateaplus("allocations_calls_agrif.h");
984  sprintf(ligne,"NewModule_%s.h",NameTampon);
985  modulealloc=associate(ligne);
986  /*--------------------------------------------------------------------------*/
987  IndiceMax = 0;
988
989  newvar = globliste;
990  while (newvar)
991  {
992     v = newvar->var;
993     if ( (v->common == 1) || (v->module == 1) )
994     {
995        listedesnoms = write_allocation(newvar,v,
996                                       listedesnoms,
997                                       alloccalls,
998                                       instanceUSE,
999                                       modulealloc,
1000                                       &IndiceMax);
1001     }
1002     newvar = newvar->suiv;
1003  }
1004 
1005  fclose (instanceUSE);
1006  fclose (alloccalls);
1007  fclose (modulealloc);
1008}
Note: See TracBrowser for help on using the repository browser.