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 : test23.f
21  C       *
22  C       * - Description : ecriture de mailles MED_POLYGONE dans un maillage MED
23  C       *
24  C       ******************************************************************************
25          program test23
26  C
27          implicit none
28          include 'med.hf'
29  C
30          integer cret, fid,mdim
31          parameter  (mdim = 3)
32          character*32 maa    
33          integer ni, n
34          parameter (ni=4, n=3)
35          integer index(ni)
36          character*16 nom(n)
37          integer num(n),fam(n)
38          integer con(16)
39  C
40          data con  / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /
41          data nom  / "poly1", "poly2", "poly3"/
42          data num  / 1,2,3 /, fam /0,-1,-2/
43          data index /1,6,12,17/
44          data maa /"maa1"/
45
46  C       ** Creation du fichier test23.med                   **
47          call efouvr(fid,'test23.med',MED_CREATION, cret)
48          print *,cret
49          print *,'Creation du fichier test23.med'
50
51  C       ** Creation du maillage          **
52          if (cret .eq. 0) then
53              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
54       &                 'un maillage pour test23',cret)
55          endif
56          print *,cret
57          print *,'Creation du maillage'
58
59  C       ** Ecriture de la connectivite des mailles polygones **
60          if (cret .eq. 0) then
61              call efpgce(fid,maa,index,ni,con,MED_MAILLE,MED_NOD,cret)
62          endif
63          print *,cret
64          print *,'Ecriture des connectivites des mailles de type MED_POLYGONE'
65
66  C       ** Ecriture des noms des mailles polygones          **
67          if (cret .eq. 0) then
68              call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYGONE,
69       &                 cret)
70          endif
71          print *,cret
72          print *,'Ecriture des noms des polygones'
73
74  C       ** Ecriture des numeros des mailles polygones **
75          if (cret .eq. 0) then
76             call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYGONE,
77       &                 cret)
78          endif
79          print *,cret
80          print *,'Ecriture des numeros des polygones'
81
82  C       ** Ecriture des numeros des familles des segments  **
83          if (cret .eq. 0) then
84           call effame(fid,maa,fam,n,
85       &              MED_MAILLE,MED_POLYGONE,cret)
86          endif
87          print *,cret
88          print *,'Ecriture des numeros de familles des polygones'
89
90  C       ** Fermeture du fichier                            **
91          call efferm (fid,cret)
92          print *,cret
93          print *,'Fermeture du fichier'
94
95          end