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

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

Update Agrif, see ticket:#39
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 37.2 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_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     Save_Length(sub,23);
240     strcpy(listnomtmp->o_module,mod);
241     Save_Length(mod,24);
242     listnomtmp->suiv = NULL;
243     List_SubroutineWhereAgrifUsed  =  listnomtmp;
244  }
245  else
246  {
247    parcours = List_SubroutineWhereAgrifUsed;
248    while ( parcours && strcasecmp(parcours->o_nom,sub) )
249    {
250       parcours = parcours->suiv;
251    }
252    if ( !parcours )
253    {
254       listnomtmp=(listnom *)malloc(sizeof(listnom));
255       strcpy(listnomtmp->o_nom,sub);
256       Save_Length(sub,23);
257       strcpy(listnomtmp->o_module,mod);
258       Save_Length(mod,24);
259       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
260       List_SubroutineWhereAgrifUsed  =  listnomtmp;
261    }
262  }
263  }
264}
265
266/******************************************************************************/
267/*                                AddUseAgrifUtil_0                           */
268/******************************************************************************/
269/* Add use Agrif_Util at the beginning of the subroutine definition           */
270/* if it is necessary                                                         */
271/******************************************************************************/
272/*                                                                            */
273/*       subroutine sub            |  subroutine sub                          */
274/*                                 |  USE Agrif_Util                          */
275/*       implicit none             |  implicit none                           */
276/*       ...                       |  ...                                     */
277/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
278/*       ...                       |  ...                                     */
279/*       end                       |  end                                     */
280/*                                                                            */
281/*                                                                            */
282/******************************************************************************/
283void  AddUseAgrifUtil_0(FILE *fileout)
284{
285  listnom *parcours;
286
287  if ( firstpass == 0 )
288  {
289     parcours = List_SubroutineWhereAgrifUsed;
290     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
291                                                    parcours = parcours -> suiv;
292     if ( parcours && parcours->o_val != 0 )
293                                   fprintf(fileout,"\n      USE Agrif_Util \n");
294  }
295}
296
297void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
298{
299  listusemodule *parcours;
300
301  int out;
302
303  if ( firstpass == 0 )
304  {
305     parcours = List_NameOfModuleUsed;
306     out = 0 ;
307     while ( parcours && out == 0 )
308     {
309        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
310             !strcasecmp(parcours->u_modulename,curmodulename)   &&
311             !strcasecmp(parcours->u_cursubroutine,subroutinename)
312            ) out = 1;
313        else parcours = parcours->suiv;
314     }
315     if ( out == 0 )
316     {
317        fprintf(fileout,"\n      USE Agrif_Util \n");
318     }
319  }
320}
321
322/******************************************************************************/
323/*                         NotifyAgrifFunction_0                              */
324/******************************************************************************/
325/* Firstpass 0                                                                */
326/******************************************************************************/
327/*                                                                            */
328/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
329/*                                                                            */
330/******************************************************************************/
331void NotifyAgrifFunction_0(char *ident)
332{
333   if ( firstpass == 0 )
334   {
335      if ( !strcasecmp(ident,"Agrif_parent") )
336      {
337         InAgrifParentDef = 1;
338         pos_curagrifparent = setposcur()-12;
339      }
340      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
341      {
342         InAgrifParentDef = 2;
343         pos_curagrifparent = setposcur()-21;
344      }
345      else if ( !strcasecmp(ident,"Agrif_Rhox") )
346      {
347         InAgrifParentDef = 3;
348         pos_curagrifparent = setposcur()-10;
349      }
350      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
351      {
352         InAgrifParentDef = 4;
353         pos_curagrifparent = setposcur()-17;
354      }
355      else if ( !strcasecmp(ident,"Agrif_IRhox") )
356      {
357         InAgrifParentDef = 5;
358         pos_curagrifparent = setposcur()-11;
359      }
360      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
361      {
362         InAgrifParentDef = 6;
363         pos_curagrifparent = setposcur()-18;
364      }
365      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
366      {
367         InAgrifParentDef = 7;
368         pos_curagrifparent = setposcur()-10;
369      }
370      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
371      {
372         InAgrifParentDef = 8;
373         pos_curagrifparent = setposcur()-17;
374      }
375      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
376      {
377         InAgrifParentDef = 9;
378         pos_curagrifparent = setposcur()-11;
379      }
380      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
381      {
382         InAgrifParentDef = 10;
383         pos_curagrifparent = setposcur()-18;
384      }
385      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
386      {
387         InAgrifParentDef = 11;
388         pos_curagrifparent = setposcur()-10;
389      }
390      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
391      {
392         InAgrifParentDef = 12;
393         pos_curagrifparent = setposcur()-17;
394      }
395      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
396      {
397         InAgrifParentDef = 13;
398         pos_curagrifparent = setposcur()-11;
399      }
400      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
401      {
402         InAgrifParentDef = 14;
403         pos_curagrifparent = setposcur()-18;
404      }
405      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
406      {
407         InAgrifParentDef = 15;
408         pos_curagrifparent = setposcur()-23;
409      }
410      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
411      {
412         InAgrifParentDef = 16;
413         pos_curagrifparent = setposcur()-23;
414      }
415      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
416      {
417         InAgrifParentDef = 17;
418         pos_curagrifparent = setposcur()-23;
419      }
420      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
421      {
422         InAgrifParentDef = 18;
423         pos_curagrifparent = setposcur()-26;
424      }
425      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
426      {
427         InAgrifParentDef = 19;
428         pos_curagrifparent = setposcur()-26;
429      }
430      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
431      {
432         InAgrifParentDef = 20;
433         pos_curagrifparent = setposcur()-26;
434      }
435      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
436      {
437         InAgrifParentDef = 21;
438         pos_curagrifparent = setposcur()-19;
439      }
440      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
441      {
442         InAgrifParentDef = 22;
443         pos_curagrifparent = setposcur()-17;
444      }
445      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
446      {
447         InAgrifParentDef = 23;
448         pos_curagrifparent = setposcur()-15;
449      }
450      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
451      {
452         InAgrifParentDef = 24;
453         pos_curagrifparent = setposcur()-15;
454      }
455      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
456      {
457         InAgrifParentDef = 25;
458         pos_curagrifparent = setposcur()-15;
459      }
460      else if ( !strcasecmp(ident,"Agrif_Iz") )
461      {
462         InAgrifParentDef = 26;
463         pos_curagrifparent = setposcur()-8;
464      }
465      else if ( !strcasecmp(ident,"Agrif_Iy") )
466      {
467         InAgrifParentDef = 27;
468         pos_curagrifparent = setposcur()-8;
469      }
470      else if ( !strcasecmp(ident,"Agrif_Ix") )
471      {
472         InAgrifParentDef = 28;
473         pos_curagrifparent = setposcur()-8;
474      }
475      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
476      {
477         InAgrifParentDef = 29;
478         pos_curagrifparent = setposcur()-20;
479      }
480      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
481      {
482         InAgrifParentDef = 29;
483         pos_curagrifparent = setposcur()-19;
484      }
485      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
486      {
487         InAgrifParentDef = 30;
488         pos_curagrifparent = setposcur()-13;
489      }
490   }
491}
492
493/******************************************************************************/
494/*                       ModifyTheAgrifFunction_0                             */
495/******************************************************************************/
496/* Firstpass 0                                                                */
497/******************************************************************************/
498/*                                                                            */
499/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
500/*                                                                            */
501/******************************************************************************/
502void ModifyTheAgrifFunction_0(char *ident)
503{
504   if ( InAgrifParentDef != 0 )
505          AgriffunctionModify_0(ident,InAgrifParentDef);
506   /*                                                                         */
507   InAgrifParentDef = 0;
508}
509
510
511/******************************************************************************/
512/*                         AgriffunctionModify_0                              */
513/******************************************************************************/
514/* Firstpass 0                                                                */
515/******************************************************************************/
516/* if whichone = 1 Agrif_parent ===>                                          */
517/*                                                                            */
518/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
519/*                                                                            */
520/* if whichone = 3 Agrif_Rhox ===>                                            */
521/*                                                                            */
522/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
523/*                                                                            */
524/* if whichone = 5 Agrif_IRhox ===>                                           */
525/*                                                                            */
526/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
527/*                                                                            */
528/* if whichone = 7 Agrif_Rhoy ===>                                            */
529/*                                                                            */
530/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
531/*                                                                            */
532/* if whichone = 9 Agrif_IRhoy ===>                                           */
533/*                                                                            */
534/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
535/*                                                                            */
536/* if whichone = 11 Agrif_Rhoz ===>                                           */
537/*                                                                            */
538/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
539/*                                                                            */
540/* if whichone = 13 Agrif_IRhoz ===>                                          */
541/*                                                                            */
542/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
543/*                                                                            */
544/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
545/*                                                                            */
546/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
547/*                                                                            */
548/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
549/*                                                                            */
550/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
551/*                                                                            */
552/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
553/*                                                                            */
554/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
555/*                                                                            */
556/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
557/*                                                                            */
558/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
559/*                                                                            */
560/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
561/*                                                                            */
562/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
563/*                                                                            */
564/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
565/*                                                                            */
566/* if whichone = 26 Agrif_Iz ===>                                             */
567/*                                                                            */
568/* if whichone = 27 Agrif_Iy ===>                                             */
569/*                                                                            */
570/* if whichone = 28 Agrif_Ix ===>                                             */
571/*                                                                            */
572/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
573/*                                                                            */
574/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
575/*                                                                            */
576/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
577/*                                                                            */
578/*                                                                            */
579/******************************************************************************/
580void AgriffunctionModify_0(char *ident,int whichone)
581{
582   char toprint[LONG_C];
583
584   if ( firstpass == 0 )
585   {
586      strcpy(toprint,"");
587      pos_end = setposcur();
588      fseek(fortranout,pos_curagrifparent,SEEK_SET);
589      if ( whichone == 1 || whichone == 2 )
590      {
591         /*                                                                   */
592         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
593         if ( !strcasecmp(ident,toprint) )
594         {
595            /* la liste des use de cette subroutine                           */
596            strcpy(toprint,"");
597            FindAndChangeNameToTabvars(ident,
598                                          toprint,List_Common_Var,whichone);
599         }
600         if ( !strcasecmp(ident,toprint) )
601         {
602            /* la liste des use de cette subroutine                           */
603            strcpy(toprint,"");
604            FindAndChangeNameToTabvars(ident,
605                                          toprint,List_ModuleUsed_Var,whichone);
606         }
607      }
608      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
609      {
610         sprintf(toprint,"REAL(");
611         if( retour77 == 0 ) strcat(toprint," & \n");
612         else strcat(toprint,"\n     & ");
613         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
614      }
615      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
616      {
617         sprintf(toprint,"REAL(");
618         if( retour77 == 0 ) strcat(toprint," & \n");
619         else strcat(toprint,"\n     & ");
620         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
621      }
622      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
623      {
624         sprintf(toprint,"Agrif_Curgrid");
625         if( retour77 == 0 ) strcat(toprint," & \n");
626         else strcat(toprint,"\n     & ");
627         strcat(toprint,"% spaceref(1)");
628      }
629      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
630      {
631         sprintf(toprint,"Agrif_Curgrid");
632         if( retour77 == 0 ) strcat(toprint," & \n");
633         else strcat(toprint,"\n     & ");
634         strcat(toprint,"% parent % spaceref(1)");
635      }
636      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
637      {
638         sprintf(toprint,"REAL(Agrif_Curgrid");
639         if( retour77 == 0 ) strcat(toprint," & \n");
640         else strcat(toprint,"\n     & ");
641         strcat(toprint,"% spaceref(2))");
642      }
643      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
644      {
645         sprintf(toprint,"REAL(Agrif_Curgrid");
646         if( retour77 == 0 ) strcat(toprint," & \n");
647         else strcat(toprint,"\n     & ");
648         strcat(toprint,"% parent % spaceref(2))");
649      }
650      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
651      {
652         sprintf(toprint,"Agrif_Curgrid");
653         if( retour77 == 0 ) strcat(toprint," & \n");
654         else strcat(toprint,"\n     & ");
655         strcat(toprint,"% spaceref(2)");
656      }
657      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
658      {
659         sprintf(toprint,"Agrif_Curgrid");
660         if( retour77 == 0 ) strcat(toprint," & \n");
661         else strcat(toprint,"\n     & ");
662         strcat(toprint,"% parent % spaceref(2)");
663      }
664      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
665      {
666         sprintf(toprint,"REAL(Agrif_Curgrid");
667         if( retour77 == 0 ) strcat(toprint," & \n");
668         else strcat(toprint,"\n     & ");
669         strcat(toprint,"% spaceref(3))");
670      }
671      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
672      {
673         sprintf(toprint,"REAL(Agrif_Curgrid");
674         if( retour77 == 0 ) strcat(toprint," & \n");
675         else strcat(toprint,"\n     & ");
676         strcat(toprint,"% parent % spaceref(3))");
677      }
678      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
679      {
680         sprintf(toprint,"Agrif_Curgrid");
681         if( retour77 == 0 ) strcat(toprint," & \n");
682         else strcat(toprint,"\n     & ");
683         strcat(toprint,"% spaceref(3)");
684      }
685      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
686      {
687         sprintf(toprint,"Agrif_Curgrid");
688         if( retour77 == 0 ) strcat(toprint," & \n");
689         else strcat(toprint,"\n     & ");
690         strcat(toprint,"% parent % spaceref(3)");
691      }
692      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
693      {
694         sprintf(toprint,"Agrif_Curgrid");
695         if( retour77 == 0 ) strcat(toprint," & \n");
696         else strcat(toprint,"\n     & ");
697         strcat(toprint,"% NearRootBorder(1)");
698      }
699      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
700      {
701         sprintf(toprint,"Agrif_Curgrid");
702         if( retour77 == 0 ) strcat(toprint," & \n");
703         else strcat(toprint,"\n     & ");
704         strcat(toprint,"% NearRootBorder(2)");
705      }
706      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
707      {
708         sprintf(toprint,"Agrif_Curgrid");
709         if( retour77 == 0 ) strcat(toprint," & \n");
710         else strcat(toprint,"\n     & ");
711         strcat(toprint,"% NearRootBorder(3)");
712      }
713      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
714      {
715         sprintf(toprint,"Agrif_Curgrid");
716         if( retour77 == 0 ) strcat(toprint," & \n");
717         else strcat(toprint,"\n     & ");
718         strcat(toprint,"% DistantRootBorder(1)");
719      }
720      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
721      {
722         sprintf(toprint,"Agrif_Curgrid");
723         if( retour77 == 0 ) strcat(toprint," & \n");
724         else strcat(toprint,"\n     & ");
725         strcat(toprint,"% DistantRootBorder(2)");
726      }
727      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
728      {
729         sprintf(toprint,"Agrif_Curgrid");
730         if( retour77 == 0 ) strcat(toprint," & \n");
731         else strcat(toprint,"\n     & ");
732         strcat(toprint,"% DistantRootBorder(3)");
733      }
734      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
735      {
736         sprintf(toprint,"Agrif_Curgrid");
737         if( retour77 == 0 ) strcat(toprint," & \n");
738         else strcat(toprint,"\n     & ");
739         strcat(toprint,"% parent % grid_id");
740      }
741      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
742      {
743         sprintf(toprint,"Agrif_Curgrid");
744         if( retour77 == 0 ) strcat(toprint," & \n");
745         else strcat(toprint,"\n     & ");
746         strcat(toprint,"% grid_id");
747      }
748      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
749      {
750         sprintf(toprint,"Agrif_Curgrid");
751         if( retour77 == 0 ) strcat(toprint," & \n");
752         else strcat(toprint,"\n     & ");
753         strcat(toprint,"% parent % ix(3)");
754      }
755      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
756      {
757         sprintf(toprint,"Agrif_Curgrid");
758         if( retour77 == 0 ) strcat(toprint," & \n");
759         else strcat(toprint,"\n     & ");
760         strcat(toprint,"% parent % ix(2)");
761      }
762      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
763      {
764         sprintf(toprint,"Agrif_Curgrid");
765         if( retour77 == 0 ) strcat(toprint," & \n");
766         else strcat(toprint,"\n     & ");
767         strcat(toprint,"% parent % ix(1)");
768      }
769      else if ( whichone == 26 ) /* Agrif_Iz                                  */
770      {
771         sprintf(toprint,"Agrif_Curgrid");
772         if( retour77 == 0 ) strcat(toprint," & \n");
773         else strcat(toprint,"\n     & ");
774         strcat(toprint," % ix(3)");
775      }
776      else if ( whichone == 27 ) /* Agrif_Iy                                  */
777      {
778         sprintf(toprint,"Agrif_Curgrid");
779         if( retour77 == 0 ) strcat(toprint," & \n");
780         else strcat(toprint,"\n     & ");
781         strcat(toprint,"% ix(2)");
782      }
783      else if ( whichone == 28 ) /* Agrif_Ix                                  */
784      {
785         sprintf(toprint,"Agrif_Curgrid");
786         if( retour77 == 0 ) strcat(toprint," & \n");
787         else strcat(toprint,"\n     & ");
788         strcat(toprint,"% ix(1)");
789      }
790      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
791      {
792         sprintf(toprint,"Agrif_nbfixedgrids");
793      }
794      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
795      {
796         sprintf(toprint,"Agrif_Curgrid");
797         if( retour77 == 0 ) strcat(toprint," & \n");
798         else strcat(toprint,"\n     & ");
799         strcat(toprint,"% ngridstep");
800      }
801      /*                                                                      */
802      if ( whichone == 1 || whichone == 2 )
803      {
804         Save_Length(toprint,43);
805         tofich(fortranout,toprint,2);
806      }
807      else
808      {
809/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
810         else fprintf(fortranout,"\n     & ");*/
811         Save_Length(toprint,43);
812         fprintf(fortranout,"%s",toprint);
813      }
814   }
815}
816
817
818/******************************************************************************/
819/*                             Instanciation_0                                */
820/******************************************************************************/
821/* Firstpass 0                                                                */
822/******************************************************************************/
823/*                                                                            */
824/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
825/*                                                                            */
826/******************************************************************************/
827void Instanciation_0(char *ident)
828{
829   listvar *newvar;
830   int out;
831
832   if ( firstpass == 0 && sameagrifargument == 1 )
833   {
834      newvar = List_Global_Var;
835
836      out=0;
837      while ( newvar && out == 0 )
838      {
839         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
840         else newvar=newvar->suiv;
841      }
842
843      if ( out == 0 )
844      {
845         newvar = List_Common_Var;
846
847         out=0;
848         while ( newvar && out == 0 )
849         {
850            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
851            else newvar=newvar->suiv;
852         }
853      }
854      if ( out == 0 )
855      {
856         newvar = List_ModuleUsed_Var;
857
858         out=0;
859         while ( newvar && out == 0 )
860         {
861            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
862            else newvar=newvar->suiv;
863         }
864      }
865
866      if ( out == 1 )
867      {
868         /* then write the instanciation                                      */
869         fprintf(fortranout,"\n      %s = %s",ident,
870                                          vargridcurgridtabvars(newvar->var,3));
871         colnum = 0;
872      }
873   }
874   sameagrifargument = 0;
875}
Note: See TracBrowser for help on using the repository browser.