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 : test6.f
 21  C       *
 22  C       * - Description : exemples d'ecriture d'elements dans un maillage MED
 23  C       *
 24  C       ******************************************************************************
 25      program test6
 26  C
 27      implicit none
 28      include 'med.hf'
 29  C
 30  C
 31          integer cret, fid
 32          integer     mdim,nse2,ntr3
 33          parameter  (nse2 = 5, ntr3 = 2, mdim = 2)
 34          integer     se2 (2*nse2)
 35          character*16 nomse2(nse2)
 36          integer     numse2(nse2),nufase2(nse2)
 37
 38          integer     tr3 (3*ntr3)
 39          character*16 nomtr3(ntr3)
 40          integer     numtr3(ntr3), nufatr3(ntr3)
 41          character*32 maa
 42
 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 /, nomtr3 /"tr1","tr2"/, numtr3 /4,5/
 47          data nufatr3 /0,-1/,  maa /"maa1"/
 48
 49  C       ** Ouverture du fichier                            **
 50          call efouvr(fid,'test6.med',MED_CREATION, cret)
 51          print *,cret
 52
 53  C       ** Creation du maillage maa de dimension 2         **
 54          if (cret .eq. 0) then
 55              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
 56       &                 'un maillage pour test6',cret)
 57          endif
 58          print *,cret
 59
 60  C       ** Ecriture des connectivites des segments         **
 61          if (cret .eq. 0) then
 62              call efcone(fid,maa,mdim,se2,MED_NO_INTERLACE,
 63       &               nse2,MED_ARETE,
 64       &               MED_SEG2,MED_DESC,cret )
 65          endif
 66          print *,cret
 67
 68  C       ** Ecriture (optionnelle) des noms des segments    **
 69          if (cret .eq. 0) then
 70              call efnome(fid,maa,nomse2,nse2,MED_ARETE,
 71       &                      MED_SEG2 ,cret)
 72          endif
 73          print *,cret
 74  C       ** Ecriture (optionnelle) des numeros des segments **
 75          if (cret .eq. 0) then
 76              call efnume(fid,maa,numse2,nse2,
 77       &              MED_ARETE ,MED_SEG2,cret)
 78          endif
 79          print *,cret
 80
 81  C      ** Ecriture des numeros des familles des segments  **
 82         if (cret .eq. 0) then
 83           call effame(fid,maa,nufase2,nse2,
 84       &              MED_ARETE,MED_SEG2,cret)
 85         endif
 86         print *,cret
 87
 88  C      ** Ecriture des connectivites des triangles        **
 89         if (cret .eq. 0) then
 90             call efcone(fid,maa,mdim,tr3,MED_NO_INTERLACE,
 91       &              ntr3,MED_MAILLE,
 92       &              MED_TRIA3,MED_DESC,cret )
 93         endif
 94         print *,cret
 95  C      ** Ecriture (optionnelle) des noms des triangles   **
 96         if (cret .eq. 0) then
 97              call efnome(fid,maa,nomtr3,ntr3,MED_MAILLE,
 98       &                      MED_TRIA3,cret)
 99         endif
100  C       ** Ecriture (optionnelle) des numeros des triangles **
101         if (cret .eq. 0) then
102             call efnume(fid,maa,numtr3,ntr3,MED_MAILLE,
103       &                       MED_TRIA3,cret)
104         endif
105         print *,cret
106
107  C      ** Ecriture des numeros des familles des triangles  **
108         if (cret .eq. 0) then
109           call effame(fid,maa,nufatr3,ntr3,MED_MAILLE,
110       &                      MED_TRIA3,cret)
111         endif
112         print *,cret
113
114  C       ** Fermeture du fichier   **
115         call efferm (fid,cret)
116         print *,cret
117
118         end