MED fichier
f/test28.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 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