MED fichier
f/test32.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 : test32.f
21C *
22C * - Description : lecture nominale d'une numerotation globale dans un maillage MED
23C *
24C ******************************************************************************
25 program test32
26C
27 implicit none
28 include 'med.hf'
29C
30C
31 integer*8 fid
32 integer cret
33 character*64 maa
34 character*200 des
35 integer nmaa, mdim ,nnoe,type,sdim
36 character*16 nomcoo(2)
37 character*16 unicoo(2)
38 character(16) :: dtunit
39 integer nstep, stype, atype,chgt,tsf
40 integer numglb(100),i
41
42
43C ** Ouverture du fichier test31.med **
44 call mfiope(fid,'test31.med',med_acc_rdonly, cret)
45 print '(I1)',cret
46 if (cret .ne. 0 ) then
47 print *,'Erreur ouverture du fichier test31.med'
48 call efexit(-1)
49 endif
50
51C ** lecture des infos pour le premier maillage
52
53 call mmhmii(fid,1,maa,sdim,mdim,type,des,dtunit,
54 & stype,nstep,atype,nomcoo,unicoo,cret)
55 print '(I1)',cret
56 if (cret .ne. 0 ) then
57 print *,'Erreur acces au premier maillage'
58 call efexit(-1)
59 endif
60
61 nnoe = 0
62 call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,
63 & med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
64 if (cret .ne. 0 ) then
65 print *,'Erreur acces au nombre de noeud du premier maillage'
66 call efexit(-1)
67 endif
68
69
70 print '(A,I1,A,A4,A,I1,A,I4)','maillage '
71 & ,0,' de nom ',maa,' et de dimension ',mdim,
72 & ' comportant le nombre de noeud ',nnoe
73
74
75C ** lecture de la numerotation globale
76 call mmhgnr(fid,maa,med_no_dt,med_no_it,med_node,med_none,
77 & numglb,cret)
78
79 if (cret .ne. 0 ) then
80 print *,'Erreur lecture numerotation globale '
81 call efexit(-1)
82 endif
83
84
85C ** Ecriture à l'ecran des numeros globaux
86
87 do i=1,min(nnoe,100)
88 print '(A,I3,A,I4)',
89 & 'Numero global du noeud ',i,' : ',numglb(i)
90 enddo
91
92
93C ** Fermeture du fichier **
94 call mficlo(fid,cret)
95 print '(I1)',cret
96 if (cret .ne. 0 ) then
97 print *,'Erreur fermeture du fichier'
98 call efexit(-1)
99 endif
100C
101 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 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:110
subroutine mmhgnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:997
program test32
Definition: test32.f:25