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 - 2017 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 cret, ret, fid
31
32 integer nse2
33 integer, allocatable, dimension (:) :: se2,se21
34 character*16, allocatable, dimension (:) :: nomse2
35 integer, allocatable, dimension (:) :: numse2,nufase2
36
37 integer ntr3
38 integer, allocatable, dimension (:) :: tr3
39 character*16, allocatable, dimension (:) :: nomtr3
40 integer, allocatable, dimension (:) :: numtr3,nufatr3
41
42 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
43 character*64 :: maa
44 character*200 :: desc
45 integer :: mdim,edim,nstep,stype,atype
46 logical inoele,inuele
47 integer, parameter :: profil (2) = (/ 2,3 /)
48 integer type
49 integer tse2,ttr3, i
50 character*16 nomcoo(2)
51 character*16 unicoo(2)
52 character*16 dtunit
53 integer :: chgt,tsf
54 integer flta(1)
55 integer*8 flt(1)
56
57 ! ** Ouverture du fichier test6.med en lecture seule **
58 call mfiope(fid,'test6.med',med_acc_rdonly, cret)
59 print *,cret
60
61 ! ** Lecture des infos concernant le premier maillage **
62 if (cret.eq.0) then
63 call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
64 print *,"Maillage de nom : ",maa," et de dimension :", mdim
65 endif
66 if (cret.ne.0) then
67 call efexit(-1)
68 endif
69 ! ** Combien de segments et de triangles **
70 if (cret.eq.0) then
71 nse2 = 0
72 call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
73 endif
74 if (cret.ne.0) then
75 call efexit(-1)
76 endif
77
78 if (cret.eq.0) then
79 ntr3 = 0
80 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
81 endif
82 if (cret.ne.0) then
83 call efexit(-1)
84 endif
85
86 if (cret.eq.0) then
87 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
88 endif
89
90 ! ** Allocations memoire **
91 tse2 = 2
92 allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),stat=ret )
93 se2(:)=0; se21(:)=0
94 ! print *,ret
95
96 ttr3 = 3
97 allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),stat=ret )
98 tr3(:)=0
99 ! print *,ret
100
101
102 ! ** Lecture de la connectivite des segments **
103 if (cret.eq.0) then
104 call mmhcyr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_full_interlace,se2,cret)
105 endif
106 if (cret.ne.0) then
107 call efexit(-1)
108 endif
109 print *,se2
110
111 ! ** Lecture de de la composante 2 de la connectivite des segments **
112 ! ** On cree un filtre associe
113 if (cret .eq. 0) then
114 call mfrall(1,flt,cret)
115 endif
116 if (cret.ne.0) then
117 call efexit(-1)
118 endif
119
120 ! ** on initialise le filtre pour lire uniquement la deuxième composante.
121 if (cret .eq. 0) then
122 call mfrcre(fid,nse2,1,edim,2,med_full_interlace,med_global_stmode, &
123 med_no_profile,med_undef_size,flta,flt(1),cret)
124 endif
125 if (cret.ne.0) then
126 call efexit(-1)
127 endif
128
129 ! ** Lecture des composantes n°2 des segments
130 if (cret.eq.0) then
131 call mmhyar(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending, &
132 flt(1),se21,cret)
133 endif
134 if (cret.ne.0) then
135 call efexit(-1)
136 endif
137 print *,se21
138
139 ! ** On desalloue le filtre
140 if (cret .eq. 0) then
141 call mfrdea(1,flt,cret)
142 endif
143 if (cret.ne.0) then
144 call efexit(-1)
145 endif
146
147 ! ** Lecture (optionnelle) des noms des segments **
148 if (cret.eq.0) then
149 call mmhear(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nomse2,cret)
150 endif
151
152 if (ret <0) then
153 inoele = .false.
154 else
155 inoele = .true.
156 endif
157
158 ! ** Lecture (optionnelle) des numeros des segments **
159 if (cret.eq.0) then
160 call mmhenr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,numse2,cret)
161 endif
162
163 if (ret <0) then
164 inuele = .false.
165 else
166 inuele = .true.
167 endif
168
169 ! ** Lecture des numeros des familles des segments **
170 if (cret.eq.0) then
171 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nufase2,cret)
172 endif
173 if (cret.ne.0) then
174 call efexit(-1)
175 endif
176
177 ! ** Lecture de la connectivite des triangles sans profil **
178 if (cret.eq.0) then
179 call mmhcyr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,cret)
180 endif
181 if (cret.ne.0) then
182 call efexit(-1)
183 endif
184
185 ! ** Lecture (optionnelle) des noms des triangles **
186 if (cret.eq.0) then
187 call mmhear(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nomtr3,cret)
188 endif
189
190 if (ret <0) then
191 inoele = .false.
192 else
193 inoele = .true.
194 endif
195 print *,cret
196
197 ! ** Lecture (optionnelle) des numeros des segments **
198 if (cret.eq.0) then
199 call mmhenr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,numtr3,cret)
200 endif
201
202 if (ret <0) then
203 inuele = .false.
204 else
205 inuele = .true.
206 endif
207 print *,cret
208
209 ! ** Lecture des numeros des familles des segments **
210 if (cret.eq.0) then
211 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nufatr3,cret)
212 endif
213 print *,cret
214
215 ! ** Fermeture du fichier **
216 call mficlo(fid,cret)
217 if (cret.ne.0) then
218 call efexit(-1)
219 endif
220
221 ! ** Affichage des resulats **
222 if (cret.eq.0) then
223
224 print *,"Connectivite des segments : "
225 print *, se2
226
227 if (inoele) then
228 print *,"Noms des segments :"
229 print *,nomse2
230 endif
231
232 if (inuele) then
233 print *,"Numeros des segments :"
234 print *,numse2
235 endif
236
237 print *,"Numeros des familles des segments :"
238 print *,nufase2
239
240 print *,"Connectivite des triangles :"
241 print *,tr3
242
243 if (inoele) then
244 print *,"Noms des triangles :"
245 print *,nomtr3
246 endif
247
248 if (inuele) then
249 print *,"Numeros des triangles :"
250 print *,numtr3
251 endif
252
253 print *,"Numeros des familles des triangles :"
254 print *,nufatr3
255
256 endif
257
258 ! ** Nettoyage memoire **
259 deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
260
261 ! ** Code retour
262 call efexit(cret)
263
264 end program test7
265
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:504
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:829
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
test7
program test7
Definition: test7.f90:24
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 séquence de calcul donnée...
Definition: medmesh.f:525
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:106
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:464
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:59
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:572
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. Initialisé en sortie de fonction, le filtre filter sera utilisé pour lire/écrire des valeurs associées à ces entités. Ces valeurs peuvent être des coordonnées, des connectivités des valeurs de champs résultats mais aussi des numéros de familles, des noms ou numéros optionnels.
Definition: medfilter.f:22
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:43
false
#define false
Definition: libmedimport.c:36
true
#define true
Definition: libmedimport.c:37
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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:424