      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 : test25.f
     21  C       *
     22  C       * - Description : ecriture de mailles MED_POLYEDRE dans un maillage MED
     23  C       *
     24  C       ******************************************************************************
     25          program test25
     26  C
     27          implicit none
     28          include 'med.hf'
     29  C
     30          integer cret, fid,mdim
     31          parameter  (mdim = 3)
     32          character*32 maa
     33          integer n
     34          parameter (n=2)
     35  C       Connectivite nodale
     36          integer np,nf
     37          parameter (nf=9,np=3)
     38          integer indexp(np),indexf(nf)
     39          integer conn(24)
     40  C       Connectivite descendante
     41          integer np2,nf2
     42          parameter (nf2=8,np2=3)
     43          integer indexp2(np2),indexf2(nf2)
     44          integer conn2(nf2)
     45          character*16 nom(n)
     46          integer num(n),fam(n)
     47  C
     48          data indexp / 1,5,9 /
     49          data indexf / 1,4,7,10,13,16,19,22,25 /
     50          data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24 /
     51          data indexp2 / 1,5,9 /
     52          data indexf2 / MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3 /
     53          data conn2 / 1,2,3,4,5,6,7,8 /
     54          data nom  / "poly1", "poly2"/
     55          data num  / 1,2 /, fam / 0,-1 /
     56          data maa /"maa1"/
     57
     58  C       ** Creation du fichier test25.med  **
     59          call efouvr(fid,'test25.med',MED_CREATION, cret)
     60          print *,cret
     61          print *,'Creation du fichier test25.med'
     62
     63  C       ** Creation du maillage          **
     64          if (cret .eq. 0) then
     65            call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     66       &                 'un maillage pour test25',cret)
     67          endif
     68          print *,cret
     69          print *,'Creation du maillage'
     70
     71  C       ** Ecriture des connectivites des mailles polyedres en mode nodal **
     72          if (cret .eq. 0) then
     73            call efpece(fid,maa,indexp,np,indexf,nf,conn,MED_NOD,cret)
     74          endif
     75          print *,cret
     76          print *,'Ecriture des connectivites des mailles de type MED_POLYEDRE'
     77          print *,'Description nodale'
     78
     79  C       ** Ecriture des connectivites des mailles polyedres en mode descendant **
     80          if (cret .eq. 0) then
     81            call efpece(fid,maa,indexp2,np2,indexf2,nf2,conn2,MED_DESC,cret)
     82          endif
     83          print *,cret
     84          print *,'Ecriture des connectivites des mailles de type MED_POLYEDRE'
     85          print *,'Description descendante'
     86
     87  C       ** Ecriture des noms des mailles polyedres          **
     88          if (cret .eq. 0) then
     89              call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYEDRE,
     90       &                 cret)
     91          endif
     92          print *,cret
     93          print *,'Ecriture des noms des polyedress'
     94
     95  C       ** Ecriture des numeros des mailles polyedres **
     96          if (cret .eq. 0) then
     97              call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYEDRE,
     98       &                 cret)
     99          endif
    100          print *,cret
    101          print *,'Ecriture des numeros des polyedres'
    102
    103  C       ** Ecriture des numeros des familles des segments  **
    104          if (cret .eq. 0) then
    105              call effame(fid,maa,fam,n,
    106       &              MED_MAILLE,MED_POLYEDRE,cret)
    107          endif
    108          print *,cret
    109          print *,'Ecriture des numeros de familles des polyedres'
    110
    111  C       ** Fermeture du fichier                            **
    112          call efferm (fid,cret)
    113          print *,cret
    114          print *,'Fermeture du fichier'
    115
    116          end