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 vendors/AGRIF/current/LIB – NEMO

source: vendors/AGRIF/current/LIB/UtilAgrif.c @ 4777

Last change on this file since 4777 was 4777, checked in by rblod, 10 years ago

Load working_directory into vendors/AGRIF/current.

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