MED fichier
test24.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C *******************************************************************************
19C * - Nom du fichier : test24.f
20C *
21C * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
22C * du fichier test23.med
23C *
24C ******************************************************************************
25 program test23
26C
27 implicit none
28 include 'med.hf'
29C
30 integer*8 fid
31 integer cret,mdim,nmaa,npoly,i,j,k,taille
32 integer edim,nstep,stype,atype, chgt, tsf
33 character*64 maa
34 character*200 desc
35 integer ni, n, isize;
36 parameter(ni=4, n=3)
37 integer index(ni),ind1,ind2
38 character*16 nom(n)
39 integer num(n),fam(n)
40 integer con(16)
41 integer type
42 character*16 nomcoo(2)
43 character*16 unicoo(2)
44 character(16) :: dtunit
45C
46C Ouverture du fichier test23.med en lecture seule
47 call mfiope(fid,'test23.med',med_acc_rdonly, cret)
48 print *,cret
49 if (cret .ne. 0 ) then
50 print *,'Erreur ouverture du fichier'
51 call efexit(-1)
52 endif
53 print *,'Ouverture du fichier test23.med'
54C
55C Lecture du nombre de maillages
56 call mmhnmh(fid,nmaa,cret)
57 print *,cret
58 if (cret .ne. 0 ) then
59 print *,'Erreur lecture nombre de maillage'
60 call efexit(-1)
61 endif
62 print *,'Nombre de maillages : ',nmaa
63C
64C Lecture de toutes les mailles MED_POLYGONE
65C dans chaque maillage
66 do 10 i=1,nmaa
67C
68C Info sur chaque maillage
69 call mmhmii(fid,i,maa,edim,mdim,type,desc,
70 & dtunit,stype,nstep,atype,
71 & nomcoo,unicoo,cret)
72 if (cret .ne. 0 ) then
73 print *,'Erreur lecture infos maillage'
74 call efexit(-1)
75 endif
76 print *,cret
77 print *,'Maillage : ',maa
78 print *,'Dimension : ',mdim
79C
80C Combien de mailles polygones
81 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
82 & med_index_node,med_nodal,chgt,tsf,isize,cret)
83 npoly = isize - 1;
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur lecture du nombre de polygone'
87 call efexit(-1)
88 endif
89 print *,'Nombre de mailles MED_POLYGONE : ',npoly
90C
91C Taille des connectivites
92 call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
93 & med_connectivity,med_nodal,chgt,tsf,taille,cret)
94 print *,cret
95 if (cret .ne. 0 ) then
96 print *,'Erreur lecture infos polygones'
97 call efexit(-1)
98 endif
99 print *,'Taille de la connectivite : ',taille
100C
101C Lecture de la connectivite
102 call mmhpgr(fid,maa,med_no_dt,med_no_it,med_cell,
103 & med_nodal,index,con,cret)
104 print *,cret
105 if (cret .ne. 0 ) then
106 print *,'Erreur lecture des connectivites polygones'
107 call efexit(-1)
108 endif
109 print *,'Lecture de la connectivite des polygones'
110C
111C Lecture des noms
112 call mmhear(fid,maa,med_no_dt,med_no_it,
113 & med_cell,med_polygon,nom,cret)
114 print *,cret
115 if (cret .ne. 0 ) then
116 print *,'Erreur lecture des noms des polygones'
117 call efexit(-1)
118 endif
119 print *,'Lecture des noms'
120C
121C Lecture des numeros
122 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
123 & num,cret)
124 print *,cret
125 if (cret .ne. 0 ) then
126 print *,'Erreur lecture des numeros des polygones'
127 call efexit(-1)
128 endif
129 print *,'Lecture des numeros'
130C
131C Lecture des numeros de familles
132 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_polygon,
133 & fam,cret)
134 print *,cret
135 if (cret .ne. 0 ) then
136 print *,'Erreur lecture des numeros de famille des
137 & polygones'
138 call efexit(-1)
139 endif
140 print *,'Lecture des numeros de famille'
141C
142C Affichage des resultats
143 print *,'Affichage des resultats'
144 do 20 j=1,npoly
145C
146 print *,'>> Maille polygone ',j
147 print *,'---- Connectivite ---- : '
148 ind1 = index(j)
149 ind2 = index(j+1)
150 do 30 k=ind1,ind2-1
151 print *,con(k)
152 30 continue
153c print *,'---- Nom ---- : ',nom(j)
154 print *,'---- Numero ----: ',num(j)
155 print *,'---- Numero de famille ---- : ',fam(j)
156C
157 20 continue
158C
159 10 continue
160C
161C Fermeture du fichier
162 call mficlo(fid,cret)
163 print *,cret
164 if (cret .ne. 0 ) then
165 print *,'Erreur fermeture du fichier'
166 call efexit(-1)
167 endif
168 print *,'Fermeture du fichier'
169C
170 end
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
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 étape de calcul donnée.
Definition: medmesh.f:551
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:529
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:110
subroutine mmhpgr(fid, name, numdt, numit, entype, cmode, index, con, cret)
Definition: medmesh.f:912
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:487
program test23
Definition: test23.f:24