     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 : 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_CREATION, cret)
    48          print *,cret
    49          print *,'Creation du fichier test23.med'
    50
    51  C       ** Creation du maillage          **
    52          if (cret .eq. 0) then
    53              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    54       &                 'un maillage pour test23',cret)
    55          endif
    56          print *,cret
    57          print *,'Creation du maillage'
    58
    59  C       ** Ecriture de la connectivite des mailles polygones **
    60          if (cret .eq. 0) then
    61              call efpgce(fid,maa,index,ni,con,MED_MAILLE,MED_NOD,cret)
    62          endif
    63          print *,cret
    64          print *,'Ecriture des connectivites des mailles de type MED_POLYGONE'
    65
    66  C       ** Ecriture des noms des mailles polygones          **
    67          if (cret .eq. 0) then
    68              call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYGONE,
    69       &                 cret)
    70          endif
    71          print *,cret
    72          print *,'Ecriture des noms des polygones'
    73
    74  C       ** Ecriture des numeros des mailles polygones **
    75          if (cret .eq. 0) then
    76             call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYGONE,
    77       &                 cret)
    78          endif
    79          print *,cret
    80          print *,'Ecriture des numeros des polygones'
    81
    82  C       ** Ecriture des numeros des familles des segments  **
    83          if (cret .eq. 0) then
    84           call effame(fid,maa,fam,n,
    85       &              MED_MAILLE,MED_POLYGONE,cret)
    86          endif
    87          print *,cret
    88          print *,'Ecriture des numeros de familles des polygones'
    89
    90  C       ** Fermeture du fichier                            **
    91          call efferm (fid,cret)
    92          print *,cret
    93          print *,'Fermeture du fichier'
    94
    95          end