# f/2.3.6/test8.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 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*32  maa
    00032         integer       mdim
    00033         character*32  nomfam
    00034         integer       numfam
    00035         character*200 attdes
    00036         integer       natt, attide, attval
    00037         integer       ngro
    00038         character*80  gro
    00039         integer       nfamn
    00040         character*16   str
    00041
    00042         parameter  ( mdim = 2, nfamn = 2 )
    00043         data       maa /"maa1"/
    00044
    00045 C     ** Creation du fichier test8.med                       **
    00046         call efouvr(fid,'test8.med',MED_LECTURE_ECRITURE, cret)
    00047         print *,cret
    00048         if (cret .ne. 0 ) then
    00049            print *,'Erreur creation du fichier'
    00050            call efexit(-1)
    00051         endif
    00052
    00053 C     ** Creation du maillage maa de dimension 2         **
    00054         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    00055      &                 'un maillage pour test8',cret)
    00056         print *,cret
    00057         if (cret .ne. 0 ) then
    00058            print *,'Erreur creation du maillage'
    00059            call efexit(-1)
    00060         endif
    00061
    00062 C     ** Ecriture des familles                           **
    00063 C     * Conventions :
    00064 C       - Toujours creer une famille de numero 0 ne comportant aucun attribut
    00065 C         ni groupe (famille de reference pour les noeuds ou les elements
    00066 C         qui ne sont rattaches a aucun groupe ni attribut)
    00067 C       - Les numeros de familles de noeuds sont > 0
    00068 C       - Les numeros de familles des elements sont < 0
    00069 C       - Rien d'imposer sur les noms de familles
    00070 C     **                                                 **
    00071
    00072 C     * Creation de la famille 0                                     **
    00073         numfam = 0
    00074         nomfam="FAMILLE_0"
    00075         call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
    00076      &          0,gro,0,cret)
    00077         print *,cret
    00078         if (cret .ne. 0 ) then
    00079            print *,'Erreur creation de la famille 0'
    00080            call efexit(-1)
    00081         endif
    00082
    00083 C  * Creation pour correspondre aux cas tests precedents, 3 familles  *
    00084 C  *  d'elements (-1,-2,-3) et deux familles de noeuds (1,2)         *
    00085         do numfam=-1,-3,-1
    00086            write(str,'(I1.0)') (-numfam)
    00087            nomfam = "FAMILLE_ELEMENT_"//str
    00088            attide = 1
    00089            attval = numfam*100
    00090            natt = 1
    00091            attdes="description attribut"
    00092            gro="groupe1"
    00093            ngro = 1
    00094            print *, nomfam," - ",numfam," - ",attide," - ",
    00095      &                attval," - ",ngro
    00096
    00097            call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
    00098      &                natt,gro,ngro,cret)
    00099            print *,cret
    00100            if (cret .ne. 0 ) then
    00101               print *,'Erreur creation de famille'
    00102               call efexit(-1)
    00103            endif
    00104         end do
    00105
    00106         do numfam=1,nfamn
    00107            write(str,'(I1.0)') numfam
    00108            nomfam = "FAMILLE_NOEUD_"//str
    00109            attide = 1
    00110            attval = numfam*100
    00111            natt = 1
    00112            attdes="description attribut"
    00113            gro="groupe1"
    00114            ngro = 1
    00115            print *, nomfam," - ",numfam," - ",attide," - ",
    00116      &                attval," - ",ngro
    00117            call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
    00118      &                natt,gro,ngro,cret)
    00119            print *,cret
    00120            if (cret .ne. 0 ) then
    00121               print *,'Erreur creation de famille'
    00122               call efexit(-1)
    00123            endif
    00124         end do
    00125
    00126
    00127 C     * Fermeture du fichier *
    00128         call efferm (fid,cret)
    00129         print *,cret
    00130         if (cret .ne. 0 ) then
    00131            print *,'Erreur fermeture du fichier'
    00132            call efexit(-1)
    00133         endif
    00134 C
    00135         end
    00136
    00137
    00138
    00139
    00140
    00141