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

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

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