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 
20 C ******************************************************************************
21 C * - Nom du fichier : test12.f
22 C *
23 C * - Description : ecriture d'une equivalence dans un maillage MED 
24 C *
25 C ******************************************************************************
26         program test12
27 C     
28         implicit none
29         include 'med.hf'
30 C
31 C
32         integer cret,fid
33         character*32 maa , equ 
34         character*200 des
35         integer mdim ,ncor
36         integer cor(6)
37 
38         parameter (maa ="maa1",mdim = 3,ncor = 3 )
39         data cor /1,2,3,4,5,6/, equ / "equivalence"/
40         data des / "equivalence sur les mailles MED_TRIA3" /
41 
42 C  ** Creation du fichier test12.med **
43         call efouvr(fid,'test12.med',MED_LECTURE_ECRITURE, cret)
44         print *,cret
45         if (cret .ne. 0 ) then
46            print *,'Erreur creation du fichier'
47            call efexit(-1)
48         endif      
49 
50   
51 C  ** Creation du maillage **
52         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
53      &                 'Un maillage pour test12',cret)
54         print *,cret  
55                 if (cret .ne. 0 ) then
56            print *,'Erreur creation du maillage'
57            call efexit(-1)
58         endif      
59   
60 C ** Creation de l'equivalence **
61         call efequc(fid,maa,equ,des,cret)
62         print *,cret
63         if (cret .ne. 0 ) then
64            print *,'Erreur creation equivalence'
65            call efexit(-1)
66         endif
67 
68 C ** Ecriture des correspondances sur les mailles MED_TRIA3 **
69         call efeque(fid,maa,equ,cor,ncor,
70      &          MED_MAILLE,MED_TRIA3,cret)
71         print *,cret
72         if (cret .ne. 0 ) then
73            print *,'Erreur ecriture de correspondances'
74            call efexit(-1)
75         endif
76 
77 C ** Fermeture du fichier                                **
78         call efferm (fid,cret)
79         print *,cret
80         if (cret .ne. 0 ) then
81            print *,'Erreur fermeture du fichier'
82            call efexit(-1)
83         endif
84 C
85         end