MED fichier
test20.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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), dtunit
34  character*64 nomcha,nommaa
35  integer lmesh, ncst
36 C
37 C ** 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'
45 C
46 C ** 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
54 C
55 C ** 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'
63 C
64 C ** 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
72 C
73 C ** Acces a tous les champs de test10.med a travers le point de
74 C ** montage
75 C
76  do 10 i = 1,ncha
77 C
78 C ** 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
85 C
86  10 continue
87 C
88 C
89 C ** 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'
97 C
98 C ** 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
106 C
107 C ** 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'
115 C
116 
117 C * Phase 2 : Test de montage de champs et de maillages
118 C dans un fichier vierge
119 
120 C ** 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'
128 C
129 C ** 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'
137 C
138 C ** 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
146 C
147 C ** 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'
155 C
156 C ** 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
164 C
165 C ** 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'
173 C
174 C ** 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'
182 C
183 C ** 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'
191 C
192  end
193 C
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfdnfd
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:180
test20
program test20
Definition: test20.f:24
mfiomn
subroutine mfiomn(fid, fname, class, mid, cret)
Definition: medfile.f:187
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mfdnfc
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:202
mfioun
subroutine mfioun(fid, mid, class, cret)
Definition: medfile.f:211