# f/2.3.6/test16.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  EDF R&D, CEA/DEN
    00004 C*  MED is free software: you can redistribute it and/or modify
    00005 C*  it under the terms of the GNU Lesser General Public License as published by
    00006 C*  the Free Software Foundation, either version 3 of the License, or
    00007 C*  (at your option) any later version.
    00008 C*
    00009 C*  MED is distributed in the hope that it will be useful,
    00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 C*  GNU Lesser General Public License for more details.
    00013 C*
    00014 C*  You should have received a copy of the GNU Lesser General Public License
    00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 C*
    00017
    00018
    00019 C       ******************************************************************************
    00020 C       * - Nom du fichier : test16.f
    00021 C       *
    00022 C       * - Description : ecriture d'elements d'un maillage MED
    00023 C       *                 via les routines de niveau 2
    00024 C       *                 - equivalent a test6.f
    00025 C       *
    00026 C       ******************************************************************************
    00027         program test16
    00028 C
    00029         implicit none
    00030         include 'med.hf'
    00031 C
    00032 C
    00033         integer      cret, fid, mdim, nse2, ntr3
    00034         character*32 maa
    00035         parameter    (mdim = 2,nse2 = 5,maa = "maa1", ntr3 = 2)
    00036         integer      se2   (2*nse2)
    00037         character*16  nomse2(nse2)
    00038         integer      numse2(nse2),nufase2(nse2)
    00039         integer      tr3   (3*ntr3)
    00040         character*16  nomtr3(ntr3)
    00041         integer      numtr3(ntr3), nufatr3(ntr3)
    00042         data se2    /1,2,1,3,2,4,3,4,2,3/
    00043         data nomse2 /"se1","se2","se3","se4","se5"/
    00044         data numse2 /1,2,3,4,5/, nufase2 /-1,-1,0,-2,-3/
    00045         data tr3    /1,2,-5,-5,3,-4/
    00046         data nomtr3 /"tr1","tr2"/,numtr3/4,5/,nufatr3/0,-1/
    00047
    00048 C       ** Creation du fichier test16.med **
    00049         call efouvr(fid,'test16.med',MED_LECTURE_ECRITURE, cret)
    00050         print *,cret
    00051         if (cret .ne. 0 ) then
    00052            print *,'Erreur creation du fichier'
    00053            call efexit(-1)
    00054         endif
    00055
    00056 C       ** Creation du maillage **
    00057         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    00058      C                  'Un maillage pour test16',cret)
    00059         print *,cret
    00060         if (cret .ne. 0 ) then
    00061            print *,'Erreur creation du maillage'
    00062            call efexit(-1)
    00063         endif
    00064
    00065 C       ** Ecriture des aretes segments MED_SEG2 :
    00066 C       - Connectivite
    00067 C       - Noms (optionnel)
    00068 C       - Numeros (optionnel)
    00069 C       - Numeros des familles **
    00070         call efelee(fid,maa,mdim,se2,MED_NO_INTERLACE,
    00071      C         nomse2,MED_VRAI,numse2,MED_VRAI,
    00072      C         nufase2,nse2,MED_ARETE,MED_SEG2,MED_DESC,cret)
    00073         print *,cret
    00074         if (cret .ne. 0 ) then
    00075            print *,'Erreur des  elements'
    00076            call efexit(-1)
    00077         endif
    00078
    00079 C       ** Ecriture des mailles MED_TRIA3 :
    00080 C     - Connectivite
    00081 C     - Noms (optionnel)
    00082 C     - Numeros (optionnel)
    00083 C     - Numeros des familles **
    00084         call efelee(fid,maa,mdim,tr3,MED_NO_INTERLACE,
    00085      C      nomtr3,MED_VRAI,numtr3,MED_VRAI,
    00086      C      nufatr3,ntr3,MED_MAILLE,MED_TRIA3,MED_DESC,cret)
    00087         print *,cret
    00088         if (cret .ne. 0 ) then
    00089            print *,'Erreur ecriture des elements'
    00090            call efexit(-1)
    00091         endif
    00092
    00093 C       ** Fermeture du fichier **
    00094         call efferm (fid,cret)
    00095         print *,cret
    00096         if (cret .ne. 0 ) then
    00097            print *,'Erreur fermeture du fichier'
    00098            call efexit(-1)
    00099         endif
    00100 C
    00101         end
    00102