     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
    20  C ******************************************************************************
    21  C * - Nom du fichier : test12.f
    22  C *
    23  C * - Description : ecriture d'une equivalence dans un maillage MED
    24  C *
    25  C ******************************************************************************
    26          program test12
    27  C
    28          implicit none
    29          include 'med.hf'
    30  C
    31  C
    32          integer cret,fid
    33          character*32 maa , equ
    34          character*200 des
    35          integer mdim ,ncor
    36          integer cor(6)
    37
    38          parameter (maa ="maa1",mdim = 3,ncor = 3 )
    39          data cor /1,2,3,4,5,6/, equ / "equivalence"/
    40          data des / "equivalence sur les mailles MED_TRIA3" /
    41
    42  C       ** Creation du fichier test12.med **
    43          call efouvr(fid,'test12.med',MED_CREATION, cret)
    44          print *,cret
    45
    46
    47  C       ** Creation du maillage **
    48          if (cret .eq. 0) then
    49              call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    50       &                 'Un maillage pour test12',cret)
    51          endif
    52          print *,cret
    53
    54  C       ** Creation de l'equivalence **
    55          if (cret .eq. 0) then
    56             call efequc(fid,maa,equ,des,cret)
    57          endif
    58          print *,cret
    59
    60  C       ** Ecriture des correspondances sur les mailles MED_TRIA3 **
    61          if (cret .eq. 0) then
    62            call efeque(fid,maa,equ,cor,ncor,
    63       &          MED_MAILLE,MED_TRIA3,cret)
    64          endif
    65          print *,cret
    66
    67  C ** Fermeture du fichier                                **
    68          call efferm (fid,cret)
    69          print *,cret
    70
    71          end