MED fichier
test7.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4!* MED is free software: you can redistribute it and/or modify
5!* it under the terms of the GNU Lesser General Public License as published by
6!* the Free Software Foundation, either version 3 of the License, or
7!* (at your option) any later version.
8!*
9!* MED is distributed in the hope that it will be useful,
10!* but WITHOUT ANY WARRANTY; without even the implied warranty of
11!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12!* GNU Lesser General Public License for more details.
13!*
14!* You should have received a copy of the GNU Lesser General Public License
15!* along with MED. If not, see <http://www.gnu.org/licenses/>.
16!*
17
18! ******************************************************************************
19! * - Nom du fichier : test7.f90
20! *
21! * - Description : lecture des elements du maillage MED ecrits par test6
22! *
23! ******************************************************************************
24 program test7
25
26 implicit none
27 include 'med.hf90'
28!
29!
30 integer*8 fid
31 integer cret, ret
32
33 integer nse2
34 integer, allocatable, dimension (:) :: se2,se21
35 character*16, allocatable, dimension (:) :: nomse2
36 integer, allocatable, dimension (:) :: numse2,nufase2
37
38 integer ntr3
39 integer, allocatable, dimension (:) :: tr3
40 character*16, allocatable, dimension (:) :: nomtr3
41 integer, allocatable, dimension (:) :: numtr3,nufatr3
42
43! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
44 character*64 :: maa
45 character*200 :: desc
46 integer :: mdim,edim,nstep,stype,atype
47 logical inoele,inuele
48 integer, parameter :: profil (2) = (/ 2,3 /)
49 integer type
50 integer tse2,ttr3, i
51 character*16 nomcoo(2)
52 character*16 unicoo(2)
53 character*16 dtunit
54 integer :: chgt,tsf
55 integer flta(1)
56 integer*8 flt(1)
57
58! ** Ouverture du fichier test6.med en lecture seule **
59 call mfiope(fid,'test6.med',med_acc_rdonly, cret)
60 print *,cret
61
62! ** Lecture des infos concernant le premier maillage **
63 if (cret.eq.0) then
64 call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
65 print *,"Maillage de nom : ",maa," et de dimension :", mdim
66 endif
67 if (cret.ne.0) then
68 call efexit(-1)
69 endif
70! ** Combien de segments et de triangles **
71 if (cret.eq.0) then
72 nse2 = 0
73 call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
74 endif
75 if (cret.ne.0) then
76 call efexit(-1)
77 endif
78
79 if (cret.eq.0) then
80 ntr3 = 0
81 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
82 endif
83 if (cret.ne.0) then
84 call efexit(-1)
85 endif
86
87 if (cret.eq.0) then
88 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
89 endif
90
91! ** Allocations memoire **
92 tse2 = 2
93 allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),stat=ret )
94 se2(:)=0; se21(:)=0
95! print *,ret
96
97 ttr3 = 3
98 allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),stat=ret )
99 tr3(:)=0
100! print *,ret
101
102
103! ** Lecture de la connectivite des segments **
104 if (cret.eq.0) then
105 call mmhcyr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_full_interlace,se2,cret)
106 endif
107 if (cret.ne.0) then
108 call efexit(-1)
109 endif
110 print *,se2
111
112! ** Lecture de de la composante 2 de la connectivite des segments **
113! ** On cree un filtre associe
114 if (cret .eq. 0) then
115 call mfrall(1,flt,cret)
116 endif
117 if (cret.ne.0) then
118 call efexit(-1)
119 endif
120
121! ** on initialise le filtre pour lire uniquement la deuxième composante.
122 if (cret .eq. 0) then
123 call mfrcre(fid,nse2,1,edim,2,med_full_interlace,med_global_stmode, &
124 med_no_profile,med_undef_size,flta,flt(1),cret)
125 endif
126 if (cret.ne.0) then
127 call efexit(-1)
128 endif
129
130! ** Lecture des composantes n°2 des segments
131 if (cret.eq.0) then
132 call mmhyar(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending, &
133 flt(1),se21,cret)
134 endif
135 if (cret.ne.0) then
136 call efexit(-1)
137 endif
138 print *,se21
139
140! ** On desalloue le filtre
141 if (cret .eq. 0) then
142 call mfrdea(1,flt,cret)
143 endif
144 if (cret.ne.0) then
145 call efexit(-1)
146 endif
147
148! ** Lecture (optionnelle) des noms des segments **
149 if (cret.eq.0) then
150 call mmhear(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nomse2,cret)
151 endif
152
153 if (ret <0) then
154 inoele = .false.
155 else
156 inoele = .true.
157 endif
158
159! ** Lecture (optionnelle) des numeros des segments **
160 if (cret.eq.0) then
161 call mmhenr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,numse2,cret)
162 endif
163
164 if (ret <0) then
165 inuele = .false.
166 else
167 inuele = .true.
168 endif
169
170! ** Lecture des numeros des familles des segments **
171 if (cret.eq.0) then
172 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nufase2,cret)
173 endif
174 if (cret.ne.0) then
175 call efexit(-1)
176 endif
177
178! ** Lecture de la connectivite des triangles sans profil **
179 if (cret.eq.0) then
180 call mmhcyr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,cret)
181 endif
182 if (cret.ne.0) then
183 call efexit(-1)
184 endif
185
186! ** Lecture (optionnelle) des noms des triangles **
187 if (cret.eq.0) then
188 call mmhear(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nomtr3,cret)
189 endif
190
191 if (ret <0) then
192 inoele = .false.
193 else
194 inoele = .true.
195 endif
196 print *,cret
197
198! ** Lecture (optionnelle) des numeros des segments **
199 if (cret.eq.0) then
200 call mmhenr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,numtr3,cret)
201 endif
202
203 if (ret <0) then
204 inuele = .false.
205 else
206 inuele = .true.
207 endif
208 print *,cret
209
210! ** Lecture des numeros des familles des segments **
211 if (cret.eq.0) then
212 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nufatr3,cret)
213 endif
214 print *,cret
215
216! ** Fermeture du fichier **
217 call mficlo(fid,cret)
218 if (cret.ne.0) then
219 call efexit(-1)
220 endif
221
222! ** Affichage des resulats **
223 if (cret.eq.0) then
224
225 print *,"Connectivite des segments : "
226 print *, se2
227
228 if (inoele) then
229 print *,"Noms des segments :"
230 print *,nomse2
231 endif
232
233 if (inuele) then
234 print *,"Numeros des segments :"
235 print *,numse2
236 endif
237
238 print *,"Numeros des familles des segments :"
239 print *,nufase2
240
241 print *,"Connectivite des triangles :"
242 print *,tr3
243
244 if (inoele) then
245 print *,"Noms des triangles :"
246 print *,nomtr3
247 endif
248
249 if (inuele) then
250 print *,"Numeros des triangles :"
251 print *,numtr3
252 endif
253
254 print *,"Numeros des familles des triangles :"
255 print *,nufatr3
256
257 endif
258
259! ** Nettoyage memoire **
260 deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
261
262! ** Code retour
263 call efexit(cret)
264
265 end program test7
266
#define true
#define false
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition medfilter.f:22
subroutine mfrall(nflt, flt, cret)
Definition medfilter.f:44
subroutine mfrdea(nflt, flt, cret)
Definition medfilter.f:60
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:487
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:445
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition medmesh.f:551
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Definition medmesh.f:529
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition medmesh.f:600
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Definition medmesh.f:868
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110