MED fichier
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 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:487
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition: medfilter.f:22
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Definition: medmesh.f:868
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:445
program test7
Definition: test7.f90:24
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mfrdea(nflt, flt, cret)
Definition: medfilter.f:60
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Definition: medmesh.f:529
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
subroutine mfrall(nflt, flt, cret)
Definition: medfilter.f:44
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:41
#define false
Definition: libmedimport.c:36
#define true
Definition: libmedimport.c:37