/******************************************************************************/ /* */ /* 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 #include #include #include "decl.h" int line_num=1; extern FILE * convert_in; int convert_error(const char *s) { printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file); exit(0); } %} %union { char na[LONG_M]; } %token TOK_SEP %token TOK_KIND %token TOK_EQUAL %token TOK_USE %token TOK_MODULEMAIN /* name of the module */ %token TOK_NOTGRIDDEP /* Variable which are not grid dependent */ %token TOK_USEITEM %token TOK_NAME %token TOK_CSTINT %token TOK_PROBTYPE /* dimension of the problem */ %token ',' %token ';' %% input : | input line ; line : '\n' | TOK_PROBTYPE TOK_NAME ';' { initdimprob(1,$2,"0","0"); } | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';' { initdimprob(2,$2, $4,"0"); } | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';' { initdimprob(3,$2, $4, $6); } | TOK_MODULEMAIN TOK_NAME ';' { listofmodules = Addtolistnom($2,listofmodules,0); Addmoduletothelist($2); } | TOK_KIND TOK_NAME TOK_EQUAL TOK_CSTINT ';' { if (!strcasecmp($4,"4")) { listofkind = Addtolistnom($2,listofkind,4); } else if (!strcasecmp($4,"8")) { listofkind = Addtolistnom($2,listofkind,8); } else { printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",$4); exit(0); } } | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';' { Add_NotGridDepend_Var_1($3); } | TOK_USE TOK_USEITEM ';' { if (!strcasecmp($2,"FIXED_GRIDS")) fixedgrids = 1; if (!strcasecmp($2,"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1; } ; %% void print_usage() { printf("usage : conv -convfile \n"); printf(" [-workdir ] [-incdir ]\n"); printf(" [-comdirin ] [-comdirout ]\n"); printf(" [-convfile ] [-SubloopScalar] [-SubloopScalar1] \n"); printf(" [-free|-fixed]\n"); exit(0); } int main(int argc,char *argv[]) { extern FILE * convert_in ; FILE *dependglobaloutput; int i; listnom *parcours; listvar *newvar; int stylegiven = 0; int infreegiven ; int infixedgiven ; int lengthmainfile; char filetoparse[LONG_FNAME]; /******************************************************************************/ /* 1- Variables initialization */ /******************************************************************************/ List_Global_Var = (listvar *) NULL; List_GlobalParameter_Var = (listvar *) NULL; List_Common_Var = (listvar *) NULL; List_Allocate_Var = (listallocate *) NULL; List_SubroutineWhereAgrifUsed = (listnom *) NULL; List_Subroutine_For_Alloc = (listnom *) NULL; List_Include = (listusemodule *) NULL; List_NameOfModuleUsed = (listusemodule *) NULL; listofmoduletmp = (listusemodule *) NULL; List_SubroutineDeclaration_Var = (listvar *) NULL; List_UsedInSubroutine_Var = (listvar *) NULL; List_NotGridDepend_Var = (listvar *) NULL; Listofavailableindices = (listindice *) NULL; Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); List_CouplePointed_Var = (listvarpointtovar *) NULL; List_ModuleUsed_Var = (listvar *) NULL; List_ModuleUsedInModuleUsed_Var = (listvar *) NULL; List_GlobParamModuleUsed_Var = (listparameter *) NULL; List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL; List_SubroutineArgument_Var = (listvar *) NULL; List_FunctionType_Var = (listvar *) NULL; tmpuselocallist = (listusemodule *) NULL; List_ContainsSubroutine = (listnom *) NULL; oldfortran_out = (FILE *) NULL; if (argc < 2) print_usage(); strcpy(config_file, argv[1]); strcpy(work_dir, "."); strcpy(input_dir, "."); strcpy(output_dir, "AGRIF_MODELFILES"); strcpy(include_dir, "AGRIF_INC"); strcpy(filetoparse, ""); strcpy(subofagrifinitgrids, ""); strcpy(meetagrifinitgrids, ""); strcpy(mpiinitvar, ""); length_last = 0 ; length_first = 0 ; length_v_vallengspec = 0 ; length_v_commoninfile = 0 ; length_v_precision = 0 ; length_v_IntentSpec = 0 ; length_v_initialvalue = 0 ; length_v_readedlistdimension = 0 ; length_a_nomvar = 0 ; length_toprintglob = 0 ; length_tmpvargridname = 0 ; length_ligne_Subloop = 0 ; length_toprint_utilagrif = 0 ; length_toprinttmp_utilchar = 0 ; length_ligne_writedecl = 0 ; length_newname_toamr = 0 ; length_newname_writedecl = 0 ; length_ligne_toamr = 0 ; length_tmpligne_writedecl = 0 ; value_char_size = 0 ; value_char_size1 = 0 ; value_char_size2 = 0 ; value_char_size3 = 0 ; inallocate = 0; infixed = 1; infree = 0; onlyfixedgrids=0; fixedgrids=0; InAgrifParentDef = 0; IndicenbmaillesX=0; IndicenbmaillesY=0; IndicenbmaillesZ=0; created_dimensionlist = 1; /* current indice in the table tabvars */ for ( i=0 ; i.in */ /******************************************************************************/ if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0; convert_parse(); /******************************************************************************/ /* 4- Preparation of the file parsing */ /******************************************************************************/ sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir); /* */ if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL ) { for (i=0;ivar->v_nomvar, newvar->var->v_nbdim, newvar->var->v_subroutinename, newvar->var->v_modulename, newvar->var->v_typevar); newvar = newvar->suiv; } /******************************************************************************/ /* 6- Write informations in output files */ /******************************************************************************/ /* Write the .dependglobal_agrif file which contain the max indice */ /* of the tabvars table */ sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir); dependglobaloutput = fopen(dependfilename, "w"); for (i=0;i file which contain general informations */ /* about variable of this file */ parcours = List_NameOfModule; while( parcours ) { Writethedependlistofmoduleused(parcours->o_nom); WritedependParameterList(parcours->o_nom); Writethedependfile(parcours->o_nom,List_Global_Var); parcours=parcours->suiv; } parcours = List_NameOfCommon; while( parcours ) { Writethedependfile(parcours->o_nom,List_Common_Var); parcours=parcours->suiv; } Write_Subroutine_For_Alloc(); /******************************************************************************/ /* 7- Create files in AGRIF_INC directory */ /******************************************************************************/ creefichieramr(); Write_val_max(); if ( todebug == 1 ) printf("Out of CONV \n"); return 0; }