MED fichier
f/2.3.6/test2.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 : test2.f
20
C *
21
C * - Description : exemples de creations de maillage MED
22
C *
23
C ******************************************************************************
24
program
test2
25
C
26
implicit none
27
include
'med.hf'
28
C
29
C
30
integer
cret,ret
31
integer*8
fid
32
33
character*200
des
34
35
C ** verifie que le fichier test1.med est au bon format **
36
call
effoco(
'test1.med'
,cret)
37
print *,cret
38
if
(cret .ne. 0 )
then
39
print *,
'Erreur à la vérification du format'
40
call
efexit(-1)
41
endif
42
43
C ** Ouverture en mode de lecture du fichier test1.med
44
call
efouvr(fid,
'test1.med'
,med_lecture, cret)
45
print *,cret
46
if
(cret .ne. 0 )
then
47
print *,
'Erreur ouverture du fichier en lecture'
48
call
efexit(-1)
49
endif
50
51
C ** Lecture de l'en-tete du fichier
52
call
effien (fid, med_fich_des,des,cret)
53
print *,cret
54
if
(cret .ne. 0 )
then
55
print *,
'Erreur lecture en-tete du fichier'
56
call
efexit(-1)
57
endif
58
print *,
"DESCRIPTEUR DE FICHIER : "
,des
59
60
61
C ** Fermeture du fichier test1.med
62
call
efferm (fid,cret)
63
print *,cret
64
if
(cret .ne. 0 )
then
65
print *,
'Erreur fermeture du fichier'
66
call
efexit(-1)
67
endif
68
69
70
C ** Ouverture en mode de creation du fichier test2.med
71
call
efouvr(fid,
'test2.med'
,med_lecture_ecriture, cret)
72
print *,cret
73
if
(cret .ne. 0 )
then
74
print *,
'Erreur creation du fichier'
75
call
efexit(-1)
76
endif
77
78
C ** Creation du maillage maa1 de type MED_NON_STRUCTURE
79
C ** et de dimension 3
80
C ** attention le ../test3 de V3.0 supposait une dimension 2
81
C ** ce qui propoquait un écrasement de mdim lors du traitement
82
C ** des chaines unites et nom des axes.
83
call
efmaac(fid,
'maa1'
,3,
84
& med_non_structure,
85
&
'un premier maillage'
,ret)
86
cret = cret + ret
87
C ** Creation du nom universel
88
call
efunvc(fid,
'maa1'
,ret)
89
cret = cret + ret
90
print *,cret
91
if
(cret .ne. 0 )
then
92
print *,
'Erreur creation du maillage'
93
call
efexit(-1)
94
endif
95
96
C ** Creation du maillage maa2 de type MED_NON_STRUCTURE
97
C ** et de dimension 2
98
call
efmaac(fid,
'maa2'
,2,
99
& med_non_structure,
100
&
'un second maillage'
,ret)
101
cret = cret + ret
102
C ** Ecriture de la dimension de l'espace : maillage
103
C ** de dimension 2 dans un espace de dimension 3
104
call
efespc(fid,
'maa2'
,3,ret)
105
cret = cret + ret
106
print *,cret
107
if
(cret .ne. 0 )
then
108
print *,
'Erreur creation du maillage'
109
call
efexit(-1)
110
endif
111
112
C ** Creation du maillage maa3 de type MED_STRUCTURE
113
C ** et de dimension 1
114
call
efmaac(fid,
'maa3'
,1,
115
& med_structure,
116
&
'un troisieme maillage'
,ret)
117
cret = cret + ret
118
print *,cret
119
if
(cret .ne. 0 )
then
120
print *,
'Erreur creation du maillage'
121
call
efexit(-1)
122
endif
123
124
C ** Fermeture du fichier
125
call
efferm (fid,cret)
126
print *,cret
127
if
(cret .ne. 0 )
then
128
print *,
'Erreur fermeture du fichier'
129
call
efexit(-1)
130
endif
131
C
132
end
133
134
135
136
137
test2
program test2
Definition:
test2.f:24
Généré par
1.8.16