MED fichier: f/test20.f

MED fichier

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

f/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), dtunit
33 character*64 nomcha,nommaa
34 integer lmesh, ncst
35 C
36 C ** Ouverture du fichier test20-0.med en mode lecture ajout
37 call mfiope(fid,'test20-0.med',med_acc_rdext, 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 test20-0.med'
44 C
45 C ** Lecture du nombre de champ
46 call mfdnfd(fid,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 test20-0.med : ',ncha
53 C
54 C ** Montage du fichier test10-0.med (acces aux champs et maillages)
55 call mfiomn(fid, 'test10-0.med', med_field, 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-0.med'
62 C
63 C ** Lecture du nombre de champ apres montage
64 call mfdnfd(fid,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 test20-0.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 mfdnfc(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 10 continue
86 C
87 C
88 C ** Demontage de test10-0.med
89 call mfioun(fid, mid, med_field, cret)
90 print *,cret
91 if (cret .ne. 0 ) then
92 print *,'Erreur demontage du fichier'
93 call efexit(-1)
94 endif
95 print *,'On demonte le fichier test10-0.med'
96 C
97 C ** Lecture du nombre de champ apres demontage
98 call mfdnfd(fid,ncha,cret)
99 print *,cret
100 if (cret .ne. 0 ) then
101 print *,'Erreur lecture du nombre de champ'
102 call efexit(-1)
103 endif
104 print *,'Nombre de champs apres demontage : ',ncha
105 C
106 C ** Fermeture du fichier
107 call mficlo(fid,cret)
108 print *, cret
109 if (cret .ne. 0 ) then
110 print *,'Erreur fermeture du fichier'
111 call efexit(-1)
112 endif
113 print *,'On ferme le fichier test20-0.med'
114 C
115
116 C * Phase 2 : Test de montage de champs et de maillages
117 C dans un fichier vierge
118
119 C ** Creation du fichier test20.med
120 call mfiope(fid,'test20.med',med_acc_rdwr,cret)
121 print *,cret
122 if (cret .ne. 0 ) then
123 print *,'Erreur creation du fichier'
124 call efexit(-1)
125 endif
126 print *,'Creation du fichier test20.med'
127 C
128 C ** Montage du fichier test20-0.med (acces aux maillages)
129 call mfiomn(fid, 'test20-0.med', med_mesh, mid, cret)
130 print *,cret
131 if (cret .ne. 0 ) then
132 print *,'Erreur montage du fichier'
133 call efexit(-1)
134 endif
135 print *,'On monte le fichier test20-0.med'
136 C
137 C ** Lecture du nombre de maillage apres montage
138 call mmhnmh(fid,nmaa,cret)
139 print *,cret
140 if (cret .ne. 0 ) then
141 print *,'Erreur lecture du nombre de maillage'
142 call efexit(-1)
143 endif
144 print *,'Nombre de maillage apres montage : ', nmaa
145 C
146 C ** Montage du fichier test10-0.med (acces aux champs)
147 call mfiomn(fid, 'test10-0.med', med_field, mid2, cret)
148 print *,cret
149 if (cret .ne. 0 ) then
150 print *,'Erreur montage du fichier'
151 call efexit(-1)
152 endif
153 print *,'On monte le fichier test10-0.med'
154 C
155 C ** Lecture du nombre de champs apres montage
156 call mfdnfd(fid,ncha,cret)
157 print *,cret
158 if (cret .ne. 0 ) then
159 print *,'Erreur lecture du nombre de champ'
160 call efexit(-1)
161 endif
162 print *,'Nombre de champ apres montage : ',ncha
163 C
164 C ** Demontage de test10.med
165 call mfioun(fid, mid2,med_field,cret)
166 print *,cret
167 if (cret .ne. 0 ) then
168 print *,'Erreur demontage du fichier'
169 call efexit(-1)
170 endif
171 print *,'On demonte test10.med'
172 C
173 C ** Demontage de test20-0.med
174 call mfioun(fid, mid,med_mesh,cret)
175 print *,cret
176 if (cret .ne. 0 ) then
177 print *,'Erreur demontage du fichier'
178 call efexit(-1)
179 endif
180 print *,'On demonte test20-0.med'
181 C
182 C ** Fermeture du fichier
183 call mficlo(fid,cret)
184 print *,cret
185 if (cret .ne. 0 ) then
186 print *,'Erreur fermeture du fichier'
187 call efexit(-1)
188 endif
189 print *,'Fermeture du fichier test20.med'
190 C
191 end
192 C