MED fichier
test32.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 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*64 maa
33  character*200 des
34  integer nmaa, mdim ,nnoe,type,sdim
35  character*16 nomcoo(2)
36  character*16 unicoo(2)
37  character(16) :: dtunit
38  integer nstep, stype, atype,chgt,tsf
39  integer numglb(100),i
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 C ** lecture des infos pour le premier maillage
51 
52  call mmhmii(fid,1,maa,sdim,mdim,type,des,dtunit,
53  & stype,nstep,atype,nomcoo,unicoo,cret)
54  print '(I1)',cret
55  if (cret .ne. 0 ) then
56  print *,'Erreur acces au premier maillage'
57  call efexit(-1)
58  endif
59 
60  nnoe = 0
61  call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,
62  & med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
63  if (cret .ne. 0 ) then
64  print *,'Erreur acces au nombre de noeud du premier maillage'
65  call efexit(-1)
66  endif
67 
68 
69  print '(A,I1,A,A4,A,I1,A,I4)','maillage '
70  & ,0,' de nom ',maa,' et de dimension ',mdim,
71  & ' comportant le nombre de noeud ',nnoe
72 
73 
74 C ** lecture de la numerotation globale
75  call mmhgnr(fid,maa,med_no_dt,med_no_it,med_node,med_none,
76  & numglb,cret)
77 
78  if (cret .ne. 0 ) then
79  print *,'Erreur lecture numerotation globale '
80  call efexit(-1)
81  endif
82 
83 
84 C ** Ecriture à l'ecran des numeros globaux
85 
86  do i=1,min(nnoe,100)
87  print '(A,I3,A,I4)',
88  & 'Numero global du noeud ',i,' : ',numglb(i)
89  enddo
90 
91 
92 C ** Fermeture du fichier **
93  call mficlo(fid,cret)
94  print '(I1)',cret
95  if (cret .ne. 0 ) then
96  print *,'Erreur fermeture du fichier'
97  call efexit(-1)
98  endif
99 C
100  end
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 mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:106
program test32
Definition: test32.f:25
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41