MED fichier
f/test28.f
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