1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
26
27 implicit none
28 include 'med.hf'
29
30
31 integer*8 fid
32 integer cret,i,j
33
34 integer mdim,nind,nmaa,type,quoi,rep,typmaa
35 integer edim,nstep,stype,atype, chgt, tsf
36
37 character*64 maa
38
39 integer nnoe
40
41 real*8 coo(8)
42 character*16 nomcoo(2), unicoo(2)
43 character*200 desc
44 integer strgri(2)
45
46 integer axe
47 real*8 indice(4)
48 character(16) :: dtunit
49
50
51
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
60
62 print *,cret
63 if (cret .ne. 0 ) then
64 print *,'Erreur lecture du nombre de maillage'
65 call efexit(-1)
66 endif
67
68
69
70 do 10 i=1,nmaa
71
72
73
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
90
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
106
107
108 if ((typmaa.eq.med_curvilinear_grid)
109 & .and. (type.eq.med_structured_mesh)) then
110
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
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
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
143 if ((typmaa.eq.med_cartesian_grid)
144 & .and. (type.eq. med_structured_mesh)) then
145
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
157
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
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 coordonnes'
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
183 endif
184
185 10 continue
186
187
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
196 end
197
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhgsr(fid, name, numdt, numit, st, cret)
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
subroutine mmhgcr(fid, name, numdt, numit, axis, index, cret)
subroutine mmhnmh(fid, n, cret)
subroutine mmhgtr(fid, name, gtype, cret)
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)