     1 C*************************************************************************
     2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
     3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
     4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
     5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
     6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
     7 C
     8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
     9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
    10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
    11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
    12 C
    13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
    14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
    15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
    16 C
    17 C**************************************************************************
    18
    19 C ******************************************************************************
    20 C * - Nom du fichier : test3.f
    21 C *
    22 C * - Description : lecture des informations sur les maillages dans un fichier
    23 C*                  MED.
    24 C *
    25 C ******************************************************************************
    26       program test3
    27 C
    28       implicit none
    29       include 'med.hf'
    30 C
    31 C
    32       integer       cret,fid,cres,type,cnu
    33       character*32  maa
    34       character*80  nomu
    35       character*200 desc
    36       integer       nmaa,i,mdim,edim
    37
    38 C ** Ouverture du fichier en lecture seule
    39       call efouvr(fid,'test2.med',MED_LECTURE, cret)
    40       print *,cret
    41       if (cret .ne. 0 ) then
    42          print *,'Erreur ouverture du fichier en lecture'
    43          call efexit(-1)
    44       endif
    45
    46 C ** lecture du nombre de maillage                      **
    47       call efnmaa(fid,nmaa,cret)
    48       print *,cret
    49       if (cret .ne. 0 ) then
    50          print *,'Erreur lecture du nombre de maillage'
    51          call efexit(-1)
    52       endif
    53       print *,'Nombre de maillages = ',nmaa
    54
    55 C ** lecture des infos sur les maillages : **
    56 C ** - nom, dimension, type,description
    57 C ** - options : nom universel, dimension de l'espace
    58       do i=1,nmaa
    59          call efmaai(fid,i,maa,mdim,type,desc,cret)
    60          edim = -1
    61          call efespl(fid,maa,edim,cres)
    62          call efunvl(fid,maa,nomu,cnu)
    63          print *,cret
    64          if (cret .ne. 0 ) then
    65             print *,'Erreur acces au maillage'
    66             call efexit(-1)
    67          endif
    68          print '(A,I1,A,A4,A,I1,A,A65,A65)','maillage '
    69      &        ,i,' de nom ',maa,' et de dimension ',mdim,
    70      &        ' de description ',desc
    71          if (type .eq. MED_NON_STRUCTURE) then
    72             print *,'Maillage non structure'
    73          else
    74             print *,'Maillage structure'
    75          endif
    76          if (cres .eq. 0) then
    77             print *,'Dimension espace ', edim
    78          else
    79             print *,'Dimension espace ', mdim
    80          endif
    81          if (cnu .eq. 0) then
    82             print *,'Nom universel : ',nomu
    83          else
    84             print *,'Pas de nom universel'
    85          endif
    86       enddo
    87
    88 C **  fermeture du fichier
    89       call efferm (fid,cret)
    90       print *,cret
    91       if (cret .ne. 0 ) then
    92          print *,'Erreur fermeture du fichier'
    93          call efexit(-1)
    94       endif
    95 C
    96       end
    97