MED fichier
f/test33.f
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18
19C ******************************************************************************
20C * - Nom du fichier : test33.f
21C *
22C * - Description : lecture d'une numerotation globale inexistante dans un maillage MED
23C *
24C ******************************************************************************
25 program test33
26
27C
28 implicit none
29 include 'med.hf'
30C
31C
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
42C ** 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
51C ** 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
68C ** 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 gnrer une erreur."
78
79C ** 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
86C
87 end
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
subroutine mmhgnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:997
program test33
Definition: test33.f:25