2.3.6/test8.f

Aller à la documentation de ce fichier.
00001 C*  This file is part of MED.
00002 C*
00003 C*  COPYRIGHT (C) 1999 - 2015  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 

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1