      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