MED fichier: Fichier source de test5.f90

MED fichier

test5.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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
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
true
#define true
Definition: libmedimport.c:37
false
#define false
Definition: libmedimport.c:36
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
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
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
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
test5
program test5
Definition: test5.f90:24
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42