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.
Changeset 8139 for branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c – NEMO

Ignore:
Timestamp:
2017-06-05T12:05:17+02:00 (7 years ago)
Author:
timgraham
Message:

Updates to conv library as received from Laurent - required for vertical refinement

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c

    r5656 r8139  
    4747        "tabvars_i"     // v_catvar == 4 
    4848    }; 
     49 
    4950    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4]. 
    5051} 
    … …  
    137138    static char tname_1[LONG_C]; 
    138139    static char tname_2[LONG_C]; 
    139  
     140     
    140141    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars); 
    141142    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var)); 
    142143 
    143     if (!strcasecmp(var->v_typevar, "REAL")) 
     144    if (!strcasecmp(var->v_typevar, "real")) 
    144145    { 
    145146        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 
    146147        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 
    147         else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim); 
     148        else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 
     149        else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);         
     150        else   
     151          { 
     152          sprintf(tname_2, "%% array%d",  var->v_nbdim); 
     153          } 
    148154    } 
    149155    else if (!strcasecmp(var->v_typevar, "integer")) 
    … …  
    195201        if (!strcasecmp(var->v_typevar, "REAL")) 
    196202        { 
    197             if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 
    198             else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 
    199             else                                                sprintf(tname_2, "%% array%d", var->v_nbdim); 
     203            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); 
     204            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); 
     205            else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); 
     206            else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); 
     207            else sprintf(tname_2, "array%d", var->v_nbdim); 
    200208        } 
    201209        else if (!strcasecmp(var->v_typevar, "INTEGER")) 
    202210        { 
    203             sprintf(tname_2, "%% iarray%d", var->v_nbdim); 
     211            sprintf(tname_2, "iarray%d", var->v_nbdim); 
    204212        } 
    205213        else if (!strcasecmp(var->v_typevar, "LOGICAL")) 
    206214        { 
    207             sprintf(tname_2, "%% larray%d", var->v_nbdim); 
     215            sprintf(tname_2, "larray%d", var->v_nbdim); 
    208216        } 
    209217        else if (!strcasecmp(var->v_typevar, "CHARACTER")) 
    210218        { 
    211219            WARNING_CharSize(var); 
    212             sprintf(tname_2, "%% carray%d", var->v_nbdim); 
    213         } 
    214         strcat(tname_1, tname_2); 
     220            sprintf(tname_2, "carray%d", var->v_nbdim); 
     221        } 
     222        if (var->v_pointerdeclare) 
     223        { 
     224                strcat(tname_1,"%p"); 
     225                strcat(tname_1, tname_2); 
     226        } 
     227        else 
     228        { 
     229                strcat(tname_1,"%"); 
     230                strcat(tname_1, tname_2); 
     231        } 
    215232    } 
    216233    Save_Length(tname_1, 46); 
    … …  
    232249 
    233250    sprintf(tname_1, "(%d)", var->v_indicetabvars); 
    234  
    235     if (!strcasecmp (var->v_typevar, "REAL")) 
    236     { 
    237         if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); 
    238         else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); 
    239         else                                                sprintf(tname_2, "%% array%d", var->v_nbdim); 
    240     } 
    241     else if (!strcasecmp(var->v_typevar, "INTEGER")) 
    242     { 
    243         sprintf(tname_2, "%% iarray%d", var->v_nbdim); 
    244     } 
    245     else if (!strcasecmp(var->v_typevar, "LOGICAL")) 
    246     { 
    247         sprintf(tname_2, "%% larray%d", var->v_nbdim); 
    248     } 
    249     else if (!strcasecmp(var->v_typevar, "CHARACTER")) 
    250     { 
    251         WARNING_CharSize(var); 
    252         sprintf(tname_2, "%% carray%d", var->v_nbdim); 
    253     } 
    254  
    255     strcat(tname_1, tname_2); 
     251     
     252        if (!strcasecmp(var->v_typevar, "REAL")) 
     253        { 
     254            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); 
     255            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); 
     256            else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); 
     257            else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); 
     258            else sprintf(tname_2, "array%d", var->v_nbdim); 
     259        } 
     260        else if (!strcasecmp(var->v_typevar, "INTEGER")) 
     261        { 
     262            sprintf(tname_2, "iarray%d", var->v_nbdim); 
     263        } 
     264        else if (!strcasecmp(var->v_typevar, "LOGICAL")) 
     265        { 
     266            sprintf(tname_2, "larray%d", var->v_nbdim); 
     267        } 
     268        else if (!strcasecmp(var->v_typevar, "CHARACTER")) 
     269        { 
     270            WARNING_CharSize(var); 
     271            sprintf(tname_2, "carray%d", var->v_nbdim); 
     272        } 
     273        if (var->v_pointerdeclare) 
     274        { 
     275                strcat(tname_1,"%p"); 
     276                strcat(tname_1, tname_2); 
     277        } 
     278        else 
     279        { 
     280                strcat(tname_1,"%"); 
     281                strcat(tname_1, tname_2); 
     282        } 
     283 
    256284    Save_Length(tname_1, 46); 
    257285 
    … …  
    535563    listvar *parcoursprec; 
    536564    listvar *parcours1; 
     565    listname *parcours_name; 
     566    listname *parcours_name_array; 
     567    listdoloop *parcours_loop; 
    537568    FILE *allocationagrif; 
    538569    FILE *paramtoamr; 
    539570    char ligne[LONG_M]; 
    540571    char ligne2[LONG_M]; 
     572    char ligne3[LONG_M]; 
    541573    variable *v; 
    542574    int IndiceMax; 
    … …  
    550582    listindice *parcoursindic; 
    551583    int i; 
     584    int nb_initial; 
     585    int is_parameter_local; 
     586    int global_check; 
    552587 
    553588    parcoursprec = (listvar *) NULL; 
    … …  
    561596            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); 
    562597            allocationagrif = open_for_write(ligne); 
     598 
    563599            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom); 
    564  
    565600            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom); 
    566601            paramtoamr = open_for_write(ligne); 
    … …  
    568603            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); 
    569604 
    570 //             shouldincludempif = 1 ; 
     605             shouldincludempif = 1 ; 
    571606            parcours = List_Common_Var; 
    572607            while ( parcours ) 
    … …  
    621656                                        IndiceMin = parcours->var->v_indicetabvars; 
    622657                                        IndiceMax = parcours->var->v_indicetabvars+compteur; 
    623                                         sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1)); 
     658                                        sprintf(ligne,"    if (.not. allocated(%s)) allocate(%s", vargridnametabvars(v,1), vargridnametabvars(v,1)); 
    624659                                        sprintf(ligne2,"%s)", vargridparam(v)); 
    625660                                        strcat(ligne,ligne2); 
    … …  
    639674                                    else 
    640675                                    { 
    641                                         sprintf(ligne,"allocate(%s", vargridnametabvars(v,0)); 
     676                                        sprintf(ligne,"if (.not. allocated(%s)) allocate(%s", vargridnametabvars(v,0), vargridnametabvars(v,0)); 
    642677                                        sprintf(ligne2,"%s)", vargridparam(v)); 
    643678                                        strcat(ligne,ligne2); 
    … …  
    648683                                        list_indic[parcours->var->v_catvar] = parcoursindic; 
    649684                                    } 
    650                                     neededparameter = writedeclarationintoamr(List_Parameter_Var, 
    651                                                         paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname); 
     685 
     686                                    global_check = 0; 
     687                                    is_parameter_local = writedeclarationintoamr(List_Parameter_Var, 
     688                                                        paramtoamr,v,parcours_nom->o_nom,&neededparameter,v->v_commonname,global_check); 
     689                                    if (is_parameter_local == 0) 
     690                                    { 
     691                                    global_check = 1; 
     692                                    is_parameter_local = writedeclarationintoamr(List_GlobalParameter_Var, 
     693                                                        paramtoamr,v,parcours_nom->o_nom,&neededparameter,v->v_commonname,global_check); 
     694                                    } 
    652695                                } 
    653696                            } /* end of the allocation part                                       */ 
    654697                            /*                INITIALISATION                                      */ 
    655                             if ( strcasecmp(v->v_initialvalue,"") ) 
     698                            if ( v->v_initialvalue ) 
     699                            { 
     700                            parcours_name = v->v_initialvalue; 
     701                            parcours_name_array = v->v_initialvalue_array; 
     702                            if (parcours_name_array) 
     703                            { 
     704                            while (parcours_name) 
    656705                            { 
    657706                                strcpy(ligne, vargridnametabvars(v,0)); 
     707                                if (parcours_name_array) 
     708                                { 
     709                                if (strcasecmp(parcours_name_array->n_name,"") ) 
     710                                { 
     711                                sprintf(ligne2,"(%s)",parcours_name_array->n_name); 
     712                                strcat(ligne,ligne2); 
     713                                } 
     714                                } 
    658715                                /* We should modify the initialvalue in the case of variable has been defined with others variables */ 
    659                                 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var)); 
    660                                 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 
    661                                 { 
    662                                     strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var)); 
    663                                 } 
    664                                 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 
    665                                 { 
    666                                     strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var)); 
     716                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); 
     717                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     718                                { 
     719                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); 
     720                                } 
     721                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     722                                { 
     723                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); 
    667724                                } 
    668725                                strcat (ligne," = "); 
    669726 
    670                                 if (v->v_nbdim == 0) 
     727                                if (v->v_nbdim >= 0) 
    671728                                { 
    672729                                    strcpy(ligne2,initialvalue); 
    … …  
    678735                                strcat(ligne,ligne2); 
    679736                                tofich(allocationagrif,ligne,1); 
     737                              
     738                             parcours_name = parcours_name->suiv; 
     739                             if (parcours_name_array) parcours_name_array = parcours_name_array->suiv; 
     740                            } 
     741                            } 
     742                            else 
     743                            { 
     744                            strcpy(ligne, vargridnametabvars(v,0)); 
     745                            strcat (ligne," = "); 
     746                            strcpy(ligne2,""); 
     747                            nb_initial = 0; 
     748                             
     749                            while (parcours_name) 
     750                            { 
     751                            nb_initial = nb_initial + 1; 
     752                                /* We should modify the initialvalue in the case of variable has been defined with others variables */ 
     753                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); 
     754                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     755                                { 
     756                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); 
     757                                } 
     758                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     759                                { 
     760                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); 
     761                                } 
     762 
     763                                strcat(ligne2,initialvalue); 
     764                             if (parcours_name->suiv) 
     765                             { 
     766                             strcat(ligne2,","); 
     767                             } 
     768                              
     769                             parcours_name = parcours_name->suiv; 
     770                            } 
     771                            if (nb_initial > 1) 
     772                            { 
     773                            sprintf(ligne3,"reshape((/%s/),shape(%s))",ligne2,vargridnametabvars(v,0)); 
     774                            } 
     775                            else 
     776                            { 
     777                            strcpy(ligne3,ligne2); 
     778                            } 
     779                            strcat(ligne,ligne3); 
     780                            tofich(allocationagrif,ligne,1); 
     781                            } 
    680782                            } 
    681783                        } 
    … …  
    705807    char ligne[LONG_M]; 
    706808    char ligne2[LONG_M]; 
     809    char ligne3[LONG_M]; 
     810    listname *parcours_name; 
     811    listname *parcours_name_array; 
    707812    variable *v; 
    708813    int IndiceMax; 
    … …  
    714819    char initialvalue[LONG_M]; 
    715820    int typeiswritten ; 
     821    int nb_initial; 
    716822 
    717823    parcoursprec = (listvar *) NULL; 
    … …  
    794900                                        IndiceMin = parcours->var->v_indicetabvars; 
    795901                                        IndiceMax = parcours->var->v_indicetabvars+compteur; 
    796                                         sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1)); 
     902                                        sprintf(ligne,"    if (.not. allocated(%s)) allocate(%s", vargridnametabvars(v,1), vargridnametabvars(v,1)); 
    797903                                        sprintf(ligne2,"%s)", vargridparam(v)); 
    798904                                        strcat(ligne,ligne2); 
    … …  
    803909                                    else 
    804910                                    { 
    805                                         sprintf(ligne,"allocate(%s", vargridnametabvars(v,0)); 
     911                                        sprintf(ligne,"if (.not. allocated(%s)) allocate(%s", vargridnametabvars(v,0), vargridnametabvars(v,0)); 
    806912                                        sprintf(ligne2,"%s)", vargridparam(v)); 
    807913                                        strcat(ligne,ligne2); 
    … …  
    811917                            } /* end of the allocation part                                       */ 
    812918                            /*                INITIALISATION                                      */ 
    813                             if ( strcasecmp(v->v_initialvalue,"") ) 
     919 
     920               if ( v->v_initialvalue ) 
     921                            { 
     922                            parcours_name = v->v_initialvalue; 
     923                            parcours_name_array = v->v_initialvalue_array; 
     924                            if (parcours_name_array) 
     925                            { 
     926                            while (parcours_name) 
    814927                            { 
    815928                                strcpy(ligne, vargridnametabvars(v,0)); 
     929                                if (parcours_name_array) 
     930                                { 
     931                                if (strcasecmp(parcours_name_array->n_name,"") ) 
     932                                { 
     933                                sprintf(ligne2,"(%s)",parcours_name_array->n_name); 
     934                                strcat(ligne,ligne2); 
     935                                } 
     936                                } 
    816937                                /* We should modify the initialvalue in the case of variable has been defined with others variables */ 
    817                                 strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var)); 
    818                                 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 
    819                                 { 
    820                                     strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var)); 
    821                                 } 
    822                                 if ( !strcasecmp(initialvalue,v->v_initialvalue) ) 
    823                                 { 
    824                                     strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var)); 
     938                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); 
     939                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     940                                { 
     941                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); 
     942                                } 
     943                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     944                                { 
     945                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); 
    825946                                } 
    826947                                strcat (ligne," = "); 
    827                                 strcat (ligne,initialvalue); 
    828                                 Save_Length(ligne,48); 
     948 
     949                                if (v->v_nbdim >= 0) 
     950                                { 
     951                                    strcpy(ligne2,initialvalue); 
     952                                } 
     953                                else 
     954                                { 
     955                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0)); 
     956                                } 
     957                                strcat(ligne,ligne2); 
    829958                                tofich(allocationagrif,ligne,1); 
     959                              
     960                             parcours_name = parcours_name->suiv; 
     961                             if (parcours_name_array) parcours_name_array = parcours_name_array->suiv; 
     962                            } 
     963                            } 
     964                            else 
     965                            { 
     966                            strcpy(ligne, vargridnametabvars(v,0)); 
     967                            strcat (ligne," = "); 
     968                            strcpy(ligne2,""); 
     969                            nb_initial = 0; 
     970                             
     971                            while (parcours_name) 
     972                            { 
     973                            nb_initial = nb_initial + 1; 
     974                                /* We should modify the initialvalue in the case of variable has been defined with others variables */ 
     975                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); 
     976                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     977                                { 
     978                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); 
     979                                } 
     980                                if ( !strcasecmp(initialvalue,parcours_name->n_name) ) 
     981                                { 
     982                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); 
     983                                } 
     984 
     985                                strcat(ligne2,initialvalue); 
     986                             if (parcours_name->suiv) 
     987                             { 
     988                             strcat(ligne2,","); 
     989                             } 
     990                              
     991                             parcours_name = parcours_name->suiv; 
     992                            } 
     993                            if (nb_initial > 1) 
     994                            { 
     995                            sprintf(ligne3,"reshape((/%s/),shape(%s))",ligne2,vargridnametabvars(v,0)); 
     996                            } 
     997                            else 
     998                            { 
     999                            strcpy(ligne3,ligne2); 
     1000                            } 
     1001                            strcat(ligne,ligne3); 
     1002                            tofich(allocationagrif,ligne,1); 
     1003                            } 
    8301004                            } 
    8311005                        } 
Note: See TracChangeset for help on using the changeset viewer.