MED fichier: Fichier source de test26.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test26.f
Aller à la documentation de ce fichier.
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,nfindex
31 integer edim,nstep,stype,atype, chgt, tsf
32 integer nfaces, nnoeuds
33 integer ind1, ind2
34 character*64 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 character*16 nomcoo(3)
48 character*16 unicoo(3)
49 character(16) :: dtunit
50 C
51 C Ouverture du fichier test25.med en lecture seule
52 call mfiope(fid,'test25.med',med_acc_rdonly, cret)
53 print *,cret
54 if (cret .ne. 0 ) then
55 print *,'Erreur ouverture du fichier'
56 call efexit(-1)
57 endif
58 print *,'Ouverture du fichier test25.med'
59 C
60 C Combien de maillage
61 call mmhnmh(fid,nmaa,cret)
62 print *,cret
63 if (cret .ne. 0 ) then
64 print *,'Erreur lecture du nombre de maillage'
65 call efexit(-1)
66 endif
67 print *,'Nombre de maillages : ',nmaa
68 C
69 C Lecture de toutes les mailles MED_POLYEDRE
70 C dans chaque maillage
71 do 10 i=1,nmaa
72 C
73 C Info sur chaque maillage
74 call mmhmii(fid,i,maa,edim,mdim,type,desc,
75 & dtunit,stype,nstep,atype,
76 & nomcoo,unicoo,cret)
77 print *,cret
78 if (cret .ne. 0 ) then
79 print *,'Erreur infos maillage'
80 call efexit(-1)
81 endif
82 print *,'Maillage : ',maa
83 print *,'Dimension : ',mdim
84 C
85 C Combien de mailles polyedres a partir de la taille du tableau
86 C d'indexation des faces en connectivite nodale
87 call mmhnme(fid,maa,med_no_dt,med_no_it,
88 & med_cell,med_polyhedron,med_index_face,med_nodal,
89 & chgt,tsf,nfindex,cret)
90 npoly = nfindex - 1
91 print *,cret
92 if (cret .ne. 0 ) then
93 print *,'Erreur lecture nombre de polyedre'
94 call efexit(-1)
95 endif
96 print *,'Nombre de mailles MED_POLYEDRE : ',npoly
97 C
98 C Taille des connectivites et du tableau d'indexation des faces
99 C en connectivite nodale
100 call mmhnme(fid,maa,med_no_dt,med_no_it,
101 & med_cell,med_polyhedron,
102 & med_index_node,med_nodal,
103 & chgt,tsf,taille,cret)
104 print *,cret
105 if (cret .ne. 0 ) then
106 print *,'Erreur infos sur les polyedres'
107 call efexit(-1)
108 endif
109 print *,'Taille de la connectivite : ',taille
110 print *,'Taille du tableau indexf : ', nfindex
111 C
112 C Lecture de la connectivite en mode nodal
113 call mmhphr(fid,maa,med_no_dt,med_no_it,med_cell,
114 & med_nodal,indexp,indexf,conn,cret)
115 print *,cret
116 if (cret .ne. 0 ) then
117 print *,'Erreur lecture connectivites polyedres'
118 call efexit(-1)
119 endif
120 print *,'Lecture de la connectivite des polyedres'
121 print *,'Connectivite nodale'
122 C
123 C Lecture de la connectivite en mode descendant
124 call mmhphr(fid,maa,med_no_dt,med_no_it,med_cell,
125 & med_descending,indexp2,indexf2,conn2,cret)
126 print *,cret
127 if (cret .ne. 0 ) then
128 print *,'Erreur lecture connectivite des polyedres'
129 call efexit(-1)
130 endif
131 print *,'Lecture de la connectivite des polyedres'
132 print *,'Connectivite descendante'
133 C
134 C Lecture des noms
135 call mmhear(fid,maa,med_no_dt,med_no_it,
136 & med_cell,med_polyhedron,nom,cret)
137 print *,cret
138 if (cret .ne. 0 ) then
139 print *,'Erreur lecture noms des polyedres'
140 call efexit(-1)
141 endif
142 print *,'Lecture des noms'
143 C
144 C Lecture des numeros
145 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,
146 & med_polyhedron,num,cret)
147 print *,cret
148 if (cret .ne. 0 ) then
149 print *,'Erreur lecture des numeros des polyedres'
150 call efexit(-1)
151 endif
152 print *,'Lecture des numeros'
153 C
154 C Lecture des numeros de familles
155 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,
156 & med_polyhedron,fam,cret)
157 print *,cret
158 if (cret .ne. 0 ) then
159 print *,'Erreur lecture numeros de famille polyedres'
160 call efexit(-1)
161 endif
162 print *,'Lecture des numeros de famille'
163 C
164 C Affichage des resultats
165 print *,'Affichage des resultats'
166 do 20 j=1,npoly
167 C
168 print *,'>> Maille polyhedre ',j
169 print *,'---- Connectivite nodale ---- : '
170 nfaces = indexp(j+1) - indexp(j)
171 C ind1 = indice dans "indexf" pour acceder aux
172 C numeros des faces
173 ind1 = indexp(j)
174 do 30 k=1,nfaces
175 C ind2 = indice dans "conn" pour acceder au premier noeud
176 ind2 = indexf(ind1+k-1)
177 nnoeuds = indexf(ind1+k) - indexf(ind1+k-1)
178 print *,' - Face ',k
179 do 40 l=1,nnoeuds
180 print *,' ',conn(ind2+l-1)
181 40 continue
182 30 continue
183 print *,'---- Connectivite descendante ---- : '
184 nfaces = indexp2(j+1) - indexp2(j)
185 C ind1 = indice dans "conn2" pour acceder aux faces
186 ind1 = indexp2(j)
187 do 50 k=1,nfaces
188 print *,' - Face ',k
189 print *,' => Numero : ',conn2(ind1+k-1)
190 print *,' => Type : ',indexf2(ind1+k-1)
191 50 continue
192 print *,'---- Nom ---- : ',nom(j)
193 print *,'---- Numero ----: ',num(j)
194 print *,'---- Numero de famille ---- : ',fam(j)
195 C
196 20 continue
197 C
198 10 continue
199 C
200 C Fermeture du fichier
201 call mficlo(fid,cret)
202 print *,cret
203 if (cret .ne. 0 ) then
204 print *,'Erreur fermeture du fichier'
205 call efexit(-1)
206 endif
207 print *,'Fermeture du fichier'
208 C
209 end
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:40
mmhphr
subroutine mmhphr(fid, name, numdt, numit, entype, cmode, findex, nindex, con, cret)
Cette routine permet la lecture dans un maillage des connectivités de polyèdres.
Definition: medmesh.f:912
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:504
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
test26
program test26
Definition: test26.f:25
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 séquence de calcul donnée...
Definition: medmesh.f:525
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:106
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:464
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41