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 : test16.f
22  C       *
23  C       * - Description : ecriture d'elements d'un maillage MED
24  C       *                 via les routines de niveau 2
25  C       *                 - equivalent a test6.f
26  C       *
27  C       ******************************************************************************
28          program test16
29  C       
30          implicit none
31          include 'med.hf'
32  C   
33  C
34          integer      cret, fid, mdim, nse2, ntr3
35          character*32 maa
36          parameter    (mdim = 2,nse2 = 5,maa = "maa1", ntr3 = 2)
37          integer      se2   (2*nse2)
38          character*16  nomse2(nse2)
39          integer      numse2(nse2),nufase2(nse2)
40          integer      tr3   (3*ntr3)
41          character*16  nomtr3(ntr3)
42          integer      numtr3(ntr3), nufatr3(ntr3)
43          data se2    /1,2,1,3,2,4,3,4,2,3/
44          data nomse2 /"se1","se2","se3","se4","se5"/
45          data numse2 /1,2,3,4,5/, nufase2 /-1,-1,0,-2,-3/
46          data tr3    /1,2,-5,-5,3,-4/
47          data nomtr3 /"tr1","tr2"/,numtr3/4,5/,nufatr3/0,-1/
48
49  C       ** Creation du fichier test16.med **
50          call efouvr(fid,'test16.med',MED_CREATION, cret)
51          print *,cret
52
53  C       ** Creation du maillage **
54          if (cret .eq. 0) then
55             call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
56       C                  'Un maillage pour test16',cret)
57          endif
58          print *,cret
59      
60  C       ** Ecriture des aretes segments MED_SEG2 :
61  C       - Connectivite
62  C       - Noms (optionnel) 
63  C       - Numeros (optionnel)
64  C       - Numeros des familles **
65          if (cret .eq. 0) then
66             call efelee(fid,maa,mdim,se2,MED_NO_INTERLACE,
67       C         nomse2,MED_VRAI,numse2,MED_VRAI,
68       C         nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret)
69          endif
70          print *,cret
71
72  C       ** Ecriture des mailles MED_TRIA3 :
73  C     - Connectivite
74  C     - Noms (optionnel) 
75  C     - Numeros (optionnel)
76  C     - Numeros des familles **
77          if (cret .eq. 0) then
78             call efelee(fid,maa,mdim,tr3,MED_NO_INTERLACE,
79       C      nomtr3,MED_VRAI,numtr3,MED_VRAI,
80       C      nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret)
81          endif
82          print *,cret
83
84  C       ** Fermeture du fichier **
85          call efferm (fid,cret)
86          print *,cret
87
88          end
89