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

Last change on this file since 5573 was 5573, checked in by rblod, 5 years ago

Fix ticket #1573 for the trunk

  • Property svn:keywords set to Id
File size: 41.9 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       {
416        if( strcasecmp(subroutinename,"Agrif_InvLoc") )   
417       fprintf(fileout,"\n      USE Agrif_Util \n");
418       else fprintf(fileout,"\n      USE Agrif_Types \n");
419
420       }
421  }
422}
423
424void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
425{
426  listusemodule *parcours;
427
428  int out;
429
430  if ( firstpass == 0 )
431  {
432     parcours = List_NameOfModuleUsed;
433     out = 0 ;
434     while ( parcours && out == 0 )
435     {
436        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
437             !strcasecmp(parcours->u_modulename,curmodulename)   &&
438             !strcasecmp(parcours->u_cursubroutine,subroutinename)
439            ) out = 1;
440        else parcours = parcours->suiv;
441     }
442     if ( out == 0 )
443     {
444       if( strcasecmp(subroutinename,"Agrif_InitWorkspace") )   
445       fprintf(fileout,"\n      USE Agrif_Util \n");
446       else fprintf(fileout,"\n      USE Agrif_Types \n");
447     }
448  }
449}
450
451/******************************************************************************/
452/*                         NotifyAgrifFunction_0                              */
453/******************************************************************************/
454/* Firstpass 0                                                                */
455/******************************************************************************/
456/*                                                                            */
457/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
458/*                                                                            */
459/******************************************************************************/
460void NotifyAgrifFunction_0(char *ident)
461{
462   if ( firstpass == 0 )
463   {
464      if ( !strcasecmp(ident,"Agrif_parent") )
465      {
466         InAgrifParentDef = 1;
467         pos_curagrifparent = setposcur()-12;
468      }
469      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
470      {
471         InAgrifParentDef = 2;
472         pos_curagrifparent = setposcur()-21;
473      }
474      else if ( !strcasecmp(ident,"Agrif_Rhox") )
475      {
476         InAgrifParentDef = 3;
477         pos_curagrifparent = setposcur()-10;
478      }
479      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
480      {
481         InAgrifParentDef = 4;
482         pos_curagrifparent = setposcur()-17;
483      }
484      else if ( !strcasecmp(ident,"Agrif_IRhox") )
485      {
486         InAgrifParentDef = 5;
487         pos_curagrifparent = setposcur()-11;
488      }
489      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
490      {
491         InAgrifParentDef = 6;
492         pos_curagrifparent = setposcur()-18;
493      }
494      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
495      {
496         InAgrifParentDef = 7;
497         pos_curagrifparent = setposcur()-10;
498      }
499      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
500      {
501         InAgrifParentDef = 8;
502         pos_curagrifparent = setposcur()-17;
503      }
504      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
505      {
506         InAgrifParentDef = 9;
507         pos_curagrifparent = setposcur()-11;
508      }
509      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
510      {
511         InAgrifParentDef = 10;
512         pos_curagrifparent = setposcur()-18;
513      }
514      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
515      {
516         InAgrifParentDef = 11;
517         pos_curagrifparent = setposcur()-10;
518      }
519      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
520      {
521         InAgrifParentDef = 12;
522         pos_curagrifparent = setposcur()-17;
523      }
524      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
525      {
526         InAgrifParentDef = 13;
527         pos_curagrifparent = setposcur()-11;
528      }
529      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
530      {
531         InAgrifParentDef = 14;
532         pos_curagrifparent = setposcur()-18;
533      }
534      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
535      {
536         InAgrifParentDef = 15;
537         pos_curagrifparent = setposcur()-23;
538      }
539      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
540      {
541         InAgrifParentDef = 16;
542         pos_curagrifparent = setposcur()-23;
543      }
544      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
545      {
546         InAgrifParentDef = 17;
547         pos_curagrifparent = setposcur()-23;
548      }
549      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
550      {
551         InAgrifParentDef = 18;
552         pos_curagrifparent = setposcur()-26;
553      }
554      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
555      {
556         InAgrifParentDef = 19;
557         pos_curagrifparent = setposcur()-26;
558      }
559      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
560      {
561         InAgrifParentDef = 20;
562         pos_curagrifparent = setposcur()-26;
563      }
564      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
565      {
566         InAgrifParentDef = 21;
567         pos_curagrifparent = setposcur()-19;
568      }
569      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
570      {
571         InAgrifParentDef = 22;
572         pos_curagrifparent = setposcur()-17;
573      }
574      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
575      {
576         InAgrifParentDef = 23;
577         pos_curagrifparent = setposcur()-15;
578      }
579      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
580      {
581         InAgrifParentDef = 24;
582         pos_curagrifparent = setposcur()-15;
583      }
584      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
585      {
586         InAgrifParentDef = 25;
587         pos_curagrifparent = setposcur()-15;
588      }
589      else if ( !strcasecmp(ident,"Agrif_Iz") )
590      {
591         InAgrifParentDef = 26;
592         pos_curagrifparent = setposcur()-8;
593      }
594      else if ( !strcasecmp(ident,"Agrif_Iy") )
595      {
596         InAgrifParentDef = 27;
597         pos_curagrifparent = setposcur()-8;
598      }
599      else if ( !strcasecmp(ident,"Agrif_Ix") )
600      {
601         InAgrifParentDef = 28;
602         pos_curagrifparent = setposcur()-8;
603      }
604      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
605      {
606         InAgrifParentDef = 29;
607         pos_curagrifparent = setposcur()-20;
608      }
609      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
610      {
611         InAgrifParentDef = 29;
612         pos_curagrifparent = setposcur()-19;
613      }
614      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
615      {
616         InAgrifParentDef = 30;
617         pos_curagrifparent = setposcur()-13;
618      }
619   }
620}
621
622/******************************************************************************/
623/*                       ModifyTheAgrifFunction_0                             */
624/******************************************************************************/
625/* Firstpass 0                                                                */
626/******************************************************************************/
627/*                                                                            */
628/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
629/*                                                                            */
630/******************************************************************************/
631void ModifyTheAgrifFunction_0(char *ident)
632{
633   if ( InAgrifParentDef != 0 )
634          AgriffunctionModify_0(ident,InAgrifParentDef);
635   /*                                                                         */
636   InAgrifParentDef = 0;
637}
638
639
640/******************************************************************************/
641/*                         AgriffunctionModify_0                              */
642/******************************************************************************/
643/* Firstpass 0                                                                */
644/******************************************************************************/
645/* if whichone = 1 Agrif_parent ===>                                          */
646/*                                                                            */
647/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
648/*                                                                            */
649/* if whichone = 3 Agrif_Rhox ===>                                            */
650/*                                                                            */
651/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
652/*                                                                            */
653/* if whichone = 5 Agrif_IRhox ===>                                           */
654/*                                                                            */
655/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
656/*                                                                            */
657/* if whichone = 7 Agrif_Rhoy ===>                                            */
658/*                                                                            */
659/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
660/*                                                                            */
661/* if whichone = 9 Agrif_IRhoy ===>                                           */
662/*                                                                            */
663/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
664/*                                                                            */
665/* if whichone = 11 Agrif_Rhoz ===>                                           */
666/*                                                                            */
667/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
668/*                                                                            */
669/* if whichone = 13 Agrif_IRhoz ===>                                          */
670/*                                                                            */
671/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
672/*                                                                            */
673/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
674/*                                                                            */
675/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
676/*                                                                            */
677/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
678/*                                                                            */
679/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
680/*                                                                            */
681/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
682/*                                                                            */
683/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
684/*                                                                            */
685/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
686/*                                                                            */
687/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
688/*                                                                            */
689/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
690/*                                                                            */
691/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
692/*                                                                            */
693/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
694/*                                                                            */
695/* if whichone = 26 Agrif_Iz ===>                                             */
696/*                                                                            */
697/* if whichone = 27 Agrif_Iy ===>                                             */
698/*                                                                            */
699/* if whichone = 28 Agrif_Ix ===>                                             */
700/*                                                                            */
701/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
702/*                                                                            */
703/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
704/*                                                                            */
705/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
706/*                                                                            */
707/*                                                                            */
708/******************************************************************************/
709void AgriffunctionModify_0(char *ident,int whichone)
710{
711   char toprint[LONG_C];
712   if ( firstpass == 0 )
713   {
714      strcpy(toprint,"");
715      pos_end = setposcur();
716      fseek(fortranout,pos_curagrifparent,SEEK_SET);
717      if ( whichone == 1 || whichone == 2 )
718      {
719         /*                                                                   */
720         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
721         if ( !strcasecmp(ident,toprint) )
722         {
723            /* la liste des use de cette subroutine                           */
724            strcpy(toprint,"");
725            FindAndChangeNameToTabvars(ident,
726                                          toprint,List_Common_Var,whichone);
727         }
728         if ( !strcasecmp(ident,toprint) )
729         {
730            /* la liste des use de cette subroutine                           */
731            strcpy(toprint,"");
732            FindAndChangeNameToTabvars(ident,
733                                          toprint,List_ModuleUsed_Var,whichone);
734         }
735      }
736      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
737      {
738         sprintf(toprint,"REAL(");
739         if( retour77 == 0 ) strcat(toprint," & \n");
740         else strcat(toprint,"\n     & ");
741         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
742      }
743      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
744      {
745         sprintf(toprint,"REAL(");
746         if( retour77 == 0 ) strcat(toprint," & \n");
747         else strcat(toprint,"\n     & ");
748         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
749      }
750      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
751      {
752         sprintf(toprint,"Agrif_Curgrid");
753         if( retour77 == 0 ) strcat(toprint," & \n");
754         else strcat(toprint,"\n     & ");
755         strcat(toprint,"% spaceref(1)");
756      }
757      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
758      {
759         sprintf(toprint,"Agrif_Curgrid");
760         if( retour77 == 0 ) strcat(toprint," & \n");
761         else strcat(toprint,"\n     & ");
762         strcat(toprint,"% parent % spaceref(1)");
763      }
764      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
765      {
766         sprintf(toprint,"REAL(Agrif_Curgrid");
767         if( retour77 == 0 ) strcat(toprint," & \n");
768         else strcat(toprint,"\n     & ");
769         strcat(toprint,"% spaceref(2))");
770      }
771      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
772      {
773         sprintf(toprint,"REAL(Agrif_Curgrid");
774         if( retour77 == 0 ) strcat(toprint," & \n");
775         else strcat(toprint,"\n     & ");
776         strcat(toprint,"% parent % spaceref(2))");
777      }
778      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
779      {
780         sprintf(toprint,"Agrif_Curgrid");
781         if( retour77 == 0 ) strcat(toprint," & \n");
782         else strcat(toprint,"\n     & ");
783         strcat(toprint,"% spaceref(2)");
784      }
785      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
786      {
787         sprintf(toprint,"Agrif_Curgrid");
788         if( retour77 == 0 ) strcat(toprint," & \n");
789         else strcat(toprint,"\n     & ");
790         strcat(toprint,"% parent % spaceref(2)");
791      }
792      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
793      {
794         sprintf(toprint,"REAL(Agrif_Curgrid");
795         if( retour77 == 0 ) strcat(toprint," & \n");
796         else strcat(toprint,"\n     & ");
797         strcat(toprint,"% spaceref(3))");
798      }
799      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
800      {
801         sprintf(toprint,"REAL(Agrif_Curgrid");
802         if( retour77 == 0 ) strcat(toprint," & \n");
803         else strcat(toprint,"\n     & ");
804         strcat(toprint,"% parent % spaceref(3))");
805      }
806      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
807      {
808         sprintf(toprint,"Agrif_Curgrid");
809         if( retour77 == 0 ) strcat(toprint," & \n");
810         else strcat(toprint,"\n     & ");
811         strcat(toprint,"% spaceref(3)");
812      }
813      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
814      {
815         sprintf(toprint,"Agrif_Curgrid");
816         if( retour77 == 0 ) strcat(toprint," & \n");
817         else strcat(toprint,"\n     & ");
818         strcat(toprint,"% parent % spaceref(3)");
819      }
820      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
821      {
822         sprintf(toprint,"Agrif_Curgrid");
823         if( retour77 == 0 ) strcat(toprint," & \n");
824         else strcat(toprint,"\n     & ");
825         strcat(toprint,"% NearRootBorder(1)");
826      }
827      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
828      {
829         sprintf(toprint,"Agrif_Curgrid");
830         if( retour77 == 0 ) strcat(toprint," & \n");
831         else strcat(toprint,"\n     & ");
832         strcat(toprint,"% NearRootBorder(2)");
833      }
834      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
835      {
836         sprintf(toprint,"Agrif_Curgrid");
837         if( retour77 == 0 ) strcat(toprint," & \n");
838         else strcat(toprint,"\n     & ");
839         strcat(toprint,"% NearRootBorder(3)");
840      }
841      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
842      {
843         sprintf(toprint,"Agrif_Curgrid");
844         if( retour77 == 0 ) strcat(toprint," & \n");
845         else strcat(toprint,"\n     & ");
846         strcat(toprint,"% DistantRootBorder(1)");
847      }
848      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
849      {
850         sprintf(toprint,"Agrif_Curgrid");
851         if( retour77 == 0 ) strcat(toprint," & \n");
852         else strcat(toprint,"\n     & ");
853         strcat(toprint,"% DistantRootBorder(2)");
854      }
855      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
856      {
857         sprintf(toprint,"Agrif_Curgrid");
858         if( retour77 == 0 ) strcat(toprint," & \n");
859         else strcat(toprint,"\n     & ");
860         strcat(toprint,"% DistantRootBorder(3)");
861      }
862      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
863      {
864         sprintf(toprint,"Agrif_Curgrid");
865         if( retour77 == 0 ) strcat(toprint," & \n");
866         else strcat(toprint,"\n     & ");
867         strcat(toprint,"% parent % grid_id");
868      }
869      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
870      {
871         sprintf(toprint,"Agrif_Curgrid");
872         if( retour77 == 0 ) strcat(toprint," & \n");
873         else strcat(toprint,"\n     & ");
874         strcat(toprint,"% grid_id");
875      }
876      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
877      {
878         sprintf(toprint,"Agrif_Curgrid");
879         if( retour77 == 0 ) strcat(toprint," & \n");
880         else strcat(toprint,"\n     & ");
881         strcat(toprint,"% parent % ix(3)");
882      }
883      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
884      {
885         sprintf(toprint,"Agrif_Curgrid");
886         if( retour77 == 0 ) strcat(toprint," & \n");
887         else strcat(toprint,"\n     & ");
888         strcat(toprint,"% parent % ix(2)");
889      }
890      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
891      {
892         sprintf(toprint,"Agrif_Curgrid");
893         if( retour77 == 0 ) strcat(toprint," & \n");
894         else strcat(toprint,"\n     & ");
895         strcat(toprint,"% parent % ix(1)");
896      }
897      else if ( whichone == 26 ) /* Agrif_Iz                                  */
898      {
899         sprintf(toprint,"Agrif_Curgrid");
900         if( retour77 == 0 ) strcat(toprint," & \n");
901         else strcat(toprint,"\n     & ");
902         strcat(toprint," % ix(3)");
903      }
904      else if ( whichone == 27 ) /* Agrif_Iy                                  */
905      {
906         sprintf(toprint,"Agrif_Curgrid");
907         if( retour77 == 0 ) strcat(toprint," & \n");
908         else strcat(toprint,"\n     & ");
909         strcat(toprint,"% ix(2)");
910      }
911      else if ( whichone == 28 ) /* Agrif_Ix                                  */
912      {
913         sprintf(toprint,"Agrif_Curgrid");
914         if( retour77 == 0 ) strcat(toprint," & \n");
915         else strcat(toprint,"\n     & ");
916         strcat(toprint,"% ix(1)");
917      }
918      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
919      {
920         sprintf(toprint,"Agrif_nbfixedgrids");
921      }
922      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
923      {
924         sprintf(toprint,"Agrif_Curgrid");
925         if( retour77 == 0 ) strcat(toprint," & \n");
926         else strcat(toprint,"\n     & ");
927         strcat(toprint,"% ngridstep");
928      }
929      /*                                                                      */
930      if ( whichone == 1 || whichone == 2 )
931      {
932         Save_Length(toprint,43);
933         tofich(fortranout,toprint,2);
934      }
935      else
936      {
937/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
938         else fprintf(fortranout,"\n     & ");*/
939         Save_Length(toprint,43);
940         fprintf(fortranout,"%s",toprint);
941      }
942   }
943}
944
945
946/******************************************************************************/
947/*                             Instanciation_0                                */
948/******************************************************************************/
949/* Firstpass 0                                                                */
950/******************************************************************************/
951/*                                                                            */
952/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
953/*                                                                            */
954/******************************************************************************/
955void Instanciation_0(char *ident)
956{
957   listvar *newvar;
958   int out;
959
960   if ( firstpass == 0 && sameagrifargument == 1 )
961   {
962      newvar = List_Global_Var;
963
964      out=0;
965      while ( newvar && out == 0 )
966      {
967         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
968         else newvar=newvar->suiv;
969      }
970
971      if ( out == 0 )
972      {
973         newvar = List_Common_Var;
974
975         out=0;
976         while ( newvar && out == 0 )
977         {
978            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
979            else newvar=newvar->suiv;
980         }
981      }
982      if ( out == 0 )
983      {
984         newvar = List_ModuleUsed_Var;
985
986         out=0;
987         while ( newvar && out == 0 )
988         {
989            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
990            else newvar=newvar->suiv;
991         }
992      }
993
994      if ( out == 1 )
995      {
996         /* then write the instanciation                                      */
997         fprintf(fortranout,"\n      %s = %s",ident,
998                                          vargridcurgridtabvars(newvar->var,3));
999         colnum = 0;
1000      }
1001   }
1002   sameagrifargument = 0;
1003}
Note: See TracBrowser for help on using the repository browser.