MED fichier: Fichier source de test28.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test28.f
Aller à la documentation de ce fichier.
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
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:40
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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:230
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, selon une séquence de calcul donnée.
Definition: medmesh.f:305
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 séquence de calcul donnée...
Definition: medmesh.f:525
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:106
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:385
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:266
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41