# f/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 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