1  !*************************************************************************
  2  ! COPYRIGHT (C) 1999 - 2003  EDF R&D
  3  ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
  4  ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
  5  ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
  6  ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
  7  !
  8  ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
  9  ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
 10  ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
 11  ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
 12  !
 13  ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
 14  ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
 15  ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
 16  !
 17  !**************************************************************************
 18
 19  ! ******************************************************************************
 20  ! * - Nom du fichier : test9.f90
 21  ! *
 22  ! * - Description : lecture des familles d'un maillage MED 
 23  ! *
 24  ! ******************************************************************************
 25  program test9
 26
 27    implicit none
 28    include 'med.hf'
 29  !
 30    integer        ret,cret,fid
 31    character*32   maa
 32    integer        mdim
 33    integer        nfam
 34    integer        i,j
 35    integer        natt,ngro
 36    character*200, allocatable, dimension (:) :: attdes
 37    character*80,  allocatable, dimension (:) :: gro
 38    integer,       allocatable, dimension (:) :: attval,attide
 39    character*32   nomfam
 40    character*200  desc
 41    integer        numfam
 42    integer        type
 43
 44
 45  !  ** Ouverture du fichier test8.med en lecture seule **
 46    call efouvr(fid,'test8.med',MED_LECTURE, cret)
 47    print *,cret
 48
 49  !  ** Lecture des infos sur le 1er maillage **
 50    if (cret.eq.0) then
 51       call efmaai(fid,1,maa,mdim,type,desc,cret)
 52       print *,"Maillage de nom : ",maa," et de dimension : ", mdim
 53    endif
 54    print *,cret
 55
 56  !  ** Lecture du nombre de famille **
 57    if (cret .eq. 0) then
 58       call efnfam(fid,maa,nfam,cret)
 59       print *,' Nombre de familles a lire : ',nfam
 60    endif
 61    print *,cret
 62
 63  !  ** Lecture de chaque famille **
 64    if (cret .eq. 0) then
 65       do i=1,nfam
 66
 67  !   ** Lecture du nombre de groupe **
 68          if (cret .eq. 0) then
 69             call efngro(fid,maa,i,ngro,cret)
 70          endif
 71          print *,cret
 72
 73  !   ** Lecture du nombre d'attribut **
 74          if (cret .eq. 0) then
 75             call efnatt(fid,maa,i,natt,cret)
 76          endif
 77          print *,cret
 78
 79          print *,"Famille ",i," a ",natt," attributs et ",ngro," groupes "
 80
 81  !   ** Lecture de : nom,numero,attributs,groupes **
 82          if (cret .eq. 0) then
 83             allocate(attide(natt),attval(natt),attdes(natt),gro(ngro),STAT=ret)
 84  !              print *,ret
 85
 86             call effami(fid,maa,i,nomfam,numfam,attide,     &
 87                  &                     attval,attdes,natt,gro,ngro,cret)
 88             print *,cret
 89             print *,"Famille de nom ",nomfam," et de numero ",numfam
 90             print *,"Attributs :"
 91             do j=1,natt
 92                print *,"ide = ",attide(j)," - val = ",attval(j)," - des = ",attdes(j)
 93             enddo
 94             deallocate(attide,attval,attdes)
 95
 96             do j=1,ngro
 97                print *,"gro = ",gro(j)
 98             enddo
 99             deallocate(gro)
100          endif
101       enddo
102    endif
103
104
105  !  ** Fermeture du fichier                                           **
106       call efferm (fid,cret)
107       print *,cret
108
109
110     end program test9
111
112