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