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