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