     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