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