MED fichier
f/2.3.6/test26.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 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 cret,fid,mdim,nmaa,npoly,i,j,k,l
31  integer nfaces, nnoeuds
32  integer ind1, ind2
33  character*32 maa
34  character*200 desc
35  integer n
36  parameter(n=2)
37  integer np,nf,np2,nf2,taille,tmp
38  parameter(np=3,nf=9,np2=3,nf2=8)
39  integer indexp(np),indexf(nf)
40  integer conn(24)
41  integer indexp2(np2),indexf2(nf2)
42  integer conn2(nf2)
43  character*16 nom(n)
44  integer num(n),fam(n)
45  integer type
46 C
47 C Ouverture du fichier test25.med en lecture seule
48  call efouvr(fid,'test25.med',med_lecture, cret)
49  print *,cret
50  if (cret .ne. 0 ) then
51  print *,'Erreur ouverture du fichier'
52  call efexit(-1)
53  endif
54  print *,'Ouverture du fichier test25.med'
55 C
56 C Combien de maillage
57  call efnmaa(fid,nmaa,cret)
58  print *,cret
59  if (cret .ne. 0 ) then
60  print *,'Erreur lecture du nombre de maillage'
61  call efexit(-1)
62  endif
63  print *,'Nombre de maillages : ',nmaa
64 C
65 C Lecture de toutes les mailles MED_POLYEDRE
66 C dans chaque maillage
67  do 10 i=1,nmaa
68 C
69 C Info sur chaque maillage
70  call efmaai(fid,i,maa,mdim,type,desc,cret)
71  print *,cret
72  if (cret .ne. 0 ) then
73  print *,'Erreur infos maillage'
74  call efexit(-1)
75  endif
76  print *,'Maillage : ',maa
77  print *,'Dimension : ',mdim
78 C
79 C Combien de mailles polyedres
80  call efnema(fid,maa,med_conn,med_maille,med_polyedre,
81  & med_nod,npoly,cret)
82  print *,cret
83  if (cret .ne. 0 ) then
84  print *,'Erreur lecture nombre de polyedre'
85  call efexit(-1)
86  endif
87  print *,'Nombre de mailles MED_POLYEDRE : ',npoly
88 C
89 C Taille des connectivites et du tableau d'indexation
90  call efpyei(fid,maa,med_nod,tmp,taille,cret)
91  print *,cret
92  if (cret .ne. 0 ) then
93  print *,'Erreur infos sur les polyedres'
94  call efexit(-1)
95  endif
96  print *,'Taille de la connectivite : ',taille
97  print *,'Taille du tableau indexf : ',tmp
98 C
99 C Lecture de la connectivite en mode nodal
100  call efpecl(fid,maa,indexp,npoly+1,indexf,tmp,conn,
101  & med_nod,cret)
102  print *,cret
103  if (cret .ne. 0 ) then
104  print *,'Erreur lecture connectivites polyedres'
105  call efexit(-1)
106  endif
107  print *,'Lecture de la connectivite des polyedres'
108  print *,'Connectivite nodale'
109 C
110 C Lecture de la connectivite en mode descendant
111  call efpecl(fid,maa,indexp2,npoly+1,indexf2,tmp,conn2,
112  & med_desc,cret)
113  print *,cret
114  if (cret .ne. 0 ) then
115  print *,'Erreur lecture connectivite des polyedres'
116  call efexit(-1)
117  endif
118  print *,'Lecture de la connectivite des polyedres'
119  print *,'Connectivite descendante'
120 C
121 C Lecture des noms
122  call efnoml(fid,maa,nom,npoly,med_maille,med_polyedre,
123  & cret)
124  print *,cret
125  if (cret .ne. 0 ) then
126  print *,'Erreur lecture noms des polyedres'
127  call efexit(-1)
128  endif
129  print *,'Lecture des noms'
130 C
131 C Lecture des numeros
132  call efnuml(fid,maa,num,npoly,med_maille,med_polyedre,
133  & cret)
134  print *,cret
135  if (cret .ne. 0 ) then
136  print *,'Erreur lecture des numeros des polyedres'
137  call efexit(-1)
138  endif
139  print *,'Lecture des numeros'
140 C
141 C Lecture des numeros de familles
142  call effaml(fid,maa,fam,npoly,med_maille,med_polyedre,
143  & cret)
144  print *,cret
145  if (cret .ne. 0 ) then
146  print *,'Erreur lecture numeros de famille polyedres'
147  call efexit(-1)
148  endif
149  print *,'Lecture des numeros de famille'
150 C
151 C Affichage des resultats
152  print *,'Affichage des resultats'
153  do 20 j=1,npoly
154 C
155  print *,'>> Maille polygone ',j
156  print *,'---- Connectivite nodale ---- : '
157  nfaces = indexp(j+1) - indexp(j)
158 C ind1 = indice dans "indexf" pour acceder aux
159 C numeros des faces
160  ind1 = indexp(j)
161  do 30 k=1,nfaces
162 C ind2 = indice dans "conn" pour acceder au premier noeud
163  ind2 = indexf(ind1+k-1)
164  nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
165  print *,' - Face ',k
166  do 40 l=1,nnoeuds
167  print *,' ',conn(ind2+l-1)
168  40 continue
169  30 continue
170  print *,'---- Connectivite descendante ---- : '
171  nfaces = indexp2(j+1) - indexp2(j)
172 C ind1 = indice dans "conn2" pour acceder aux faces
173  ind1 = indexp2(j)
174  do 50 k=1,nfaces
175  print *,' - Face ',k
176  print *,' => Numero : ',conn2(ind1+k-1)
177  print *,' => Type : ',indexf2(ind1+k-1)
178  50 continue
179  print *,'---- Nom ---- : ',nom(j)
180  print *,'---- Numero ----: ',num(j)
181  print *,'---- Numero de famille ---- : ',fam(j)
182 C
183  20 continue
184 C
185  10 continue
186 C
187 C Fermeture du fichier
188  call efferm (fid,cret)
189  print *,cret
190  if (cret .ne. 0 ) then
191  print *,'Erreur fermeture du fichier'
192  call efexit(-1)
193  endif
194  print *,'Fermeture du fichier'
195 C
196  end