# test8.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2011  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 C ******************************************************************************
    00019 C * - Nom du fichier : test8.f
    00020 C *
    00021 C * - Description : exemple d'ecriture des familles d'un maillage MED
    00022 C *
    00023 C *****************************************************************************
    00024         program test8
    00025 C
    00026         implicit none
    00027         include 'med.hf'
    00028 C
    00029         integer cret, fid
    00030
    00031         character*64  maa
    00032         integer       mdim, sdim
    00033         character*64  nomfam
    00034         integer       numfam
    00035         integer       ngro
    00036         character*80  gro
    00037         integer       nfamn
    00038         character*16   str
    00039         character*16 nomcoo(2)
    00040         character*16 unicoo(2)
    00041
    00042         parameter  ( mdim = 2, nfamn = 2 , sdim = 2)
    00043         data       maa /"maa1"/
    00044         data  nomcoo /"x","y"/, unicoo /"cm","cm"/
    00045
    00046 C     ** Creation du fichier test8.med                       **
    00047         call mfiope(fid,'test8.med',MED_ACC_RDWR, cret)
    00048         print *,cret
    00049         if (cret .ne. 0 ) then
    00050            print *,'Erreur creation du fichier'
    00051            call efexit(-1)
    00052         endif
    00053
    00054 C     ** Creation du maillage maa de dimension 2         **
    00055         call mmhcre(fid,maa,mdim,sdim,MED_UNSTRUCTURED_MESH,
    00056      &              'un maillage pour test8',"",MED_SORT_DTIT,
    00057      &              MED_CARTESIAN,nomcoo,unicoo,cret)
    00058         print *,cret
    00059         if (cret .ne. 0 ) then
    00060            print *,'Erreur creation du maillage'
    00061            call efexit(-1)
    00062         endif
    00063
    00064 C     ** Ecriture des familles                           **
    00065 C     * Conventions :
    00066 C       - Toujours creer une famille de numero 0 ne comportant aucun attribut
    00067 C         ni groupe (famille de reference pour les noeuds ou les elements
    00068 C         qui ne sont rattaches a aucun groupe ni attribut)
    00069 C       - Les numeros de familles de noeuds sont > 0
    00070 C       - Les numeros de familles des elements sont < 0
    00071 C       - Rien d'imposer sur les noms de familles
    00072 C     **                                                 **
    00073
    00074 C     * Creation de la famille 0                                     **
    00075         numfam = 0
    00076         nomfam="FAMILLE_0"
    00077         ngro = 0
    00078         call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
    00079         print *,cret
    00080         if (cret .ne. 0 ) then
    00081            print *,'Erreur creation de la famille 0'
    00082            call efexit(-1)
    00083         endif
    00084
    00085 C  * Creation pour correspondre aux cas tests precedents, 3 familles  *
    00086 C  *  d'elements (-1,-2,-3) et deux familles de noeuds (1,2)         *
    00087         do numfam=-1,-3,-1
    00088            write(str,'(I1.0)') (-numfam)
    00089            nomfam = "FAMILLE_ELEMENT_"//str
    00090            gro="groupe1"
    00091            ngro = 1
    00092            call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
    00093            print *,cret
    00094            if (cret .ne. 0 ) then
    00095               print *,'Erreur creation de famille'
    00096               call efexit(-1)
    00097            endif
    00098         end do
    00099
    00100         do numfam=1,nfamn
    00101            write(str,'(I1.0)') numfam
    00102            nomfam = "FAMILLE_NOEUD_"//str
    00103            gro="groupe1"
    00104            ngro = 1
    00105           call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
    00106            print *,cret
    00107            if (cret .ne. 0 ) then
    00108               print *,'Erreur creation de famille'
    00109               call efexit(-1)
    00110            endif
    00111         end do
    00112
    00113
    00114 C     * Fermeture du fichier *
    00115         call mficlo(fid,cret)
    00116         print *,cret
    00117         if (cret .ne. 0 ) then
    00118            print *,'Erreur fermeture du fichier'
    00119            call efexit(-1)
    00120         endif
    00121 C
    00122         end
    00123
    00124
    00125
    00126
    00127
    00128