MED fichier
test5.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2017 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 fid
32 
33 ! ** la dimension du maillage et de l'espace de calcul**
34  integer mdim, sdim
35 ! ** nom du maillage de longueur maxi MED_SIZE_NAME **
36  character*64 maa
37  character*200 desc
38 ! ** le nombre de noeuds **
39  integer nnoe
40 ! ** table des coordonnees **
41  real*8, allocatable, dimension (:) :: coo,coo1
42 ! ** tables des noms et des unites des coordonnees **
43  character*16 nomcoo(2)
44  character*16 unicoo(2)
45 ! ** tables des noms, numeros, numeros de familles des noeuds **
46 ! autant d'elements que de noeuds - les noms ont pout longueur **
47 ! MED_SNAME_SIZE=16
48  character*16, allocatable, dimension (:) :: nomnoe
49  integer, allocatable, dimension (:) :: numnoe
50  integer, allocatable, dimension (:) :: nufano
51  integer i
52  logical inonoe,inunoe
53  integer type,chgt,tsf
54  integer flta(1)
55  integer*8 flt(1)
56  character(16) :: dtunit
57  integer nstep, stype, atype
58  integer swm
59 
60 ! Ouverture du fichier en lecture seule **
61  call mfiope(fid,'test4.med',med_acc_rdonly, cret)
62  print *,cret
63 
64 ! ** Lecture des infos concernant le premier maillage **
65  if (cret.eq.0) then
66  call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
67  endif
68  if (cret.ne.0) then
69  call efexit(-1)
70  endif
71 
72 
73 ! ** Combien de noeuds a lire **
74  if (cret.eq.0) then
75  nnoe = 0
76  call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
77  endif
78  print *,cret,' Nombre de noeuds : ',nnoe
79  if (cret.ne.0) then
80  call efexit(-1)
81  endif
82 
83 
84 ! ** Allocations memoires : **
85 ! ** table des coordonnees **
86 ! profil : (dimension * nombre de noeuds ) **
87 ! ** table des des numeros, des numeros de familles des noeuds
88 ! ** table des noms des noeuds **
89 
90  allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),stat=ret )
91  print *,ret
92  coo1(:)=0.0
93 
94 ! ** Lecture des composantes des coordonnees des noeuds avec et sans filtre **
95  if (cret.eq.0) then
96  call mmhcor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,cret)
97  endif
98  print *,'Lecture des toutes les composantes des coordonnees : '
99  print *,coo
100  if (cret.ne.0) then
101  call efexit(-1)
102  endif
103 
104 ! ** On cree un filtre
105  if (cret .eq. 0) then
106  call mfrall(1,flt,cret)
107  endif
108  if (cret.ne.0) then
109  call efexit(-1)
110  endif
111 
112  if (cret .eq. 0) then
113  call mfrcre(fid,nnoe,1,sdim,2,med_full_interlace,med_global_stmode, &
114  med_no_profile,med_undef_size,flta,flt(1),cret)
115  endif
116  if (cret.ne.0) then
117  call efexit(-1)
118  endif
119 
120 ! ** Lecture des composantes n°2 des coordonnees des noeuds
121  if (cret.eq.0) then
122  call mmhcar(fid,maa,med_no_dt,med_no_it,flt(1),coo1,cret)
123  endif
124  print *,'Lecture de la composante numero 2 des coordonnees : '
125  print *,coo1
126 
127 ! ** On desalloue le filtre
128  if (cret .eq. 0) then
129  call mfrdea(1,flt,cret)
130  endif
131  if (cret.ne.0) then
132  call efexit(-1)
133  endif
134 
135 
136 ! ** Lecture des noms des noeuds (optionnel dans un fichier MED) **
137  if (cret.eq.0) then
138  call mmhear(fid,maa,med_no_dt,med_no_it,med_node,med_none,nomnoe,cret)
139  endif
140 
141  if (ret <0) then
142  inonoe = .false.
143  else
144  inonoe = .true.
145  endif
146 
147 ! ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
148  if (cret.eq.0) then
149  call mmhenr(fid,maa,med_no_dt,med_no_it,med_node,med_none,numnoe,cret)
150  endif
151  if (ret <0) then
152  inunoe = .false.
153  else
154  inunoe = .true.
155  endif
156 
157 ! ** Lecture des numeros de familles des noeuds **
158  if (cret.eq.0) then
159  call mmhfnr(fid,maa,med_no_dt,med_no_it,med_node,med_none,nufano,cret)
160  endif
161  print *,cret
162 
163 
164 ! ** Fermeture du fichier
165  call mficlo(fid,cret)
166  if (cret.ne.0) then
167  call efexit(-1)
168  endif
169 
170 
171 ! ** Affichage des resulats **
172  if (cret.eq.0) then
173 
174 
175  print *,"Type de repere : ", atype
176  print *,"Nom des coordonnees : "
177  print *, nomcoo
178 
179  print *,"Unites des coordonnees : "
180  print *, unicoo
181 
182  print *,"Coordonnees des noeuds : "
183  print *, coo
184 
185  if (inonoe) then
186  print *,"Noms des noeuds : "
187  print *,nomnoe
188  endif
189 
190  if (inunoe) then
191  print *,"Numeros des noeuds : "
192  print *,numnoe
193  endif
194 
195  print *,"Numeros des familles des noeuds : "
196  print *,nufano
197 
198  endif
199 
200 ! ** Liberation memoire **
201  deallocate(coo,coo1,nomnoe,numnoe,nufano);
202 
203 
204 ! ** Code retour
205  call efexit(cret)
206 
207  end program test5
208 
209 
210 
211 
212 
213 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
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 mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition: medfilter.f:22
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:445
subroutine mfrdea(nflt, flt, cret)
Definition: medfilter.f:60
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Definition: medmesh.f:529
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
program test5
Definition: test5.f90:24
subroutine mfrall(nflt, flt, cret)
Definition: medfilter.f:44
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:41
#define false
Definition: libmedimport.c:36
subroutine mmhcar(fid, name, numdt, numit, flt, coo, cret)
Definition: medmesh.f:824
#define true
Definition: libmedimport.c:37