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 : test24.f
20C       *
21C       * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
22C       *                 du fichier test23.med
23C       *
24C       ******************************************************************************
25	program test23
26C
27	implicit none
28	include 'med.hf'
29C
30	integer*8 fid
31	integer cret,mdim,nmaa,npoly,i,j,k,taille
32        integer edim,nstep,stype,atype, chgt, tsf
33	character*64 maa
34 	character*200 desc
35        integer ni, n, isize;
36	parameter (ni=4, n=3)
37	integer index(ni),ind1,ind2
38	character*16 nom(n)
39	integer num(n),fam(n)
40        integer con(16)
41	integer type
42	character*16 nomcoo(2)
43	character*16 unicoo(2)
44	character(16)  :: dtunit
45C
46C       Ouverture du fichier test23.med en lecture seule
47	call mfiope(fid,'test23.med',MED_ACC_RDONLY, cret)
48        print *,cret
49	if (cret .ne. 0 ) then
50	   print *,'Erreur ouverture du fichier'
51	   call efexit(-1)
52	endif
53        print *,'Ouverture du fichier test23.med'
54C
55C       Lecture du nombre de maillages
56	call mmhnmh(fid,nmaa,cret)
57	print *,cret
58	if (cret .ne. 0 ) then
59	   print *,'Erreur lecture nombre de maillage'
60	   call efexit(-1)
61	endif
62	print *,'Nombre de maillages : ',nmaa
63C
64C       Lecture de toutes les mailles MED_POLYGONE
65C       dans chaque maillage
66	do 10 i=1,nmaa
67C
68C          Info sur chaque maillage
69	   call mmhmii(fid,i,maa,edim,mdim,type,desc,
70     &	               dtunit,stype,nstep,atype,
71     &		       nomcoo,unicoo,cret)
72	   if (cret .ne. 0 ) then
73	      print *,'Erreur lecture infos maillage'
74	      call efexit(-1)
75	   endif
76	   print *,cret
77	   print *,'Maillage : ',maa
78	   print *,'Dimension : ',mdim
79C
80C          Combien de mailles polygones
81           call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
82     &                 MED_INDEX_NODE,MED_NODAL,chgt,tsf,isize,cret)
83	   npoly = isize - 1;
84	   print *,cret
85	   if (cret .ne. 0 ) then
86	      print *,'Erreur lecture du nombre de polygone'
87	      call efexit(-1)
88	   endif
89	   print *,'Nombre de mailles MED_POLYGONE : ',npoly
90C
91C          Taille des connectivites
92           call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
93     &                 MED_CONNECTIVITY,MED_NODAL,chgt,tsf,taille,cret)
94	   print *,cret
95	   if (cret .ne. 0 ) then
96	      print *,'Erreur lecture infos polygones'
97	      call efexit(-1)
98	   endif
99	   print *,'Taille de la connectivite : ',taille
100C
101C          Lecture de la connectivite
102	   call mmhpgr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
103     &                 MED_NODAL,index,con,cret)
104	   print *,cret
105	   if (cret .ne. 0 ) then
106	      print *,'Erreur lecture des connectivites polygones'
107	      call efexit(-1)
108	   endif
109	   print *,'Lecture de la connectivite des polygones'
110C
111C          Lecture des noms
112	   call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
113     &                 MED_CELL,MED_POLYGON,nom,cret)
114	   print *,cret
115	   if (cret .ne. 0 ) then
116	      print *,'Erreur lecture des noms des polygones'
117	      call efexit(-1)
118	   endif
119	   print *,'Lecture des noms'
120C
121C          Lecture des numeros
122	   call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
123     &                 num,cret)
124	   print *,cret
125	   if (cret .ne. 0 ) then
126	      print *,'Erreur lecture des numeros des polygones'
127	      call efexit(-1)
128	   endif
129	   print *,'Lecture des numeros'
130C
131C          Lecture des numeros de familles
132	   call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,MED_POLYGON,
133     &                 fam,cret)
134	   print *,cret
135	   if (cret .ne. 0 ) then
136	      print *,'Erreur lecture des numeros de famille des
137     & polygones'
138	      call efexit(-1)
139	   endif
140	   print *,'Lecture des numeros de famille'
141C
142C          Affichage des resultats
143	   print *,'Affichage des resultats'
144	   do 20 j=1,npoly
145C
146	      print *,'>> Maille polygone ',j
147	      print *,'---- Connectivite      ---- : '
148	      ind1 = index(j)
149	      ind2 = index(j+1)
150	      do 30 k=ind1,ind2-1
151		 print *,con(k)
152 30	      continue
153c	      print *,'---- Nom               ---- : ',nom(j)
154	      print *,'---- Numero            ----:  ',num(j)
155	      print *,'---- Numero de famille ---- : ',fam(j)
156C
157 20	   continue
158C
159 10	continue
160C
161C       Fermeture du fichier
162	call mficlo(fid,cret)
163	print *,cret
164	if (cret .ne. 0 ) then
165	   print *,'Erreur fermeture du fichier'
166	   call efexit(-1)
167	endif
168	print *,'Fermeture du fichier'
169C
170        end
171