      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