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