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