      1 C*************************************************************************
      2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
      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_LECTURE_ECRITURE, cret)
     51         print *,cret
     52         if (cret .ne. 0 ) then
     53            print *,'Erreur creation du fichier'
     54            call efexit(-1)
     55         endif
     56
     57 C       ** Creation du maillage **
     58         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     59      C                  'Un maillage pour test16',cret)
     60         print *,cret
     61         if (cret .ne. 0 ) then
     62            print *,'Erreur creation du maillage'
     63            call efexit(-1)
     64         endif
     65
     66 C       ** Ecriture des aretes segments MED_SEG2 :
     67 C       - Connectivite
     68 C       - Noms (optionnel)
     69 C       - Numeros (optionnel)
     70 C       - Numeros des familles **
     71         call efelee(fid,maa,mdim,se2,MED_NO_INTERLACE,
     72      C         nomse2,MED_VRAI,numse2,MED_VRAI,
     73      C         nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret)
     74         print *,cret
     75         if (cret .ne. 0 ) then
     76            print *,'Erreur des  elements'
     77            call efexit(-1)
     78         endif
     79
     80 C       ** Ecriture des mailles MED_TRIA3 :
     81 C     - Connectivite
     82 C     - Noms (optionnel)
     83 C     - Numeros (optionnel)
     84 C     - Numeros des familles **
     85         call efelee(fid,maa,mdim,tr3,MED_NO_INTERLACE,
     86      C      nomtr3,MED_VRAI,numtr3,MED_VRAI,
     87      C      nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret)
     88         print *,cret
     89         if (cret .ne. 0 ) then
     90            print *,'Erreur ecriture des elements'
     91            call efexit(-1)
     92         endif
     93
     94 C       ** Fermeture du fichier **
     95         call efferm (fid,cret)
     96         print *,cret
     97         if (cret .ne. 0 ) then
     98            print *,'Erreur fermeture du fichier'
     99            call efexit(-1)
    100         endif
    101 C
    102         end
    103