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

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

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