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