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