source: trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 9 years ago

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 41.7 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 <stdio.h>
36#include <stdlib.h>
37#include <string.h>
38#include "decl.h"
39/******************************************************************************/
40/*                      Vartonumber                                           */
41/******************************************************************************/
42/* This subroutine is used to know if Agrif_ is locate in the char            */
43/* tokname                                                                    */
44/******************************************************************************/
45/*                                                                            */
46/******************************************************************************/
47int Vartonumber(char *tokname)
48{
49   int agrifintheword;
50
51   agrifintheword = 0;
52        if ( !strcasecmp(tokname,"Agrif_parent")         ) agrifintheword = 1;
53   else if ( !strcasecmp(tokname,"Agrif_set_type")       ) agrifintheword = 1;
54   else if ( !strcasecmp(tokname,"Agrif_set_raf")        ) agrifintheword = 1;
55   else if ( !strcasecmp(tokname,"Agrif_set_bc")         ) agrifintheword = 1;
56   else if ( !strcasecmp(tokname,"Agrif_set_bcinterp")   ) agrifintheword = 1;
57   else if ( !strcasecmp(tokname,"Agrif_Root")           ) agrifintheword = 1;
58   else if ( !strcasecmp(tokname,"Agrif_CFixed")         ) agrifintheword = 1;
59   else if ( !strcasecmp(tokname,"Agrif_Fixed")          ) agrifintheword = 1;
60   else if ( !strcasecmp(tokname,"Agrif_bc_variable")    ) agrifintheword = 1;
61   else if ( !strcasecmp(tokname,"Agrif_set_parent")     ) agrifintheword = 1;
62   else if ( !strcasecmp(tokname,"Agrif_interp_variable")) agrifintheword = 1;
63   else if ( !strcasecmp(tokname,"Agrif_init_variable")  ) agrifintheword = 1;
64   else if ( !strcasecmp(tokname,"Agrif_update_variable")) agrifintheword = 1;
65   else if ( !strcasecmp(tokname,"Agrif_Set_interp")     ) agrifintheword = 1;
66   else if ( !strcasecmp(tokname,"Agrif_Set_Update")     ) agrifintheword = 1;
67   else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1;
68   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
69   else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1;
70   else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1;
71   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1;
72
73   return agrifintheword;
74}
75
76/******************************************************************************/
77/*                              Agrif_in_Tok_NAME                             */
78/******************************************************************************/
79/* This subroutine is used to know if Agrif_ is locate in the char            */
80/* tokname                                                                    */
81/******************************************************************************/
82/*                                                                            */
83/*                 Agrif_name --------------> Agrif_in_Tok_NAME = 1           */
84/*                       name --------------> Agrif_in_Tok_NAME = 0           */
85/*                                                                            */
86/******************************************************************************/
87int Agrif_in_Tok_NAME(char *tokname)
88{
89   int agrifintheword;
90
91   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
92   else agrifintheword = 0;
93
94   return agrifintheword;
95}
96
97/******************************************************************************/
98/*                     ModifyTheVariableName_0                                */
99/******************************************************************************/
100/* Firstpass 0                                                                */
101/******************************************************************************/
102/*                                                                            */
103/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
104/*                                                                            */
105/******************************************************************************/
106void ModifyTheVariableName_0(char *ident, int lengthname)
107{
108   listvar *newvar;
109   int out;
110   
111   printf("ICI ident = %s\n",ident);
112   
113   if ( firstpass == 0 )
114   {
115      newvar = List_Global_Var;
116      out=0;
117      while ( newvar && out == 0 )
118      {
119         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
120         else newvar=newvar->suiv;
121      }
122       printf("out1 = %d\n",out);
123      if ( out == 0 )
124      {
125         newvar = List_ModuleUsed_Var;
126         while ( newvar && out == 0 )
127         {
128            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
129            else newvar=newvar->suiv;
130         }
131      }
132      if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return;
133
134      if ( out == 0 )
135      {
136         newvar = List_Common_Var;
137         while ( newvar && out == 0 )
138         {
139            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
140            else newvar=newvar->suiv;
141         }
142      }
143
144      if ( out == 0 )
145      {
146         newvar = List_ModuleUsedInModuleUsed_Var;
147         while ( newvar && out == 0 )
148         {
149            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
150            else newvar=newvar->suiv;
151         }
152      }
153
154      if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
155      {
156      printf("ICIC3\n");
157         /* remove the variable                                               */
158         RemoveWordCUR_0(fortranout,(long)(-lengthname),
159                               lengthname);
160         fseek(fortranout,(long)(-lengthname),SEEK_CUR);
161         /* then write the new name                                           */
162         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
163            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
164         else
165         {
166            if ( retour77 == 0 )
167            {
168               fprintf(fortranout," Agrif_tabvars & \n      ");
169            }
170            else
171            {
172               fprintf(fortranout,"Agrif_tabvars");
173               fprintf(fortranout," \n     & ");
174            }
175            fprintf(fortranout,"%s",
176                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
177            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
178         }
179      }
180      else
181      {
182         /* we should look in the List_ModuleUsed_Var                         */
183         if ( inagrifcallargument != 1 )
184         {
185            newvar = List_ModuleUsed_Var;
186            while ( newvar && out == 0 )
187            {
188               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
189               else newvar=newvar->suiv;
190            }
191            if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
192            {
193            printf("ICICIC4 %s\n",newvar->var->v_typevar);
194               /* remove the variable                                         */
195               RemoveWordCUR_0(fortranout,(long)(-lengthname),
196                                     lengthname);
197               fseek(fortranout,(long)(-lengthname),SEEK_CUR);
198               /* then write the new name                                     */
199               if ( retour77 == 0 )
200               {
201                  fprintf(fortranout," Agrif_tabvars & \n      ");
202               }
203               else
204               {
205                  fprintf(fortranout," \n     & Agrif_tabvars");
206               }
207               fprintf(fortranout,"%s",
208                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
209               colnum = strlen(
210                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
211            }
212         }
213      }
214   }
215}
216
217/******************************************************************************/
218/*                     ModifyTheVariableName_0                                */
219/******************************************************************************/
220/* Firstpass 0                                                                */
221/******************************************************************************/
222/*                                                                            */
223/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
224/*                                                                            */
225/******************************************************************************/
226void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident)
227{
228   listvar *newvar;
229   int out;
230   
231   if ( firstpass == 0 )
232   {
233      newvar = List_Global_Var;
234      out=0;
235      while ( newvar && out == 0 )
236      {
237         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
238         else newvar=newvar->suiv;
239      }
240
241      if ( out == 0 )
242      {
243         newvar = List_ModuleUsed_Var;
244         while ( newvar && out == 0 )
245         {
246            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
247            else newvar=newvar->suiv;
248         }
249      }
250      if ( out == 0 )
251      {
252         newvar = List_Common_Var;
253         while ( newvar && out == 0 )
254         {
255            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
256            else newvar=newvar->suiv;
257         }
258      }
259
260      if ( out == 0 )
261      {
262         newvar = List_ModuleUsedInModuleUsed_Var;
263         while ( newvar && out == 0 )
264         {
265            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
266            else newvar=newvar->suiv;
267         }
268      }
269
270      if ( out == 1 )
271      {
272         /* remove the variable                                               */
273         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
274                               strlen(ident));
275         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
276         /* then write the new name                                           */
277         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
278            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
279         else
280         {
281            if ( retour77 == 0 )
282            {
283               fprintf(fortranout," Agrif_tabvars & \n      ");
284            }
285            else
286            {
287               fprintf(fortranout,"Agrif_tabvars");
288               fprintf(fortranout," \n     & ");
289            }
290            fprintf(fortranout,"%s",
291                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
292            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
293         }
294      }
295      else
296      {
297         /* we should look in the List_ModuleUsed_Var                         */
298         if ( inagrifcallargument != 1 )
299         {
300            newvar = List_ModuleUsed_Var;
301            while ( newvar && out == 0 )
302            {
303               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
304               else newvar=newvar->suiv;
305            }
306            if ( out == 1 )
307            {
308               /* remove the variable                                         */
309               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
310                                     strlen(ident));
311               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
312               /* then write the new name                                     */
313               if ( retour77 == 0 )
314               {
315                  fprintf(fortranout," Agrif_tabvars & \n      ");
316               }
317               else
318               {
319                  fprintf(fortranout," \n     & Agrif_tabvars");
320               }
321               fprintf(fortranout,"%s",
322                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
323               colnum = strlen(
324                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
325            }
326         }
327      }
328   }
329}
330
331
332
333/******************************************************************************/
334/*                         Add_SubroutineWhereAgrifUsed_1                     */
335/******************************************************************************/
336/* This subroutine is used to add a record to                                 */
337/* List_SubroutineWhereAgrifUsed                                              */
338/******************************************************************************/
339/*                                                                            */
340/*       subroutine sub ... Agrif_<something>                                 */
341/*                                                                            */
342/*        _______     _______     _______     _______     _______             */
343/*       +      +    +      +    +      +    +      +    +      +             */
344/*       + list +--->+ list +--->+ list +--->+ list +--->+ sub  +             */
345/*       +______+    +______+    +______+    +______+    +______+             */
346/*                                                                            */
347/*       list = List_SubroutineWhereAgrifUsed                                 */
348/*                                                                            */
349/******************************************************************************/
350void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod)
351{
352  listnom *listnomtmp;
353  listnom *parcours;
354
355  if ( firstpass == 1 )
356  {
357  if ( !List_SubroutineWhereAgrifUsed )
358  {
359     listnomtmp=(listnom *)malloc(sizeof(listnom));
360     strcpy(listnomtmp->o_nom,sub);
361     Save_Length(sub,23);
362     strcpy(listnomtmp->o_module,mod);
363     Save_Length(mod,24);
364     listnomtmp->suiv = NULL;
365     List_SubroutineWhereAgrifUsed  =  listnomtmp;
366  }
367  else
368  {
369    parcours = List_SubroutineWhereAgrifUsed;
370    while ( parcours && strcasecmp(parcours->o_nom,sub) )
371    {
372       parcours = parcours->suiv;
373    }
374    if ( !parcours )
375    {
376       listnomtmp=(listnom *)malloc(sizeof(listnom));
377       strcpy(listnomtmp->o_nom,sub);
378       Save_Length(sub,23);
379       strcpy(listnomtmp->o_module,mod);
380       Save_Length(mod,24);
381       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
382       List_SubroutineWhereAgrifUsed  =  listnomtmp;
383    }
384  }
385  }
386}
387
388/******************************************************************************/
389/*                                AddUseAgrifUtil_0                           */
390/******************************************************************************/
391/* Add use Agrif_Util at the beginning of the subroutine definition           */
392/* if it is necessary                                                         */
393/******************************************************************************/
394/*                                                                            */
395/*       subroutine sub            |  subroutine sub                          */
396/*                                 |  USE Agrif_Util                          */
397/*       implicit none             |  implicit none                           */
398/*       ...                       |  ...                                     */
399/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
400/*       ...                       |  ...                                     */
401/*       end                       |  end                                     */
402/*                                                                            */
403/*                                                                            */
404/******************************************************************************/
405void  AddUseAgrifUtil_0(FILE *fileout)
406{
407  listnom *parcours;
408
409  if ( firstpass == 0 )
410  {
411     parcours = List_SubroutineWhereAgrifUsed;
412     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
413                                                    parcours = parcours -> suiv;
414     if ( parcours && parcours->o_val != 0 )
415                                   fprintf(fileout,"\n      USE Agrif_Util \n");
416  }
417}
418
419void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
420{
421  listusemodule *parcours;
422
423  int out;
424
425  if ( firstpass == 0 )
426  {
427     parcours = List_NameOfModuleUsed;
428     out = 0 ;
429     while ( parcours && out == 0 )
430     {
431        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
432             !strcasecmp(parcours->u_modulename,curmodulename)   &&
433             !strcasecmp(parcours->u_cursubroutine,subroutinename)
434            ) out = 1;
435        else parcours = parcours->suiv;
436     }
437     if ( out == 0 )
438     {
439        fprintf(fileout,"\n      USE Agrif_Util \n");
440     }
441  }
442}
443
444/******************************************************************************/
445/*                         NotifyAgrifFunction_0                              */
446/******************************************************************************/
447/* Firstpass 0                                                                */
448/******************************************************************************/
449/*                                                                            */
450/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
451/*                                                                            */
452/******************************************************************************/
453void NotifyAgrifFunction_0(char *ident)
454{
455   if ( firstpass == 0 )
456   {
457      if ( !strcasecmp(ident,"Agrif_parent") )
458      {
459         InAgrifParentDef = 1;
460         pos_curagrifparent = setposcur()-12;
461      }
462      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
463      {
464         InAgrifParentDef = 2;
465         pos_curagrifparent = setposcur()-21;
466      }
467      else if ( !strcasecmp(ident,"Agrif_Rhox") )
468      {
469         InAgrifParentDef = 3;
470         pos_curagrifparent = setposcur()-10;
471      }
472      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
473      {
474         InAgrifParentDef = 4;
475         pos_curagrifparent = setposcur()-17;
476      }
477      else if ( !strcasecmp(ident,"Agrif_IRhox") )
478      {
479         InAgrifParentDef = 5;
480         pos_curagrifparent = setposcur()-11;
481      }
482      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
483      {
484         InAgrifParentDef = 6;
485         pos_curagrifparent = setposcur()-18;
486      }
487      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
488      {
489         InAgrifParentDef = 7;
490         pos_curagrifparent = setposcur()-10;
491      }
492      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
493      {
494         InAgrifParentDef = 8;
495         pos_curagrifparent = setposcur()-17;
496      }
497      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
498      {
499         InAgrifParentDef = 9;
500         pos_curagrifparent = setposcur()-11;
501      }
502      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
503      {
504         InAgrifParentDef = 10;
505         pos_curagrifparent = setposcur()-18;
506      }
507      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
508      {
509         InAgrifParentDef = 11;
510         pos_curagrifparent = setposcur()-10;
511      }
512      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
513      {
514         InAgrifParentDef = 12;
515         pos_curagrifparent = setposcur()-17;
516      }
517      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
518      {
519         InAgrifParentDef = 13;
520         pos_curagrifparent = setposcur()-11;
521      }
522      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
523      {
524         InAgrifParentDef = 14;
525         pos_curagrifparent = setposcur()-18;
526      }
527      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
528      {
529         InAgrifParentDef = 15;
530         pos_curagrifparent = setposcur()-23;
531      }
532      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
533      {
534         InAgrifParentDef = 16;
535         pos_curagrifparent = setposcur()-23;
536      }
537      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
538      {
539         InAgrifParentDef = 17;
540         pos_curagrifparent = setposcur()-23;
541      }
542      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
543      {
544         InAgrifParentDef = 18;
545         pos_curagrifparent = setposcur()-26;
546      }
547      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
548      {
549         InAgrifParentDef = 19;
550         pos_curagrifparent = setposcur()-26;
551      }
552      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
553      {
554         InAgrifParentDef = 20;
555         pos_curagrifparent = setposcur()-26;
556      }
557      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
558      {
559         InAgrifParentDef = 21;
560         pos_curagrifparent = setposcur()-19;
561      }
562      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
563      {
564         InAgrifParentDef = 22;
565         pos_curagrifparent = setposcur()-17;
566      }
567      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
568      {
569         InAgrifParentDef = 23;
570         pos_curagrifparent = setposcur()-15;
571      }
572      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
573      {
574         InAgrifParentDef = 24;
575         pos_curagrifparent = setposcur()-15;
576      }
577      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
578      {
579         InAgrifParentDef = 25;
580         pos_curagrifparent = setposcur()-15;
581      }
582      else if ( !strcasecmp(ident,"Agrif_Iz") )
583      {
584         InAgrifParentDef = 26;
585         pos_curagrifparent = setposcur()-8;
586      }
587      else if ( !strcasecmp(ident,"Agrif_Iy") )
588      {
589         InAgrifParentDef = 27;
590         pos_curagrifparent = setposcur()-8;
591      }
592      else if ( !strcasecmp(ident,"Agrif_Ix") )
593      {
594         InAgrifParentDef = 28;
595         pos_curagrifparent = setposcur()-8;
596      }
597      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
598      {
599         InAgrifParentDef = 29;
600         pos_curagrifparent = setposcur()-20;
601      }
602      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
603      {
604         InAgrifParentDef = 29;
605         pos_curagrifparent = setposcur()-19;
606      }
607      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
608      {
609         InAgrifParentDef = 30;
610         pos_curagrifparent = setposcur()-13;
611      }
612   }
613}
614
615/******************************************************************************/
616/*                       ModifyTheAgrifFunction_0                             */
617/******************************************************************************/
618/* Firstpass 0                                                                */
619/******************************************************************************/
620/*                                                                            */
621/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
622/*                                                                            */
623/******************************************************************************/
624void ModifyTheAgrifFunction_0(char *ident)
625{
626   if ( InAgrifParentDef != 0 )
627          AgriffunctionModify_0(ident,InAgrifParentDef);
628   /*                                                                         */
629   InAgrifParentDef = 0;
630}
631
632
633/******************************************************************************/
634/*                         AgriffunctionModify_0                              */
635/******************************************************************************/
636/* Firstpass 0                                                                */
637/******************************************************************************/
638/* if whichone = 1 Agrif_parent ===>                                          */
639/*                                                                            */
640/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
641/*                                                                            */
642/* if whichone = 3 Agrif_Rhox ===>                                            */
643/*                                                                            */
644/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
645/*                                                                            */
646/* if whichone = 5 Agrif_IRhox ===>                                           */
647/*                                                                            */
648/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
649/*                                                                            */
650/* if whichone = 7 Agrif_Rhoy ===>                                            */
651/*                                                                            */
652/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
653/*                                                                            */
654/* if whichone = 9 Agrif_IRhoy ===>                                           */
655/*                                                                            */
656/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
657/*                                                                            */
658/* if whichone = 11 Agrif_Rhoz ===>                                           */
659/*                                                                            */
660/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
661/*                                                                            */
662/* if whichone = 13 Agrif_IRhoz ===>                                          */
663/*                                                                            */
664/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
665/*                                                                            */
666/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
667/*                                                                            */
668/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
669/*                                                                            */
670/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
671/*                                                                            */
672/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
673/*                                                                            */
674/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
675/*                                                                            */
676/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
677/*                                                                            */
678/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
679/*                                                                            */
680/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
681/*                                                                            */
682/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
683/*                                                                            */
684/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
685/*                                                                            */
686/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
687/*                                                                            */
688/* if whichone = 26 Agrif_Iz ===>                                             */
689/*                                                                            */
690/* if whichone = 27 Agrif_Iy ===>                                             */
691/*                                                                            */
692/* if whichone = 28 Agrif_Ix ===>                                             */
693/*                                                                            */
694/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
695/*                                                                            */
696/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
697/*                                                                            */
698/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
699/*                                                                            */
700/*                                                                            */
701/******************************************************************************/
702void AgriffunctionModify_0(char *ident,int whichone)
703{
704   char toprint[LONG_C];
705   if ( firstpass == 0 )
706   {
707      strcpy(toprint,"");
708      pos_end = setposcur();
709      fseek(fortranout,pos_curagrifparent,SEEK_SET);
710      if ( whichone == 1 || whichone == 2 )
711      {
712         /*                                                                   */
713         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
714         if ( !strcasecmp(ident,toprint) )
715         {
716            /* la liste des use de cette subroutine                           */
717            strcpy(toprint,"");
718            FindAndChangeNameToTabvars(ident,
719                                          toprint,List_Common_Var,whichone);
720         }
721         if ( !strcasecmp(ident,toprint) )
722         {
723            /* la liste des use de cette subroutine                           */
724            strcpy(toprint,"");
725            FindAndChangeNameToTabvars(ident,
726                                          toprint,List_ModuleUsed_Var,whichone);
727         }
728      }
729      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
730      {
731         sprintf(toprint,"REAL(");
732         if( retour77 == 0 ) strcat(toprint," & \n");
733         else strcat(toprint,"\n     & ");
734         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
735      }
736      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
737      {
738         sprintf(toprint,"REAL(");
739         if( retour77 == 0 ) strcat(toprint," & \n");
740         else strcat(toprint,"\n     & ");
741         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
742      }
743      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
744      {
745         sprintf(toprint,"Agrif_Curgrid");
746         if( retour77 == 0 ) strcat(toprint," & \n");
747         else strcat(toprint,"\n     & ");
748         strcat(toprint,"% spaceref(1)");
749      }
750      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
751      {
752         sprintf(toprint,"Agrif_Curgrid");
753         if( retour77 == 0 ) strcat(toprint," & \n");
754         else strcat(toprint,"\n     & ");
755         strcat(toprint,"% parent % spaceref(1)");
756      }
757      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
758      {
759         sprintf(toprint,"REAL(Agrif_Curgrid");
760         if( retour77 == 0 ) strcat(toprint," & \n");
761         else strcat(toprint,"\n     & ");
762         strcat(toprint,"% spaceref(2))");
763      }
764      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
765      {
766         sprintf(toprint,"REAL(Agrif_Curgrid");
767         if( retour77 == 0 ) strcat(toprint," & \n");
768         else strcat(toprint,"\n     & ");
769         strcat(toprint,"% parent % spaceref(2))");
770      }
771      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
772      {
773         sprintf(toprint,"Agrif_Curgrid");
774         if( retour77 == 0 ) strcat(toprint," & \n");
775         else strcat(toprint,"\n     & ");
776         strcat(toprint,"% spaceref(2)");
777      }
778      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
779      {
780         sprintf(toprint,"Agrif_Curgrid");
781         if( retour77 == 0 ) strcat(toprint," & \n");
782         else strcat(toprint,"\n     & ");
783         strcat(toprint,"% parent % spaceref(2)");
784      }
785      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
786      {
787         sprintf(toprint,"REAL(Agrif_Curgrid");
788         if( retour77 == 0 ) strcat(toprint," & \n");
789         else strcat(toprint,"\n     & ");
790         strcat(toprint,"% spaceref(3))");
791      }
792      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
793      {
794         sprintf(toprint,"REAL(Agrif_Curgrid");
795         if( retour77 == 0 ) strcat(toprint," & \n");
796         else strcat(toprint,"\n     & ");
797         strcat(toprint,"% parent % spaceref(3))");
798      }
799      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
800      {
801         sprintf(toprint,"Agrif_Curgrid");
802         if( retour77 == 0 ) strcat(toprint," & \n");
803         else strcat(toprint,"\n     & ");
804         strcat(toprint,"% spaceref(3)");
805      }
806      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
807      {
808         sprintf(toprint,"Agrif_Curgrid");
809         if( retour77 == 0 ) strcat(toprint," & \n");
810         else strcat(toprint,"\n     & ");
811         strcat(toprint,"% parent % spaceref(3)");
812      }
813      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
814      {
815         sprintf(toprint,"Agrif_Curgrid");
816         if( retour77 == 0 ) strcat(toprint," & \n");
817         else strcat(toprint,"\n     & ");
818         strcat(toprint,"% NearRootBorder(1)");
819      }
820      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
821      {
822         sprintf(toprint,"Agrif_Curgrid");
823         if( retour77 == 0 ) strcat(toprint," & \n");
824         else strcat(toprint,"\n     & ");
825         strcat(toprint,"% NearRootBorder(2)");
826      }
827      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
828      {
829         sprintf(toprint,"Agrif_Curgrid");
830         if( retour77 == 0 ) strcat(toprint," & \n");
831         else strcat(toprint,"\n     & ");
832         strcat(toprint,"% NearRootBorder(3)");
833      }
834      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
835      {
836         sprintf(toprint,"Agrif_Curgrid");
837         if( retour77 == 0 ) strcat(toprint," & \n");
838         else strcat(toprint,"\n     & ");
839         strcat(toprint,"% DistantRootBorder(1)");
840      }
841      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
842      {
843         sprintf(toprint,"Agrif_Curgrid");
844         if( retour77 == 0 ) strcat(toprint," & \n");
845         else strcat(toprint,"\n     & ");
846         strcat(toprint,"% DistantRootBorder(2)");
847      }
848      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
849      {
850         sprintf(toprint,"Agrif_Curgrid");
851         if( retour77 == 0 ) strcat(toprint," & \n");
852         else strcat(toprint,"\n     & ");
853         strcat(toprint,"% DistantRootBorder(3)");
854      }
855      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
856      {
857         sprintf(toprint,"Agrif_Curgrid");
858         if( retour77 == 0 ) strcat(toprint," & \n");
859         else strcat(toprint,"\n     & ");
860         strcat(toprint,"% parent % grid_id");
861      }
862      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
863      {
864         sprintf(toprint,"Agrif_Curgrid");
865         if( retour77 == 0 ) strcat(toprint," & \n");
866         else strcat(toprint,"\n     & ");
867         strcat(toprint,"% grid_id");
868      }
869      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
870      {
871         sprintf(toprint,"Agrif_Curgrid");
872         if( retour77 == 0 ) strcat(toprint," & \n");
873         else strcat(toprint,"\n     & ");
874         strcat(toprint,"% parent % ix(3)");
875      }
876      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
877      {
878         sprintf(toprint,"Agrif_Curgrid");
879         if( retour77 == 0 ) strcat(toprint," & \n");
880         else strcat(toprint,"\n     & ");
881         strcat(toprint,"% parent % ix(2)");
882      }
883      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
884      {
885         sprintf(toprint,"Agrif_Curgrid");
886         if( retour77 == 0 ) strcat(toprint," & \n");
887         else strcat(toprint,"\n     & ");
888         strcat(toprint,"% parent % ix(1)");
889      }
890      else if ( whichone == 26 ) /* Agrif_Iz                                  */
891      {
892         sprintf(toprint,"Agrif_Curgrid");
893         if( retour77 == 0 ) strcat(toprint," & \n");
894         else strcat(toprint,"\n     & ");
895         strcat(toprint," % ix(3)");
896      }
897      else if ( whichone == 27 ) /* Agrif_Iy                                  */
898      {
899         sprintf(toprint,"Agrif_Curgrid");
900         if( retour77 == 0 ) strcat(toprint," & \n");
901         else strcat(toprint,"\n     & ");
902         strcat(toprint,"% ix(2)");
903      }
904      else if ( whichone == 28 ) /* Agrif_Ix                                  */
905      {
906         sprintf(toprint,"Agrif_Curgrid");
907         if( retour77 == 0 ) strcat(toprint," & \n");
908         else strcat(toprint,"\n     & ");
909         strcat(toprint,"% ix(1)");
910      }
911      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
912      {
913         sprintf(toprint,"Agrif_nbfixedgrids");
914      }
915      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
916      {
917         sprintf(toprint,"Agrif_Curgrid");
918         if( retour77 == 0 ) strcat(toprint," & \n");
919         else strcat(toprint,"\n     & ");
920         strcat(toprint,"% ngridstep");
921      }
922      /*                                                                      */
923      if ( whichone == 1 || whichone == 2 )
924      {
925         Save_Length(toprint,43);
926         tofich(fortranout,toprint,2);
927      }
928      else
929      {
930/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
931         else fprintf(fortranout,"\n     & ");*/
932         Save_Length(toprint,43);
933         fprintf(fortranout,"%s",toprint);
934      }
935   }
936}
937
938
939/******************************************************************************/
940/*                             Instanciation_0                                */
941/******************************************************************************/
942/* Firstpass 0                                                                */
943/******************************************************************************/
944/*                                                                            */
945/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
946/*                                                                            */
947/******************************************************************************/
948void Instanciation_0(char *ident)
949{
950   listvar *newvar;
951   int out;
952
953   if ( firstpass == 0 && sameagrifargument == 1 )
954   {
955      newvar = List_Global_Var;
956
957      out=0;
958      while ( newvar && out == 0 )
959      {
960         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
961         else newvar=newvar->suiv;
962      }
963
964      if ( out == 0 )
965      {
966         newvar = List_Common_Var;
967
968         out=0;
969         while ( newvar && out == 0 )
970         {
971            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
972            else newvar=newvar->suiv;
973         }
974      }
975      if ( out == 0 )
976      {
977         newvar = List_ModuleUsed_Var;
978
979         out=0;
980         while ( newvar && out == 0 )
981         {
982            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
983            else newvar=newvar->suiv;
984         }
985      }
986
987      if ( out == 1 )
988      {
989         /* then write the instanciation                                      */
990         fprintf(fortranout,"\n      %s = %s",ident,
991                                          vargridcurgridtabvars(newvar->var,3));
992         colnum = 0;
993      }
994   }
995   sameagrifargument = 0;
996}
Note: See TracBrowser for help on using the repository browser.