C*************************************************************************
C COPYRIGHT (C) 1999 - 2003  EDF R&D
C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
C
C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
C
C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
C
C**************************************************************************

C       *******************************************************************************
C       * - Nom du fichier : test6.f
C       *
C       * - Description : exemples d'ecriture d'elements dans un maillage MED
C       *
C       ******************************************************************************
	program test6
C       
	implicit none
	include 'med.hf'
C
C	
	integer cret, fid
	
	integer     mdim,nse2,ntr3
	parameter  (nse2 = 5, ntr3 = 2, mdim = 2)
	integer     se2 (2*nse2)
	character*16 nomse2(nse2)
	integer     numse2(nse2),nufase2(nse2)

	integer     tr3 (3*ntr3)
	character*16 nomtr3(ntr3)
	integer     numtr3(ntr3), nufatr3(ntr3) 
	character*32 maa 

	data se2     / 1,2,1,3,2,4,3,4,2,3 /    
	data nomse2  /"se1","se2","se3","se4","se5" / 
	data numse2  / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
	data tr3     /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/, numtr3 /4,5/
	data nufatr3 /0,-1/,  maa /"maa1"/

C       ** Ouverture du fichier                            **
 	call efouvr(fid,'test6.med',MED_CREATION, cret)
	print *,cret

C       ** Creation du maillage maa de dimension 2         **
	if (cret .eq. 0) then
	   call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
     &                 'un maillage pour test6',cret)
	endif
	print *,cret

C       ** Ecriture des connectivites des segments         **
	if (cret .eq. 0) then
	   call efcone(fid,maa,mdim,se2,MED_NO_INTERLACE,
     &               nse2,MED_ARETE,
     &               MED_SEG2,MED_DESC,cret ) 
	endif
	print *,cret

C       ** Ecriture (optionnelle) des noms des segments    **
	if (cret .eq. 0) then
	   call efnome(fid,maa,nomse2,nse2,MED_ARETE,
     &	                      MED_SEG2 ,cret)
	endif
	print *,cret
C       ** Ecriture (optionnelle) des numeros des segments **
	if (cret .eq. 0) then
	   call efnume(fid,maa,numse2,nse2,
     &              MED_ARETE ,MED_SEG2,cret)
	endif
	print *,cret

C	** Ecriture des numeros des familles des segments  **
	if (cret .eq. 0) then
         call effame(fid,maa,nufase2,nse2,
     &              MED_ARETE,MED_SEG2,cret)
	endif
	print *,cret

C       ** Ecriture des connectivites des triangles        **
	if (cret .eq. 0) then
	   call efcone(fid,maa,mdim,tr3,MED_NO_INTERLACE,
     &              ntr3,MED_MAILLE,
     &	            MED_TRIA3,MED_DESC,cret ) 
	endif
	print *,cret
C       ** Ecriture (optionnelle) des noms des triangles   **
	if (cret .eq. 0) then
	   call efnome(fid,maa,nomtr3,ntr3,MED_MAILLE,
     &	                      MED_TRIA3,cret)
	endif
C       ** Ecriture (optionnelle) des numeros des triangles **
	if (cret .eq. 0) then
	   call efnume(fid,maa,numtr3,ntr3,MED_MAILLE,
     &                       MED_TRIA3,cret)
	endif
	print *,cret

C      ** Ecriture des numeros des familles des triangles  **
	if (cret .eq. 0) then
         call effame(fid,maa,nufatr3,ntr3,MED_MAILLE,
     &                      MED_TRIA3,cret)
	endif
	print *,cret

C       ** Fermeture du fichier   **
	call efferm (fid,cret)
	print *,cret
	
	end
