MED fichier
f/test28.f
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 : test28.f
20C *
21C * - Description : lecture des maillages structures (grille cartesienne |
22C * grille de-structuree ) dans le fichier test27.med
23C *
24C *****************************************************************************
25 program test28
26C
27 implicit none
28 include 'med.hf'
29C
30C
31 integer*8 fid
32 integer cret,i,j
33C ** la dimension du maillage **
34 integer mdim,nind,nmaa,type,quoi,rep,typmaa
35 integer edim,nstep,stype,atype, chgt, tsf
36C ** nom du maillage de longueur maxi MED_TAILLE_NOM **
37 character*64 maa
38C ** le nombre de noeuds **
39 integer nnoe
40C ** table des coordonnees **
41 real*8 coo(8)
42 character*16 nomcoo(2), unicoo(2)
43 character*200 desc
44 integer strgri(2)
45C ** grille cartesienne **
46 integer axe
47 real*8 indice(4)
48 character(16) :: dtunit
49
50C
51C 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'
59C
60C 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
67C
68C On boucle sur les maillages et on ne lit que les
69C maillages structures
70 do 10 i=1,nmaa
71C
72C On repere les maillages qui nous interessent
73C
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
89C
90C 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
105C
106C On regarde la structure et les coordonnees de la grille
107C MED_CURVILINEAR_GRID
108 if ((typmaa.eq.med_curvilinear_grid)
109 & .and. (type.eq.med_structured_mesh)) then
110C
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
120C
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
129C
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
142C
143 if ((typmaa.eq.med_cartesian_grid)
144 & .and. (type.eq. med_structured_mesh)) then
145C
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
156C Lecture de la taille de l'indice selon la dimension
157C 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
168C 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
182C
183 endif
184C
185 10 continue
186C
187C 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'
195C
196 end
197
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 mmhgtr(fid, name, gtype, cret)
Cette routine permet de lire le type d'un maillage structuré (MED_STRUCTURED_MESH).
Definition medmesh.f:241
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 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 mmhgsr(fid, name, numdt, numit, st, cret)
Definition medmesh.f:279
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition medmesh.f:320
subroutine mmhgcr(fid, name, numdt, numit, axis, index, cret)
Definition medmesh.f:404
program test28
Definition test28.f:25