      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