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 : test8.f
C *
C * - Description : exemple d'ecriture des familles d'un maillage MED 
C *
C *****************************************************************************
	program test8
C     
	implicit none
	include 'med.hf'
C
        integer cret, fid
        
        character*32  maa 
        integer       mdim
        character*32  nomfam
        integer       numfam
        character*200 attdes
        integer       natt, attide, attval
        integer       ngro
        character*80  gro
        integer       nfame, nfamn
        character*16   str
        
        parameter  ( mdim = 2, nfame = 3, nfamn = 2 )
        data       maa /"maa1"/
        
C     ** Creation du fichier test8.med                       **
 	call efouvr(fid,'test8.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 test8',cret)
	endif
	print *,cret
        
C     ** Ecriture des familles                           **
C     * Conventions :
C       - Toujours creer une famille de numero 0 ne comportant aucun attribut
C         ni groupe (famille de reference pour les noeuds ou les elements
C         qui ne sont rattaches a aucun groupe ni attribut)
C       - Les numeros de familles de noeuds sont > 0
C       - Les numeros de familles des elements sont < 0
C       - Rien d'imposer sur les noms de familles
C     **                                                 **

C     * Creation de la famille 0                                     **
	if (cret .eq. 0) then
           numfam = 0
           nomfam="FAMILLE_0"
           call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
     &          0,gro,0,cret)  
        endif
	print *,cret

C  * Creation pour correspondre aux cas tests precedents, 3 familles  *
C  *  d'elements (-1,-2,-3) et deux familles de noeuds (1,2)         *
	if (cret .eq. 0) then
           do numfam=-1,-3,-1
              if (cret .eq. 0) then
                 write(str,'(I1.0)') (-numfam)
                 nomfam = "FAMILLE_ELEMENT_"//str
                 attide = 1
                 attval = numfam*100
                 natt = 1
                 attdes="description attribut"
                 gro="groupe1"
                 ngro = 1
                 print *, nomfam," - ",numfam," - ",attide," - ",
     &                attval," - ",ngro

                 call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
     &                natt,gro,ngro,cret)  
                 print *,"MEDfamCr : ",cret
              endif
           end do
        end if
  
	if (cret .eq. 0) then
           do numfam=1,nfamn
              if (cret .eq. 0) then
                 write(str,'(I1.0)') numfam
                 nomfam = "FAMILLE_NOEUD_"//str
                 attide = 1
                 attval = numfam*100
                 natt = 1
                 attdes="description attribut"
                 gro="groupe1"
                 ngro = 1
                 print *, nomfam," - ",numfam," - ",attide," - ",
     &                attval," - ",ngro
                 call effamc(fid,maa,nomfam,numfam,attide,attval,attdes,
     &                natt,gro,ngro,cret)  
                 print *,"MEDfamCr : ",cret

              endif
           end do
         end if
               

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


	end 






