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 : test25.f
C       *
C       * - Description : ecriture de mailles MED_POLYEDRE dans un maillage MED
C       *
C       ******************************************************************************
	program test25
C       
	implicit none
	include 'med.hf'
C	
	integer cret, fid,mdim
	parameter  (mdim = 3)
	character*32 maa 	
        integer n
	parameter (n=2)
C       Connectivite nodale
	integer np,nf
	parameter (nf=9,np=3)
	integer indexp(np),indexf(nf)
	integer conn(24)
C       Connectivite descendante
	integer np2,nf2
	parameter (nf2=8,np2=3)
	integer indexp2(np2),indexf2(nf2)
	integer conn2(nf2)
	character*16 nom(n)
	integer num(n),fam(n)
C
	data indexp / 1,5,9 /
	data indexf / 1,4,7,10,13,16,19,22,25 /
	data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24 /    
	data indexp2 / 1,5,9 /
	data indexf2 / MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3,MED_TRIA3 /
	data conn2 / 1,2,3,4,5,6,7,8 /
	data nom  / "poly1", "poly2"/ 
	data num  / 1,2 /, fam / 0,-1 /
	data maa /"maa1"/

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

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

C       ** Ecriture des connectivites des mailles polyedres en mode nodal **
	if (cret .eq. 0) then
	   call efpece(fid,maa,indexp,np,indexf,nf,conn,MED_NOD,cret) 
	endif
	print *,cret
	print *,'Ecriture des connectivites des mailles de type MED_POLYEDRE'
	print *,'Description nodale'

C       ** Ecriture des connectivites des mailles polyedres en mode descendant **
	if (cret .eq. 0) then
	   call efpece(fid,maa,indexp2,np2,indexf2,nf2,conn2,MED_DESC,cret) 
	endif
	print *,cret
	print *,'Ecriture des connectivites des mailles de type MED_POLYEDRE'
	print *,'Description descendante'

C       ** Ecriture des noms des mailles polyedres          **
	if (cret .eq. 0) then
	   call efnome(fid,maa,nom,n,MED_MAILLE,MED_POLYEDRE,
     &		       cret)
	endif
	print *,cret
	print *,'Ecriture des noms des polyedress'

C       ** Ecriture des numeros des mailles polyedres **
	if (cret .eq. 0) then
	   call efnume(fid,maa,num,n,MED_MAILLE,MED_POLYEDRE,
     &                 cret)
	endif
	print *,cret
	print *,'Ecriture des numeros des polyedres'

C	** Ecriture des numeros des familles des segments  **
	if (cret .eq. 0) then
         call effame(fid,maa,fam,n,
     &              MED_MAILLE,MED_POLYEDRE,cret)
	endif
	print *,cret
	print *,'Ecriture des numeros de familles des polyedres'

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