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 branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

set proper svn properties to all files...
  • Property svn:keywords set to Id
File size: 41.3 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
6/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
7/* This software is governed by the CeCILL-C license under French law and     */
8/* abiding by the rules of distribution of free software.  You can  use,      */
9/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
10/* license as circulated by CEA, CNRS and INRIA at the following URL          */
11/* "http://www.cecill.info".                                                  */
12/*                                                                            */
13/* As a counterpart to the access to the source code and  rights to copy,     */
14/* modify and redistribute granted by the license, users are provided only    */
15/* with a limited warranty  and the software's author,  the holder of the     */
16/* economic rights,  and the successive licensors  have only  limited         */
17/* liability.                                                                 */
18/*                                                                            */
19/* In this respect, the user's attention is drawn to the risks associated     */
20/* with loading,  using,  modifying and/or developing or reproducing the      */
21/* software by the user in light of its specific status of free software,     */
22/* that may mean  that it is complicated to manipulate,  and  that  also      */
23/* therefore means  that it is reserved for developers  and  experienced      */
24/* professionals having in-depth computer knowledge. Users are therefore      */
25/* encouraged to load and test the software's suitability as regards their    */
26/* requirements in conditions enabling the security of their systems and/or   */
27/* data to be ensured and,  more generally, to use and operate it in the      */
28/* same conditions as regards security.                                       */
29/*                                                                            */
30/* The fact that you are presently reading this means that you have had       */
31/* knowledge of the CeCILL-C license and that you accept its terms.           */
32/******************************************************************************/
33/* version 1.7                                                                */
34/******************************************************************************/
35#include <stdio.h>
36#include <stdlib.h>
37#include <string.h>
38#include "decl.h"
39/******************************************************************************/
40/*                      Vartonumber                                           */
41/******************************************************************************/
42/* This subroutine is used to know if Agrif_ is locate in the char            */
43/* tokname                                                                    */
44/******************************************************************************/
45/*                                                                            */
46/******************************************************************************/
47int Vartonumber(char *tokname)
48{
49   int agrifintheword;
50
51   agrifintheword = 0;
52        if ( !strcasecmp(tokname,"Agrif_parent")         ) agrifintheword = 1;
53   else if ( !strcasecmp(tokname,"Agrif_set_type")       ) agrifintheword = 1;
54   else if ( !strcasecmp(tokname,"Agrif_set_raf")        ) agrifintheword = 1;
55   else if ( !strcasecmp(tokname,"Agrif_set_bc")         ) agrifintheword = 1;
56   else if ( !strcasecmp(tokname,"Agrif_set_bcinterp")   ) agrifintheword = 1;
57   else if ( !strcasecmp(tokname,"Agrif_Root")           ) agrifintheword = 1;
58   else if ( !strcasecmp(tokname,"Agrif_CFixed")         ) agrifintheword = 1;
59   else if ( !strcasecmp(tokname,"Agrif_Fixed")          ) agrifintheword = 1;
60   else if ( !strcasecmp(tokname,"Agrif_bc_variable")    ) agrifintheword = 1;
61   else if ( !strcasecmp(tokname,"Agrif_set_parent")     ) agrifintheword = 1;
62   else if ( !strcasecmp(tokname,"Agrif_interp_variable")) agrifintheword = 1;
63   else if ( !strcasecmp(tokname,"Agrif_init_variable")  ) agrifintheword = 1;
64   else if ( !strcasecmp(tokname,"Agrif_update_variable")) agrifintheword = 1;
65   else if ( !strcasecmp(tokname,"Agrif_Set_interp")     ) agrifintheword = 1;
66   else if ( !strcasecmp(tokname,"Agrif_Set_Update")     ) agrifintheword = 1;
67   else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1;
68   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
69   else if ( !strcasecmp(tokname,"agrif_init_grids")     ) agrifintheword = 1;
70   else if ( !strcasecmp(tokname,"agrif_step")           ) agrifintheword = 1;
71
72   return agrifintheword;
73}
74
75/******************************************************************************/
76/*                              Agrif_in_Tok_NAME                             */
77/******************************************************************************/
78/* This subroutine is used to know if Agrif_ is locate in the char            */
79/* tokname                                                                    */
80/******************************************************************************/
81/*                                                                            */
82/*                 Agrif_name --------------> Agrif_in_Tok_NAME = 1           */
83/*                       name --------------> Agrif_in_Tok_NAME = 0           */
84/*                                                                            */
85/******************************************************************************/
86int Agrif_in_Tok_NAME(char *tokname)
87{
88   int agrifintheword;
89
90   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
91   else agrifintheword = 0;
92
93   return agrifintheword;
94}
95
96/******************************************************************************/
97/*                     ModifyTheVariableName_0                                */
98/******************************************************************************/
99/* Firstpass 0                                                                */
100/******************************************************************************/
101/*                                                                            */
102/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
103/*                                                                            */
104/******************************************************************************/
105void ModifyTheVariableName_0(char *ident, int lengthname)
106{
107   listvar *newvar;
108   int out;
109   
110   if ( firstpass == 0 )
111   {
112      newvar = List_Global_Var;
113      out=0;
114      while ( newvar && out == 0 )
115      {
116         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
117         else newvar=newvar->suiv;
118      }
119
120      if ( out == 0 )
121      {
122         newvar = List_ModuleUsed_Var;
123         while ( newvar && out == 0 )
124         {
125            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
126            else newvar=newvar->suiv;
127         }
128      }
129      if ( out == 0 )
130      {
131         newvar = List_Common_Var;
132         while ( newvar && out == 0 )
133         {
134            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
135            else newvar=newvar->suiv;
136         }
137      }
138
139      if ( out == 0 )
140      {
141         newvar = List_ModuleUsedInModuleUsed_Var;
142         while ( newvar && out == 0 )
143         {
144            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
145            else newvar=newvar->suiv;
146         }
147      }
148
149      if ( out == 1 )
150      {
151         /* remove the variable                                               */
152         RemoveWordCUR_0(fortranout,(long)(-lengthname),
153                               lengthname);
154         fseek(fortranout,(long)(-lengthname),SEEK_CUR);
155         /* then write the new name                                           */
156         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
157            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
158         else
159         {
160            if ( retour77 == 0 )
161            {
162               fprintf(fortranout," Agrif_tabvars & \n      ");
163            }
164            else
165            {
166               fprintf(fortranout,"Agrif_tabvars");
167               fprintf(fortranout," \n     & ");
168            }
169            fprintf(fortranout,"%s",
170                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
171            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
172         }
173      }
174      else
175      {
176         /* we should look in the List_ModuleUsed_Var                         */
177         if ( inagrifcallargument != 1 )
178         {
179            newvar = List_ModuleUsed_Var;
180            while ( newvar && out == 0 )
181            {
182               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
183               else newvar=newvar->suiv;
184            }
185            if ( out == 1 )
186            {
187               /* remove the variable                                         */
188               RemoveWordCUR_0(fortranout,(long)(-lengthname),
189                                     lengthname);
190               fseek(fortranout,(long)(-lengthname),SEEK_CUR);
191               /* then write the new name                                     */
192               if ( retour77 == 0 )
193               {
194                  fprintf(fortranout," Agrif_tabvars & \n      ");
195               }
196               else
197               {
198                  fprintf(fortranout," \n     & Agrif_tabvars");
199               }
200               fprintf(fortranout,"%s",
201                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
202               colnum = strlen(
203                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
204            }
205         }
206      }
207   }
208}
209
210/******************************************************************************/
211/*                     ModifyTheVariableName_0                                */
212/******************************************************************************/
213/* Firstpass 0                                                                */
214/******************************************************************************/
215/*                                                                            */
216/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
217/*                                                                            */
218/******************************************************************************/
219void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident)
220{
221   listvar *newvar;
222   int out;
223   
224   if ( firstpass == 0 )
225   {
226      newvar = List_Global_Var;
227      out=0;
228      while ( newvar && out == 0 )
229      {
230         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
231         else newvar=newvar->suiv;
232      }
233
234      if ( out == 0 )
235      {
236         newvar = List_ModuleUsed_Var;
237         while ( newvar && out == 0 )
238         {
239            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
240            else newvar=newvar->suiv;
241         }
242      }
243      if ( out == 0 )
244      {
245         newvar = List_Common_Var;
246         while ( newvar && out == 0 )
247         {
248            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
249            else newvar=newvar->suiv;
250         }
251      }
252
253      if ( out == 0 )
254      {
255         newvar = List_ModuleUsedInModuleUsed_Var;
256         while ( newvar && out == 0 )
257         {
258            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
259            else newvar=newvar->suiv;
260         }
261      }
262
263      if ( out == 1 )
264      {
265         /* remove the variable                                               */
266         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
267                               strlen(ident));
268         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
269         /* then write the new name                                           */
270         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
271            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
272         else
273         {
274            if ( retour77 == 0 )
275            {
276               fprintf(fortranout," Agrif_tabvars & \n      ");
277            }
278            else
279            {
280               fprintf(fortranout,"Agrif_tabvars");
281               fprintf(fortranout," \n     & ");
282            }
283            fprintf(fortranout,"%s",
284                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
285            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
286         }
287      }
288      else
289      {
290         /* we should look in the List_ModuleUsed_Var                         */
291         if ( inagrifcallargument != 1 )
292         {
293            newvar = List_ModuleUsed_Var;
294            while ( newvar && out == 0 )
295            {
296               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
297               else newvar=newvar->suiv;
298            }
299            if ( out == 1 )
300            {
301               /* remove the variable                                         */
302               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
303                                     strlen(ident));
304               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
305               /* then write the new name                                     */
306               if ( retour77 == 0 )
307               {
308                  fprintf(fortranout," Agrif_tabvars & \n      ");
309               }
310               else
311               {
312                  fprintf(fortranout," \n     & Agrif_tabvars");
313               }
314               fprintf(fortranout,"%s",
315                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
316               colnum = strlen(
317                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
318            }
319         }
320      }
321   }
322}
323
324
325
326/******************************************************************************/
327/*                         Add_SubroutineWhereAgrifUsed_1                     */
328/******************************************************************************/
329/* This subroutine is used to add a record to                                 */
330/* List_SubroutineWhereAgrifUsed                                              */
331/******************************************************************************/
332/*                                                                            */
333/*       subroutine sub ... Agrif_<something>                                 */
334/*                                                                            */
335/*        _______     _______     _______     _______     _______             */
336/*       +      +    +      +    +      +    +      +    +      +             */
337/*       + list +--->+ list +--->+ list +--->+ list +--->+ sub  +             */
338/*       +______+    +______+    +______+    +______+    +______+             */
339/*                                                                            */
340/*       list = List_SubroutineWhereAgrifUsed                                 */
341/*                                                                            */
342/******************************************************************************/
343void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod)
344{
345  listnom *listnomtmp;
346  listnom *parcours;
347
348  if ( firstpass == 1 )
349  {
350  if ( !List_SubroutineWhereAgrifUsed )
351  {
352     listnomtmp=(listnom *)malloc(sizeof(listnom));
353     strcpy(listnomtmp->o_nom,sub);
354     Save_Length(sub,23);
355     strcpy(listnomtmp->o_module,mod);
356     Save_Length(mod,24);
357     listnomtmp->suiv = NULL;
358     List_SubroutineWhereAgrifUsed  =  listnomtmp;
359  }
360  else
361  {
362    parcours = List_SubroutineWhereAgrifUsed;
363    while ( parcours && strcasecmp(parcours->o_nom,sub) )
364    {
365       parcours = parcours->suiv;
366    }
367    if ( !parcours )
368    {
369       listnomtmp=(listnom *)malloc(sizeof(listnom));
370       strcpy(listnomtmp->o_nom,sub);
371       Save_Length(sub,23);
372       strcpy(listnomtmp->o_module,mod);
373       Save_Length(mod,24);
374       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
375       List_SubroutineWhereAgrifUsed  =  listnomtmp;
376    }
377  }
378  }
379}
380
381/******************************************************************************/
382/*                                AddUseAgrifUtil_0                           */
383/******************************************************************************/
384/* Add use Agrif_Util at the beginning of the subroutine definition           */
385/* if it is necessary                                                         */
386/******************************************************************************/
387/*                                                                            */
388/*       subroutine sub            |  subroutine sub                          */
389/*                                 |  USE Agrif_Util                          */
390/*       implicit none             |  implicit none                           */
391/*       ...                       |  ...                                     */
392/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
393/*       ...                       |  ...                                     */
394/*       end                       |  end                                     */
395/*                                                                            */
396/*                                                                            */
397/******************************************************************************/
398void  AddUseAgrifUtil_0(FILE *fileout)
399{
400  listnom *parcours;
401
402  if ( firstpass == 0 )
403  {
404     parcours = List_SubroutineWhereAgrifUsed;
405     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
406                                                    parcours = parcours -> suiv;
407     if ( parcours && parcours->o_val != 0 )
408                                   fprintf(fileout,"\n      USE Agrif_Util \n");
409  }
410}
411
412void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
413{
414  listusemodule *parcours;
415
416  int out;
417
418  if ( firstpass == 0 )
419  {
420     parcours = List_NameOfModuleUsed;
421     out = 0 ;
422     while ( parcours && out == 0 )
423     {
424        if ( !strcasecmp(parcours->u_usemodule,"Agrif_Util")     &&
425             !strcasecmp(parcours->u_modulename,curmodulename)   &&
426             !strcasecmp(parcours->u_cursubroutine,subroutinename)
427            ) out = 1;
428        else parcours = parcours->suiv;
429     }
430     if ( out == 0 )
431     {
432        fprintf(fileout,"\n      USE Agrif_Util \n");
433     }
434  }
435}
436
437/******************************************************************************/
438/*                         NotifyAgrifFunction_0                              */
439/******************************************************************************/
440/* Firstpass 0                                                                */
441/******************************************************************************/
442/*                                                                            */
443/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
444/*                                                                            */
445/******************************************************************************/
446void NotifyAgrifFunction_0(char *ident)
447{
448   if ( firstpass == 0 )
449   {
450      if ( !strcasecmp(ident,"Agrif_parent") )
451      {
452         InAgrifParentDef = 1;
453         pos_curagrifparent = setposcur()-12;
454      }
455      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
456      {
457         InAgrifParentDef = 2;
458         pos_curagrifparent = setposcur()-21;
459      }
460      else if ( !strcasecmp(ident,"Agrif_Rhox") )
461      {
462         InAgrifParentDef = 3;
463         pos_curagrifparent = setposcur()-10;
464      }
465      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
466      {
467         InAgrifParentDef = 4;
468         pos_curagrifparent = setposcur()-17;
469      }
470      else if ( !strcasecmp(ident,"Agrif_IRhox") )
471      {
472         InAgrifParentDef = 5;
473         pos_curagrifparent = setposcur()-11;
474      }
475      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
476      {
477         InAgrifParentDef = 6;
478         pos_curagrifparent = setposcur()-18;
479      }
480      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
481      {
482         InAgrifParentDef = 7;
483         pos_curagrifparent = setposcur()-10;
484      }
485      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
486      {
487         InAgrifParentDef = 8;
488         pos_curagrifparent = setposcur()-17;
489      }
490      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
491      {
492         InAgrifParentDef = 9;
493         pos_curagrifparent = setposcur()-11;
494      }
495      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
496      {
497         InAgrifParentDef = 10;
498         pos_curagrifparent = setposcur()-18;
499      }
500      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
501      {
502         InAgrifParentDef = 11;
503         pos_curagrifparent = setposcur()-10;
504      }
505      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
506      {
507         InAgrifParentDef = 12;
508         pos_curagrifparent = setposcur()-17;
509      }
510      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
511      {
512         InAgrifParentDef = 13;
513         pos_curagrifparent = setposcur()-11;
514      }
515      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
516      {
517         InAgrifParentDef = 14;
518         pos_curagrifparent = setposcur()-18;
519      }
520      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
521      {
522         InAgrifParentDef = 15;
523         pos_curagrifparent = setposcur()-23;
524      }
525      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
526      {
527         InAgrifParentDef = 16;
528         pos_curagrifparent = setposcur()-23;
529      }
530      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
531      {
532         InAgrifParentDef = 17;
533         pos_curagrifparent = setposcur()-23;
534      }
535      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
536      {
537         InAgrifParentDef = 18;
538         pos_curagrifparent = setposcur()-26;
539      }
540      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
541      {
542         InAgrifParentDef = 19;
543         pos_curagrifparent = setposcur()-26;
544      }
545      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
546      {
547         InAgrifParentDef = 20;
548         pos_curagrifparent = setposcur()-26;
549      }
550      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
551      {
552         InAgrifParentDef = 21;
553         pos_curagrifparent = setposcur()-19;
554      }
555      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
556      {
557         InAgrifParentDef = 22;
558         pos_curagrifparent = setposcur()-17;
559      }
560      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
561      {
562         InAgrifParentDef = 23;
563         pos_curagrifparent = setposcur()-15;
564      }
565      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
566      {
567         InAgrifParentDef = 24;
568         pos_curagrifparent = setposcur()-15;
569      }
570      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
571      {
572         InAgrifParentDef = 25;
573         pos_curagrifparent = setposcur()-15;
574      }
575      else if ( !strcasecmp(ident,"Agrif_Iz") )
576      {
577         InAgrifParentDef = 26;
578         pos_curagrifparent = setposcur()-8;
579      }
580      else if ( !strcasecmp(ident,"Agrif_Iy") )
581      {
582         InAgrifParentDef = 27;
583         pos_curagrifparent = setposcur()-8;
584      }
585      else if ( !strcasecmp(ident,"Agrif_Ix") )
586      {
587         InAgrifParentDef = 28;
588         pos_curagrifparent = setposcur()-8;
589      }
590      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
591      {
592         InAgrifParentDef = 29;
593         pos_curagrifparent = setposcur()-20;
594      }
595      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
596      {
597         InAgrifParentDef = 29;
598         pos_curagrifparent = setposcur()-19;
599      }
600      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
601      {
602         InAgrifParentDef = 30;
603         pos_curagrifparent = setposcur()-13;
604      }
605   }
606}
607
608/******************************************************************************/
609/*                       ModifyTheAgrifFunction_0                             */
610/******************************************************************************/
611/* Firstpass 0                                                                */
612/******************************************************************************/
613/*                                                                            */
614/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
615/*                                                                            */
616/******************************************************************************/
617void ModifyTheAgrifFunction_0(char *ident)
618{
619   if ( InAgrifParentDef != 0 )
620          AgriffunctionModify_0(ident,InAgrifParentDef);
621   /*                                                                         */
622   InAgrifParentDef = 0;
623}
624
625
626/******************************************************************************/
627/*                         AgriffunctionModify_0                              */
628/******************************************************************************/
629/* Firstpass 0                                                                */
630/******************************************************************************/
631/* if whichone = 1 Agrif_parent ===>                                          */
632/*                                                                            */
633/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
634/*                                                                            */
635/* if whichone = 3 Agrif_Rhox ===>                                            */
636/*                                                                            */
637/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
638/*                                                                            */
639/* if whichone = 5 Agrif_IRhox ===>                                           */
640/*                                                                            */
641/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
642/*                                                                            */
643/* if whichone = 7 Agrif_Rhoy ===>                                            */
644/*                                                                            */
645/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
646/*                                                                            */
647/* if whichone = 9 Agrif_IRhoy ===>                                           */
648/*                                                                            */
649/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
650/*                                                                            */
651/* if whichone = 11 Agrif_Rhoz ===>                                           */
652/*                                                                            */
653/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
654/*                                                                            */
655/* if whichone = 13 Agrif_IRhoz ===>                                          */
656/*                                                                            */
657/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
658/*                                                                            */
659/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
660/*                                                                            */
661/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
662/*                                                                            */
663/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
664/*                                                                            */
665/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
666/*                                                                            */
667/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
668/*                                                                            */
669/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
670/*                                                                            */
671/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
672/*                                                                            */
673/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
674/*                                                                            */
675/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
676/*                                                                            */
677/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
678/*                                                                            */
679/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
680/*                                                                            */
681/* if whichone = 26 Agrif_Iz ===>                                             */
682/*                                                                            */
683/* if whichone = 27 Agrif_Iy ===>                                             */
684/*                                                                            */
685/* if whichone = 28 Agrif_Ix ===>                                             */
686/*                                                                            */
687/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
688/*                                                                            */
689/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
690/*                                                                            */
691/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
692/*                                                                            */
693/*                                                                            */
694/******************************************************************************/
695void AgriffunctionModify_0(char *ident,int whichone)
696{
697   char toprint[LONG_C];
698   if ( firstpass == 0 )
699   {
700      strcpy(toprint,"");
701      pos_end = setposcur();
702      fseek(fortranout,pos_curagrifparent,SEEK_SET);
703      if ( whichone == 1 || whichone == 2 )
704      {
705         /*                                                                   */
706         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
707         if ( !strcasecmp(ident,toprint) )
708         {
709            /* la liste des use de cette subroutine                           */
710            strcpy(toprint,"");
711            FindAndChangeNameToTabvars(ident,
712                                          toprint,List_Common_Var,whichone);
713         }
714         if ( !strcasecmp(ident,toprint) )
715         {
716            /* la liste des use de cette subroutine                           */
717            strcpy(toprint,"");
718            FindAndChangeNameToTabvars(ident,
719                                          toprint,List_ModuleUsed_Var,whichone);
720         }
721      }
722      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
723      {
724         sprintf(toprint,"REAL(");
725         if( retour77 == 0 ) strcat(toprint," & \n");
726         else strcat(toprint,"\n     & ");
727         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
728      }
729      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
730      {
731         sprintf(toprint,"REAL(");
732         if( retour77 == 0 ) strcat(toprint," & \n");
733         else strcat(toprint,"\n     & ");
734         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
735      }
736      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
737      {
738         sprintf(toprint,"Agrif_Curgrid");
739         if( retour77 == 0 ) strcat(toprint," & \n");
740         else strcat(toprint,"\n     & ");
741         strcat(toprint,"% spaceref(1)");
742      }
743      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
744      {
745         sprintf(toprint,"Agrif_Curgrid");
746         if( retour77 == 0 ) strcat(toprint," & \n");
747         else strcat(toprint,"\n     & ");
748         strcat(toprint,"% parent % spaceref(1)");
749      }
750      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
751      {
752         sprintf(toprint,"REAL(Agrif_Curgrid");
753         if( retour77 == 0 ) strcat(toprint," & \n");
754         else strcat(toprint,"\n     & ");
755         strcat(toprint,"% spaceref(2))");
756      }
757      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
758      {
759         sprintf(toprint,"REAL(Agrif_Curgrid");
760         if( retour77 == 0 ) strcat(toprint," & \n");
761         else strcat(toprint,"\n     & ");
762         strcat(toprint,"% parent % spaceref(2))");
763      }
764      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
765      {
766         sprintf(toprint,"Agrif_Curgrid");
767         if( retour77 == 0 ) strcat(toprint," & \n");
768         else strcat(toprint,"\n     & ");
769         strcat(toprint,"% spaceref(2)");
770      }
771      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
772      {
773         sprintf(toprint,"Agrif_Curgrid");
774         if( retour77 == 0 ) strcat(toprint," & \n");
775         else strcat(toprint,"\n     & ");
776         strcat(toprint,"% parent % spaceref(2)");
777      }
778      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
779      {
780         sprintf(toprint,"REAL(Agrif_Curgrid");
781         if( retour77 == 0 ) strcat(toprint," & \n");
782         else strcat(toprint,"\n     & ");
783         strcat(toprint,"% spaceref(3))");
784      }
785      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
786      {
787         sprintf(toprint,"REAL(Agrif_Curgrid");
788         if( retour77 == 0 ) strcat(toprint," & \n");
789         else strcat(toprint,"\n     & ");
790         strcat(toprint,"% parent % spaceref(3))");
791      }
792      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
793      {
794         sprintf(toprint,"Agrif_Curgrid");
795         if( retour77 == 0 ) strcat(toprint," & \n");
796         else strcat(toprint,"\n     & ");
797         strcat(toprint,"% spaceref(3)");
798      }
799      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
800      {
801         sprintf(toprint,"Agrif_Curgrid");
802         if( retour77 == 0 ) strcat(toprint," & \n");
803         else strcat(toprint,"\n     & ");
804         strcat(toprint,"% parent % spaceref(3)");
805      }
806      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
807      {
808         sprintf(toprint,"Agrif_Curgrid");
809         if( retour77 == 0 ) strcat(toprint," & \n");
810         else strcat(toprint,"\n     & ");
811         strcat(toprint,"% NearRootBorder(1)");
812      }
813      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
814      {
815         sprintf(toprint,"Agrif_Curgrid");
816         if( retour77 == 0 ) strcat(toprint," & \n");
817         else strcat(toprint,"\n     & ");
818         strcat(toprint,"% NearRootBorder(2)");
819      }
820      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
821      {
822         sprintf(toprint,"Agrif_Curgrid");
823         if( retour77 == 0 ) strcat(toprint," & \n");
824         else strcat(toprint,"\n     & ");
825         strcat(toprint,"% NearRootBorder(3)");
826      }
827      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
828      {
829         sprintf(toprint,"Agrif_Curgrid");
830         if( retour77 == 0 ) strcat(toprint," & \n");
831         else strcat(toprint,"\n     & ");
832         strcat(toprint,"% DistantRootBorder(1)");
833      }
834      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
835      {
836         sprintf(toprint,"Agrif_Curgrid");
837         if( retour77 == 0 ) strcat(toprint," & \n");
838         else strcat(toprint,"\n     & ");
839         strcat(toprint,"% DistantRootBorder(2)");
840      }
841      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
842      {
843         sprintf(toprint,"Agrif_Curgrid");
844         if( retour77 == 0 ) strcat(toprint," & \n");
845         else strcat(toprint,"\n     & ");
846         strcat(toprint,"% DistantRootBorder(3)");
847      }
848      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
849      {
850         sprintf(toprint,"Agrif_Curgrid");
851         if( retour77 == 0 ) strcat(toprint," & \n");
852         else strcat(toprint,"\n     & ");
853         strcat(toprint,"% parent % grid_id");
854      }
855      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
856      {
857         sprintf(toprint,"Agrif_Curgrid");
858         if( retour77 == 0 ) strcat(toprint," & \n");
859         else strcat(toprint,"\n     & ");
860         strcat(toprint,"% grid_id");
861      }
862      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
863      {
864         sprintf(toprint,"Agrif_Curgrid");
865         if( retour77 == 0 ) strcat(toprint," & \n");
866         else strcat(toprint,"\n     & ");
867         strcat(toprint,"% parent % ix(3)");
868      }
869      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
870      {
871         sprintf(toprint,"Agrif_Curgrid");
872         if( retour77 == 0 ) strcat(toprint," & \n");
873         else strcat(toprint,"\n     & ");
874         strcat(toprint,"% parent % ix(2)");
875      }
876      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
877      {
878         sprintf(toprint,"Agrif_Curgrid");
879         if( retour77 == 0 ) strcat(toprint," & \n");
880         else strcat(toprint,"\n     & ");
881         strcat(toprint,"% parent % ix(1)");
882      }
883      else if ( whichone == 26 ) /* Agrif_Iz                                  */
884      {
885         sprintf(toprint,"Agrif_Curgrid");
886         if( retour77 == 0 ) strcat(toprint," & \n");
887         else strcat(toprint,"\n     & ");
888         strcat(toprint," % ix(3)");
889      }
890      else if ( whichone == 27 ) /* Agrif_Iy                                  */
891      {
892         sprintf(toprint,"Agrif_Curgrid");
893         if( retour77 == 0 ) strcat(toprint," & \n");
894         else strcat(toprint,"\n     & ");
895         strcat(toprint,"% ix(2)");
896      }
897      else if ( whichone == 28 ) /* Agrif_Ix                                  */
898      {
899         sprintf(toprint,"Agrif_Curgrid");
900         if( retour77 == 0 ) strcat(toprint," & \n");
901         else strcat(toprint,"\n     & ");
902         strcat(toprint,"% ix(1)");
903      }
904      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
905      {
906         sprintf(toprint,"Agrif_nbfixedgrids");
907      }
908      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
909      {
910         sprintf(toprint,"Agrif_Curgrid");
911         if( retour77 == 0 ) strcat(toprint," & \n");
912         else strcat(toprint,"\n     & ");
913         strcat(toprint,"% ngridstep");
914      }
915      /*                                                                      */
916      if ( whichone == 1 || whichone == 2 )
917      {
918         Save_Length(toprint,43);
919         tofich(fortranout,toprint,2);
920      }
921      else
922      {
923/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
924         else fprintf(fortranout,"\n     & ");*/
925         Save_Length(toprint,43);
926         fprintf(fortranout,"%s",toprint);
927      }
928   }
929}
930
931
932/******************************************************************************/
933/*                             Instanciation_0                                */
934/******************************************************************************/
935/* Firstpass 0                                                                */
936/******************************************************************************/
937/*                                                                            */
938/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
939/*                                                                            */
940/******************************************************************************/
941void Instanciation_0(char *ident)
942{
943   listvar *newvar;
944   int out;
945
946   if ( firstpass == 0 && sameagrifargument == 1 )
947   {
948      newvar = List_Global_Var;
949
950      out=0;
951      while ( newvar && out == 0 )
952      {
953         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
954         else newvar=newvar->suiv;
955      }
956
957      if ( out == 0 )
958      {
959         newvar = List_Common_Var;
960
961         out=0;
962         while ( newvar && out == 0 )
963         {
964            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
965            else newvar=newvar->suiv;
966         }
967      }
968      if ( out == 0 )
969      {
970         newvar = List_ModuleUsed_Var;
971
972         out=0;
973         while ( newvar && out == 0 )
974         {
975            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
976            else newvar=newvar->suiv;
977         }
978      }
979
980      if ( out == 1 )
981      {
982         /* then write the instanciation                                      */
983         fprintf(fortranout,"\n      %s = %s",ident,
984                                          vargridcurgridtabvars(newvar->var,3));
985         colnum = 0;
986      }
987   }
988   sameagrifargument = 0;
989}
Note: See TracBrowser for help on using the repository browser.