MED fichier: f/2.3.6/test20.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

f/2.3.6/test20.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 : 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