1  C*************************************************************************
 2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
 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,ret, fid,cres,type
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
42  C ** lecture du nombre de maillage                      **
43        if (cret .eq. 0) then
44           call efnmaa(fid,nmaa,cret)
45           print *,'Nombre de maillages = ',nmaa
46        endif
47        print *,cret
48
49  C ** lecture des infos sur les maillages : **
50  C ** - nom, dimension, type,description
51  C ** - options : nom universel, dimension de l'espace
52        if (cret.eq.0) then
53           do i=1,nmaa
54              if (cret.eq.0) then
55                 call efmaai(fid,i,maa,mdim,type,desc,cret)
56                 edim = -1
57                 call efespl(fid,maa,edim,cres)
58                 call efunvl(fid,maa,nomu,ret)
59                 cret = cret + ret
60                 print '(A,I1,A,A4,A,I1,A,A65,A65)','maillage '
61       &                ,i,' de nom ',maa,' et de dimension ',mdim,
62       &                ' de description ',desc
63       &                ,'et de nom univ. ',nomu
64                 if (type .eq. MED_NON_STRUCTURE) then
65                    print *,'Maillage non structure'
66                 else
67                    print *,'Maillage structure'
68                 endif
69                 if (cres .eq. 0) then
70                    print *,'Dimension espace ', edim
71                 else
72                    print *,'Dimension espace ', mdim
73                 endif
74                 print *,cret
75              endif
76           enddo
77        endif
78
79  C **  fermeture du fichier
80        call efferm (fid,cret)
81        print *,cret
82
83        end
84