      1 C*************************************************************************
      2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
      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
     49 C
     50 C
     51         data  coo    /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
     52         data  comp2  /"x","y"/, unit2 /"cm","cm"/
     53 C
     54 C       Creation du fichier test27.med
     55         call efouvr(fid,'test27.med',MED_LECTURE_ECRITURE, cret)
     56         print *,cret
     57         if (cret .ne. 0 ) then
     58            print *,'Erreur creation du fichier'
     59            call efexit(-1)
     60         endif
     61         print *,'Creation du fichier test27.med'
     62 C
     63 C       Creation d'un maillage MED_NON_STRUCTURE
     64         mdim = 3
     65         maa = 'maillage vide'
     66         desc = 'un maillage vide'
     67         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,desc,cret)
     68         print *,cret
     69         if (cret .ne. 0 ) then
     70            print *,'Erreur creation du maillage'
     71            call efexit(-1)
     72         endif
     73 C
     74 C       Creation d'une grille cartesienne
     75         mdim = 2
     76         maa = 'grille cartesienne'
     77         desc = 'un exemple de grille cartesienne'
     78         call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
     79         print *,cret
     80         if (cret .ne. 0 ) then
     81            print *,'Erreur creation du maillage'
     82            call efexit(-1)
     83         endif
     84         print *,'Creation d un maillage MED_STRUCTURE'
     85
     86 C
     87 C       On specifie la nature du maillage structure
     88         call efnage(fid,maa,MED_GRILLE_CARTESIENNE,cret)
     89         print *,cret
     90         print *,'On definit la nature de la grille :
     91      & MED_GRILLE_CARTESIENNE'
     92         if (cret .ne. 0 ) then
     93            print *,'Erreur ecriture de la nature de la grille'
     94            call efexit(-1)
     95         endif
     96 C
     97 C       On definit les indices de la grille selon chaque dimension
     98         indice(1) = 1.1D0
     99         indice(2) = 1.2D0
    100         indice(3) = 1.3D0
    101         indice(4) = 1.4D0
    102         nind = 4
    103         axe = 1
    104         comp = 'X'
    105         unit = 'cm'
    106         call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
    107         print *,cret
    108         if (cret .ne. 0 ) then
    109            print *,'Erreur ecriture des indices'
    110            call efexit(-1)
    111         endif
    112         print *,'Ecriture des indices des coordonnees selon axe X'
    113 C
    114         indice(1) = 2.1D0
    115         indice(2) = 2.2D0
    116         indice(3) = 2.3D0
    117         indice(4) = 2.4D0
    118         nind = 4
    119         axe = 2
    120         comp = 'Y'
    121         unit = 'cm'
    122         call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
    123         print *,cret
    124         if (cret .ne. 0 ) then
    125            print *,'Erreur ecriture des indices'
    126            call efexit(-1)
    127         endif
    128         print *,'Ecriture des indices des coordonnees selon axe Y'
    129 C
    130 C       Creation d'une grille MED_GRILLE_STANDARD de dimension 2
    131         maa = 'grille standard'
    132         mdim = 2
    133         desc = 'un exemple de grille standard'
    134         call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret)
    135         print *,cret
    136         if (cret .ne. 0 ) then
    137            print *,'Erreur creation de maillage'
    138            call efexit(-1)
    139         endif
    140         print *,'Nouveau maillage MED_STRUCTURE'
    141 C
    142         call efnage(fid,maa,MED_GRILLE_STANDARD,cret)
    143         print *,cret
    144         if (cret .ne. 0 ) then
    145            print *,'Erreur ecriture de la nature de la grille'
    146            call efexit(-1)
    147         endif
    148         print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
    149 C
    150 C       On ecrit les coordonnes de la grille
    151         nnoe = 4
    152         call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,nnoe,MED_CART,
    153      &                 comp2,unit2,cret)
    154         print *,cret
    155         if (cret .ne. 0 ) then
    156            print *,'Erreur ecriture des coordonnees des noeuds'
    157            call efexit(-1)
    158         endif
    159         print *,'Ecriture des coordonnees de la grille'
    160 C
    161 C       On definit la structure des coordonnees de la grille
    162         strgri(1) = 2
    163         strgri(2) = 2
    164         call efscoe(fid,maa,mdim,strgri,cret)
    165         print *,cret
    166         if (cret .ne. 0 ) then
    167            print *,'Erreur ecriture de la structure'
    168            call efexit(-1)
    169         endif
    170         print *,'Ecriture de la structure de la grille : / 2,2 /'
    171 C
    172 C       On ferme le fichier
    173         call efferm (fid,cret)
    174         print *,cret
    175         if (cret .ne. 0 ) then
    176            print *,'Erreur fermeture du fichier'
    177            call efexit(-1)
    178         endif
    179         print *,'Fermeture du fichier'
    180 C
    181          end
    182
    183
    184
    185
    186
    187