# test16.f

Aller à la documentation de ce fichier.

    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, sdim
    00034         character*64 maa
    00035         parameter    (mdim = 2,nse2 = 5,maa = "maa1", ntr3 = 2, sdim=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         character*16 nomcoo(2)
    00048         character*16 unicoo(2)
    00049         real*8 dt
    00050         data  nomcoo /"x","y"/, unicoo /"cm","cm"/
    00051         parameter (dt=0.0)
    00052
    00053 C       ** Creation du fichier test16.med **
    00054         call mfiope(fid,'test16.med',MED_ACC_CREAT, cret)
    00055         print *,cret
    00056         if (cret .ne. 0 ) then
    00057            print *,'Erreur creation du fichier'
    00058            call efexit(-1)
    00059         endif
    00060
    00061 C       ** Creation du maillage **
    00062         call mmhcre(fid,maa,mdim,sdim,MED_UNSTRUCTURED_MESH,
    00063      &              'Un maillage pour test16',"",
    00064      &              MED_SORT_DTIT,MED_CARTESIAN,nomcoo,unicoo,cret)
    00065         print *,cret
    00066         if (cret .ne. 0 ) then
    00067            print *,'Erreur creation du maillage'
    00068            call efexit(-1)
    00069         endif
    00070
    00071 C       ** Ecriture des aretes segments MED_SEG2 :
    00072 C       - Connectivite
    00073 C       - Noms (optionnel)
    00074 C       - Numeros (optionnel)
    00075 C       - Numeros des familles **
    00076         call mmhelw(fid,maa,MED_NO_DT,MED_NO_IT,dt,MED_DESCENDING_EDGE,
    00077      &              MED_SEG2,MED_DESCENDING,MED_NO_INTERLACE,nse2,se2,
    00078      &              MED_TRUE,nomse2,MED_TRUE,numse2,MED_TRUE,nufase2,
    00079      &              cret)
    00080         print *,cret
    00081         if (cret .ne. 0 ) then
    00082            print *,'Erreur des  elements'
    00083            call efexit(-1)
    00084         endif
    00085
    00086 C       ** Ecriture des mailles MED_TRIA3 :
    00087 C     - Connectivite
    00088 C     - Noms (optionnel)
    00089 C     - Numeros (optionnel)
    00090 C     - Numeros des familles **
    00091         call mmhelw(fid,maa,MED_NO_DT,MED_NO_IT,dt,MED_CELL,
    00092      &              MED_TRIA3,MED_DESCENDING,MED_NO_INTERLACE,ntr3,tr3,
    00093      &              MED_TRUE,nomtr3,MED_TRUE,numtr3,MED_TRUE,nufatr3,
    00094      &              cret)
    00095         print *,cret
    00096         if (cret .ne. 0 ) then
    00097            print *,'Erreur ecriture des elements'
    00098            call efexit(-1)
    00099         endif
    00100
    00101 C       ** Fermeture du fichier **
    00102         call mficlo(fid,cret)
    00103         print *,cret
    00104         if (cret .ne. 0 ) then
    00105            print *,'Erreur fermeture du fichier'
    00106            call efexit(-1)
    00107         endif
    00108 C
    00109         end
    00110