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