MED fichier

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