MED fichier
Documentation MED
Guides d'utilisation
Guides de référence
f/2.3.6/test32.f
1
C* This file is part of MED.
2
C*
3
C* COPYRIGHT (C) 1999 - 2016 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
19
C ******************************************************************************
20
C * - Nom du fichier : test32.f
21
C *
22
C * - Description : lecture nominale d'une numerotation globale dans un maillage MED
23
C *
24
C ******************************************************************************
25
program
test32
26
C
27
implicit none
28
include
'med.hf'
29
C
30
C
31
integer
cret,fid
32
character*32
maa
33
character*200
des
34
integer
nmaa, mdim , nnoe,type
35
36
integer
numglb(100),i
37
38
39
C ** Ouverture du fichier test31.med **
40
call
efouvr(fid,
'test31.med'
,med_lecture, cret)
41
print
'(I1)'
,cret
42
if
(cret .ne. 0 )
then
43
print *,
'Erreur ouverture du fichier test31.med'
44
call
efexit(-1)
45
endif
46
47
48
C ** lecture du nombre de maillage **
49
50
call
efnmaa(fid,nmaa,cret)
51
print
'(I1)'
,cret
52
if
(cret .ne. 0 )
then
53
print *,
'Erreur lecture du nombre de maillage'
54
call
efexit(-1)
55
endif
56
print
'(A,I1)'
,
'Nombre de maillages = '
,nmaa
57
58
C ** lecture des infos pour le premier maillage
59
60
61
call
efmaai(fid,1,maa,mdim,
type
,des,cret)
62
print
'(I1)'
,cret
63
if
(cret .ne. 0 )
then
64
print *,
'Erreur acces au premier maillage'
65
call
efexit(-1)
66
endif
67
68
nnoe = 0
69
call
efnema(fid,maa,med_coor,med_noeud,0,0,nnoe,cret)
70
if
(cret .ne. 0 )
then
71
print *,
'Erreur acces au nombre de noeud du premier maillage'
72
call
efexit(-1)
73
endif
74
75
76
print
'(A,I1,A,A4,A,I1,A,I4)'
,
'maillage '
77
& ,0,
' de nom '
,maa,
' et de dimension '
,mdim,
78
&
' comportant le nombre de noeud '
,nnoe
79
80
81
C ** lecture de la numerotation globale
82
83
call
efgnml(fid,maa,numglb,min(nnoe,100),med_noeud,0,cret)
84
85
if
(cret .ne. 0 )
then
86
print *,
'Erreur lecture numerotation globale '
87
call
efexit(-1)
88
endif
89
90
91
C ** Ecriture à l'ecran des numeros globaux
92
93
do
i=1,min(nnoe,100)
94
print
'(A,I3,A,I4)'
,
95
&
'Numero global du noeud '
,i,
' : '
,numglb(i)
96
enddo
97
98
99
C ** Fermeture du fichier **
100
call
efferm (fid,cret)
101
print
'(I1)'
,cret
102
if
(cret .ne. 0 )
then
103
print *,
'Erreur fermeture du fichier'
104
call
efexit(-1)
105
endif
106
C
107
end
Généré le Lundi 7 Novembre 2016 14:19:23 pour MED fichier par
1.8.9.1