1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
25
26 implicit none
27 include 'med.hf'
28
29
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
37
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
46
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
55
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
64
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
73
74
75
76 do 10 i = 1,ncha
77
78
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
86 10 continue
87
88
89
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
98
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
107
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
116
117
118
119
120
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
129
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
138
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
147
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
156
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
165
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
174
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
183
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
192 end
193
subroutine mfdnfd(fid, n, cret)
subroutine mfdnfc(fid, ind, n, cret)
subroutine mfioun(fid, mid, class, cret)
subroutine mfiomn(fid, fname, class, mid, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhnmh(fid, n, cret)