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 mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
subroutine mficlo(fid, cret)
subroutine mmhnmh(fid, n, cret)
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)