      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