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