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

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

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
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.