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