MED fichier
f/2.3.6/test26.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C *******************************************************************************
19 C * - Nom du fichier : test26.f
20 C *
21 C * - Description : lecture de mailles MED_POLYEDRE dans le maillage MED
22 C * du fichier test25.med
23 C *
24 C ******************************************************************************
25  program test26
26 C
27  implicit none
28  include 'med.hf'
29 C
30  integer*8 fid
31  integer cret,mdim,nmaa,npoly,i,j,k,l
32  integer nfaces, nnoeuds
33  integer ind1, ind2
34  character*32 maa
35  character*200 desc
36  integer n
37  parameter(n=2)
38  integer np,nf,np2,nf2,taille,tmp
39  parameter(np=3,nf=9,np2=3,nf2=8)
40  integer indexp(np),indexf(nf)
41  integer conn(24)
42  integer indexp2(np2),indexf2(nf2)
43  integer conn2(nf2)
44  character*16 nom(n)
45  integer num(n),fam(n)
46  integer type
47 C
48 C Ouverture du fichier test25.med en lecture seule
49  call efouvr(fid,'test25.med',med_lecture, cret)
50  print *,cret
51  if (cret .ne. 0 ) then
52  print *,'Erreur ouverture du fichier'
53  call efexit(-1)
54  endif
55  print *,'Ouverture du fichier test25.med'
56 C
57 C Combien de maillage
58  call efnmaa(fid,nmaa,cret)
59  print *,cret
60  if (cret .ne. 0 ) then
61  print *,'Erreur lecture du nombre de maillage'
62  call efexit(-1)
63  endif
64  print *,'Nombre de maillages : ',nmaa
65 C
66 C Lecture de toutes les mailles MED_POLYEDRE
67 C dans chaque maillage
68  do 10 i=1,nmaa
69 C
70 C Info sur chaque maillage
71  call efmaai(fid,i,maa,mdim,type,desc,cret)
72  print *,cret
73  if (cret .ne. 0 ) then
74  print *,'Erreur infos maillage'
75  call efexit(-1)
76  endif
77  print *,'Maillage : ',maa
78  print *,'Dimension : ',mdim
79 C
80 C Combien de mailles polyedres
81  call efnema(fid,maa,med_conn,med_maille,med_polyedre,
82  & med_nod,npoly,cret)
83  print *,cret
84  if (cret .ne. 0 ) then
85  print *,'Erreur lecture nombre de polyedre'
86  call efexit(-1)
87  endif
88  print *,'Nombre de mailles MED_POLYEDRE : ',npoly
89 C
90 C Taille des connectivites et du tableau d'indexation
91  call efpyei(fid,maa,med_nod,tmp,taille,cret)
92  print *,cret
93  if (cret .ne. 0 ) then
94  print *,'Erreur infos sur les polyedres'
95  call efexit(-1)
96  endif
97  print *,'Taille de la connectivite : ',taille
98  print *,'Taille du tableau indexf : ',tmp
99 C
100 C Lecture de la connectivite en mode nodal
101  call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
102  & med_nod,cret)
103  print *,cret
104  if (cret .ne. 0 ) then
105  print *,'Erreur lecture connectivites polyedres'
106  call efexit(-1)
107  endif
108  print *,'Lecture de la connectivite des polyedres'
109  print *,'Connectivite nodale'
110 C
111 C Lecture de la connectivite en mode descendant
112  call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
113  & med_desc,cret)
114  print *,cret
115  if (cret .ne. 0 ) then
116  print *,'Erreur lecture connectivite des polyedres'
117  call efexit(-1)
118  endif
119  print *,'Lecture de la connectivite des polyedres'
120  print *,'Connectivite descendante'
121 C
122 C Lecture des noms
123  call efnoml(fid,maa,nom,npoly,med_maille,med_polyedre,
124  & cret)
125  print *,cret
126  if (cret .ne. 0 ) then
127  print *,'Erreur lecture noms des polyedres'
128  call efexit(-1)
129  endif
130  print *,'Lecture des noms'
131 C
132 C Lecture des numeros
133  call efnuml(fid,maa,num,npoly,med_maille,med_polyedre,
134  & cret)
135  print *,cret
136  if (cret .ne. 0 ) then
137  print *,'Erreur lecture des numeros des polyedres'
138  call efexit(-1)
139  endif
140  print *,'Lecture des numeros'
141 C
142 C Lecture des numeros de familles
143  call effaml(fid,maa,fam,npoly,med_maille,med_polyedre,
144  & cret)
145  print *,cret
146  if (cret .ne. 0 ) then
147  print *,'Erreur lecture numeros de famille polyedres'
148  call efexit(-1)
149  endif
150  print *,'Lecture des numeros de famille'
151 C
152 C Affichage des resultats
153  print *,'Affichage des resultats'
154  do 20 j=1,npoly
155 C
156  print *,'>> Maille polygone ',j
157  print *,'---- Connectivite nodale ---- : '
158  nfaces = indexp(j+1) - indexp(j)
159 C ind1 = indice dans "indexf" pour acceder aux
160 C numeros des faces
161  ind1 = indexp(j)
162  do 30 k=1,nfaces
163 C ind2 = indice dans "conn" pour acceder au premier noeud
164  ind2 = indexf(ind1+k-1)
165  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
166  print *,' - Face ',k
167  do 40 l=1,nnoeuds
168  print *,' ',conn(ind2+l-1)
169  40 continue
170  30 continue
171  print *,'---- Connectivite descendante ---- : '
172  nfaces = indexp2(j+1) - indexp2(j)
173 C ind1 = indice dans "conn2" pour acceder aux faces
174  ind1 = indexp2(j)
175  do 50 k=1,nfaces
176  print *,' - Face ',k
177  print *,' => Numero : ',conn2(ind1+k-1)
178  print *,' => Type : ',indexf2(ind1+k-1)
179  50 continue
180  print *,'---- Nom ---- : ',nom(j)
181  print *,'---- Numero ----: ',num(j)
182  print *,'---- Numero de famille ---- : ',fam(j)
183 C
184  20 continue
185 C
186  10 continue
187 C
188 C Fermeture du fichier
189  call efferm (fid,cret)
190  print *,cret
191  if (cret .ne. 0 ) then
192  print *,'Erreur fermeture du fichier'
193  call efexit(-1)
194  endif
195  print *,'Fermeture du fichier'
196 C
197  end
test26
program test26
Definition: test26.f:25