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*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 

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