MED fichier: Fichier source de test24.f

MED fichier

test24.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
test23
program test23
Definition: test23.f:24
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
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