1  C*************************************************************************
  2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
  3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
  4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
  5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
  6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
  7  C
  8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
  9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
 10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
 11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
 12  C
 13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
 14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
 15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
 16  C
 17  C**************************************************************************
 18
 19  C******************************************************************************
 20  C * - Nom du fichier : test19.f
 21  C *
 22  C * - Description : conversion groupes => familles
 23  C *
 24  C *****************************************************************************
 25        program test19
 26  C     
 27        implicit none
 28        include 'med.hf'
 29  C
 30  C
 31        integer cret
 32        integer fid
 33        character *32 maa
 34        parameter (maa = "maillage_test19")
 35        character*200 des
 36        parameter (des = "un maillage pour test19")
 37        integer mdim
 38        parameter (mdim = 2)
 39  C     Donnees de tests pour MEDgro2FamCr() 
 40  C     Les noeuds/mailles sont numerotes de 1 a 5 et les
 41  C     groupes de 1 a 3.
 42  C     Au depart, on a :
 43  C     - G1 : 1,2
 44  C     - G2 : 3,4,6
 45  C     - G3 : 1,4
 46  C     Au retour, on foit avoir 4 familles de noeuds + 4 familles de mailles 
 47  C     + la famille 0 dans le fichier :
 48  C     - F0 : 5       - groupes : aucun groupe par defaut (convention habituelle).
 49  C     - F1 : 1       - groupes : G1,G3  
 50  C     - F2 : 2       - groupes : G1
 51  C     - F3 : 3,6     - groupes : G2
 52  C     - F4 : 4       - groupes : G2,G3
 53  C  
 54        integer ngroup
 55        parameter (ngroup = 3)
 56        integer nent
 57        parameter (nent = 6)
 58        character*80 nomgro(ngroup)
 59        integer ent(7)
 60        integer ind(ngroup+1)
 61        integer i
 62        integer ngeo
 63        parameter (ngeo = 3)
 64        integer geo(ngeo)
 65        integer indgeo(ngeo+1)
 66        character*200 attdes,gro
 67        integer attval,attide
 68        integer typgeo
 69        integer indtmp
 70  C
 71        data nomgro    / "GROUPE1","GROUPE2","GROUPE3"    /
 72        data ent       /  1,2, 3,4,6, 1,4                 /
 73        data ind       /  1,   3,     6,   8              /
 74        data geo       /  MED_SEG2, MED_TRIA3, MED_TETRA4 /
 75        data indgeo    /  1,4,6,7 /
 76  C      
 77  C     ** Creation du fichier test19.med
 78        call efouvr(fid,'test19.med',MED_CREATION, cret)
 79        print *,cret
 80        print *,'Creation du fichier test19.med'
 81  C
 82  C     ** Creation du maillage
 83        if (cret .eq. 0) then
 84           call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,des,cret)
 85           print *,cret
 86           print *,'Creation du maillage'
 87        endif
 88  C
 89  C     ** Creation de la famille 0
 90        if (cret .eq. 0) then
 91           call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0,
 92       &               cret)
 93           print *,cret
 94           print *,'Creation de la famille 0'
 95        endif
 96  C
 97  C     ** Creation des familles de noeuds
 98        if (cret .eq. 0) then
 99           call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_NOEUD,
100       &               typgeo,indtmp,0,cret)
101           print *,cret
102           print *,'Creation des familles de noeuds dans test19.med'
103        endif
104  C
105  C     ** Creation des familles de mailles
106        if (cret .eq. 0) then
107           call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_MAILLE,
108       &               geo,indgeo,ngeo,cret)
109           print *,cret
110           print *,'Creation des familles de mailles dans test19.med'
111        endif
112  C      
113  C     ** Fermeture du fichier
114        call efferm (fid,cret)
115        print *,cret
116        print *,'Fermeture du fichier'
117  C
118        end