1 C*************************************************************************
  2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
  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 ngeo
 62       parameter (ngeo = 3)
 63       integer geo(ngeo)
 64       integer indgeo(ngeo+1)
 65       character*200 attdes,gro
 66       integer attval,attide
 67       integer typgeo
 68       integer indtmp
 69 C
 70       data nomgro    / "GROUPE1","GROUPE2","GROUPE3"    /
 71       data ent       /  1,2, 3,4,6, 1,4                 /
 72       data ind       /  1,   3,     6,   8              /
 73       data geo       /  MED_SEG2, MED_TRIA3, MED_TETRA4 /
 74       data indgeo    /  1,4,6,7 /
 75 C      
 76 C     ** Creation du fichier test19.med
 77       call efouvr(fid,'test19.med',MED_LECTURE_ECRITURE, cret)
 78       print *,cret
 79       if (cret .ne. 0 ) then
 80          print *,'Erreur creation du fichier'
 81          call efexit(-1)
 82       endif
 83       print *,'Creation du fichier test19.med'
 84 C
 85 C     ** Creation du maillage
 86       call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,des,cret)
 87       print *,cret
 88       if (cret .ne. 0 ) then
 89          print *,'Erreur creation du maillage'
 90          call efexit(-1)
 91       endif
 92       print *,'Creation du maillage'
 93 C
 94 C     ** Creation de la famille 0
 95       call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0,
 96      &               cret)
 97       print *,cret
 98       if (cret .ne. 0 ) then
 99          print *,'Erreur creation de la famille 0'
100          call efexit(-1)
101       endif
102       print *,'Creation de la famille 0'
103 C
104 C     ** Creation des familles de noeuds
105       call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_NOEUD,
106      &               typgeo,indtmp,0,cret)
107       print *,cret
108       if (cret .ne. 0 ) then
109          print *,'Erreur creation des familles de noeud'
110          call efexit(-1)
111       endif
112       print *,'Creation des familles de noeuds dans test19.med'
113 C
114 C     ** Creation des familles de mailles
115       call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,MED_MAILLE,
116      &               geo,indgeo,ngeo,cret)
117       print *,cret
118       if (cret .ne. 0 ) then
119          print *,'Erreur creation des familles de maille'
120          call efexit(-1)
121       endif
122       print *,'Creation des familles de mailles dans test19.med'
123 C      
124 C     ** Fermeture du fichier
125       call efferm (fid,cret)
126       print *,cret
127       if (cret .ne. 0 ) then
128          print *,'Erreur fermeture du fichier'
129          call efexit(-1)
130       endif
131       print *,'Fermeture du fichier'
132 C
133       end