MED fichier
f/test24.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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 : test24.f
20 C *
21 C * - Description : lecture de mailles MED_POLYGONE dans le maillage MED
22 C * du fichier test23.med
23 C *
24 C ******************************************************************************
25  program test23
26 C
27  implicit none
28  include 'med.hf'
29 C
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
45 C
46 C 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'
54 C
55 C 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
63 C
64 C Lecture de toutes les mailles MED_POLYGONE
65 C dans chaque maillage
66  do 10 i=1,nmaa
67 C
68 C 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
79 C
80 C 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
90 C
91 C 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
100 C
101 C 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'
110 C
111 C 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'
120 C
121 C 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'
130 C
131 C 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'
141 C
142 C Affichage des resultats
143  print *,'Affichage des resultats'
144  do 20 j=1,npoly
145 C
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
153 c print *,'---- Nom ---- : ',nom(j)
154  print *,'---- Numero ----: ',num(j)
155  print *,'---- Numero de famille ---- : ',fam(j)
156 C
157  20 continue
158 C
159  10 continue
160 C
161 C 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'
169 C
170  end
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:110
mmhpgr
subroutine mmhpgr(fid, name, numdt, numit, entype, cmode, index, con, cret)
Cette routine permet la lecture des connectivités de polygones.
Definition: medmesh.f:912
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
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:529
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
test23
program test23
Definition: test23.f:24
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 étape de calcul donnée.
Definition: medmesh.f:551
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:487
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42