MED fichier
f/test26.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C *******************************************************************************
19 C * - Nom du fichier : test26.f
20 C *
21 C * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED
22 C * du fichier test25.med
23 C *
24 C ******************************************************************************
25  program test26
26 C
27  implicit none
28  include 'med.hf'
29 C
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
51 C
52 C 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'
60 C
61 C 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
69 C
70 C Lecture de toutes les mailles MED_POLYEDRE
71 C dans chaque maillage
72  do 10 i=1,nmaa
73 C
74 C 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
85 C
86 C Combien de mailles polyedres a partir de la taille du tableau
87 C 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
98 C
99 C Taille des connectivites et du tableau d'indexation des faces
100 C 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
112 C
113 C 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'
123 C
124 C 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'
134 C
135 C 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'
144 C
145 C 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'
154 C
155 C 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'
164 C
165 C Affichage des resultats
166  print *,'Affichage des resultats'
167  do 20 j=1,npoly
168 C
169  print *,'>> Maille polyhedre ',j
170  print *,'---- Connectivite nodale ---- : '
171  nfaces = indexp(j+1) - indexp(j)
172 C ind1 = indice dans "indexf" pour acceder aux
173 C numeros des faces
174  ind1 = indexp(j)
175  do 30 k=1,nfaces
176 C 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)
186 C 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)
196 C
197  20 continue
198 C
199  10 continue
200 C
201 C 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'
209 C
210  end
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:110
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
mmhear
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Cette routine permet de lire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:529
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul donnée.
Definition: medmesh.f:551
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:487
test26
program test26
Definition: test26.f:25
mmhphr
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
Cette routine permet la lecture dans un maillage des connectivités de polyèdres.
Definition: medmesh.f:955
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42