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

! ******************************************************************************
! * - Nom du fichier : test13.f90
! *
! * - Description : lecture des equivalences dans un maillage MED.
! *
! ******************************************************************************

program test13
  
  implicit none
  include 'med.hf'
!
!
  integer      ret,cret,fid
  character*32 maa
  integer      mdim,nequ,ncor
  integer, allocatable, dimension(:) :: cor
  character*32  equ
  character*200 des
  integer       i,j,k
  character*255 argc
  integer, parameter :: MED_NBR_MAILLE_EQU = 8
  integer,parameter  :: typmai(MED_NBR_MAILLE_EQU) =  (/ MED_POINT1,MED_SEG2,   &
                                                      &  MED_SEG3,MED_TRIA3,    &
                                                      &  MED_TRIA6,MED_QUAD4,   &
                                                      &  MED_QUAD8,MED_POLYGONE/)

   integer,parameter :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,       &
					&	 MED_QUAD4,MED_QUAD8, MED_POLYGONE/)
   integer,parameter ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
   character*200 desc
   integer type
 
   print *,"Indiquez le fichier med a decrire : "
   read(*,*) argc

   !  ** Ouverture du fichier en lecture seule **
   call efouvr(fid,argc,MED_LECTURE, cret)
   print *,cret
   
     
   !  ** Lecture des infos sur le premier maillage **
   if (cret.eq.0) then
      call efmaai(fid,1,maa,mdim,type,desc,cret)
      print *,"Maillage de nom : ",maa," et de dimension : ", mdim
   endif
   print *,cret


   !  ** Lecture du nombre d'equivalence  **
   if (cret.eq.0) then
      call efnequ(fid,maa,nequ,cret)
      if (cret.eq.0) then
         print *,"Nombre d'equivalences : ",nequ
      endif
   endif
 
   !** Lecture de toutes les equivalences **
   if (cret.eq.0) then
      do i=1,nequ
         print *,"Equivalence numero : ",i
         !** Lecture des infos sur l'equivalence **
         if (cret.eq.0) then
            call efequi(fid,maa,i,equ,des,cret)
         endif
         print *,cret
         if (cret.eq.0) then
            print *,"Nom de l'equivalence : ",equ          
            print *,"Description de l'equivalence : ",des 
         endif

         !** Lecture des correspondances sur les differents types d'entites **
         if (cret.eq.0) then
	    !** Les noeuds **
            call efncor(fid,maa,equ,MED_NOEUD,0,ncor,cret)
            print *,"Il y a ",ncor," correspondances sur les noeuds "
            if (ncor > 0) then
               allocate(cor(ncor*2),STAT=ret)
               call efequl(fid,maa,equ,cor,ncor,MED_NOEUD,0,cret)
               do j=0,(ncor-1)
                  print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
               end do
               deallocate(cor)
            end if
	    
	    !** Les mailles : on ne prend pas en compte les mailles 3D **

            do j=1,MED_NBR_MAILLE_EQU
               call efncor(fid,maa,equ,MED_MAILLE,typmai(j),ncor,cret)
               print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
               if (ncor > 0 ) then
                  allocate(cor(2*ncor),STAT=ret)
                  call efequl(fid,maa,equ,cor,ncor,MED_MAILLE,typmai(j),cret)
                  do k=0,(ncor-1)
                     print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
                  end do
                  deallocate(cor)
               endif
            end do

	    ! ** Les faces **
            do j=1,MED_NBR_GEOMETRIE_FACE+1
               call efncor(fid,maa,equ,MED_FACE,typfac(j),ncor,cret)
               print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
               if (ncor > 0 ) then
                  allocate(cor(2*ncor),STAT=ret)
                  call efequl(fid,maa,equ,cor,ncor,MED_FACE,typfac(j),cret)
                  do k=0,(ncor-1)
                     print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
                  end do
                  deallocate(cor)
               endif
            end do

	    ! **  Les aretes **
            do j=1,MED_NBR_GEOMETRIE_ARETE
               call efncor(fid,maa,equ,MED_ARETE,typare(j),ncor,cret)
               print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
               if (ncor > 0 ) then
                  allocate(cor(2*ncor),STAT=ret)
                  call efequl(fid,maa,equ,cor,ncor,MED_ARETE,typare(j),cret)
                  do k=0,(ncor-1)
                     print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
                  end do
                  deallocate(cor)
               endif
            end do

         end if
      end do
   end if

!  ** Fermeture du fichier   **
   call efferm (fid,cret)
   print *,cret
   
 end program test13
	




