      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 : test29.f
     22 C *
     23 C * - Description : ecriture d'un joint dans un maillage MED
     24 C *
     25 C ******************************************************************************
     26         program test29
     27 C
     28         implicit none
     29         include 'med.hf'
     30 C
     31 C
     32         integer cret,fid, domdst
     33         character*32 maa , jnt, maadst
     34         character*200 des
     35         integer mdim ,ncor
     36         integer cor(6)
     37
     38         parameter (maa ="maa1",maadst="maa1", domdst=2,
     39      &     mdim = 3,ncor = 3 )
     40         data cor /1,2,3,4,5,6/, jnt / "joint"/
     41         data des / "joint avec le sous-domaine 2" /
     42
     43
     44
     45 C  ** Creation du fichier test29.med **
     46         call efouvr(fid,'test29.med',MED_LECTURE_ECRITURE, cret)
     47         print *,cret
     48         if (cret .ne. 0 ) then
     49            print *,'Erreur creation du fichier'
     50            call efexit(-1)
     51         endif
     52
     53
     54 C  ** Creation du maillage **
     55         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     56      &                 'Un maillage pour test29',cret)
     57         print *,cret
     58         if (cret .ne. 0 ) then
     59            print *,'Erreur creation du maillage'
     60            call efexit(-1)
     61         endif
     62
     63 C ** Creation du joint **
     64         call efjntc(fid,maa,jnt,des,domdst,maadst,cret)
     65         print *,cret
     66         if (cret .ne. 0 ) then
     67            print *,'Erreur creation joint'
     68            call efexit(-1)
     69         endif
     70
     71
     72 C ** Ecriture de la correspondance Noeud, Noeud **
     73         call efjnte(fid,maa,jnt,cor,ncor,
     74      &    MED_NOEUD,0,MED_NOEUD,0,
     75      &    cret)
     76         print *,cret
     77         if (cret .ne. 0 ) then
     78            print *,'Erreur ecriture correspondance (Noeud,Noeud)'
     79            call efexit(-1)
     80         endif
     81
     82
     83 C ** Ecriture de la correspondance Noeud, TRIA3 **
     84         call efjnte(fid,maa,jnt,cor,ncor,
     85      &    MED_NOEUD,0,MED_MAILLE,MED_TRIA3,
     86      &    cret)
     87         print *,cret
     88         if (cret .ne. 0 ) then
     89            print *,'Erreur ecriture correspondance (Noeud,Tria3)'
     90            call efexit(-1)
     91         endif
     92
     93 C ** Fermeture du fichier                                **
     94         call efferm (fid,cret)
     95         print *,cret
     96         if (cret .ne. 0 ) then
     97            print *,'Erreur fermeture du fichier'
     98            call efexit(-1)
     99         endif
    100 C
    101         end