      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 : 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,
     51      &              15,16,17,18,19,20,21,22,23,24 /
     52         data indexp2 / 1,5,9 /
     53         data indexf2 / MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,
     54      &                 MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3 /
     55         data conn2 / 1,2,3,4,5,6,7,8 /
     56         data nom  / "poly1", "poly2"/
     57         data num  / 1,2 /, fam / 0,-1 /
     58         data maa /"maa1"/
     59
     60 C       ** Creation du fichier test25.med  **
     61         call efouvr(fid,'test25.med',MED_LECTURE_ECRITURE, cret)
     62         print *,cret
     63         if (cret .ne. 0 ) then
     64            print *,'Erreur creation du fichier'
     65            call efexit(-1)
     66         endif
     67         print *,'Creation du fichier test25.med'
     68
     69 C       ** Creation du maillage          **
     70         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     71      &                 'un maillage pour test25',cret)
     72         if (cret .ne. 0 ) then
     73            print *,'Erreur creation du maillage'
     74            call efexit(-1)
     75         endif
     76         print *,cret
     77         print *,'Creation du maillage'
     78
     79 C       ** Ecriture des connectivites des mailles polyedres en mode nodal **
     80         call efpece(fid,maa,indexp,np,indexf,nf,conn,MED_NOD,cret)
     81         print *,cret
     82         if (cret .ne. 0 ) then
     83            print *,'Erreur ecriture connectivite des polyedres'
     84            call efexit(-1)
     85         endif
     86         print *,'Ecriture des connectivites des mailles
     87      & de type MED_POLYEDRE'
     88         print *,'Description nodale'
     89
     90 C       ** Ecriture des connectivites des mailles polyedres en mode descendant **
     91         call efpece(fid,maa,indexp2,np2,indexf2,nf2,conn2,MED_DESC,cret)
     92         print *,cret
     93         if (cret .ne. 0 ) then
     94            print *,'Erreur ecriture connectivite des polyedres'
     95            call efexit(-1)
     96         endif
     97         print *,'Ecriture des connectivites des mailles
     98      & de type MED_POLYEDRE'
     99         print *,'Description descendante'
    100
    101 C       ** Ecriture des noms des mailles polyedres          **
    102         call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYEDRE,
    103      &                 cret)
    104         print *,cret
    105         if (cret .ne. 0 ) then
    106            print *,'Erreur ecriture noms des polyedres'
    107            call efexit(-1)
    108         endif
    109         print *,'Ecriture des noms des polyedress'
    110
    111 C       ** Ecriture des numeros des mailles polyedres **
    112         call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYEDRE,
    113      &                 cret)
    114         print *,cret
    115         if (cret .ne. 0 ) then
    116            print *,'Erreur ecriture numeros des polyedres'
    117            call efexit(-1)
    118         endif
    119         print *,'Ecriture des numeros des polyedres'
    120
    121 C       ** Ecriture des numeros des familles des segments  **
    122         call effame(fid,maa,fam,n,
    123      &              MED_MAILLE,MED_POLYEDRE,cret)
    124         print *,cret
    125         if (cret .ne. 0 ) then
    126            print *,'Erreur ecriture numeros de familles polyedres'
    127            call efexit(-1)
    128         endif
    129         print *,'Ecriture des numeros de familles des polyedres'
    130
    131 C       ** Fermeture du fichier                            **
    132         call efferm (fid,cret)
    133         print *,cret
    134         if (cret .ne. 0 ) then
    135            print *,'Erreur fermeture du fichier'
    136            call efexit(-1)
    137         endif
    138         print *,'Fermeture du fichier'
    139 C
    140         end