     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
    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_LECTURE_ECRITURE, cret)
    44         print *,cret
    45         if (cret .ne. 0 ) then
    46            print *,'Erreur creation du fichier'
    47            call efexit(-1)
    48         endif
    49
    50
    51 C  ** Creation du maillage **
    52         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
    53      &                 'Un maillage pour test12',cret)
    54         print *,cret
    55                 if (cret .ne. 0 ) then
    56            print *,'Erreur creation du maillage'
    57            call efexit(-1)
    58         endif
    59
    60 C ** Creation de l'equivalence **
    61         call efequc(fid,maa,equ,des,cret)
    62         print *,cret
    63         if (cret .ne. 0 ) then
    64            print *,'Erreur creation equivalence'
    65            call efexit(-1)
    66         endif
    67
    68 C ** Ecriture des correspondances sur les mailles MED_TRIA3 **
    69         call efeque(fid,maa,equ,cor,ncor,
    70      &          MED_MAILLE,MED_TRIA3,cret)
    71         print *,cret
    72         if (cret .ne. 0 ) then
    73            print *,'Erreur ecriture de correspondances'
    74            call efexit(-1)
    75         endif
    76
    77 C ** Fermeture du fichier                                **
    78         call efferm (fid,cret)
    79         print *,cret
    80         if (cret .ne. 0 ) then
    81            print *,'Erreur fermeture du fichier'
    82            call efexit(-1)
    83         endif
    84 C
    85         end