MED fichier
test20.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C ******************************************************************************
19C * - Nom du fichier : test20.f
20C *
21C * - Description : montage/demontage de fichiers MED.
22C *
23C ******************************************************************************
24 program test20
25C
26 implicit none
27 include 'med.hf'
28C
29C
30 integer*8 fid, mid, mid2
31 integer cret, ncha, nmaa
32 integer i, ncomp, type
33 character*16 comp(3), unit(3), dtunit
34 character*64 nomcha,nommaa
35 integer lmesh, ncst
36C
37C ** Ouverture du fichier test20-0.med en mode lecture ajout
38 call mfiope(fid,'test20-0.med',med_acc_rdext, cret)
39 print *,cret
40 if (cret .ne. 0 ) then
41 print *,'Erreur ouverture du fichier'
42 call efexit(-1)
43 endif
44 print *,'On ouvre le fichier test20-0.med'
45C
46C ** Lecture du nombre de champ
47 call mfdnfd(fid,ncha,cret)
48 print *,cret
49 if (cret .ne. 0 ) then
50 print *,'Erreur lecture du nombre de champ'
51 call efexit(-1)
52 endif
53 print *,'Nombre de champs dans test20-0.med : ',ncha
54C
55C ** Montage du fichier test10-0.med (acces aux champs et maillages)
56 call mfiomn(fid, 'test10-0.med', med_field, mid, cret)
57 print *,cret
58 if (cret .ne. 0 ) then
59 print *,'Erreur montage du fichier'
60 call efexit(-1)
61 endif
62 print *,'On monte les champs du fichier test10-0.med'
63C
64C ** Lecture du nombre de champs apres montage
65 call mfdnfd(fid,ncha,cret)
66 print *,cret
67 if (cret .ne. 0 ) then
68 print *,'Erreur lecture du nombre de champs'
69 call efexit(-1)
70 endif
71 print *,'Nombre de champs dans test20-0.med apres montage : ',ncha
72C
73C ** Acces a tous les champs de test10.med a travers le point de
74C ** montage
75C
76 do 10 i = 1,ncha
77C
78C ** Lecture du nombre de composante dans le champ
79 call mfdnfc(fid,i,ncomp,cret)
80 print *,cret
81 if (cret .ne. 0 ) then
82 print *,'Erreur lecture du nombre de composante'
83 call efexit(-1)
84 endif
85C
86 10 continue
87C
88C
89C ** Demontage de test10-0.med
90 call mfioun(fid, mid, med_field, cret)
91 print *,cret
92 if (cret .ne. 0 ) then
93 print *,'Erreur demontage du fichier'
94 call efexit(-1)
95 endif
96 print *,'On demonte le fichier test10-0.med'
97C
98C ** Lecture du nombre de champ apres demontage
99 call mfdnfd(fid,ncha,cret)
100 print *,cret
101 if (cret .ne. 0 ) then
102 print *,'Erreur lecture du nombre de champ'
103 call efexit(-1)
104 endif
105 print *,'Nombre de champs apres demontage : ',ncha
106C
107C ** Fermeture du fichier
108 call mficlo(fid,cret)
109 print *, cret
110 if (cret .ne. 0 ) then
111 print *,'Erreur fermeture du fichier'
112 call efexit(-1)
113 endif
114 print *,'On ferme le fichier test20-0.med'
115C
116
117C * Phase 2 : Test de montage de champs et de maillages
118C dans un fichier vierge
119
120C ** Creation du fichier test20.med
121 call mfiope(fid,'test20.med',med_acc_rdwr,cret)
122 print *,cret
123 if (cret .ne. 0 ) then
124 print *,'Erreur creation du fichier'
125 call efexit(-1)
126 endif
127 print *,'Creation du fichier test20.med'
128C
129C ** Montage du fichier test20-0.med (acces aux maillages)
130 call mfiomn(fid, 'test20-0.med', med_mesh, mid, cret)
131 print *,cret
132 if (cret .ne. 0 ) then
133 print *,'Erreur montage du fichier'
134 call efexit(-1)
135 endif
136 print *,'On monte le fichier test20-0.med'
137C
138C ** Lecture du nombre de maillage apres montage
139 call mmhnmh(fid,nmaa,cret)
140 print *,cret
141 if (cret .ne. 0 ) then
142 print *,'Erreur lecture du nombre de maillage'
143 call efexit(-1)
144 endif
145 print *,'Nombre de maillage apres montage : ', nmaa
146C
147C ** Montage du fichier test10-0.med (acces aux champs)
148 call mfiomn(fid, 'test10-0.med', med_field, mid2, cret)
149 print *,cret
150 if (cret .ne. 0 ) then
151 print *,'Erreur montage du fichier'
152 call efexit(-1)
153 endif
154 print *,'On monte le fichier test10-0.med'
155C
156C ** Lecture du nombre de champs apres montage
157 call mfdnfd(fid,ncha,cret)
158 print *,cret
159 if (cret .ne. 0 ) then
160 print *,'Erreur lecture du nombre de champ'
161 call efexit(-1)
162 endif
163 print *,'Nombre de champ apres montage : ',ncha
164C
165C ** Demontage de test10.med
166 call mfioun(fid, mid2,med_field,cret)
167 print *,cret
168 if (cret .ne. 0 ) then
169 print *,'Erreur demontage du fichier'
170 call efexit(-1)
171 endif
172 print *,'On demonte test10.med'
173C
174C ** Demontage de test20-0.med
175 call mfioun(fid, mid,med_mesh,cret)
176 print *,cret
177 if (cret .ne. 0 ) then
178 print *,'Erreur demontage du fichier'
179 call efexit(-1)
180 endif
181 print *,'On demonte test20-0.med'
182C
183C ** Fermeture du fichier
184 call mficlo(fid,cret)
185 print *,cret
186 if (cret .ne. 0 ) then
187 print *,'Erreur fermeture du fichier'
188 call efexit(-1)
189 endif
190 print *,'Fermeture du fichier test20.med'
191C
192 end
193C
subroutine mfdnfd(fid, n, cret)
Definition medfield.f:180
subroutine mfdnfc(fid, ind, n, cret)
Definition medfield.f:202
subroutine mfioun(fid, mid, class, cret)
Definition medfile.f:211
subroutine mfiomn(fid, fname, class, mid, cret)
Definition medfile.f:187
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mmhnmh(fid, n, cret)
Definition medmesh.f:41
program test20
Definition test20.f:24