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 530 for trunk/AGRIF/LIB/toamr.c – NEMO

Ignore:
Timestamp:
2006-10-17T17:36:11+02:00 (18 years ago)
Author:
opalod
Message:

RB: update of the conv for IOM and NEC MPI library

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/LIB/toamr.c

    r396 r530  
    33/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */ 
    44/*                                                                            */ 
    5 /*     Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)             */ 
     5/* Copyright or © or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */ 
    66/*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */ 
    7 /*                                                                            */ 
    8 /*     This program is free software; you can redistribute it and/or modify   */ 
    9 /*    it                                                                      */ 
    10 /*                                                                            */ 
    11 /*    This program is distributed in the hope that it will be useful,         */ 
    12 /*     but WITHOUT ANY WARRANTY; without even the implied warranty of         */ 
    13 /*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          */ 
    14 /*    GNU General Public License for more details.                            */ 
    15 /*                                                                            */ 
     7/* This software is governed by the CeCILL-C license under French law and     */ 
     8/* abiding by the rules of distribution of free software.  You can  use,      */ 
     9/* modify and/ or redistribute the software under the terms of the CeCILL-C   */ 
     10/* license as circulated by CEA, CNRS and INRIA at the following URL          */ 
     11/* "http://www.cecill.info".                                                  */ 
     12/*                                                                            */ 
     13/* As a counterpart to the access to the source code and  rights to copy,     */ 
     14/* modify and redistribute granted by the license, users are provided only    */ 
     15/* with a limited warranty  and the software's author,  the holder of the     */ 
     16/* economic rights,  and the successive licensors  have only  limited         */ 
     17/* liability.                                                                 */ 
     18/*                                                                            */ 
     19/* In this respect, the user's attention is drawn to the risks associated     */ 
     20/* with loading,  using,  modifying and/or developing or reproducing the      */ 
     21/* software by the user in light of its specific status of free software,     */ 
     22/* that may mean  that it is complicated to manipulate,  and  that  also      */ 
     23/* therefore means  that it is reserved for developers  and  experienced      */ 
     24/* professionals having in-depth computer knowledge. Users are therefore      */ 
     25/* encouraged to load and test the software's suitability as regards their    */ 
     26/* requirements in conditions enabling the security of their systems and/or   */ 
     27/* data to be ensured and,  more generally, to use and operate it in the      */ 
     28/* same conditions as regards security.                                       */ 
     29/*                                                                            */ 
     30/* The fact that you are presently reading this means that you have had       */ 
     31/* knowledge of the CeCILL-C license and that you accept its terms.           */ 
     32/******************************************************************************/ 
     33/* version 1.0                                                                */ 
    1634/******************************************************************************/ 
    1735#include <stdlib.h> 
    … …  
    3755 
    3856  ligne = (char *) malloc (LONGLIGNE * sizeof (char)); 
    39   sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var", var->indicetabvars); 
     57  sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var ", var->indicetabvars); 
    4058  return ligne; 
    4159} 
    … …  
    84102                               var->indicetabvars); 
    85103  else if ( ParentOrCurgrid == 2 ) sprintf (ligne,  
    86                               " Agrif_Gr %% tabvars(%d) %% var", 
     104                              " Agrif_Mygrid %% tabvars(%d) %% var", 
     105                               var->indicetabvars); 
     106  else if ( ParentOrCurgrid == 3 ) sprintf (ligne,  
     107                              " Agrif_Curgrid %% tabvars(%d) %% var", 
    87108                               var->indicetabvars); 
    88109  else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var", 
    … …  
    163184  if (!strcasecmp (var->typevar, "REAL")) 
    164185    { 
    165       sprintf (lvargridname2, "%%array%d", var->nbdim); 
     186      sprintf (lvargridname2, "%% array%d", var->nbdim); 
    166187    } 
    167188  else if (!strcasecmp (var->typevar, "REAL*8")) 
    168189    { 
    169       sprintf (lvargridname2, "%%darray%d", var->nbdim); 
     190      sprintf (lvargridname2, "%% darray%d", var->nbdim); 
    170191    } 
    171192  else if (!strcasecmp (var->typevar, "INTEGER")) 
    172193    { 
    173       sprintf (lvargridname2, "%%iarray%d", var->nbdim); 
     194      sprintf (lvargridname2, "%% iarray%d", var->nbdim); 
    174195    } 
    175196  else if (!strcasecmp (var->typevar, "LOGICAL")) 
    176197    { 
    177       sprintf (lvargridname2, "%%larray%d", var->nbdim); 
     198      sprintf (lvargridname2, "%% larray%d", var->nbdim); 
    178199    } 
    179200  else if (!strcasecmp (var->typevar, "CHARACTER")) 
    180201    { 
    181       sprintf (lvargridname2, "%%carray%d", var->nbdim); 
     202      sprintf (lvargridname2, "%% carray%d", var->nbdim); 
    182203    } 
    183204 
    … …  
    267288 
    268289/******************************************************************************/ 
    269 /*                            write_includeagrif_file                         */ 
    270 /******************************************************************************/ 
    271 /* This subroutine is used to create the file include_agrif.h                 */ 
    272 /******************************************************************************/ 
    273 /*                                                                            */ 
    274 /*               include_agrif.h                                              */ 
    275 /*                                                                            */ 
    276 /*               USE <name of module>                                         */ 
    277 /*               ...                                                          */ 
    278 /******************************************************************************/ 
    279 void write_includeagrif_file() 
    280 { 
    281   FILE *inclproc; 
    282   char ligne[LONGLIGNE*100]; 
    283   listnom *newnom; 
    284  
    285   inclproc = associate ("include_agrif.h"); 
    286  
    287   if (strcasecmp(commonfile_main,"") ) 
    288   { 
    289     strcpy (ligne, "include '"); 
    290     strcat (ligne, commonfile_main); 
    291     strcat (ligne, "'"); 
    292   } 
    293   else 
    294   { 
    295     if ( listofmodules )  
    296     { 
    297        newnom = listofmodules; 
    298        while(newnom) 
    299        { 
    300           strcpy (ligne, "USE "); 
    301           strcat (ligne, newnom->nom); 
    302           newnom=newnom->suiv; 
    303           tofich (inclproc, ligne,1); 
    304        } 
    305     } 
    306   } 
    307   fclose (inclproc); 
    308 } 
    309  
    310 /******************************************************************************/ 
    311290/*                             write_keysagrif_file                           */ 
    312291/******************************************************************************/ 
    … …  
    335314 
    336315/******************************************************************************/ 
    337 /*                       write_clusteringagrif_file                           */ 
    338 /******************************************************************************/ 
    339 /* This subroutine is used to create the file  clustering_agrif.h             */ 
    340 /******************************************************************************/ 
    341 /*                                                                            */ 
    342 /*               clustering_agrif                                             */ 
    343 /*                                                                            */ 
    344 /*               Agrif_regridding =                                           */ 
    345 /*               Agrif_Minwidth   =                                           */ 
    346 /*               Agrif_Efficiency =                                           */ 
    347 /*               Agrif_mind(1)    =                                           */ 
    348 /*               Agrif_mind(2)    =                                           */ 
    349 /*               Agrif_mind(3)    =                                           */ 
    350 /*                                                                            */ 
    351 /******************************************************************************/ 
    352 void write_clusteringagrif_file() 
    353 { 
    354   FILE *clustering; 
    355   char ligne[LONGLIGNE*100]; 
    356   int i; 
    357   float res; 
    358  
    359   clustering = associate ("clustering_agrif.h"); 
    360  
    361   sprintf(ligne,"Agrif_Regridding = %d",regridding); 
    362   tofich(clustering,ligne,1); 
    363   sprintf(ligne,"Agrif_Minwidth = %d",minwidth); 
    364   tofich(clustering,ligne,1); 
    365   sprintf(ligne,"Agrif_Efficiency = %e",(float) (efficiency)/100.); 
    366   tofich(clustering,ligne,1); 
    367   res=1.; 
    368   for (i=1;i<rafmaxx;i++) 
    369     res=res*(float)coeffrafx; 
    370     if (res == 0.) res=1.; 
    371   sprintf(ligne,"Agrif_mind(1) = %e",1./res); 
    372   tofich(clustering,ligne,1); 
    373    
    374   res=1.; 
    375   for (i=1;i<rafmaxy;i++) 
    376     res=res*(float)coeffrafy;  
    377     if (res == 0.) res=1.;      
    378   sprintf(ligne,"Agrif_mind(2) = %e",1./res); 
    379   tofich(clustering,ligne,1); 
    380  
    381   res=1.; 
    382   for (i=1;i<rafmaxz;i++)   
    383     res=res*(float)coeffrafz;  
    384     if (res == 0.) res=1.;     
    385   sprintf(ligne,"Agrif_mind(3) = %e",1./res); 
    386   tofich(clustering,ligne,1); 
    387  
    388   fclose(clustering); 
    389 } 
    390  
    391 /******************************************************************************/ 
    392316/*                      write_modtypeagrif_file                               */ 
    393317/******************************************************************************/ 
    … …  
    397321/*               modtype_agrif.h                                              */ 
    398322/*                                                                            */ 
    399 /*               Agrif_coeffref(i)  =                                         */ 
    400 /*               Agrif_coeffreft(i) =                                         */ 
    401323/*               Agrif_NbVariables =                                          */ 
    402324/*                                                                            */ 
    … …  
    408330 
    409331  typedata = associate ("modtype_agrif.h"); 
    410   /* AGRIF_coeffrefx : space refinement factor in the x-direction             */ 
    411   if (coeffrafx == 0) coeffrafx = 1; 
    412   sprintf (ligne, "AGRIF_coeffref(1) = %d", coeffrafx); 
    413   tofich (typedata, ligne,1); 
    414   /* AGRIF_coeffrefy : space refinement factor in the y-direction             */ 
    415   if (coeffrafy == 0) coeffrafy = 1; 
    416   sprintf (ligne, "AGRIF_coeffref(2) = %d", coeffrafy); 
    417   tofich (typedata, ligne,1); 
    418   /* AGRIF_coeffrefz : space refinement factor in the z-direction             */ 
    419   if (coeffrafz == 0) coeffrafz = 1; 
    420   sprintf (ligne, "AGRIF_coeffref(3) = %d", coeffrafz); 
    421   tofich (typedata, ligne,1); 
    422   /* AGRIF_coeffreftx : time refinement factor in the x-direction             */ 
    423   sprintf (ligne, "AGRIF_coeffreft(1) = %d", coeffraftx); 
    424   tofich (typedata, ligne,1); 
    425   /* AGRIF_coeffrefty : time refinement factor in the y-direction             */ 
    426   sprintf (ligne, "AGRIF_coeffreft(2) = %d", coeffrafty); 
    427   tofich (typedata, ligne,1); 
    428   /* AGRIF_coeffreftz : time refinement factor in the z-direction             */ 
    429   sprintf (ligne, "AGRIF_coeffreft(3) = %d", coeffraftz); 
    430   tofich (typedata, ligne,1); 
    431332  /* AGRIF_NbVariables : number of variables                                  */ 
    432333  sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars); 
    … …  
    476377  setnumberofcells=associate("SetNumberofcells.h"); 
    477378   
     379  if (onlyfixedgrids != 1 ) 
     380  { 
     381  sprintf (ligne,  
     382           "Agrif_Gr %% nb(1) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", 
     383           IndicenbmaillesX); 
     384  } 
     385  else 
     386  { 
    478387  sprintf (ligne,  
    479388           "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", 
    480389           IndicenbmaillesX); 
     390  } 
    481391  tofich (setnumberofcells, ligne,1); 
    482392  if (dimprob > 1) 
    483393  { 
     394     if (onlyfixedgrids != 1 ) 
     395     { 
     396     sprintf (ligne,  
     397           "Agrif_Gr %% nb(2) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", 
     398           IndicenbmaillesY); 
     399     } 
     400     else 
     401     { 
    484402     sprintf (ligne,  
    485403           "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", 
    486404           IndicenbmaillesY); 
     405     } 
     406 
    487407     tofich (setnumberofcells, ligne,1); 
    488408  } 
    489409  if (dimprob > 2) 
    490410  { 
     411     if (onlyfixedgrids != 1 ) 
     412     { 
     413     sprintf (ligne,  
     414           "Agrif_Gr %% nb(3) = Agrif_Gr %% tabvars(%d) %% var %% iarray0", 
     415           IndicenbmaillesZ); 
     416     } 
     417     else 
     418     { 
    491419     sprintf (ligne,  
    492420           "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0", 
    493421           IndicenbmaillesZ); 
     422     } 
    494423     tofich (setnumberofcells, ligne,1); 
    495424  } 
     425 
    496426  fclose (setnumberofcells); 
    497427} 
    … …  
    580510                          listnom *listedesnoms, 
    581511                          FILE *alloccalls, 
    582                           FILE *instanceUSE, 
     512                          FILE *AllocUSE, 
    583513                          FILE *modulealloc, 
    584514                          int *IndiceMax) 
    … …  
    593523  int ValeurMax; 
    594524  int donotwrite=0; 
    595   FILE *IntegerI; 
     525  FILE *alloc_agrif; 
    596526   
    597527  ValeurMax = 2; 
    … …  
    616546     *IndiceMax = 0; 
    617547     AllocEmpty = 1; 
     548 
    618549     sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)", curname); 
    619550     tofich(allocationagrif,ligne,1); 
    … …  
    635566     strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr"); 
    636567     tofich(allocationagrif,ligne,1); 
    637      sprintf (ligne, "#include \"IntegerI_%s.h\"\n",curname); 
    638      fprintf(allocationagrif,ligne); 
     568     /* Add the declaration of I into the allocationagrif file                */ 
     569     strcpy(ligne, "INTEGER :: i"); 
     570     tofich (allocationagrif, ligne,1); 
     571 
    639572     if ( fortran77 == 1 ) 
    640573     { 
    … …  
    687620                                          newvar->var->indicetabvars+compteur); 
    688621                *IndiceMax = newvar->var->indicetabvars+compteur; 
    689                  IntegerIShouldBeAdd = 1; 
    690622                 strcpy (ligne, "allocate "); 
    691623                 strcat (ligne, "("); 
    … …  
    764696     fclose(allocationagrif); 
    765697     allocationagrif = (FILE *)NULL; 
    766      /* Add the declaration of I into the allocationagrif file                */ 
    767      sprintf (ligne, "IntegerI_%s.h",curname); 
    768      IntegerI = associate(ligne); 
    769      if ( IntegerIShouldBeAdd == 1 ) 
    770      {      
    771         strcpy(ligne, "INTEGER :: i"); 
    772         tofich (IntegerI, ligne,1); 
    773      } 
    774      fclose (IntegerI); 
     698 
    775699/******************************************************************************/ 
    776700/*                 NewModule_module.h                                         */ 
    … …  
    780704     { 
    781705        donotwrite = 0 ; 
    782         if ( strcmp(v->commoninfile,mainfile)) donotwrite = 1 ; 
     706        if ( strcasecmp(v->commoninfile,mainfile)) donotwrite = 1 ; 
    783707        else  
    784708        { 
    … …  
    798722           if ( AllocEmpty == 1 ) 
    799723           { 
     724            sprintf (ligne, "\n#include \"agrif_alloc_%s.h\"\n", curname); 
     725            fprintf(alloccalls,ligne); 
     726            sprintf (ligne, "agrif_alloc_%s.h", curname); 
     727            alloc_agrif = associate(ligne); 
     728            sprintf (ligne, "!", curname); 
     729            tofich (alloc_agrif, ligne,1); 
     730 
    800731            fprintf(modulealloc,"! empty module alloc %s \n",curname ); 
     732       fclose(alloc_agrif); 
    801733           } 
    802734           else 
    803735           { 
    804736/******************************************************************************/ 
    805 /*                 include_use_instance_agrif.h                               */ 
     737/*                 include_use_Alloc_agrif.h                               */ 
    806738/*                 USE mod                                                    */ 
    807739/******************************************************************************/ 
    808740            sprintf (ligne, "USE %s", curname); 
    809             tofich (instanceUSE, ligne,1); 
     741            tofich (AllocUSE, ligne,1); 
    810742/******************************************************************************/ 
    811743/*                 allocations_calls_agrif.h                                  */ 
    812744/*                 Call Alloc_agrif_module (Agrif_Gr)                         */ 
    813745/******************************************************************************/ 
     746            sprintf (ligne, "\n#include \"agrif_alloc_%s.h\"\n", curname); 
     747            fprintf(alloccalls,ligne); 
     748            sprintf (ligne, "agrif_alloc_%s.h", curname); 
     749            alloc_agrif = associate(ligne); 
    814750            sprintf (ligne, "Call Alloc_agrif_%s(Agrif_Gr)", curname); 
    815             tofich (alloccalls, ligne,1); 
     751            tofich (alloc_agrif, ligne,1); 
     752       fclose(alloc_agrif); 
    816753/******************************************************************************/ 
    817754/******************************************************************************/ 
    … …  
    834771           { 
    835772/******************************************************************************/ 
    836 /*                 include_use_instance_agrif.h                               */ 
     773/*                 include_use_Alloc_agrif.h                                  */ 
    837774/*                 USE mod                                                    */ 
    838775/******************************************************************************/ 
    839776              sprintf (ligne, "USE %s", curname); 
    840               tofich (instanceUSE, ligne,1); 
     777              tofich (AllocUSE, ligne,1); 
    841778/******************************************************************************/ 
    842779/*                 allocations_calls_agrif.h                                  */ 
    843780/*                 Call Alloc_agrif_module (Agrif_Gr)                         */ 
    844781/******************************************************************************/ 
     782              sprintf (ligne, "#include \"agrif_alloc_%s.h\" \n", curname); 
     783              fprintf (alloccalls, ligne); 
     784              sprintf (ligne, "agrif_alloc_%s.h", curname); 
     785              alloc_agrif = associate(ligne); 
    845786              sprintf (ligne, "Call Alloc_agrif_%s(Agrif_Gr)", curname); 
    846               tofich (alloccalls, ligne,1); 
     787              tofich (alloc_agrif, ligne,1); 
     788         fclose(alloc_agrif); 
    847789           } 
    848790        } 
    … …  
    876818  FILE *createvarnameglobal; 
    877819  FILE *alloccalls; 
    878   FILE *instanceUSE; 
     820  FILE *AllocUSE; 
    879821  FILE *modulealloc; 
    880822   
    881   erreur = tests_entrees (); 
    882   if (erreur) 
    883     exit (0); 
    884   else 
    885  
    886823  strcpy (filefich, "cd "); 
    887824  strcat (filefich, nomdir); 
    … …  
    900837  write_probdimagrif_file(); 
    901838  write_keysagrif_file(); 
    902   write_clusteringagrif_file(); 
    903   write_includeagrif_file(); 
    904839  write_modtypeagrif_file();      
    905840  write_Setnumberofcells_file(); 
    906841  write_Getnumberofcells_file();      
    907842  /*--------------------------------------------------------------------------*/ 
    908   /*   Record the list of module used in the file include_use_instance_agrif  */ 
     843  /*   Record the list of module used in the file include_use_Alloc_agrif     */ 
    909844  listedesnoms = (listnom *)NULL; 
    910845 
    … …  
    980915/*----------------------------------------------------------------------------*/ 
    981916/*----------------------------------------------------------------------------*/ 
    982   instanceUSE= associateaplus("include_use_instance_agrif.h"); 
     917  AllocUSE= associateaplus("include_use_Alloc_agrif.h"); 
    983918  alloccalls = associateaplus("allocations_calls_agrif.h"); 
    984919  sprintf(ligne,"NewModule_%s.h",NameTampon); 
    … …  
    996931                                       listedesnoms, 
    997932                                       alloccalls, 
    998                                        instanceUSE, 
     933                                       AllocUSE, 
    999934                                       modulealloc, 
    1000935                                       &IndiceMax); 
    … …  
    1003938  } 
    1004939   
    1005   fclose (instanceUSE); 
     940  fclose (AllocUSE); 
    1006941  fclose (alloccalls); 
    1007942  fclose (modulealloc); 
Note: See TracChangeset for help on using the changeset viewer.