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