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