31 integer cret,mdim,nmaa,npoly,i,j,k,l,nfindex
32 integer edim,nstep,stype,atype, chgt, tsf
33 integer nfaces, nnoeuds
39 integer np,nf,np2,nf2,taille,tmp
40 parameter(np=3,nf=9,np2=3,nf2=8)
41 integer indexp(np),indexf(nf)
43 integer indexp2(np2),indexf2(nf2)
48 character*16 nomcoo(3)
49 character*16 unicoo(3)
50 character(16) :: dtunit
53 call mfiope(fid,
'test25.med',med_acc_rdonly, cret)
55 if (cret .ne. 0 )
then
56 print *,
'Erreur ouverture du fichier'
59 print *,
'Ouverture du fichier test25.med'
64 if (cret .ne. 0 )
then
65 print *,
'Erreur lecture du nombre de maillage'
68 print *,
'Nombre de maillages : ',nmaa
75 call mmhmii(fid,i,maa,edim,mdim,
type,desc,
76 & dtunit,stype,nstep,atype,
79 if (cret .ne. 0 )
then
80 print *,
'Erreur infos maillage'
83 print *,
'Maillage : ',maa
84 print *,
'Dimension : ',mdim
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)
93 if (cret .ne. 0 )
then
94 print *,
'Erreur lecture nombre de polyedre'
97 print *,
'Nombre de mailles MED_POLYEDRE : ',npoly
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)
106 if (cret .ne. 0 )
then
107 print *,
'Erreur infos sur les polyedres'
110 print *,
'Taille de la connectivite : ',taille
111 print *,
'Taille du tableau indexf : ', nfindex
114 call mmhphr(fid,maa,med_no_dt,med_no_it,med_cell,
115 & med_nodal,indexp,indexf,conn,cret)
117 if (cret .ne. 0 )
then
118 print *,
'Erreur lecture connectivites polyedres'
121 print *,
'Lecture de la connectivite des polyedres'
122 print *,
'Connectivite nodale'
125 call mmhphr(fid,maa,med_no_dt,med_no_it,med_cell,
126 & med_descending,indexp2,indexf2,conn2,cret)
128 if (cret .ne. 0 )
then
129 print *,
'Erreur lecture connectivite des polyedres'
132 print *,
'Lecture de la connectivite des polyedres'
133 print *,
'Connectivite descendante'
136 call mmhear(fid,maa,med_no_dt,med_no_it,
137 & med_cell,med_polyhedron,nom,cret)
139 if (cret .ne. 0 )
then
140 print *,
'Erreur lecture noms des polyedres'
143 print *,
'Lecture des noms'
146 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,
147 & med_polyhedron,num,cret)
149 if (cret .ne. 0 )
then
150 print *,
'Erreur lecture des numeros des polyedres'
153 print *,
'Lecture des numeros'
156 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,
157 & med_polyhedron,fam,cret)
159 if (cret .ne. 0 )
then
160 print *,
'Erreur lecture numeros de famille polyedres'
163 print *,
'Lecture des numeros de famille'
166 print *,
'Affichage des resultats'
169 print *,
'>> Maille polyhedre ',j
170 print *,
'---- Connectivite nodale ---- : '
171 nfaces = indexp(j+1) - indexp(j)
177 ind2 = indexf(ind1+k-1)
178 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
181 print *,
' ',conn(ind2+l-1)
184 print *,
'---- Connectivite descendante ---- : '
185 nfaces = indexp2(j+1) - indexp2(j)
190 print *,
' => Numero : ',conn2(ind1+k-1)
191 print *,
' => Type : ',indexf2(ind1+k-1)
193 print *,
'---- Nom ---- : ',nom(j)
194 print *,
'---- Numero ----: ',num(j)
195 print *,
'---- Numero de famille ---- : ',fam(j)
204 if (cret .ne. 0 )
then
205 print *,
'Erreur fermeture du fichier'
208 print *,
'Fermeture du fichier'
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
subroutine mmhnmh(fid, n, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
subroutine mficlo(fid, cret)