MED fichier: Fichier source de test7.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test7.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 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
mmhear
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Definition: medmesh.f:529
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:445
mfrcre
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition: medfilter.f:22
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:487
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
test7
program test7
Definition: test7.f90:24
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
mmhyar
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Definition: medmesh.f:868
false
#define false
Definition: libmedimport.c:36
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82
true
#define true
Definition: libmedimport.c:37