      1  C*************************************************************************
      2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
      3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
      4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
      5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
      6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
      7  C
      8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
      9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
     10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
     11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
     12  C
     13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
     14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
     15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
     16  C
     17  C**************************************************************************
     18
     19  C       ******************************************************************************
     20  C       * - Nom du fichier : test27.f
     21  C       *
     22  C       * - Description : creation de maillages structures (grille cartesienne |
     23  C       *                 grille standard ) dans le fichier test27.med
     24  C       *
     25  C       *****************************************************************************
     26        program test27
     27  C
     28          implicit none
     29          include 'med.hf'
     30  C
     31  C
     32          integer       cret, fid
     33  C       ** la dimension du maillage                         **
     34          integer       mdim
     35  C       ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
     36          character*32  maa
     37  C       ** le nombre de noeuds                              **
     38          integer       nnoe
     39  C       ** table des coordonnees                            **
     40          real*8        coo(8)
     41          character*16  comp, comp2(2)
     42          character*16  unit, unit2(2)
     43          character*200 desc
     44          integer       strgri(2)
     45  C       ** grille cartesienne                               **
     46          integer       axe,nind
     47          real*8        indice(4)
     48  C
     49  C
     50          data  coo    /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
     51          data  comp2  /"x","y"/, unit2 /"cm","cm"/
     52  C
     53  C       Creation du fichier test27.med
     54          call efouvr(fid,'test27.med',MED_CREATION, cret)
     55          print *,cret
     56          print *,'Creation du fichier test27.med'
     57  C
     58  C       Creation d'un maillage MED_NON_STRUCTURE
     59          if (cret .eq. 0) then
     60              mdim = 3
     61              maa = 'maillage vide'
     62              desc = 'un maillage vide'
     63              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,desc,cret)
     64              print *,cret
     65          endif
     66  C
     67  C       Creation d'une grille cartesienne
     68          if (cret .eq. 0) then
     69              mdim = 2
     70              maa = 'grille cartesienne'
     71              desc = 'un exemple de grille cartesienne'
     72              call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
     73              print *,cret
     74              print *,'Creation d un maillage MED_STRUCTURE'
     75          endif
     76  C
     77  C       On specifie la nature du maillage structure
     78          if (cret .eq. 0) then
     79              call efnage(fid,maa,MED_GRILLE_CARTESIENNE,cret)
     80              print *,cret
     81              print *,'On definit la nature de la grille : MED_GRILLE_CART
     82       &               ESIENNE'
     83          endif
     84  C
     85  C       On definit les indices de la grille selon chaque dimension
     86          if (cret .eq. 0) then
     87              indice(1) = 1.1
     88              indice(2) = 1.2
     89              indice(3) = 1.3
     90              indice(4) = 1.4
     91              nind = 4
     92              axe = 1
     93              comp = 'X'
     94              unit = 'cm'
     95              call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
     96              print *,cret
     97              print *,'Ecriture des indices des coordonnees selon axe X'
     98          endif
     99  C
    100          if (cret .eq. 0) then
    101              indice(1) = 2.1
    102              indice(2) = 2.2
    103              indice(3) = 2.3
    104              indice(4) = 2.4
    105              nind = 4
    106              axe = 2
    107              comp = 'Y'
    108              unit = 'cm'
    109              call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
    110              print *,cret
    111              print *,'Ecriture des indices des coordonnees selon axe Y'
    112          endif
    113  C
    114  C       Creation d'une grille MED_GRILLE_STANDARD de dimension 2
    115          if (cret .eq. 0) then
    116              maa = 'grille standard'
    117              mdim = 2
    118              desc = 'un exemple de grille standard'
    119              call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
    120              print *,cret
    121              print *,'Nouveau maillage MED_STRUCTURE'
    122          endif
    123  C
    124          if (cret .eq. 0) then
    125              call efnage(fid,maa,MED_GRILLE_STANDARD,cret)
    126              print *,cret
    127              print *,'On definit la nature du maillage structure : MED_GR
    128       &               ILLE_STANDARD'
    129          endif
    130  C
    131  C       On ecrit les coordonnes de la grille
    132          if (cret .eq. 0) then
    133              nnoe = 4
    134              call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,nnoe,MED_CART,
    135       &                 comp2,unit2,cret)
    136              print *,cret
    137              print *,'Ecriture des coordonnees de la grille'
    138          endif
    139  C
    140  C       On definit la structure des coordonnees de la grille
    141          if (cret .eq. 0) then
    142              strgri(1) = 2
    143              strgri(2) = 2
    144              call efscoe(fid,maa,mdim,strgri,cret)
    145              print *,cret
    146              print *,'Ecriture de la structure de la grille : / 2,2 /'
    147          endif
    148  C
    149  C       On ferme le fichier
    150          call efferm (fid,cret)
    151          print *,cret
    152          print *,'Fermeture du fichier'
    153  C
    154        end
    155
    156
    157
    158
    159
    160