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.
UtilAgrif.c in trunk/AGRIF/LIB – NEMO

source: trunk/AGRIF/LIB/UtilAgrif.c @ 663

Last change on this file since 663 was 663, checked in by opalod, 17 years ago

RB: update CONV

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 33.8 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.6                                                                */
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_init_grids")     ) agrifintheword = 1;
70   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1;
71
72   return agrifintheword;
73}
74
75/******************************************************************************/
76/*                              Agrif_in_Tok_NAME                             */
77/******************************************************************************/
78/* This subroutine is used to know if Agrif_ is locate in the char            */
79/* tokname                                                                    */
80/******************************************************************************/
81/*                                                                            */
82/*                 Agrif_name --------------> Agrif_in_Tok_NAME = 1           */
83/*                       name --------------> Agrif_in_Tok_NAME = 0           */
84/*                                                                            */
85/******************************************************************************/
86int Agrif_in_Tok_NAME(char *tokname)
87{
88   int agrifintheword;
89
90   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
91   else agrifintheword = 0;
92
93   return agrifintheword;
94}
95
96/******************************************************************************/
97/*                     ModifyTheVariableName_0                                */
98/******************************************************************************/
99/* Firstpass 0                                                                */
100/******************************************************************************/
101/*                                                                            */
102/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
103/*                                                                            */
104/******************************************************************************/
105void ModifyTheVariableName_0(char *ident)
106{
107   listvar *newvar;
108   int out;
109
110   if ( firstpass == 0 )
111   {
112      newvar = List_Global_Var;
113      out=0;
114      while ( newvar && out == 0 )
115      {
116         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
117         else newvar=newvar->suiv;
118      }
119
120      if ( out == 0 )
121      {
122         newvar = List_ModuleUsed_Var;
123         while ( newvar && out == 0 )
124         {
125            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
126            else newvar=newvar->suiv;
127         }
128      }
129      if ( out == 0 )
130      {
131         newvar = List_Common_Var;
132         while ( newvar && out == 0 )
133         {
134            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
135            else newvar=newvar->suiv;
136         }
137      }
138
139      if ( out == 0 )
140      {
141         newvar = List_ModuleUsedInModuleUsed_Var;
142         while ( newvar && out == 0 )
143         {
144            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
145            else newvar=newvar->suiv;
146         }
147      }
148
149      if ( out == 1 )
150      {
151         /* remove the variable                                               */
152         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
153                               strlen(ident));
154         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
155         /* then write the new name                                           */
156         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
157            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
158         else
159         {
160            if ( retour77 == 0 )
161            {
162               fprintf(fortranout," Agrif_tabvars & \n      ");
163            }
164            else
165            {
166               fprintf(fortranout,"Agrif_tabvars");
167               fprintf(fortranout," \n     & ");
168            }
169            fprintf(fortranout,"%s",
170                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
171            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
172         }
173      }
174      else
175      {
176         /* we should look in the List_ModuleUsed_Var                         */
177         if ( inagrifcallargument != 1 )
178         {
179            newvar = List_ModuleUsed_Var;
180            while ( newvar && out == 0 )
181            {
182               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
183               else newvar=newvar->suiv;
184            }
185            if ( out == 1 )
186            {
187               /* remove the variable                                         */
188               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
189                                     strlen(ident));
190               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
191               /* then write the new name                                     */
192               if ( retour77 == 0 )
193               {
194                  fprintf(fortranout," Agrif_tabvars & \n      ");
195               }
196               else
197               {
198                  fprintf(fortranout," \n     & Agrif_tabvars");
199               }
200               fprintf(fortranout,"%s",
201                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
202               colnum = strlen(
203                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
204            }
205         }
206      }
207   }
208}
209
210
211/******************************************************************************/
212/*                         Add_SubroutineWhereAgrifUsed_1                     */
213/******************************************************************************/
214/* This subroutine is used to add a record to                                 */
215/* List_SubroutineWhereAgrifUsed                                              */
216/******************************************************************************/
217/*                                                                            */
218/*       subroutine sub ... Agrif_<something>                                 */
219/*                                                                            */
220/*        _______     _______     _______     _______     _______             */
221/*       +      +    +      +    +      +    +      +    +      +             */
222/*       + list +--->+ list +--->+ list +--->+ list +--->+ sub  +             */
223/*       +______+    +______+    +______+    +______+    +______+             */
224/*                                                                            */
225/*       list = List_SubroutineWhereAgrifUsed                                 */
226/*                                                                            */
227/******************************************************************************/
228void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod)
229{
230  listnom *listnomtmp;
231  listnom *parcours;
232
233  if ( firstpass == 1 )
234  {
235  if ( !List_SubroutineWhereAgrifUsed )
236  {
237     listnomtmp=(listnom *)malloc(sizeof(listnom));
238     strcpy(listnomtmp->o_nom,sub);
239     strcpy(listnomtmp->o_module,mod);
240     listnomtmp->suiv = NULL;
241     List_SubroutineWhereAgrifUsed  =  listnomtmp;
242  }
243  else
244  {
245    parcours = List_SubroutineWhereAgrifUsed;
246    while ( parcours && strcasecmp(parcours->o_nom,sub) )
247    {
248       parcours = parcours->suiv;
249    }
250    if ( !parcours )
251    {
252       listnomtmp=(listnom *)malloc(sizeof(listnom));
253       strcpy(listnomtmp->o_nom,sub);
254       strcpy(listnomtmp->o_module,mod);
255       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
256       List_SubroutineWhereAgrifUsed  =  listnomtmp;
257    }
258  }
259  }
260}
261
262/******************************************************************************/
263/*                                AddUseAgrifUtil_0                           */
264/******************************************************************************/
265/* Add use Agrif_Util at the beginning of the subroutine definition           */
266/* if it is necessary                                                         */
267/******************************************************************************/
268/*                                                                            */
269/*       subroutine sub            |  subroutine sub                          */
270/*                                 |  USE Agrif_Util                          */
271/*       implicit none             |  implicit none                           */
272/*       ...                       |  ...                                     */
273/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
274/*       ...                       |  ...                                     */
275/*       end                       |  end                                     */
276/*                                                                            */
277/*                                                                            */
278/******************************************************************************/
279void  AddUseAgrifUtil_0(FILE *fileout)
280{
281  listnom *parcours;
282  listusemodule *newmodule;
283  int out;
284
285  if ( firstpass == 0 )
286  {
287     parcours = List_SubroutineWhereAgrifUsed;
288     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
289                                                    parcours = parcours -> suiv;
290     if ( parcours && parcours->o_val != 0 )
291                                   fprintf(fileout,"\n      USE Agrif_Util \n");
292  }
293}
294
295void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
296{
297  listusemodule *parcours;
298
299  int out;
300
301  if ( firstpass == 0 )
302  {
303     parcours = List_NameOfModuleUsed;
304     out = 0 ;
305     while ( parcours && out == 0 )
306     {
307        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
308             !strcasecmp(parcours->u_modulename,curmodulename)   &&
309             !strcasecmp(parcours->u_cursubroutine,subroutinename)
310            ) out = 1;
311        else parcours = parcours->suiv;
312     }
313     if ( out == 0 )
314     {
315        fprintf(fileout,"\n      USE Agrif_Util \n");
316     }
317  }
318}
319
320/******************************************************************************/
321/*                         NotifyAgrifFunction_0                              */
322/******************************************************************************/
323/* Firstpass 0                                                                */
324/******************************************************************************/
325/*                                                                            */
326/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
327/*                                                                            */
328/******************************************************************************/
329void NotifyAgrifFunction_0(char *ident)
330{
331   if ( firstpass == 0 )
332   {
333      if ( !strcasecmp(ident,"Agrif_parent") )
334      {
335         InAgrifParentDef = 1;
336         pos_curagrifparent = setposcur()-12;
337      }
338      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
339      {
340         InAgrifParentDef = 2;
341         pos_curagrifparent = setposcur()-21;
342      }
343      else if ( !strcasecmp(ident,"Agrif_Rhox") )
344      {
345         InAgrifParentDef = 3;
346         pos_curagrifparent = setposcur()-10;
347      }
348      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
349      {
350         InAgrifParentDef = 4;
351         pos_curagrifparent = setposcur()-17;
352      }
353      else if ( !strcasecmp(ident,"Agrif_IRhox") )
354      {
355         InAgrifParentDef = 5;
356         pos_curagrifparent = setposcur()-11;
357      }
358      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
359      {
360         InAgrifParentDef = 6;
361         pos_curagrifparent = setposcur()-18;
362      }
363      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
364      {
365         InAgrifParentDef = 7;
366         pos_curagrifparent = setposcur()-10;
367      }
368      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
369      {
370         InAgrifParentDef = 8;
371         pos_curagrifparent = setposcur()-17;
372      }
373      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
374      {
375         InAgrifParentDef = 9;
376         pos_curagrifparent = setposcur()-11;
377      }
378      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
379      {
380         InAgrifParentDef = 10;
381         pos_curagrifparent = setposcur()-18;
382      }
383      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
384      {
385         InAgrifParentDef = 11;
386         pos_curagrifparent = setposcur()-10;
387      }
388      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
389      {
390         InAgrifParentDef = 12;
391         pos_curagrifparent = setposcur()-17;
392      }
393      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
394      {
395         InAgrifParentDef = 13;
396         pos_curagrifparent = setposcur()-11;
397      }
398      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
399      {
400         InAgrifParentDef = 14;
401         pos_curagrifparent = setposcur()-18;
402      }
403      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
404      {
405         InAgrifParentDef = 15;
406         pos_curagrifparent = setposcur()-23;
407      }
408      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
409      {
410         InAgrifParentDef = 16;
411         pos_curagrifparent = setposcur()-23;
412      }
413      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
414      {
415         InAgrifParentDef = 17;
416         pos_curagrifparent = setposcur()-23;
417      }
418      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
419      {
420         InAgrifParentDef = 18;
421         pos_curagrifparent = setposcur()-26;
422      }
423      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
424      {
425         InAgrifParentDef = 19;
426         pos_curagrifparent = setposcur()-26;
427      }
428      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
429      {
430         InAgrifParentDef = 20;
431         pos_curagrifparent = setposcur()-26;
432      }
433      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
434      {
435         InAgrifParentDef = 21;
436         pos_curagrifparent = setposcur()-19;
437      }
438      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
439      {
440         InAgrifParentDef = 22;
441         pos_curagrifparent = setposcur()-17;
442      }
443      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
444      {
445         InAgrifParentDef = 23;
446         pos_curagrifparent = setposcur()-15;
447      }
448      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
449      {
450         InAgrifParentDef = 24;
451         pos_curagrifparent = setposcur()-15;
452      }
453      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
454      {
455         InAgrifParentDef = 25;
456         pos_curagrifparent = setposcur()-15;
457      }
458      else if ( !strcasecmp(ident,"Agrif_Iz") )
459      {
460         InAgrifParentDef = 26;
461         pos_curagrifparent = setposcur()-8;
462      }
463      else if ( !strcasecmp(ident,"Agrif_Iy") )
464      {
465         InAgrifParentDef = 27;
466         pos_curagrifparent = setposcur()-8;
467      }
468      else if ( !strcasecmp(ident,"Agrif_Ix") )
469      {
470         InAgrifParentDef = 28;
471         pos_curagrifparent = setposcur()-8;
472      }
473      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
474      {
475         InAgrifParentDef = 29;
476         pos_curagrifparent = setposcur()-20;
477      }
478      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
479      {
480         InAgrifParentDef = 29;
481         pos_curagrifparent = setposcur()-19;
482      }
483      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
484      {
485         InAgrifParentDef = 30;
486         pos_curagrifparent = setposcur()-13;
487      }
488   }
489}
490
491/******************************************************************************/
492/*                       ModifyTheAgrifFunction_0                             */
493/******************************************************************************/
494/* Firstpass 0                                                                */
495/******************************************************************************/
496/*                                                                            */
497/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
498/*                                                                            */
499/******************************************************************************/
500void ModifyTheAgrifFunction_0(char *ident)
501{
502   if ( InAgrifParentDef != 0 )
503          AgriffunctionModify_0(ident,InAgrifParentDef);
504   /*                                                                         */
505   InAgrifParentDef = 0;
506}
507
508
509/******************************************************************************/
510/*                         AgriffunctionModify_0                              */
511/******************************************************************************/
512/* Firstpass 0                                                                */
513/******************************************************************************/
514/* if whichone = 1 Agrif_parent ===>                                          */
515/*                                                                            */
516/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
517/*                                                                            */
518/* if whichone = 3 Agrif_Rhox ===>                                            */
519/*                                                                            */
520/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
521/*                                                                            */
522/* if whichone = 5 Agrif_IRhox ===>                                           */
523/*                                                                            */
524/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
525/*                                                                            */
526/* if whichone = 7 Agrif_Rhoy ===>                                            */
527/*                                                                            */
528/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
529/*                                                                            */
530/* if whichone = 9 Agrif_IRhoy ===>                                           */
531/*                                                                            */
532/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
533/*                                                                            */
534/* if whichone = 11 Agrif_Rhoz ===>                                           */
535/*                                                                            */
536/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
537/*                                                                            */
538/* if whichone = 13 Agrif_IRhoz ===>                                          */
539/*                                                                            */
540/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
541/*                                                                            */
542/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
543/*                                                                            */
544/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
545/*                                                                            */
546/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
547/*                                                                            */
548/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
549/*                                                                            */
550/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
551/*                                                                            */
552/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
553/*                                                                            */
554/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
555/*                                                                            */
556/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
557/*                                                                            */
558/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
559/*                                                                            */
560/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
561/*                                                                            */
562/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
563/*                                                                            */
564/* if whichone = 26 Agrif_Iz ===>                                             */
565/*                                                                            */
566/* if whichone = 27 Agrif_Iy ===>                                             */
567/*                                                                            */
568/* if whichone = 28 Agrif_Ix ===>                                             */
569/*                                                                            */
570/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
571/*                                                                            */
572/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
573/*                                                                            */
574/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
575/*                                                                            */
576/*                                                                            */
577/******************************************************************************/
578void AgriffunctionModify_0(char *ident,int whichone)
579{
580   char toprint[LONGNOM];
581
582   if ( firstpass == 0 )
583   {
584      strcpy(toprint,"");
585      pos_end = setposcur();
586      fseek(fortranout,pos_curagrifparent,SEEK_SET);
587      if ( whichone == 1 || whichone == 2 )
588      {
589         /*                                                                   */
590         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
591         if ( !strcasecmp(ident,toprint) )
592         {
593            /* la liste des use de cette subroutine                           */
594            strcpy(toprint,"");
595            FindAndChangeNameToTabvars(ident,
596                                          toprint,List_Common_Var,whichone);
597         }
598         if ( !strcasecmp(ident,toprint) )
599         {
600            /* la liste des use de cette subroutine                           */
601            strcpy(toprint,"");
602            FindAndChangeNameToTabvars(ident,
603                                          toprint,List_ModuleUsed_Var,whichone);
604         }
605      }
606      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
607      {
608         sprintf(toprint,"REAL(Agrif_Curgrid %% spaceref(1))");
609      }
610      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
611      {
612         sprintf(toprint,"REAL(Agrif_Curgrid %% parent %% spaceref(1))");
613      }
614      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
615      {
616         sprintf(toprint,"Agrif_Curgrid %% spaceref(1)");
617      }
618      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
619      {
620         sprintf(toprint,"Agrif_Curgrid %% parent %% spaceref(1)");
621      }
622      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
623      {
624         sprintf(toprint,"REAL(Agrif_Curgrid %% spaceref(2))");
625      }
626      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
627      {
628         sprintf(toprint,"REAL(Agrif_Curgrid %% parent %% spaceref(2))");
629      }
630      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
631      {
632         sprintf(toprint,"Agrif_Curgrid %% spaceref(2)");
633      }
634      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
635      {
636         sprintf(toprint,"Agrif_Curgrid %% parent %% spaceref(2)");
637      }
638      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
639      {
640         sprintf(toprint,"REAL(Agrif_Curgrid %% spaceref(3))");
641      }
642      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
643      {
644         sprintf(toprint,"REAL(Agrif_Curgrid %% parent %% spaceref(3))");
645      }
646      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
647      {
648         sprintf(toprint,"Agrif_Curgrid %% spaceref(3)");
649      }
650      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
651      {
652         sprintf(toprint,"Agrif_Curgrid %% parent %% spaceref(3)");
653      }
654      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
655      {
656         sprintf(toprint,"Agrif_Curgrid %% NearRootBorder(1)");
657      }
658      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
659      {
660         sprintf(toprint,"Agrif_Curgrid %% NearRootBorder(2)");
661      }
662      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
663      {
664         sprintf(toprint,"Agrif_Curgrid %% NearRootBorder(3)");
665      }
666      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
667      {
668         sprintf(toprint,"Agrif_Curgrid %% DistantRootBorder(1)");
669      }
670      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
671      {
672         sprintf(toprint,"Agrif_Curgrid %% DistantRootBorder(2)");
673      }
674      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
675      {
676         sprintf(toprint,"Agrif_Curgrid %% DistantRootBorder(3)");
677      }
678      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
679      {
680         sprintf(toprint,"Agrif_Curgrid %% parent %% grid_id");
681      }
682      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
683      {
684         sprintf(toprint,"Agrif_Curgrid %% grid_id");
685      }
686      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
687      {
688         sprintf(toprint,"Agrif_Curgrid %% parent %% ix(3)");
689      }
690      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
691      {
692         sprintf(toprint,"Agrif_Curgrid %% parent %% ix(2)");
693      }
694      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
695      {
696         sprintf(toprint,"Agrif_Curgrid %% parent %% ix(1)");
697      }
698      else if ( whichone == 26 ) /* Agrif_Iz                                  */
699      {
700         sprintf(toprint,"Agrif_Curgrid %% ix(3)");
701      }
702      else if ( whichone == 27 ) /* Agrif_Iy                                  */
703      {
704         sprintf(toprint,"Agrif_Curgrid %% ix(2)");
705      }
706      else if ( whichone == 28 ) /* Agrif_Ix                                  */
707      {
708         sprintf(toprint,"Agrif_Curgrid %% ix(1)");
709      }
710      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
711      {
712         sprintf(toprint,"Agrif_nbfixedgrids");
713      }
714      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
715      {
716         sprintf(toprint,"Agrif_Curgrid %% ngridstep");
717      }
718      /*                                                                      */
719      if ( whichone == 1 || whichone == 2 )
720      {
721         tofich(fortranout,toprint,2);
722      }
723      else
724      {
725         if( retour77 == 0 ) fprintf(fortranout," & \n");
726         else fprintf(fortranout,"\n     & ");
727         fprintf(fortranout,"%s",toprint);
728      }
729   }
730}
731
732
733/******************************************************************************/
734/*                             Instanciation_0                                */
735/******************************************************************************/
736/* Firstpass 0                                                                */
737/******************************************************************************/
738/*                                                                            */
739/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
740/*                                                                            */
741/******************************************************************************/
742void Instanciation_0(char *ident)
743{
744   listvar *newvar;
745   int out;
746
747   if ( firstpass == 0 && sameagrifargument == 1 )
748   {
749      newvar = List_Global_Var;
750
751      out=0;
752      while ( newvar && out == 0 )
753      {
754         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
755         else newvar=newvar->suiv;
756      }
757
758      if ( out == 0 )
759      {
760         newvar = List_Common_Var;
761
762         out=0;
763         while ( newvar && out == 0 )
764         {
765            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
766            else newvar=newvar->suiv;
767         }
768      }
769      if ( out == 0 )
770      {
771         newvar = List_ModuleUsed_Var;
772
773         out=0;
774         while ( newvar && out == 0 )
775         {
776            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
777            else newvar=newvar->suiv;
778         }
779      }
780
781      if ( out == 1 )
782      {
783         /* then write the instanciation                                      */
784         fprintf(fortranout,"\n      %s = %s",ident,
785                                          vargridcurgridtabvars(newvar->var,3));
786         colnum = 0;
787      }
788   }
789   sameagrifargument = 0;
790}
Note: See TracBrowser for help on using the repository browser.