      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 : test23.f
     21 C       *
     22 C       * - Description : ecriture de mailles MED_POLYGONE dans un maillage MED
     23 C       *
     24 C       ******************************************************************************
     25         program test23
     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 ni, n
     34         parameter (ni=4, n=3)
     35         integer index(ni)
     36         character*16 nom(n)
     37         integer num(n),fam(n)
     38         integer con(16)
     39 C
     40         data con  / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /
     41         data nom  / "poly1", "poly2", "poly3"/
     42         data num  / 1,2,3 /, fam /0,-1,-2/
     43         data index /1,6,12,17/
     44         data maa /"maa1"/
     45
     46 C       ** Creation du fichier test23.med                   **
     47         call efouvr(fid,'test23.med',MED_LECTURE_ECRITURE, cret)
     48         print *,cret
     49         if (cret .ne. 0 ) then
     50            print *,'Erreur creation du fichier'
     51            call efexit(-1)
     52         endif
     53         print *,'Creation du fichier test23.med'
     54
     55 C       ** Creation du maillage          **
     56         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     57      &                 'un maillage pour test23',cret)
     58         print *,cret
     59         if (cret .ne. 0 ) then
     60            print *,'Erreur creation du maillage'
     61            call efexit(-1)
     62         endif
     63         print *,'Creation du maillage'
     64
     65 C       ** Ecriture de la connectivite des mailles polygones **
     66         call efpgce(fid,maa,index,ni,con,MED_MAILLE,MED_NOD,cret)
     67         if (cret .ne. 0 ) then
     68            print *,'Erreur ecriture des connectivite polygones'
     69            call efexit(-1)
     70         endif
     71         print *,cret
     72         print *,'Ecriture des connectivites des mailles de type
     73      & MED_POLYGONE'
     74
     75 C       ** Ecriture des noms des mailles polygones          **
     76         call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYGONE,
     77      &                 cret)
     78         print *,cret
     79         if (cret .ne. 0 ) then
     80            print *,'Erreur ecriture des noms polygones'
     81            call efexit(-1)
     82         endif
     83         print *,'Ecriture des noms des polygones'
     84
     85 C       ** Ecriture des numeros des mailles polygones **
     86         call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYGONE,
     87      &                 cret)
     88         if (cret .ne. 0 ) then
     89            print *,'Erreur ecriture des numeros polygones'
     90            call efexit(-1)
     91         endif
     92         print *,cret
     93         print *,'Ecriture des numeros des polygones'
     94
     95 C       ** Ecriture des numeros des familles des segments  **
     96         call effame(fid,maa,fam,n,
     97      &              MED_MAILLE,MED_POLYGONE,cret)
     98         if (cret .ne. 0 ) then
     99            print *,'Erreur ecriture des numeros de famille polygones'
    100            call efexit(-1)
    101         endif
    102         print *,cret
    103         print *,'Ecriture des numeros de familles des polygones'
    104
    105 C       ** Fermeture du fichier                            **
    106         call efferm (fid,cret)
    107         print *,cret
    108         if (cret .ne. 0 ) then
    109            print *,'Erreur fermeture du fichier'
    110            call efexit(-1)
    111         endif
    112         print *,'Fermeture du fichier'
    113 C
    114         end