MED fichier: Fichier source de test7.f90

MED fichier

test7.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:110
mfrcre
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Crée une selection d'entités grâce a un tableau d'index filterarray de taille filterarraysize....
Definition: medfilter.f:22
mmhyar
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:868
true
#define true
Definition: libmedimport.c:37
false
#define false
Definition: libmedimport.c:36
mmhear
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Cette routine permet de lire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:529
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul donnée.
Definition: medmesh.f:551
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:600
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:487
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet de lire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:445
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42