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