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
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_CREATION, cret)
44          print *,cret
45
46
47  C       ** Creation du maillage **
48          if (cret .eq. 0) then
49              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
50       &                 'Un maillage pour test12',cret)
51          endif
52          print *,cret
53
54  C       ** Creation de l'equivalence **
55          if (cret .eq. 0) then
56             call efequc(fid,maa,equ,des,cret)
57          endif
58          print *,cret
59
60  C       ** Ecriture des correspondances sur les mailles MED_TRIA3 **
61          if (cret .eq. 0) then
62            call efeque(fid,maa,equ,cor,ncor,
63       &          MED_MAILLE,MED_TRIA3,cret)
64          endif
65          print *,cret
66
67  C ** Fermeture du fichier                                **
68          call efferm (fid,cret)
69          print *,cret
70
71          end