1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
26
27 implicit none
28 include 'med.hf'
29
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
52
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
61
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
70
71
72 do 10 i=1,nmaa
73
74
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
86
87
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
99
100
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
113
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
124
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
135
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
145
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
155
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
165
166 print *,'Affichage des resultats'
167 do 20 j=1,npoly
168
169 print *,'>> Maille polyhedre ',j
170 print *,'---- Connectivite nodale ---- : '
171 nfaces = indexp(j+1) - indexp(j)
172
173
174 ind1 = indexp(j)
175 do 30 k=1,nfaces
176
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
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
197 20 continue
198
199 10 continue
200
201
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
210 end
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
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.
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.
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.
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)