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