MED fichier
Documentation MED
Guides d'utilisation
Guides de référence
f/test3.f
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
C ******************************************************************************
19
C * - Nom du fichier : test3.f
20
C *
21
C * - Description : lecture des informations sur les maillages dans un fichier
22
C* MED.
23
C *
24
C ******************************************************************************
25
program
test3
26
C
27
implicit none
28
include
'med.hf'
29
C
30
C
31
integer
cret,fid,cres,
type
,cnu
32
character*64
maa
33
character*80
nomu
34
character*200
desc
35
integer
nmaa,i,mdim,edim,nstep,stype,atype
36
C ** chgt de dim 2->3 car le fichier dump.ref/test2.med en 2.3.6 est utilisé comme référence
37
C ** (il contient un maillage de dimension 3 et un espace induit de dimension 3
38
C ** car pas de coordonée stockée)
39
C ** dans 2.3v3.0 qui utilise ce test3 en v3.0 qui défini nomcoo et unicoo en dimension 2
40
C character*16 nomcoo(2)
41
C character*16 unicoo(2)
42
character*16
nomcoo(3)
43
character*16
unicoo(3)
44
character*16
dtunit
45
integer
maa1exist,maa4exist
46
47
C ** Ouverture du fichier en lecture seule
48
call
mfiope
(fid,
'test2.med'
,med_acc_rdonly, cret)
49
print *,cret
50
if
(cret .ne. 0 )
then
51
print *,
'Erreur ouverture du fichier en lecture'
52
call
efexit(-1)
53
endif
54
55
C ** Test de la présence d'un maillage
56
call
mfioex
(fid,med_mesh,
"maa1"
, maa1exist, cret)
57
print *,cret
58
if
(cret .ne. 0 )
then
59
print *,
'Erreur de test de présence de maillage'
60
call
efexit(-1)
61
endif
62
print *,
"Maillage maa1 existe : "
,maa1exist
63
64
call
mfioex
(fid,med_mesh,
"maa4"
, maa4exist, cret)
65
print *,cret
66
if
(cret .ne. 0 )
then
67
print *,
'Erreur de test de présence de maillage'
68
call
efexit(-1)
69
endif
70
print *,
"Maillage maa4 existe : "
,maa4exist
71
72
C ** lecture du nombre de maillage **
73
call
mmhnmh
(fid,nmaa,cret)
74
print *,cret
75
if
(cret .ne. 0 )
then
76
print *,
'Erreur lecture du nombre de maillage'
77
call
efexit(-1)
78
endif
79
print *,
'Nombre de maillages = '
,nmaa
80
81
C ** lecture des infos sur les maillages : **
82
C ** - nom, dimension, type,description
83
C ** - options : nom universel, dimension de l'espace
84
do
i=1,nmaa
85
call
mmhmii
(fid,i,maa,edim,mdim,
type
,desc,
86
& dtunit,stype,nstep,atype,
87
& nomcoo,unicoo,cret)
88
call
mmhunr
(fid,maa,nomu,cnu)
89
print *,cret
90
if
(cret .ne. 0 )
then
91
print *,
'Erreur acces au maillage'
92
call
efexit(-1)
93
endif
94
print
'(A,I1,A,A4,A,I1,A,A65,A65)'
,
'maillage '
95
& ,i,
' de nom '
,maa,
' et de dimension '
,mdim,
96
&
' de description '
,desc
97
if
(type.eq.med_unstructured_mesh)
then
98
print *,
'Maillage non structure'
99
else
100
print *,
'Maillage structure'
101
endif
102
print *,
'Dimension espace '
, edim
103
print *,
'Dimension maillage '
, mdim
104
if
(cnu.eq.0)
then
105
print *,
'Nom universel : '
,nomu
106
else
107
print *,
'Pas de nom universel'
108
endif
109
print *,
'dt unit = '
, dtunit
110
print *,
'sorting type ='
, stype
111
print *,
'number of computing step ='
, nstep
112
print *,
'coordinates axis type ='
, atype
113
print *,
'coordinates axis name ='
, nomcoo(1),nomcoo(2)
114
print *,
'coordinates axis units ='
, unicoo(1),unicoo(2)
115
enddo
116
117
C ** fermeture du fichier
118
call
mficlo
(fid,cret)
119
print *,cret
120
if
(cret .ne. 0 )
then
121
print *,
'Erreur fermeture du fichier'
122
call
efexit(-1)
123
endif
124
C
125
end
126
Généré le Mardi 31 Octobre 2017 17:15:26 pour MED fichier par
1.8.9.1