MED fichier
f/test26.f
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
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
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
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
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
Definition: medmesh.f:955
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:487
program test26
Definition: test26.f:25