f/test19.f

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 : test19.f
00020 C *
00021 C * - Description : conversion groupes => familles
00022 C *
00023 C *****************************************************************************
00024       program test19
00025 C     
00026       implicit none
00027       include 'med.hf'
00028 C
00029 C
00030 C     Cas test obsolete avec MED 3.0, on laisse les appels à l'API 2.3
00031 C
00032       integer cret
00033       integer fid
00034       character *32 maa
00035       parameter (maa = "maillage_test19")
00036       character*200 des
00037       parameter (des = "un maillage pour test19")
00038       integer mdim 
00039       parameter (mdim = 2)
00040 C     Donnees de tests pour MEDgro2FamCr() 
00041 C     Les noeuds/mailles sont numerotes de 1 a 5 et les
00042 C     groupes de 1 a 3.
00043 C     Au depart, on a :
00044 C     - G1 : 1,2
00045 C     - G2 : 3,4,6
00046 C     - G3 : 1,4
00047 C     Au retour, on foit avoir 4 familles de noeuds + 4 familles de mailles 
00048 C     + la famille 0 dans le fichier :
00049 C     - F0 : 5       - groupes : aucun groupe par defaut (convention habituelle).
00050 C     - F1 : 1       - groupes : G1,G3  
00051 C     - F2 : 2       - groupes : G1
00052 C     - F3 : 3,6     - groupes : G2
00053 C     - F4 : 4       - groupes : G2,G3
00054 C  
00055       integer ngroup 
00056       parameter (ngroup = 3)
00057       integer nent 
00058       parameter (nent = 6)
00059       character*80 nomgro(ngroup)
00060       integer ent(7)
00061       integer ind(ngroup+1)
00062       integer ngeo
00063       parameter (ngeo = 3)
00064       integer geo(ngeo)
00065       integer indgeo(ngeo+1)
00066       character*200 attdes,gro
00067       integer attval,attide
00068       integer typgeo
00069       integer indtmp
00070 C
00071       data nomgro    / "GROUPE1","GROUPE2","GROUPE3"    /
00072       data ent       /  1,2, 3,4,6, 1,4                 /
00073       data ind       /  1,   3,     6,   8              /
00074       data geo       /  MED_SEG2, MED_TRIA3, MED_TETRA4 /
00075       data indgeo    /  1,4,6,7 /
00076 C      
00077 C     ** Creation du fichier test19.med
00078       call efouvr(fid,'test19.med',MED_LECTURE_ECRITURE, cret)
00079       print *,cret
00080       if (cret .ne. 0 ) then
00081          print *,'Erreur creation du fichier'
00082          call efexit(-1)
00083       endif      
00084       print *,'Creation du fichier test19.med'
00085 C
00086 C     ** Creation du maillage
00087       call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,des,cret)
00088       print *,cret
00089       if (cret .ne. 0 ) then
00090          print *,'Erreur creation du maillage'
00091          call efexit(-1)
00092       endif      
00093       print *,'Creation du maillage'
00094 C
00095 C     ** Creation de la famille 0
00096       call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0,
00097      &               cret)
00098       print *,cret
00099       if (cret .ne. 0 ) then
00100          print *,'Erreur creation de la famille 0'
00101          call efexit(-1)
00102       endif      
00103       print *,'Creation de la famille 0'
00104 C
00105 C     ** Creation des familles de noeuds
00106       call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_NOEUD,
00107      &               typgeo,indtmp,0,cret)
00108       print *,cret
00109       if (cret .ne. 0 ) then
00110          print *,'Erreur creation des familles de noeud'
00111          call efexit(-1)
00112       endif      
00113       print *,'Creation des familles de noeuds dans test19.med'
00114 C
00115 C     ** Creation des familles de mailles
00116       call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_MAILLE,
00117      &               geo,indgeo,ngeo,cret)
00118       print *,cret
00119       if (cret .ne. 0 ) then
00120          print *,'Erreur creation des familles de maille'
00121          call efexit(-1)
00122       endif      
00123       print *,'Creation des familles de mailles dans test19.med'
00124 C      
00125 C     ** Fermeture du fichier
00126       call efferm (fid,cret)
00127       print *,cret
00128       if (cret .ne. 0 ) then
00129          print *,'Erreur fermeture du fichier'
00130          call efexit(-1)
00131       endif      
00132       print *,'Fermeture du fichier'
00133 C
00134       end

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