1C*  This file is part of MED.
2C*
3C*  COPYRIGHT (C) 1999 - 2019  EDF R&D, CEA/DEN
4C*  MED is free software: you can redistribute it and/or modify
5C*  it under the terms of the GNU Lesser General Public License as published by
6C*  the Free Software Foundation, either version 3 of the License, or
7C*  (at your option) any later version.
8C*
9C*  MED is distributed in the hope that it will be useful,
10C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
11C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12C*  GNU Lesser General Public License for more details.
13C*
14C*  You should have received a copy of the GNU Lesser General Public License
15C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C ******************************************************************************
19C * - Nom du fichier : test3.f
20C *
21C * - Description : lecture des informations sur les maillages dans un fichier
22C*                  MED.
23C *
24C ******************************************************************************
25      program test3
26C
27      implicit none
28      include 'med.hf'
29C
30C
31      integer*8     fid
32      integer       cret,cres,type,cnu
33      character*32  maa
34      character*80  nomu
35      character*200 desc
36      integer       nmaa,i,mdim,edim
37
38C ** 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
46C ** 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
55C ** lecture des infos sur les maillages : **
56C ** - nom, dimension, type,description
57C ** - 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
88C **  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
95C
96      end
97
98