MED fichier
tests
f
test33.f
Aller à la documentation de ce fichier.
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 : test33.f
21
C *
22
C * - Description : lecture d'une numerotation globale inexistante dans un maillage MED
23
C *
24
C ******************************************************************************
25
program
test33
26
27
C
28
implicit none
29
include
'med.hf'
30
C
31
C
32
integer*8
fid
33
integer
cret
34
character*64
maa
35
character*200
desc
36
integer
nmaa,mdim,
type
,narr,chgt,tsf
37
integer
numglb(100)
38
39
40
41
42
C ** Ouverture du fichier test31.med **
43
call
mfiope
(fid,
'test31.med'
,med_acc_rdonly, cret)
44
print
'(I1)'
,cret
45
if
(cret .ne. 0 )
then
46
print *,
'Erreur ouverture du fichier test31.med'
47
call
efexit(-1)
48
endif
49
50
51
C ** lecture des infos pour le premier maillage
52
call
mmhnme
(fid,
'maa1'
,med_no_dt,med_no_it,
53
& med_descending_edge,med_seg2,
54
& med_connectivity,med_descending,
55
& chgt,tsf,narr,cret)
56
if
(cret .ne. 0 )
then
57
print *,
'Erreur acces au nombre d'
'arretes'
,
58
&
' du premier maillage'
59
call
efexit(-1)
60
endif
61
62
63
print
'(A,I1,A,A4,A,I4)'
,
'maillage '
64
& ,0,
' de nom '
,
'maa1'
,
65
&
' comportant le nombre d'
'arretes '
,narr
66
67
68
C ** lecture de la numerotation globale liée aux arretes
69
call
mmhgnr
(fid,
'maa1'
,med_no_dt,med_no_it,med_descending_edge,
70
& med_seg2,numglb,cret)
71
72
if
(cret .ge. 0 )
then
73
print
'(A)'
,
'Erreur lecture numerotation globale ARRETE'
74
print
'(A)'
,
'cette numerotation devait etre inexistante '
75
call
efexit(-1)
76
endif
77
print *,
"Ce test doit générer une erreur."
78
79
C ** Fermeture du fichier **
80
call
mficlo
(fid,cret)
81
print
'(I1)'
,cret
82
if
(cret .ne. 0 )
then
83
print *,
'Erreur fermeture du fichier'
84
call
efexit(-1)
85
endif
86
C
87
end
mmhgnr
subroutine mmhgnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition:
medmesh.f:997
test33
program test33
Definition:
test33.f:25
mfiope
subroutine mfiope(fid, name, access, cret)
Definition:
medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition:
medfile.f:82
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition:
medmesh.f:551
Généré par
1.8.17