MED fichier
f/2.3.6/test20.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2016 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 : test20.f
20 C *
21 C * - Description : montage/demontage de fichiers MED.
22 C *
23 C ******************************************************************************
24  program test20
25 C
26  implicit none
27  include 'med.hf'
28 C
29 C
30  integer cret, fid, ncha, nmaa, mid, mid2
31  integer i, ncomp, type
32  character*16 comp(3), unit(3)
33  character*32 nom
34 C
35 C ** Ouverture du fichier test2.med en mode lecture ajout
36  call efouvr(fid,'test2.med',med_lecture_ajout, cret)
37  print *,cret
38  if (cret .ne. 0 ) then
39  print *,'Erreur ouverture du fichier'
40  call efexit(-1)
41  endif
42  print *,'On ouvre le fichier test2.med'
43 C
44 C ** Lecture du nombre de champ
45  call efncha(fid,0,ncha,cret)
46  print *,cret
47  if (cret .ne. 0 ) then
48  print *,'Erreur lecture du nombre de champ'
49  call efexit(-1)
50  endif
51  print *,'Nombre de champs dans test2.med : ',ncha
52 C
53 C ** Montage du fichier test10.med (acces aux champs)
54  call efmont(fid,'test10.med',med_champ,mid,cret)
55  print *,cret
56  if (cret .ne. 0 ) then
57  print *,'Erreur montage du fichier'
58  call efexit(-1)
59  endif
60  print *,'On monte les champs du fichier test10.med'
61 C
62 C ** Lecture du nombre de champ apres montage
63  call efncha(fid,0,ncha,cret)
64  print *,cret
65  if (cret .ne. 0 ) then
66  print *,'Erreur lecture du nombre de champ'
67  call efexit(-1)
68  endif
69  print *,'Nombre de champs dans test2.med apres montage : ',ncha
70 C
71 C ** Acces a tous les champs de test10.med a travers le point de
72 C ** montage
73 C
74  do 10 i = 1,ncha
75 C
76 C ** Lecture du nombre de composante dans le champ
77  call efncha(fid,i,ncomp,cret)
78  print *,cret
79  if (cret .ne. 0 ) then
80  print *,'Erreur lecture du nombre de composante'
81  call efexit(-1)
82  endif
83 C
84 C ** Lecture des informations sur le champ
85  call efchai(fid,i,nom,type,comp,unit,ncomp,cret)
86  print *,cret
87  if (cret .ne. 0 ) then
88  print *,'Erreur lecture des infos sur le champ'
89  call efexit(-1)
90  endif
91  print *,'Champ de nom ',nom
92  print *,' avec ', ncomp, ' composantes'
93 C
94  10 continue
95 C
96 C
97 C ** Demontage de test10.med
98  call efdemo(fid,mid,med_champ,cret)
99  print *,cret
100  if (cret .ne. 0 ) then
101  print *,'Erreur demontage du fichier'
102  call efexit(-1)
103  endif
104  print *,'On demonte le fichier test10.med'
105 C
106 C ** Lecture du nombre de champ apres demontage
107  call efncha(fid,0,ncha,cret)
108  print *,cret
109  if (cret .ne. 0 ) then
110  print *,'Erreur lecture du nombre de champ'
111  call efexit(-1)
112  endif
113  print *,'Nombre de champs apres demontage : ',ncha
114 C
115 C ** Fermeture du fichier
116  call efferm(fid,cret)
117  print *, cret
118  if (cret .ne. 0 ) then
119  print *,'Erreur fermeture du fichier'
120  call efexit(-1)
121  endif
122  print *,'On ferme le fichier test2.med'
123 C
124 C ** Creation du fichier test20.med
125  call efouvr(fid,'test20.med',med_lecture_ecriture,cret)
126  print *,cret
127  if (cret .ne. 0 ) then
128  print *,'Erreur creation du fichier'
129  call efexit(-1)
130  endif
131  print *,'Creation du fichier test20.med'
132 C
133 C ** Montage du fichier test2.med (acces aux maillages)
134  call efmont(fid,'test2.med',med_maillage,mid,cret)
135  print *,cret
136  if (cret .ne. 0 ) then
137  print *,'Erreur montage du fichier'
138  call efexit(-1)
139  endif
140  print *,'On monte le fichier test2.med'
141 C
142 C ** Lecture du nombre de maillage apres montage
143  call efnmaa(fid,nmaa,cret)
144  print *,cret
145  if (cret .ne. 0 ) then
146  print *,'Erreur lecture du nombre de maillage'
147  call efexit(-1)
148  endif
149  print *,'Nombre de maillage apres montage : ', nmaa
150 C
151 C ** Montage du fichier test10.med (acces aux champs)
152  call efmont(fid,'test10.med',med_champ,mid2,cret)
153  print *,cret
154  if (cret .ne. 0 ) then
155  print *,'Erreur montage du fichier'
156  call efexit(-1)
157  endif
158  print *,'On monte le fichier test10.med'
159 C
160 C ** Lecture du nombre de champs apres montage
161  call efncha(fid,0,ncha,cret)
162  print *,cret
163  if (cret .ne. 0 ) then
164  print *,'Erreur lecture du nombre de champ'
165  call efexit(-1)
166  endif
167  print *,'Nombre de champ apres montage : ',ncha
168 C
169 C ** Demontage de test10.med
170  call efdemo(fid,mid2,med_champ,cret)
171  print *,cret
172  if (cret .ne. 0 ) then
173  print *,'Erreur demontage du fichier'
174  call efexit(-1)
175  endif
176  print *,'On demonte test10.med'
177 C
178 C ** Demontage de test2.med
179  call efdemo(fid,mid,med_maillage,cret)
180  print *,cret
181  if (cret .ne. 0 ) then
182  print *,'Erreur demontage du fichier'
183  call efexit(-1)
184  endif
185  print *,'On demonte test2.med'
186 C
187 C ** Fermeture du fichier
188  call efferm(fid,cret)
189  print *,cret
190  if (cret .ne. 0 ) then
191  print *,'Erreur fermeture du fichier'
192  call efexit(-1)
193  endif
194  print *,'Fermeture du fichier test20.med'
195 C
196  end
197 C