char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var)
{
sprintf (lvargridname, "(%d) %% var", var->v_indicetabvars);
if (!strcasecmp (var->v_typevar, "REAL"))
{
if ( !strcasecmp(var->v_nameinttypename,"8") )
sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
else if ( !strcasecmp(var->v_nameinttypename,"4") )
sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "INTEGER"))
{
sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "LOGICAL"))
{
sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "CHARACTER"))
{
WARNING_CharSize(var);
sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
}
strcat (lvargridname, lvargridname2);
Save_Length(lvargridname,42);
Save_Length(lvargridname2,42);
return lvargridname;
}
void CreateAndFillin_Curvar(const char *type, variable *curvar)
{
listname *newvar;
if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
{
strcpy(curvar->v_dimchar, CharacterSize);
}
/* On donne la precision de la variable si elle a ete donnee */
curvar->v_c_star = 0;
if ( c_star == 1 ) curvar->v_c_star = 1;
strcpy(curvar->v_vallengspec,"");
if ( strcasecmp(vallengspec,"") )
{
strcpy(curvar->v_vallengspec,vallengspec);
Save_Length(vallengspec,8);
}
strcpy(curvar->v_precision,"");
if ( strcasecmp(NamePrecision,"") )
{
strcpy(curvar->v_precision,NamePrecision);
addprecision_derivedfromkind(curvar);
Save_Length(NamePrecision,12);
}
/* Si cette variable a ete declaree dans un module on met curvar->module=1 */
if ( inmoduledeclare == 1 || SaveDeclare == 1 )
{
curvar->v_module = 1;
}
/* Puis on donne le nom du module dans curvar->v_modulename */
strcpy(curvar->v_modulename,curmodulename);
/* Si cette variable a ete initialisee */
if (InitialValueGiven == 1 )
{
curvar->v_initialvalue=Insertname(curvar->v_initialvalue,InitValue,0);
// strcpy(curvar->v_initialvalue,InitValue);
Save_Length(InitValue,14);
}
/* Si cette variable est declaree en save */
if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
/* Si cette variable est v_allocatable */
if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
/* Si cette variable est v_target */
if (Targetdeclare == 1 ) curvar->v_target=1;
/* if INTENT spec has been given */
if ( strcasecmp(IntentSpec,"") )
{
strcpy(curvar->v_IntentSpec,IntentSpec);
Save_Length(IntentSpec,13);
}
}
void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2)
{
listvar *newvar;
listvar *tmpvar;
listname *tmpvar1;
listname *tmpvar2;
char ligne[LONG_C];
tmpvar1 = l1;
tmpvar2 = l2;
while (tmpvar1)
{
newvar=(listvar *)malloc(sizeof(listvar));
newvar->var=(variable *)malloc(sizeof(variable));
/* */
Init_Variable(newvar->var);
/* */
if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
Save_Length(tmpvar1->n_name,4);
strcpy(newvar->var->v_subroutinename,subroutinename);
Save_Length(subroutinename,11);
strcpy(newvar->var->v_modulename,curmodulename);
Save_Length(curmodulename,6);
strcpy(newvar->var->v_commoninfile,mainfile);
Save_Length(mainfile,10);
strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
Save_Length(tmpvar2->n_name,14);
newvar->suiv = NULL;
if ( ! (*curlist) )
{
*curlist = newvar ;
}
else
{
tmpvar = *curlist;
while (tmpvar->suiv)
tmpvar=tmpvar->suiv;
tmpvar->suiv = newvar;
}
tmpvar1 = tmpvar1->suiv;
tmpvar2 = tmpvar2->suiv;
}
return;
}
char *vargridparam (variable * v, int whichone)
{
typedim dim;
listdim *newdim;
char newname[LONG_4C];
newdim = v->v_dimension;
if (!newdim) return "";
strcpy (tmpvargridname, "(");
while (newdim)
{
dim = newdim->dim;
strcpy(newname,"");
strcpy(newname,
ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var,
whichone));
strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
List_Common_Var,whichone));
strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
List_ModuleUsed_Var,whichone));
strcat (tmpvargridname, newname);
strcat (tmpvargridname, " : ");
strcpy(newname,"");
strcpy(newname,ChangeTheInitalvaluebyTabvarsName
(dim.last,List_Global_Var,whichone));
strcpy(newname,ChangeTheInitalvaluebyTabvarsName
(newname, List_Common_Var,whichone));
strcpy(newname,ChangeTheInitalvaluebyTabvarsName
(newname, List_ModuleUsed_Var,whichone));
Save_Length(tmpvargridname,46);
strcat (tmpvargridname, newname);
newdim = newdim->suiv;
if (newdim) strcat (tmpvargridname, ",");
}
strcat (tmpvargridname, ")");
strcat (tmpvargridname, "\0");
Save_Length(tmpvargridname,40);
return tmpvargridname;
}
void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
listvar * listtosee, int whichone)
{
listvar *newvar;
int out;
if ( strcasecmp(name,"") )
{
newvar=listtosee;
out=0;
while( newvar && out == 0 )
{
if ( !strcasecmp(newvar->var->v_nomvar,name) )
{
if ( LookingForVariableInListName(
List_SubroutineArgument_Var,name) == 0 )
{
out = 1;
strcat(toprint,vargridcurgridtabvars(newvar->var,whichone));
}
else newvar=newvar->suiv;
}
else newvar=newvar->suiv;
}
if ( out == 0 ) strcat(toprint,name);
}
Save_Length(toprint,44);
}
char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid)
{
char *tmp;
char tmp1[LONG_C];
if (!strcasecmp(var->v_typevar,"type"))
{
strcpy(lvargridname2,"");
sprintf(lvargridname,"Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s",var->v_modulename,var->v_nomvar);
printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename);
}
else
{
tmp = variablecurgridtabvars (var,ParentOrCurgrid);
strcpy(tmp1,tmp);
if ( todebugfree == 1 ) free(tmp);
sprintf (lvargridname, "%s", tmp1);
if (!strcasecmp (var->v_typevar, "REAL"))
{
if ( !strcasecmp(var->v_nameinttypename,"8") )
sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
else if ( !strcasecmp(var->v_nameinttypename,"4") )
sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "INTEGER"))
{
sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "LOGICAL"))
{
sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "CHARACTER"))
{
WARNING_CharSize(var);
sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
}
}
strcat (lvargridname, lvargridname2);
Save_Length(lvargridname,42);
Save_Length(lvargridname2,42);
return lvargridname;
}
variable * createvar(const char *nom, listdim *d)
{
variable *var;
listdim *dims;
char ligne[LONG_M];
char listdimension[LONG_M];
var = (variable *) calloc(1,sizeof(variable));
Init_Variable(var);
strcpy(listdimension,"");
strcpy(var->v_nomvar,nom);
strcpy(var->v_modulename,curmodulename);
strcpy(var->v_commoninfile,cur_filename);
strcpy(var->v_subroutinename,subroutinename);
if ( strcasecmp(nameinttypename,"") )
{
strcpy(var->v_nameinttypename,nameinttypename);
}
if ( optionaldeclare == 1 ) var->v_optionaldeclare = 1;
if ( pointerdeclare == 1 ) var->v_pointerdeclare = 1;
if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
if ( PublicDeclare == 1 ) var->v_PublicDeclare = 1 ;
if ( PrivateDeclare == 1 ) var->v_PrivateDeclare = 1;
if ( ExternalDeclare == 1 ) var->v_ExternalDeclare = 1;
var->v_dimension = d;
/* Creation of the string for the dimension of this variable */
dimsempty = 1;
if ( d )
{
var->v_dimensiongiven = 1;
dims = d;
while (dims)
{
if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
{
dimsempty = 0;
}
sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
strcat(listdimension,ligne);
if ( dims->suiv )
{
strcat(listdimension,",");
}
dims = dims->suiv;
}
if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
}
strcpy(var->v_readedlistdimension,listdimension);
Save_Length(listdimension,15);
var->v_nbdim = get_num_dims(d);
return var;
}
void Add_Data_Var_1 (listvar **curlist,char *name,char *values)
{
listvar *newvar;
char ligne[LONG_C];
// if ( firstpass == 1 )
// {
newvar=(listvar *)malloc(sizeof(listvar));
newvar->var=(variable *)malloc(sizeof(variable));
/* */
Init_Variable(newvar->var);
/* */
if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
strcpy(newvar->var->v_nomvar,name);
Save_Length(name,4);
strcpy(newvar->var->v_subroutinename,subroutinename);
Save_Length(subroutinename,11);
strcpy(newvar->var->v_modulename,curmodulename);
Save_Length(curmodulename,6);
strcpy(newvar->var->v_commoninfile,mainfile);
Save_Length(mainfile,10);
if (strchr(values,',') && strncasecmp(values,"'",1))
{
sprintf(ligne,"(/%s/)",values);
}
else
strcpy(ligne,values);
strcpy(newvar->var->v_initialvalue,ligne);
Save_Length(ligne,14);
newvar->suiv = NULL;
if ( ! (*curlist) )
{
*curlist = newvar ;
}
else
{
newvar->suiv = *curlist;
*curlist = newvar;
}
// }
}
char *vargridnametabvars (variable * var,int iorindice)
{
char *tmp;
char tmp1[LONG_C];
tmp = variablenametabvars (var,iorindice);
strcpy(tmp1,tmp);
if ( todebugfree == 1 ) free(tmp);
sprintf (lvargridname, "%s", tmp1);
if (!strcasecmp (var->v_typevar, "REAL"))
{
if ( !strcasecmp(var->v_nameinttypename,"8") )
sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
else if ( !strcasecmp(var->v_nameinttypename,"4") )
sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "INTEGER"))
{
sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "LOGICAL"))
{
sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
}
else if (!strcasecmp (var->v_typevar, "CHARACTER"))
{
WARNING_CharSize(var);
sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
}
strcat (lvargridname, lvargridname2);
Save_Length(lvargridname,42);
Save_Length(lvargridname2,42);
return lvargridname;
}
void DecomposeTheName(char *nom)
{
char toprinttmp[LONG_4C];
int i;
char chartmp[2];
i=0;
strcpy(toprinttmp,"");
/* */
while ( i < strlen(nom) )
{
if ( nom[i] == '+' ||
nom[i] == '-' ||
nom[i] == '*' ||
nom[i] == '/' ||
nom[i] == ')' ||
nom[i] == '(' ||
nom[i] == ',' ||
nom[i] == ':'
)
{
if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
{
ajoutevarindoloop_definedimension (toprinttmp);
/* Is this variable present in globvarofusefile */
IsVarInUseFile(toprinttmp);
}
strcpy(toprinttmp,"");
}
else
{
sprintf(chartmp,"%c",nom[i]);
strcat(toprinttmp,chartmp);
}
/* */
i=i+1;
}
Save_Length(toprinttmp,44);
if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
{
ajoutevarindoloop_definedimension (toprinttmp);
/* Is this variable present in globvarofusefile */
IsVarInUseFile(toprinttmp);
}
strcpy(toprinttmp,"");
}
listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout)
{
char toprinttmp[LONG_4C];
int i;
char chartmp[2];
i=0;
strcpy(toprinttmp,"");
/* */
while ( i < strlen(nom) )
{
if ( nom[i] == '+' ||
nom[i] == '-' ||
nom[i] == '*' ||
nom[i] == '/' ||
nom[i] == ')' ||
nom[i] == '(' ||
nom[i] == ',' ||
nom[i] == ':'
)
{
if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
{
listout = Addtolistnom(toprinttmp,listout,0);
}
strcpy(toprinttmp,"");
}
else
{
sprintf(chartmp,"%c",nom[i]);
strcat(toprinttmp,chartmp);
}
/* */
i=i+1;
}
if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
{
listout = Addtolistnom(toprinttmp,listout,0);
}
strcpy(toprinttmp,"");
Save_Length(toprinttmp,44);
return listout;
}
void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne)
{
listvar *parcours;
/* char ligne[LONG_40M];*/
int compteur;
if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n");
parcours = List_UsedInSubroutine_Var;
compteur = 0 ;
while ( parcours )
{
/* if the readed variable is a variable of the subroutine */
/* subrotinename we should write the name of this variable */
/* in the output file */
if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
(parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
)
{
if ( didvariableadded == 1 )
{
strcat(ligne,",");
}
strcat(ligne,parcours->var->v_nomvar);
didvariableadded = 1;
}
parcours = parcours -> suiv;
}
/* if ( compteur != 3 && compteur != 0 )
{
if ( retour77 == 0 ) fprintf(outputfile,"\n %s &",ligne);
else fprintf(outputfile,"\n & %s",ligne);
}*/
Save_Length(ligne,41);
// tofich(outputfile,ligne,0);
/* Now we should replace the last ", &" by " &" */
/* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n");
}
char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
int whichone)
{
char toprinttmp[LONG_4C];
int i;
char chartmp[2];
i=0;
strcpy(toprintglob,"");
strcpy(toprinttmp,"");
/* */
while ( i < strlen(nom) )
{
if ( nom[i] == '+' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,"+");
}
else if ( nom[i] == '-' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,"-");
}
else if ( nom[i] == '*' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,"*");
}
else if ( nom[i] == '/' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,"/");
}
else if ( nom[i] == '(' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,"(");
}
else if ( nom[i] == ')' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,")");
}
else if ( nom[i] == ':' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,":");
}
else if ( nom[i] == ',' )
{
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
strcat(toprintglob,",");
}
else
{
sprintf(chartmp,"%c",nom[i]);
strcat(toprinttmp,chartmp);
}
/* */
i=i+1;
}
FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
strcpy(toprinttmp,"");
Save_Length(toprinttmp,44);
Save_Length(toprintglob,39);
/* */
return toprintglob;
}
void write_allocation_Global_0()
{
listnom *parcours_nom;
listvar *parcours;
listvar *parcoursprec;
listvar *parcours1;
FILE *allocationagrif;
char ligne[LONGNOM];
variable *v;
int IndiceMax;
int IndiceMin;
int compteur;
int out;
int indiceprec;
int ValeurMax;
char initialvalue[LONG_4C];
int typeiswritten ;
parcoursprec = (listvar *)NULL;
parcours_nom = List_NameOfModule;
ValeurMax = 2;
while ( parcours_nom )
{
/* */
if ( parcours_nom->o_val == 1 )
{
IndiceMax = 0;
IndiceMin = indicemaxtabvars;
/* Open the file to create the Alloc_agrif subroutine */
sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
allocationagrif = associate (ligne);
/* */
if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
{
/* add the call to initworkspace */
tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
tofich(allocationagrif,"else ",1);
fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
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 &&
!strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) )
{
/***************************************************************/
/***************************************************************/
/***************************************************************/
v = parcours->var;
IndiceMax = 0;
IndiceMin = indicemaxtabvars;
/* body of the file */
if ( !strcasecmp(v->v_commoninfile,mainfile) )
{
if (onlyfixedgrids != 1 && v->v_nbdim!=0)
{
strcpy (ligne, "If (.not. associated(");
strcat (ligne, vargridnametabvars(v,0));
strcat (ligne, ")) then");
Save_Length(ligne,48);
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;
}
if ( compteur > ValeurMax )
{
fprintf(allocationagrif," DO i = %d , %d\n",
parcours->var->v_indicetabvars,
parcours->var->v_indicetabvars+compteur);
IndiceMin = parcours->var->v_indicetabvars;
IndiceMax = parcours->var->v_indicetabvars+compteur;
strcpy (ligne, "allocate ");
strcat (ligne, "(");
strcat (ligne, vargridnametabvars(v,1));
strcat (ligne, vargridparam(v,0));
strcat (ligne, ")");
Save_Length(ligne,48);
tofich (allocationagrif, ligne,1);
fprintf(allocationagrif," end do\n");
parcours = parcoursprec;
}
else
{
strcpy (ligne, "allocate ");
strcat (ligne, "(");
strcat (ligne, vargridnametabvars(v,0));
strcat (ligne, vargridparam(v,0));
strcat (ligne, ")");
Save_Length(ligne,48);
tofich (allocationagrif, ligne,1);
}
}
} /* end of the allocation part */
/* INITIALISATION */
if ( strcasecmp(v->v_initialvalue,"") )
{
strcpy (ligne, "");
strcat (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,0));
if ( !strcasecmp(initialvalue,v->v_initialvalue) )
{
strcpy(initialvalue,"");
strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
(v->v_initialvalue,List_Common_Var,0));
}
if ( !strcasecmp(initialvalue,v->v_initialvalue) )
{
strcpy(initialvalue,"");
strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
(v->v_initialvalue,List_ModuleUsed_Var,0));
}
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);
strcpy(ligne,"End If");
tofich(allocationagrif, ligne, 1);
typeiswritten = 1;
}
if (onlyfixedgrids != 1 && v->v_nbdim!=0)
{
strcpy (ligne, " End if");
tofich (allocationagrif, ligne,1);
}
}
/***************************************************************/
/***************************************************************/
/***************************************************************/
}
parcours = parcours -> suiv;
}
/* */
if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
{
/* add the call to initworkspace */
tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
tofich(allocationagrif,"else ",1);
fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
tofich(allocationagrif,"endif ",1);
tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
}
/* Close the file Alloc_agrif */
fclose(allocationagrif);
} /* end parcours_nom == 1 */
/* */
parcours_nom = parcours_nom -> suiv;
}
}
void write_allocation_Common_0()
{
listnom *parcours_nom;
listnom *neededparameter;
listvar *parcours;
listvar *parcoursprec;
listvar *parcours1;
FILE *allocationagrif;
FILE *paramtoamr;
char ligne[LONGNOM];
char ligne2[LONGNOM];
variable *v;
int IndiceMax;
int IndiceMin;
int compteur;
int out;
int indiceprec;
int ValeurMax;
char initialvalue[LONG_4C];
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 = associate (ligne);
/* */
fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n",
parcours_nom->o_nom);
/* */
sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
paramtoamr = associate (ligne);
neededparameter = (listnom * )NULL;
/* */
list_indic = (listindice *)NULL;
/* */
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) == 0
)
{
/***************************************************************/
/***************************************************************/
/***************************************************************/
v = parcours->var;
IndiceMax = 0;
IndiceMin = indicemaxtabvars;
/* body of the file */
if ( !strcasecmp(v->v_commoninfile,mainfile) )
{
if (onlyfixedgrids != 1 && v->v_nbdim!=0)
{
strcpy (ligne, "If (.not. associated(");
strcat (ligne, vargridnametabvars(v,0));
strcat (ligne, ")) then");
Save_Length(ligne,48);
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;
}
if ( compteur > ValeurMax )
{
fprintf(allocationagrif," DO i = %d , %d\n",
parcours->var->v_indicetabvars,
parcours->var->v_indicetabvars+compteur);
IndiceMin = parcours->var->v_indicetabvars;
IndiceMax = parcours->var->v_indicetabvars+compteur;
strcpy (ligne, "allocate ");
strcat (ligne, "(");
strcat (ligne, vargridnametabvars(v,1));
strcat (ligne, vargridparam(v,0));
strcat (ligne, ")");
Save_Length(ligne,48);
tofich (allocationagrif, ligne,1);
fprintf(allocationagrif," end do\n");
i=parcours->var->v_indicetabvars;
do
{
parcoursindic = (listindice *)malloc(sizeof(listindice));
parcoursindic -> i_indice = i;
parcoursindic -> suiv = list_indic;
list_indic = parcoursindic;
i = i + 1;
} while ( i <= parcours->var->v_indicetabvars+compteur );
parcours = parcoursprec;
/* */
}
else
{
strcpy (ligne, "allocate ");
strcat (ligne, "(");
strcat (ligne, vargridnametabvars(v,0));
strcat (ligne, vargridparam(v,0));
strcat (ligne, ")");
Save_Length(ligne,48);
tofich (allocationagrif, ligne,1);
/* */
parcoursindic = (listindice *)malloc(sizeof(listindice));
parcoursindic -> i_indice = parcours->var->v_indicetabvars;
parcoursindic -> suiv = list_indic;
list_indic = 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, "");
strcat (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,0));
if ( !strcasecmp(initialvalue,v->v_initialvalue) )
{
strcpy(initialvalue,"");
strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
(v->v_initialvalue,List_Common_Var,0));
}
if ( !strcasecmp(initialvalue,v->v_initialvalue) )
{
strcpy(initialvalue,"");
strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
(v->v_initialvalue,List_ModuleUsed_Var,0));
}
strcat (ligne," = ");
if (v->v_nbdim == 0)
{
strcpy(ligne2,initialvalue);
}
else
{
sprintf(ligne2,"RESHAPE(%s,SHAPE(%s))",initialvalue,vargridnametabvars(v,0));
}
strcat (ligne,ligne2);
/* */
Save_Length(ligne,48);
tofich (allocationagrif, ligne,1);
}
}
if (onlyfixedgrids != 1 && v->v_nbdim!=0)
{
strcpy (ligne, " End if");
tofich (allocationagrif, ligne,1);
}
}
/***************************************************************/
/***************************************************************/
/***************************************************************/
}
parcours = parcours -> suiv;
}
/* Close the file Alloc_agrif */
fclose(allocationagrif);
fclose(paramtoamr);
}
/* */
parcours_nom = parcours_nom -> suiv;
}
}
