MED fichier
test5.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4!* MED is free software: you can redistribute it and/or modify
5!* it under the terms of the GNU Lesser General Public License as published by
6!* the Free Software Foundation, either version 3 of the License, or
7!* (at your option) any later version.
8!*
9!* MED is distributed in the hope that it will be useful,
10!* but WITHOUT ANY WARRANTY; without even the implied warranty of
11!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12!* GNU Lesser General Public License for more details.
13!*
14!* You should have received a copy of the GNU Lesser General Public License
15!* along with MED. If not, see <http://www.gnu.org/licenses/>.
16!*
17
18! *******************************************************************************
19! * - Nom du fichier : test5.f90
20! *
21! * - Description : lecture des noeuds d'un maillage MED.
22! *
23! ******************************************************************************
24 program test5
25!
26 implicit none
27 include 'med.hf90'
28!
29!
30 integer cret, ret
31 integer*8 fid
32
33
34! ** la dimension du maillage et de l'espace de calcul**
35 integer mdim, sdim
36! ** nom du maillage de longueur maxi MED_SIZE_NAME **
37 character*64 maa
38 character*200 desc
39! ** le nombre de noeuds **
40 integer nnoe
41! ** table des coordonnees **
42 real*8, allocatable, dimension (:) :: coo,coo1
43! ** tables des noms et des unites des coordonnees **
44 character*16 nomcoo(2)
45 character*16 unicoo(2)
46! ** tables des noms, numeros, numeros de familles des noeuds **
47! autant d'elements que de noeuds - les noms ont pout longueur **
48! MED_SNAME_SIZE=16
49 character*16, allocatable, dimension (:) :: nomnoe
50 integer, allocatable, dimension (:) :: numnoe
51 integer, allocatable, dimension (:) :: nufano
52 integer i
53 logical inonoe,inunoe
54 integer type,chgt,tsf
55 integer flta(1)
56 integer*8 flt(1)
57 character(16) :: dtunit
58 integer nstep, stype, atype
59 integer swm
60
61! Ouverture du fichier en lecture seule **
62 call mfiope(fid,'test4.med',med_acc_rdonly, cret)
63 print *,cret
64
65! ** Lecture des infos concernant le premier maillage **
66 if (cret.eq.0) then
67 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
68 endif
69 if (cret.ne.0) then
70 call efexit(-1)
71 endif
72
73
74! ** Combien de noeuds a lire **
75 if (cret.eq.0) then
76 nnoe = 0
77 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
78 endif
79 print *,cret,' Nombre de noeuds : ',nnoe
80 if (cret.ne.0) then
81 call efexit(-1)
82 endif
83
84
85! ** Allocations memoires : **
86! ** table des coordonnees **
87! profil : (dimension * nombre de noeuds ) **
88! ** table des des numeros, des numeros de familles des noeuds
89! ** table des noms des noeuds **
90
91 allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),stat=ret )
92 print *,ret
93 coo1(:)=0.0
94
95! ** Lecture des composantes des coordonnees des noeuds avec et sans filtre **
96 if (cret.eq.0) then
97 call mmhcor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,cret)
98 endif
99 print *,'Lecture des toutes les composantes des coordonnees : '
100 print *,coo
101 if (cret.ne.0) then
102 call efexit(-1)
103 endif
104
105! ** On cree un filtre
106 if (cret .eq. 0) then
107 call mfrall(1,flt,cret)
108 endif
109 if (cret.ne.0) then
110 call efexit(-1)
111 endif
112
113 if (cret .eq. 0) then
114 call mfrcre(fid,nnoe,1,sdim,2,med_full_interlace,med_global_stmode, &
115 med_no_profile,med_undef_size,flta,flt(1),cret)
116 endif
117 if (cret.ne.0) then
118 call efexit(-1)
119 endif
120
121! ** Lecture des composantes n°2 des coordonnees des noeuds
122 if (cret.eq.0) then
123 call mmhcar(fid,maa,med_no_dt,med_no_it,flt(1),coo1,cret)
124 endif
125 print *,'Lecture de la composante numero 2 des coordonnees : '
126 print *,coo1
127
128! ** On desalloue le filtre
129 if (cret .eq. 0) then
130 call mfrdea(1,flt,cret)
131 endif
132 if (cret.ne.0) then
133 call efexit(-1)
134 endif
135
136
137! ** Lecture des noms des noeuds (optionnel dans un fichier MED) **
138 if (cret.eq.0) then
139 call mmhear(fid,maa,med_no_dt,med_no_it,med_node,med_none,nomnoe,cret)
140 endif
141
142 if (ret <0) then
143 inonoe = .false.
144 else
145 inonoe = .true.
146 endif
147
148! ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
149 if (cret.eq.0) then
150 call mmhenr(fid,maa,med_no_dt,med_no_it,med_node,med_none,numnoe,cret)
151 endif
152 if (ret <0) then
153 inunoe = .false.
154 else
155 inunoe = .true.
156 endif
157
158! ** Lecture des numeros de familles des noeuds **
159 if (cret.eq.0) then
160 call mmhfnr(fid,maa,med_no_dt,med_no_it,med_node,med_none,nufano,cret)
161 endif
162 print *,cret
163
164
165! ** Fermeture du fichier
166 call mficlo(fid,cret)
167 if (cret.ne.0) then
168 call efexit(-1)
169 endif
170
171
172! ** Affichage des resulats **
173 if (cret.eq.0) then
174
175
176 print *,"Type de repere : ", atype
177 print *,"Nom des coordonnees : "
178 print *, nomcoo
179
180 print *,"Unites des coordonnees : "
181 print *, unicoo
182
183 print *,"Coordonnees des noeuds : "
184 print *, coo
185
186 if (inonoe) then
187 print *,"Noms des noeuds : "
188 print *,nomnoe
189 endif
190
191 if (inunoe) then
192 print *,"Numeros des noeuds : "
193 print *,numnoe
194 endif
195
196 print *,"Numeros des familles des noeuds : "
197 print *,nufano
198
199 endif
200
201! ** Liberation memoire **
202 deallocate(coo,coo1,nomnoe,numnoe,nufano);
203
204
205! ** Code retour
206 call efexit(cret)
207
208 end program test5
209
210
211
212
213
214
#define true
#define false
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition medfilter.f:22
subroutine mfrall(nflt, flt, cret)
Definition medfilter.f:44
subroutine mfrdea(nflt, flt, cret)
Definition medfilter.f:60
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition medmesh.f:320
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:487
subroutine mmhcar(fid, name, numdt, numit, flt, coo, cret)
Definition medmesh.f:824
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:445
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition medmesh.f:551
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Definition medmesh.f:529
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110
program test5
Definition test5.f90:24