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,taille
32 integer edim,nstep,stype,atype, chgt, tsf
33 character*64 maa
34 character*200 desc
35 integer ni, n, isize;
36 parameter(ni=4, n=3)
37 integer index(ni),ind1,ind2
38 character*16 nom(n)
39 integer num(n),fam(n)
40 integer con(16)
41 integer type
42 character*16 nomcoo(2)
43 character*16 unicoo(2)
44 character(16) :: dtunit
45
46
47 call mfiope(fid,
'test23.med',med_acc_rdonly, cret)
48 print *,cret
49 if (cret .ne. 0 ) then
50 print *,'Erreur ouverture du fichier'
51 call efexit(-1)
52 endif
53 print *,'Ouverture du fichier test23.med'
54
55
57 print *,cret
58 if (cret .ne. 0 ) then
59 print *,'Erreur lecture nombre de maillage'
60 call efexit(-1)
61 endif
62 print *,'Nombre de maillages : ',nmaa
63
64
65
66 do 10 i=1,nmaa
67
68
69 call mmhmii(fid,i,maa,edim,mdim,
type,desc,
70 & dtunit,stype,nstep,atype,
71 & nomcoo,unicoo,cret)
72 if (cret .ne. 0 ) then
73 print *,'Erreur lecture infos maillage'
74 call efexit(-1)
75 endif
76 print *,cret
77 print *,'Maillage : ',maa
78 print *,'Dimension : ',mdim
79
80
81 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
82 & med_index_node,med_nodal,chgt,tsf,isize,cret)
83 npoly = isize - 1;
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur lecture du nombre de polygone'
87 call efexit(-1)
88 endif
89 print *,'Nombre de mailles MED_POLYGONE : ',npoly
90
91
92 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
93 & med_connectivity,med_nodal,chgt,tsf,taille,cret)
94 print *,cret
95 if (cret .ne. 0 ) then
96 print *,'Erreur lecture infos polygones'
97 call efexit(-1)
98 endif
99 print *,'Taille de la connectivite : ',taille
100
101
102 call mmhpgr(fid,maa,med_no_dt,med_no_it,med_cell,
103 & med_nodal,index,con,cret)
104 print *,cret
105 if (cret .ne. 0 ) then
106 print *,'Erreur lecture des connectivites polygones'
107 call efexit(-1)
108 endif
109 print *,'Lecture de la connectivite des polygones'
110
111
112 call mmhear(fid,maa,med_no_dt,med_no_it,
113 & med_cell,med_polygon,nom,cret)
114 print *,cret
115 if (cret .ne. 0 ) then
116 print *,'Erreur lecture des noms des polygones'
117 call efexit(-1)
118 endif
119 print *,'Lecture des noms'
120
121
122 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
123 & num,cret)
124 print *,cret
125 if (cret .ne. 0 ) then
126 print *,'Erreur lecture des numeros des polygones'
127 call efexit(-1)
128 endif
129 print *,'Lecture des numeros'
130
131
132 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
133 & fam,cret)
134 print *,cret
135 if (cret .ne. 0 ) then
136 print *,'Erreur lecture des numeros de famille des
137 & polygones'
138 call efexit(-1)
139 endif
140 print *,'Lecture des numeros de famille'
141
142
143 print *,'Affichage des resultats'
144 do 20 j=1,npoly
145
146 print *,'>> Maille polygone ',j
147 print *,'---- Connectivite ---- : '
148 ind1 = index(j)
149 ind2 = index(j+1)
150 do 30 k=ind1,ind2-1
151 print *,con(k)
152 30 continue
153
154 print *,'---- Numero ----: ',num(j)
155 print *,'---- Numero de famille ---- : ',fam(j)
156
157 20 continue
158
159 10 continue
160
161
163 print *,cret
164 if (cret .ne. 0 ) then
165 print *,'Erreur fermeture du fichier'
166 call efexit(-1)
167 endif
168 print *,'Fermeture du fichier'
169
170 end
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhpgr(fid, name, numdt, numit, entype, cmode, index, con, cret)
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
subroutine mmhnmh(fid, n, 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)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)