MED fichier
test5.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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 
mmhcar
subroutine mmhcar(fid, name, numdt, numit, flt, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:824
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
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:487
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet de lire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:445
false
#define false
Definition: libmedimport.c:36
true
#define true
Definition: libmedimport.c:37
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
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
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
mfrcre
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Crée une selection d'entités grâce a un tableau d'index filterarray de taille filterarraysize....
Definition: medfilter.f:22
mmhear
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Cette routine permet de lire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:529
test5
program test5
Definition: test5.f90:24