ecearth3/sources/nemo-3.6/EXTERNAL/AGRIF/LIB/toamr.c

/******************************************************************************/
/*                                                                            */
/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
/*                                                                            */
/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
/* This software is governed by the CeCILL-C license under French law and     */
/* abiding by the rules of distribution of free software.  You can  use,      */
/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
/* license as circulated by CEA, CNRS and INRIA at the following URL          */
/* "http://www.cecill.info".                                                  */
/*                                                                            */
/* As a counterpart to the access to the source code and  rights to copy,     */
/* modify and redistribute granted by the license, users are provided only    */
/* with a limited warranty  and the software's author,  the holder of the     */
/* economic rights,  and the successive licensors  have only  limited         */
/* liability.                                                                 */
/*                                                                            */
/* In this respect, the user's attention is drawn to the risks associated     */
/* with loading,  using,  modifying and/or developing or reproducing the      */
/* software by the user in light of its specific status of free software,     */
/* that may mean  that it is complicated to manipulate,  and  that  also      */
/* therefore means  that it is reserved for developers  and  experienced      */
/* professionals having in-depth computer knowledge. Users are therefore      */
/* encouraged to load and test the software's suitability as regards their    */
/* requirements in conditions enabling the security of their systems and/or   */
/* data to be ensured and,  more generally, to use and operate it in the      */
/* same conditions as regards security.                                       */
/*                                                                            */
/* The fact that you are presently reading this means that you have had       */
/* knowledge of the CeCILL-C license and that you accept its terms.           */
/******************************************************************************/
/* version 1.7                                                                */
/******************************************************************************/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "decl.h"

const char * tabvarsname(const variable *var)
{
    static char * tname[5] = {
        "tabvars",      // v_catvar == 0
        "tabvars_c",    // v_catvar == 1
        "tabvars_r",    // v_catvar == 2
        "tabvars_l",    // v_catvar == 3
        "tabvars_i"     // v_catvar == 4
    };
    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4].
}

/******************************************************************************/
/*                        variablecurgridtabvars                              */
/******************************************************************************/
/* This subroutine is used to create the string                               */
/******************************************************************************/
/*                                                                            */
/*  ----------->  Agrif_Curgrid % tabvars (i)                                 */
/*                                                                            */
/******************************************************************************/
const char * variablecurgridtabvars(int which_grid)
{
    static char * varname[4] = {
        " Agrif_%s(%d)",                // which_grid == 0
        " Agrif_%s(%d) %% parent_var",  // which_grid == 1
        " Agrif_Mygrid %% %s(%d)",      // which_grid == 2
        " Agrif_Curgrid %% %s(%d)",     // which_grid == 3
    };

    return varname[which_grid];
}

void WARNING_CharSize(const variable *var)
{
    if ( var->v_nbdim == 0 )
    {
        if ( convert2int(var->v_dimchar) > 2400 )
        {
            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
            printf("   is upper than 2400. You must change         \n");
            printf("   the dimension of carray0                    \n");
            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
            printf("   line 161. Replace 2400 with %d.              \n", convert2int(var->v_dimchar)+100);
        }
        Save_Length_int(convert2int(var->v_dimchar),1);
    }
    else if ( var->v_nbdim == 1 )
    {
        if ( convert2int(var->v_dimchar) > 200 )
        {
            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
            printf("   is upper than 200. You must change          \n");
            printf("   the dimension of carray1                    \n");
            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
            printf("   line 162. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
        }
        Save_Length_int(convert2int(var->v_dimchar),2);
    }
    else if ( var->v_nbdim == 2 )
    {
        if ( convert2int(var->v_dimchar) > 200 )
        {
            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
            printf("   is upper than 200. You must change          \n");
            printf("   the dimension of carray2                    \n");
            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
            printf("   line 163. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
        }
        Save_Length_int(convert2int(var->v_dimchar),3);
    }
    else if ( var->v_nbdim == 3 )
    {
        if ( convert2int(var->v_dimchar) > 200 )
        {
            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
            printf("   is upper than 200. You must change          \n");
            printf("   the dimension of carray3                    \n");
            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
            printf("   line 164. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
        }
        Save_Length_int(convert2int(var->v_dimchar),4);
    }
}
/******************************************************************************/
/*                           vargridnametabvars                               */
/******************************************************************************/
/* This subroutine is used to create the string                               */
/******************************************************************************/
/*                                                                            */
/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % array1           */
/*                                                                            */
/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % array1          */
/*                                                                            */
/******************************************************************************/
const char *vargridnametabvars (const variable * var, int iorindice)
{
    static char tname_1[LONG_C];
    static char tname_2[LONG_C];

    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars);
    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var));

    if (!strcasecmp(var->v_typevar, "REAL"))
    {
        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
        else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "integer"))
    {
        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "logical"))
    {
        sprintf(tname_2, "%% larray%d", var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "character"))
    {
        WARNING_CharSize(var);
        sprintf (tname_2, "%% carray%d", var->v_nbdim);
    }

    strcat(tname_1, tname_2);
    Save_Length(tname_1, 46);

    return tname_1;
}

/******************************************************************************/
/*                           vargridcurgridtabvars                            */
/******************************************************************************/
/* This subroutine is used to create the string                               */
/******************************************************************************/
/*                                                                            */
/* if which_grid == 0 -->  Agrif_Curgrid % tabvars (i) % array1               */
/*                                                                            */
/* if which_grid == 1 -->  Agrif_tabvars (i) % parent_var % array1            */
/*                                                                            */
/* if which_grid == 2 -->  Agrif_Gr % tabvars (i) % array1                    */
/*                                                                            */
/******************************************************************************/
const char *vargridcurgridtabvars(const variable *var, int which_grid)
{
    static char tname_1[LONG_C];
    static char tname_2[LONG_C];

    if (!strcasecmp(var->v_typevar,"type"))
    {
        sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar);
    }
    else
    {
        sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars);

        if (!strcasecmp(var->v_typevar, "REAL"))
        {
            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
            else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
        }
        else if (!strcasecmp(var->v_typevar, "INTEGER"))
        {
            sprintf(tname_2, "%% iarray%d", var->v_nbdim);
        }
        else if (!strcasecmp(var->v_typevar, "LOGICAL"))
        {
            sprintf(tname_2, "%% larray%d", var->v_nbdim);
        }
        else if (!strcasecmp(var->v_typevar, "CHARACTER"))
        {
            WARNING_CharSize(var);
            sprintf(tname_2, "%% carray%d", var->v_nbdim);
        }
        strcat(tname_1, tname_2);
    }
    Save_Length(tname_1, 46);

    return tname_1;
}

/******************************************************************************/
/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
/******************************************************************************/
/* This subroutine is used to create the string                               */
/******************************************************************************/
/*                                                                            */
/******************************************************************************/
const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var)
{
    static char tname_1[LONG_C];
    static char tname_2[LONG_C];

    sprintf(tname_1, "(%d)", var->v_indicetabvars);

    if (!strcasecmp (var->v_typevar, "REAL"))
    {
        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
        else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "INTEGER"))
    {
        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
    {
        sprintf(tname_2, "%% larray%d", var->v_nbdim);
    }
    else if (!strcasecmp(var->v_typevar, "CHARACTER"))
    {
        WARNING_CharSize(var);
        sprintf(tname_2, "%% carray%d", var->v_nbdim);
    }

    strcat(tname_1, tname_2);
    Save_Length(tname_1, 46);

    return tname_1;
}

/******************************************************************************/
/*                               vargridparam                                 */
/******************************************************************************/
/* This subroutine is used to create the string which contains                */
/* dimension list                                                             */
/******************************************************************************/
/*                                                                            */
/*  DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj"                            */
/*                                                                            */
/******************************************************************************/
const char * vargridparam(const variable *var)
{
    typedim dim;
    listdim *newdim;
    char newname[LONG_M];

    newdim = var->v_dimension;
    if (!newdim) return "";

    strcpy (tmpvargridname, "(");
    while (newdim)
    {
        dim = newdim->dim;
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var));
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
        strcat(tmpvargridname, newname);
        strcat(tmpvargridname, " : ");
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var));
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var));
        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var));
        strcat(tmpvargridname, newname);
        newdim = newdim->suiv;
        if (newdim) strcat(tmpvargridname, ",");
    }
    strcat(tmpvargridname, ")\0");
    Save_Length(tmpvargridname,40);
    return tmpvargridname;
}

/******************************************************************************/
/*                        write_probdimagrif_file                             */
/******************************************************************************/
/* This subroutine is used to create the file probdim_agrif.h                 */
/******************************************************************************/
/*                                                                            */
/*               probdim_agrif.h                                              */
/*                                                                            */
/*               Agrif_probdim = <number>                                     */
/*                                                                            */
/******************************************************************************/
void write_probdimagrif_file()
{
  FILE *probdim;
  char ligne[LONG_M];

  probdim = open_for_write("probdim_agrif.h");
  sprintf (ligne, "Agrif_Probdim = %d", dimprob);
  tofich (probdim, ligne,1);
  fclose (probdim);
}

/******************************************************************************/
/*                             write_keysagrif_file                           */
/******************************************************************************/
/* This subroutine is used to create the file keys_agrif.h                    */
/******************************************************************************/
/*                                                                            */
/*               keys_agrif.h                                                 */
/*                                                                            */
/*               AGRIF_USE_FIXED_GRIDS = 0                                    */
/*               AGRIF_USE_ONLY_FIXED_GRIDS = 0                               */
/*               AGRIF_USE_(ONLY)_FIXED_GRIDS = 1                             */
/*                                                                            */
/******************************************************************************/
void write_keysagrif_file()
{
  FILE *keys;

  keys = open_for_write("keys_agrif.h");
  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids);
  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids);
  fclose(keys);
}

/******************************************************************************/
/*                      write_modtypeagrif_file                               */
/******************************************************************************/
/* This subroutine is used to create the file typedata                        */
/******************************************************************************/
/*                                                                            */
/*               modtype_agrif.h                                              */
/*                                                                            */
/*               Agrif_NbVariables =                                          */
/*                                                                            */
/******************************************************************************/
void write_modtypeagrif_file()
{
  char ligne[LONG_M];
  FILE *typedata;
  int i;

  typedata = open_for_write("modtype_agrif.h");
  /* AGRIF_NbVariables : number of variables                                  */
  for (i=0;i<NB_CAT_VARIABLES;i++)
   {
    sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]);
    tofich(typedata,ligne,1);
   }
  fclose (typedata);
}

/******************************************************************************/
/*                   write_createvarnameagrif_file                            */
/******************************************************************************/
/* This subroutine is used to create the file  createvarname                  */
/******************************************************************************/
/*                                                                            */
/*    Agrif_Gr % tabvars (i) % namevar = "variable"                           */
/*                                                                            */
/******************************************************************************/
void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty)
{
    char ligne[LONG_M];

    *InitEmpty = 0 ;
    sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar);
    tofich(createvarname,ligne,1);
}

/******************************************************************************/
/*                        write_Setnumberofcells_file                         */
/******************************************************************************/
/* This subroutine is used to create the file  setnumberofcells               */
/******************************************************************************/
/*                                                                            */
/*              Agrif_Gr % n(i) = nbmailles                                   */
/*                                                                            */
/******************************************************************************/
void write_Setnumberofcells_file()
{
    char ligne[LONG_VNAME];
    char cformat[LONG_VNAME];
    FILE *setnumberofcells;

    if ( IndicenbmaillesX == 0 )  return;

    setnumberofcells = open_for_write("SetNumberofcells.h");

    if ( onlyfixedgrids == 1 )
        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0");
    else
        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0");

    sprintf(ligne, cformat, 1, IndicenbmaillesX);
    tofich(setnumberofcells, ligne, 1);

    if ( dimprob > 1 )
    {
        sprintf(ligne, cformat, 2, IndicenbmaillesY);
        tofich(setnumberofcells, ligne, 1);
    }
    if ( dimprob > 2 )
    {
        sprintf(ligne, cformat, 3, IndicenbmaillesZ);
        tofich(setnumberofcells, ligne, 1);
    }
    fclose(setnumberofcells);
}

/******************************************************************************/
/*                       write_Getnumberofcells_file                          */
/******************************************************************************/
/* This subroutine is used to create the file  getnumberofcells               */
/******************************************************************************/
/*                                                                            */
/*              nbmailles = Agrif_Gr % n(i)                                   */
/*                                                                            */
/******************************************************************************/
void write_Getnumberofcells_file()
{
    char ligne[LONG_VNAME];
    char cformat[LONG_VNAME];
    FILE *getnumberofcells;

    if ( IndicenbmaillesX == 0 )    return;

    strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)");

    getnumberofcells = open_for_write("GetNumberofcells.h");

    sprintf(ligne, cformat, IndicenbmaillesX, 1);
    tofich(getnumberofcells, ligne, 1);

    if (dimprob > 1)
    {
        sprintf(ligne, cformat, IndicenbmaillesY, 2);
        tofich(getnumberofcells, ligne,1);
    }
    if (dimprob > 2)
    {
        sprintf(ligne, cformat, IndicenbmaillesZ, 3);
        tofich(getnumberofcells, ligne,1);
    }
    fclose(getnumberofcells);
}


/******************************************************************************/
/*                      write_initialisationsagrif_file                       */
/******************************************************************************/
/* This subroutine is used to create the file initproc                        */
/******************************************************************************/
/*                                                                            */
/*              ! variable                                                    */
/*              Agrif_Gr % tabvars(i) % nbdim = 1                             */
/*                                                                            */
/******************************************************************************/
void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty)
{
    char ligne[LONG_M];

    if ( v->v_nbdim != 0 )
    {
        *VarnameEmpty = 0 ;
        sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim);
        tofich (initproc, ligne,1);
    }
}


void Write_Alloc_Agrif_Files()
{
   listnom *parcours;
   FILE *alloccalls;
   FILE *AllocUSE;

   AllocUSE= open_for_write("include_use_Alloc_agrif.h");
   alloccalls = open_for_write("allocations_calls_agrif.h");

   parcours = List_Subroutine_For_Alloc;
   while ( parcours )
   {
      fprintf(AllocUSE,"      use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom );
      fprintf (alloccalls,"      call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom );
      parcours = parcours -> suiv;
   }

   fclose (AllocUSE);
   fclose (alloccalls);
}

int IndiceInlist(int indic, listindice *listin)
{
   listindice *parcoursindic;
   int out;

   out = 0 ;

   parcoursindic = listin;
   while ( parcoursindic && out == 0 )
   {
      if ( parcoursindic->i_indice == indic ) out = 1;
      else parcoursindic = parcoursindic -> suiv;
   }

   return out;
}

void write_allocation_Common_0()
{
    listnom *parcours_nom;
    listnom *neededparameter;
    listvar *parcours;
    listvar *parcoursprec;
    listvar *parcours1;
    FILE *allocationagrif;
    FILE *paramtoamr;
    char ligne[LONG_M];
    char ligne2[LONG_M];
    variable *v;
    int IndiceMax;
    int IndiceMin;
    int compteur;
    int out;
    int indiceprec;
    int ValeurMax;
    char initialvalue[LONG_M];
    listindice **list_indic;
    listindice *parcoursindic;
    int i;

    parcoursprec = (listvar *) NULL;
    parcours_nom = List_NameOfCommon;
    ValeurMax = 2;
    while ( parcours_nom  )
    {
        if ( parcours_nom->o_val == 1 )
        {
            /* Open the file to create the Alloc_agrif subroutine                */
            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
            allocationagrif = open_for_write(ligne);
            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom);

            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
            paramtoamr = open_for_write(ligne);
            neededparameter = (listnom *) NULL;
            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));

//             shouldincludempif = 1 ;
            parcours = List_Common_Var;
            while ( parcours )
            {
                if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
                    IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 )
                {
                    v = parcours->var;
                    IndiceMax = 0;
                    IndiceMin = indicemaxtabvars[v->v_catvar];
                    /* body of the file */
                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
                    {
                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
                        {
                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
                            tofich(allocationagrif,ligne,1);
                        }
                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
                        {
                            /*                ALLOCATION                                          */
                            if ( v->v_dimension != 0 )
                            {
                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
                                {
                                    parcours1 = parcours;
                                    compteur = -1;
                                    out = 0;
                                    indiceprec = parcours->var->v_indicetabvars -1 ;
                                    while ( parcours1 && out == 0
                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
                                    {
                                        if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) ||
                                             !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) )
                                        {
                                            compteur = compteur +1 ;
                                            indiceprec = parcours1->var->v_indicetabvars;
                                            parcoursprec = parcours1;
                                            parcours1 = parcours1->suiv;
                                        }
                                        else out = 1;
                                    }
                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
                                    tofich(allocationagrif,ligne,1);
                                    if ( compteur > ValeurMax )
                                    {
                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
                                                                      parcours->var->v_indicetabvars+compteur);
                                        tofich(allocationagrif,ligne,1);
                                        IndiceMin = parcours->var->v_indicetabvars;
                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
                                        sprintf(ligne2,"%s)", vargridparam(v));
                                        strcat(ligne,ligne2);
                                        tofich(allocationagrif,ligne,1);
                                        tofich(allocationagrif,"enddo",1);
                                        i = parcours->var->v_indicetabvars;
                                        do
                                        {
                                            parcoursindic =  (listindice *)calloc(1,sizeof(listindice));
                                            parcoursindic -> i_indice = i;
                                            parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
                                            list_indic[parcours->var->v_catvar] = parcoursindic;
                                            i = i + 1;
                                        } while ( i <= parcours->var->v_indicetabvars+compteur );
                                        parcours = parcoursprec;
                                    }
                                    else
                                    {
                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
                                        sprintf(ligne2,"%s)", vargridparam(v));
                                        strcat(ligne,ligne2);
                                        tofich(allocationagrif,ligne,1);
                                        parcoursindic =  (listindice *) calloc(1,sizeof(listindice));
                                        parcoursindic -> i_indice = parcours->var->v_indicetabvars;
                                        parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
                                        list_indic[parcours->var->v_catvar] = parcoursindic;
                                    }
                                    neededparameter = writedeclarationintoamr(List_Parameter_Var,
                                                        paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname);
                                }
                            } /* end of the allocation part                                       */
                            /*                INITIALISATION                                      */
                            if ( strcasecmp(v->v_initialvalue,"") )
                            {
                                strcpy(ligne, vargridnametabvars(v,0));
                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
                                {
                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
                                }
                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
                                {
                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
                                }
                                strcat (ligne," = ");

                                if (v->v_nbdim == 0)
                                {
                                    strcpy(ligne2,initialvalue);
                                }
                                else
                                {
                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0));
                                }
                                strcat(ligne,ligne2);
                                tofich(allocationagrif,ligne,1);
                            }
                        }
                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
                        {
                            tofich(allocationagrif,"endif",1);
                        }
                    }
                }
                parcours = parcours -> suiv;
            }
            /* Close the file Alloc_agrif                                        */
            fclose(allocationagrif);
            fclose(paramtoamr);
        }
        parcours_nom = parcours_nom -> suiv;
    }
}

void write_allocation_Global_0()
{
    listnom *parcours_nom;
    listvar *parcours;
    listvar *parcoursprec;
    listvar *parcours1;
    FILE *allocationagrif;
    char ligne[LONG_M];
    char ligne2[LONG_M];
    variable *v;
    int IndiceMax;
    int IndiceMin;
    int compteur;
    int out;
    int indiceprec;
    int ValeurMax;
    char initialvalue[LONG_M];
    int typeiswritten ;

    parcoursprec = (listvar *) NULL;
    parcours_nom = List_NameOfModule;
    ValeurMax = 2;

    while ( parcours_nom  )
    {
        if ( parcours_nom->o_val == 1 )
        {
            IndiceMax = 0;
            IndiceMin = indicemaxtabvars[0];
            /* Open the file to create the Alloc_agrif subroutine                */
            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
            allocationagrif = open_for_write(ligne);

//             if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
//             {
//                 /* add the call to initworkspace         */
//                 tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1);
//                 tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0);
//                 tofich(allocationagrif,"else",1);
//                 tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0);
//                 tofich(allocationagrif,"endif",1);
//                 tofich(allocationagrif,"call Agrif_InitWorkspace",1);
//             }

            typeiswritten = 0;
            parcours = List_Global_Var;
            while ( parcours )
            {
                if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
                       parcours->var->v_VariableIsParameter == 0                  &&
                       parcours->var->v_notgrid == 0  )
                {
                    v = parcours->var;
                    IndiceMax = 0;
                    IndiceMin = indicemaxtabvars[v->v_catvar];
                    /* body of the file */
                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
                    {
                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
                        {
                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
                            tofich(allocationagrif,ligne,1);
                        }
                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
                        {
                            /*                ALLOCATION                                          */
                            if ( v->v_dimension != 0 )
                            {
                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
                                {
                                    parcours1 = parcours;
                                    compteur = -1;
                                    out = 0;
                                    indiceprec = parcours->var->v_indicetabvars -1 ;
                                    while ( parcours1 && out == 0
                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
                                    {
                                        if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) ||
                                             !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) )
                                        {
                                            compteur = compteur +1 ;
                                            indiceprec = parcours1->var->v_indicetabvars;
                                            parcoursprec = parcours1;
                                            parcours1 = parcours1->suiv;
                                        }
                                        else out = 1;
                                    }
                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
                                    tofich(allocationagrif,ligne,1);
                                    if ( compteur > ValeurMax )
                                    {
                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
                                                                      parcours->var->v_indicetabvars+compteur);
                                        tofich(allocationagrif,ligne,1);
                                        IndiceMin = parcours->var->v_indicetabvars;
                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
                                        sprintf(ligne2,"%s)", vargridparam(v));
                                        strcat(ligne,ligne2);
                                        tofich(allocationagrif,ligne,1);
                                        tofich(allocationagrif,"enddo",1);
                                        parcours = parcoursprec;
                                    }
                                    else
                                    {
                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
                                        sprintf(ligne2,"%s)", vargridparam(v));
                                        strcat(ligne,ligne2);
                                        tofich(allocationagrif,ligne,1);
                                    }
                                }
                            } /* end of the allocation part                                       */
                            /*                INITIALISATION                                      */
                            if ( strcasecmp(v->v_initialvalue,"") )
                            {
                                strcpy(ligne, vargridnametabvars(v,0));
                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
                                {
                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
                                }
                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
                                {
                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
                                }
                                strcat (ligne," = ");
                                strcat (ligne,initialvalue);
                                Save_Length(ligne,48);
                                tofich(allocationagrif,ligne,1);
                            }
                        }
                        /* Case of structure types */
                        if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") )
                        {
                            sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename);
                            tofich(allocationagrif, ligne, 1);
                            sprintf(ligne,"    allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
                            tofich(allocationagrif, ligne, 1);
                            tofich(allocationagrif, "endif", 1);
                            typeiswritten = 1;
                        }
                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
                        {
                            tofich(allocationagrif,"endif",1);
                        }
                    }
                }
                parcours = parcours -> suiv;
            }
            if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
            {
                fprintf(allocationagrif, "      if ( .not.Agrif_Root() ) then\n");
                fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n");
                fprintf(allocationagrif, "      else\n");
                fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n");
                fprintf(allocationagrif, "      endif\n");
                fprintf(allocationagrif, "      call Agrif_InitWorkspace\n");
            }
            fclose(allocationagrif);
        }
        parcours_nom = parcours_nom -> suiv;
    }
}

/******************************************************************************/
/*                           creefichieramr                                   */
/******************************************************************************/
/* This subroutine is the main one to create AGRIF_INC files                  */
/******************************************************************************/
/*                                                                            */
/******************************************************************************/
void creefichieramr ()
{
    listvar *newvar;
    variable *v;
    int erreur;
    char filefich[LONG_M];

    int InitEmpty;
    int VarnameEmpty;
    int donotwrite;

    FILE *initproc;
    FILE *initglobal;
    FILE *createvarname;
    FILE *createvarnameglobal;

    if ( todebug == 1 ) printf("Enter in creefichieramr\n");

    sprintf(filefich, "cd %s", include_dir);
    erreur = system (filefich);
    if (erreur)
    {
        sprintf(filefich, "mkdir -p %s", include_dir);
        system(filefich);
        printf("%s: Directory created\n", include_dir);
    }

/******************************************************************************/
/******************** Creation of AGRIF_INC files *****************************/
/******************************************************************************/

    if ( todebug == 1 )
    {
        const char *NameTampon = "toto";
        sprintf(filefich,"initialisations_agrif_%s.h", NameTampon);
        initproc = open_for_write(filefich);

        sprintf(filefich,"createvarname_agrif_%s.h", NameTampon);
        createvarname = open_for_write(filefich);

        InitEmpty = 1 ;
        VarnameEmpty = 1 ;

        newvar = List_Global_Var;
        while ( newvar )
        {
            donotwrite = 0;
            v = newvar->var;

            if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
            {
                write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
                write_initialisationsagrif_file(v,initproc,&InitEmpty);
            }
            newvar = newvar->suiv;
        }
        fclose (createvarname);
        fclose (initproc);

        if ( is_dependfile_created(curmodulename) == 0 )
        {
            if ( InitEmpty != 1  )
            {
                initglobal = open_for_append("initialisations_agrif.h");
                fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon);
                fclose(initglobal);
            }
            if ( VarnameEmpty != 1 )
            {
                createvarnameglobal= open_for_append("createvarname_agrif.h");
                fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon);
                fclose(createvarnameglobal);
            }
        }
    }
    write_allocation_Common_0();
    write_allocation_Global_0();

    Write_Alloc_Agrif_Files();
    write_probdimagrif_file();
    write_keysagrif_file();
    write_modtypeagrif_file();

    if ( NbMailleXDefined == 1 )
    {
        write_Setnumberofcells_file();
        write_Getnumberofcells_file();
    }

    if ( todebug == 1 ) printf("Out of creefichieramr\n");
}