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 : test26.f
20C       *
21C       * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED
22C       *                 du fichier test25.med
23C       *
24C       ******************************************************************************
25	program test26
26C
27	implicit none
28	include 'med.hf'
29C
30	integer*8 fid
31	integer cret,mdim,nmaa,npoly,i,j,k,l,nfindex
32        integer edim,nstep,stype,atype, chgt, tsf
33	integer nfaces, nnoeuds
34	integer ind1, ind2
35	character*64 maa
36 	character*200 desc
37	integer n
38	parameter (n=2)
39        integer np,nf,np2,nf2,taille,tmp
40	parameter (np=3,nf=9,np2=3,nf2=8)
41	integer indexp(np),indexf(nf)
42	integer conn(24)
43	integer indexp2(np2),indexf2(nf2)
44	integer conn2(nf2)
45	character*16 nom(n)
46	integer num(n),fam(n)
47	integer type
48	character*16 nomcoo(3)
49	character*16 unicoo(3)
50	character(16)  :: dtunit
51C
52C       Ouverture du fichier test25.med en lecture seule
53	call mfiope(fid,'test25.med',MED_ACC_RDONLY, cret)
54        print *,cret
55	if (cret .ne. 0 ) then
56	   print *,'Erreur ouverture du fichier'
57	   call efexit(-1)
58	endif
59        print *,'Ouverture du fichier test25.med'
60C
61C       Combien de maillage
62	call mmhnmh(fid,nmaa,cret)
63	print *,cret
64	if (cret .ne. 0 ) then
65	   print *,'Erreur lecture du nombre de maillage'
66	   call efexit(-1)
67	endif
68	print *,'Nombre de maillages : ',nmaa
69C
70C       Lecture de toutes les mailles MED_POLYEDRE
71C       dans chaque maillage
72	do 10 i=1,nmaa
73C
74C          Info sur chaque maillage
75	   call mmhmii(fid,i,maa,edim,mdim,type,desc,
76     &	               dtunit,stype,nstep,atype,
77     &		       nomcoo,unicoo,cret)
78	   print *,cret
79	   if (cret .ne. 0 ) then
80	      print *,'Erreur infos maillage'
81	      call efexit(-1)
82	   endif
83	   print *,'Maillage : ',maa
84	   print *,'Dimension : ',mdim
85C
86C          Combien de mailles polyedres a partir de la taille du tableau
87C          d'indexation des faces en connectivite nodale
88           call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
89     &                 MED_CELL,MED_POLYHEDRON,MED_INDEX_FACE,MED_NODAL,
90     &                 chgt,tsf,nfindex,cret)
91	   npoly = nfindex - 1
92	   print *,cret
93	   if (cret .ne. 0 ) then
94	      print *,'Erreur lecture nombre de polyedre'
95	      call efexit(-1)
96	   endif
97	   print *,'Nombre de mailles MED_POLYEDRE : ',npoly
98C
99C          Taille des connectivites et du tableau d'indexation des faces
100C          en connectivite nodale
101           call mmhnme(fid,maa,MED_NO_DT,MED_NO_IT,
102     &                 MED_CELL,MED_POLYHEDRON,
103     &                 MED_INDEX_NODE,MED_NODAL,
104     &                 chgt,tsf,taille,cret)
105	   print *,cret
106	   if (cret .ne. 0 ) then
107	      print *,'Erreur infos sur les polyedres'
108	      call efexit(-1)
109	   endif
110	   print *,'Taille de la connectivite : ',taille
111	   print *,'Taille du tableau indexf : ', nfindex
112C
113C          Lecture de la connectivite en mode nodal
114	   call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
115     &                 MED_NODAL,indexp,indexf,conn,cret)
116	   print *,cret
117	   if (cret .ne. 0 ) then
118	      print *,'Erreur lecture connectivites polyedres'
119	      call efexit(-1)
120	   endif
121	   print *,'Lecture de la connectivite des polyedres'
122	   print *,'Connectivite nodale'
123C
124C          Lecture de la connectivite en mode descendant
125	   call mmhphr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
126     &                 MED_DESCENDING,indexp2,indexf2,conn2,cret)
127	   print *,cret
128	   if (cret .ne. 0 ) then
129	      print *,'Erreur lecture connectivite des polyedres'
130	      call efexit(-1)
131	   endif
132	   print *,'Lecture de la connectivite des polyedres'
133	   print *,'Connectivite descendante'
134C
135C          Lecture des noms
136	   call mmhear(fid,maa,MED_NO_DT,MED_NO_IT,
137     &                 MED_CELL,MED_POLYHEDRON,nom,cret)
138	   print *,cret
139	   if (cret .ne. 0 ) then
140	      print *,'Erreur lecture noms des polyedres'
141	      call efexit(-1)
142	   endif
143	   print *,'Lecture des noms'
144C
145C          Lecture des numeros
146	   call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
147     &                 MED_POLYHEDRON,num,cret)
148	   print *,cret
149	   if (cret .ne. 0 ) then
150	      print *,'Erreur lecture des numeros des polyedres'
151	      call efexit(-1)
152	   endif
153	   print *,'Lecture des numeros'
154C
155C          Lecture des numeros de familles
156	   call mmhfnr(fid,maa,MED_NO_DT,MED_NO_IT,MED_CELL,
157     &                 MED_POLYHEDRON,fam,cret)
158	   print *,cret
159	   if (cret .ne. 0 ) then
160	      print *,'Erreur lecture numeros de famille polyedres'
161	      call efexit(-1)
162	   endif
163	   print *,'Lecture des numeros de famille'
164C
165C          Affichage des resultats
166	   print *,'Affichage des resultats'
167	   do 20 j=1,npoly
168C
169	      print *,'>> Maille polyhedre ',j
170	      print *,'---- Connectivite nodale    ---- : '
171	      nfaces = indexp(j+1) - indexp(j)
172C             ind1 = indice dans "indexf" pour acceder aux
173C             numeros des faces
174	      ind1 = indexp(j)
175	      do 30 k=1,nfaces
176C                ind2 = indice dans "conn" pour acceder au premier noeud
177		 ind2 = indexf(ind1+k-1)
178		 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
179		 print *,'   - Face ',k
180		 do 40 l=1,nnoeuds
181		    print *,'   ',conn(ind2+l-1)
182 40		 continue
183 30	      continue
184	      print *,'---- Connectivite descendante ---- : '
185	      nfaces = indexp2(j+1) - indexp2(j)
186C             ind1 = indice dans "conn2" pour acceder aux faces
187	      ind1 = indexp2(j)
188	      do 50 k=1,nfaces
189		 print *,'   - Face ',k
190		 print *,'   => Numero : ',conn2(ind1+k-1)
191		 print *,'   => Type   : ',indexf2(ind1+k-1)
192 50	      continue
193	      print *,'---- Nom                    ---- : ',nom(j)
194	      print *,'---- Numero                 ----:  ',num(j)
195	      print *,'---- Numero de famille      ---- : ',fam(j)
196C
197 20	   continue
198C
199 10	continue
200C
201C       Fermeture du fichier
202	call mficlo(fid,cret)
203	print *,cret
204	if (cret .ne. 0 ) then
205	   print *,'Erreur fermeture du fichier'
206	   call efexit(-1)
207	endif
208	print *,'Fermeture du fichier'
209C
210        end
211