MED fichier

test28.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 : test28.f
20 C *
21 C * - Description : lecture des maillages structures (grille cartesienne |
22 C * grille de-structuree ) dans le fichier test27.med
23 C *
24 C *****************************************************************************
25 program test28
26 C
27 implicit none
28 include 'med.hf'
29 C
30 C
31 integer*8 fid
32 integer cret,i,j
33 C ** la dimension du maillage **
34 integer mdim,nind,nmaa,type,quoi,rep,typmaa
35 integer edim,nstep,stype,atype, chgt, tsf
36 C ** nom du maillage de longueur maxi MED_TAILLE_NOM **
37 character*64 maa
38 C ** le nombre de noeuds **
39 integer nnoe
40 C ** table des coordonnees **
41 real*8 coo(8)
42 character*16 nomcoo(2), unicoo(2)
43 character*200 desc
44 integer strgri(2)
45 C ** grille cartesienne **
46 integer axe
47 real*8 indice(4)
48 character(16) :: dtunit
49
50 C
51 C On ouvre le fichier test27.med en lecture seule
52 call mfiope(fid,'test27.med',med_acc_rdonly, cret)
53 if (cret .ne. 0 ) then
54 print *,'Erreur ouverture du fichier'
55 call efexit(-1)
56 endif
57 print *,cret
58 print *,'Ouverture du fichier test27.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 C
68 C On boucle sur les maillages et on ne lit que les
69 C maillages structures
70 do 10 i=1,nmaa
71 C
72 C On repere les maillages qui nous interessent
73 C
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 lecture maillage info'
80 call efexit(-1)
81 endif
82 print *,'Maillage de nom : ',maa
83 print *,'- Dimension : ',mdim
84 if (type.eq.med_structured_mesh) then
85 print *,'- Type : structure'
86 else
87 print *,'- Type : non structure'
88 endif
89 C
90 C On repere le type de la grille
91 if (type.eq.med_structured_mesh) then
92 call mmhgtr(fid,maa,typmaa,cret)
93 print *,cret
94 if (cret .ne. 0 ) then
95 print *,'Erreur lecture nature de la grille'
96 call efexit(-1)
97 endif
98 if (typmaa.eq.med_cartesian_grid) then
99 print *,'- Nature de la grille : cartesienne'
100 endif
101 if (typmaa.eq.med_curvilinear_grid) then
102 print *,'- Nature de la grille : curviligne'
103 endif
104 endif
105 C
106 C On regarde la structure et les coordonnees de la grille
107 C MED_CURVILINEAR_GRID
108 if ((typmaa.eq.med_curvilinear_grid)
109 & .and. (type.eq.med_structured_mesh)) then
110 C
111 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,
112 & med_none,med_coordinate,med_no_cmode,
113 & chgt,tsf,nnoe,cret)
114 print *,cret
115 if (cret .ne. 0 ) then
116 print *,'Erreur lecture nombre de noeud'
117 call efexit(-1)
118 endif
119 print *,'- Nombre de noeuds : ',nnoe
120 C
121 call mmhgsr(fid,maa,med_no_dt,med_no_it,strgri,cret)
122
123 print *,cret
124 if (cret .ne. 0 ) then
125 print *,'Erreur lecture structure de la grille'
126 call efexit(-1)
127 endif
128 print *,'- Structure de la grille : ',strgri
129 C
130 call mmhcor(fid,maa,med_no_dt,med_no_it,
131 & med_full_interlace,coo,cret)
132 print *,cret
133 if (cret .ne. 0 ) then
134 print *,'Erreur lecture des coordonnees des noeuds'
135 call efexit(-1)
136 endif
137 print *,'- Coordonnees :'
138 do 20 j=1,nnoe*mdim
139 print *,coo(j)
140 20 continue
141 endif
142 C
143 if ((typmaa.eq.med_cartesian_grid)
144 & .and. (type.eq. med_structured_mesh)) then
145 C
146 do 30 axe=1,mdim
147 if (axe.eq.1) then
148 quoi = med_coordinate_axis1
149 endif
150 if (axe.eq.2) then
151 quoi = med_coordinate_axis2
152 endif
153 if (axe.eq.3) then
154 quoi = med_coordinate_axis3
155 endif
156 C Lecture de la taille de l'indice selon la dimension
157 C fournie par le parametre quoi
158 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,
159 & med_none,quoi,med_no_cmode,
160 & chgt,tsf,nind,cret)
161 print *,cret
162 if (cret .ne. 0 ) then
163 print *,'Erreur lecture taille indice'
164 call efexit(-1)
165 endif
166 print *,'- Axe ',axe
167 print *,'- Nombre d indices : ',nind
168 C Lecture des indices des coordonnees de la grille
169 call mmhgcr(fid,maa,med_no_dt,med_no_it,
170 & axe,indice,cret)
171 print *,cret
172 if (cret .ne. 0 ) then
173 print *,'Erreur lecture indices de coordonnées'
174 call efexit(-1)
175 endif
176 print *,'- Axe ', nomcoo
177 print *,' unite : ',unicoo
178 do 40 j=1,nind
179 print *,indice(j)
180 40 continue
181 30 continue
182 C
183 endif
184 C
185 10 continue
186 C
187 C On ferme le fichier
188 call mficlo(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
197
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
mmhgcr
subroutine mmhgcr(fid, name, numdt, numit, axis, index, cret)
Cette routine permet la lecture des coordonnées des noeuds d'un maillage structuré selon un axe du re...
Definition: medmesh.f:404
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
test28
program test28
Definition: test28.f:25
mmhgtr
subroutine mmhgtr(fid, name, gtype, cret)
Cette routine permet de lire le type d'un maillage structuré (MED_STRUCTURED_MESH).
Definition: medmesh.f:241
mmhgsr
subroutine mmhgsr(fid, name, numdt, numit, st, cret)
Cette routine permet la lecture de la structure (nombre de points sur chaque axe du repère) d'un mail...
Definition: medmesh.f:279
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
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:320
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