29 integer ret,fid,USER_INTERLACE,USER_MODE
32 character*64 maa1,maa2,maa3
33 character*13 lien_maa2
34 character*16 nomcoo(3)
35 character*16 unicoo(3)
38 character*16 comp1(2), unit1(2)
39 character*16 dtunit1, nounit
44 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
45 integer nval1_1, nent1_1
50 real*8 gscoo1_2(6), wg1_2(3)
51 integer nval1_2, nent1_2
55 integer ngauss1_3,nval1_3, nent1_3
61 character*16 comp2(3), unit2(3)
63 integer valr2(5*3), valr2p(3*3)
67 character*16 comp3(2), unit3(2)
68 integer ncomp3, nval3, nent3
69 integer valr3(5*4*2), valr3p(3*4*2)
72 character*64 nomprofil1
73 integer profil1(2) , profil2(3)
75 parameter(user_interlace = med_full_interlace)
76 parameter(user_mode = med_compact_stmode )
77 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
78 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
80 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
81 parameter( lien_maa2=
"./testfoo.med" )
83 parameter( nomcha1 =
"champ reel" )
84 parameter( ncomp1 = 2 )
85 parameter( dtunit1 =
" ")
86 parameter( nounit =
" ")
88 parameter( gauss1_1 =
"Model n1" )
89 parameter( ngauss1_1 = 6 )
91 parameter( gauss1_2 =
"Model n2" )
92 parameter( ngauss1_2 = 3 )
94 parameter( ngauss1_3 = 6 )
95 parameter( nval1_3 = 6 )
97 parameter( nomcha2=
"champ entier")
98 parameter( ncomp2 = 3, nval2= 5 )
100 parameter( nomcha3=
"champ entier 3")
101 parameter( ncomp3 = 2, nval3= 5*4 )
103 parameter( nomprofil1 =
"PROFIL(champ(1))" )
107 data comp1 /
"comp1",
"comp2"/
108 data unit1 /
"unit1",
"unit2"/
112 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
113 1 0.0,-1.0, 0.0,0.0 /
114 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
115 1 20.0,21.0, 22.0,23.0/
118 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
119 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
120 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
123 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
124 1 20.0,21.0, 22.0,23.0 /
125 data valr1_3p / 2.0,3.0, 10.0,11.0 /
127 data comp2 /
"comp1",
"comp2",
"comp3"/
128 data unit2 /
"unit1",
"unit2",
"unit3"/
129 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
130 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
133 data comp3 /
"comp1",
"comp2"/
134 data unit3 /
"unit1",
"unit2"/
135 data valr3 / 0,1, 10,11, 20,21, 30,31,
136 1 40,41, 50,51, 60,61, 70,71,
137 1 80,81, 90,91, 100,101, 110,111,
138 1 120,121, 130,131, 140,141, 150,151,
139 1 160,161, 170,171, 180,181, 190,191 /
140 data valr3p / 0,1, 10,11, 20,21, 30,31,
141 1 80,81, 90,91, 100,101, 110,111,
142 1 160,161, 170,171, 180,181, 190,191 /
149 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
174 gscoo1_2(1) = -2.0d0/3
175 gscoo1_2(2) = 1.0d0/3
176 gscoo1_2(3) = -2.0d0/3
177 gscoo1_2(4) = -2.0d0/3
178 gscoo1_2(5) = 1.0d0/3
179 gscoo1_2(6) = -2.0d0/3
186 call mfivop(fid,
'test10.med', med_acc_rdwr,
187 & med_major_num, med_minor_num, med_release_num, ret)
189 if (ret .ne. 0 )
then
190 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med'
196 & med_unstructured_mesh,
'Maillage vide',
197 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
199 if (ret .ne. 0 )
then
200 print *,
'Erreur à la création du maillage : ', maa1
206 & med_unstructured_mesh,
'Maillage vide',
207 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
209 if (ret .ne. 0 )
then
210 print *,
'Erreur à la création du maillage : ', maa3
219 if (ret .ne. 0 )
then
220 print *,
'Erreur à la création du champ : ', nomcha1
228 if (ret .ne. 0 )
then
229 print *,
'Erreur à la création du champ : ', nomcha2
234 call mlnliw(fid,maa2,lien_maa2,ret)
236 if (ret .ne. 0 )
then
237 print *,
'Erreur à la création du lien : ', lien_maa2
243 call mlclow(fid,gauss1_1,med_tria6,2,refcoo1,user_interlace,
244 & ngauss1_1,gscoo1_1, wg1_1,med_no_interpolation,
245 & med_no_mesh_support, ret)
247 if (ret .ne. 0 )
then
248 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
253 call mlclow(fid,gauss1_2,med_tria6,2,refcoo1,user_interlace,
254 & ngauss1_2,gscoo1_2, wg1_2,med_no_interpolation,
255 & med_no_mesh_support, ret)
257 if (ret .ne. 0 )
then
258 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
267 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
268 & med_tria6,user_mode,med_allentities_profile,
269 & gauss1_1,user_interlace,2,nent1_1,valr1_1,ret)
271 if (ret .ne. 0 )
then
272 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1'
279 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
280 & med_tria6,user_mode,med_allentities_profile,
281 & gauss1_1,user_interlace,1,nent1_1,valr1_1,ret)
283 if (ret .ne. 0 )
then
284 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2'
294 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
295 & user_mode,med_allentities_profile,gauss1_2,
296 & user_interlace,1,nent1_2,valr1_2,ret)
298 if (ret .ne. 0 )
then
299 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3'
308 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
309 & user_mode,med_allentities_profile,gauss1_2,
310 & user_interlace,2,nent1_2,valr1_2,ret)
312 if (ret .ne. 0 )
then
313 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4'
322 call mfdrpw(fid,nomcha1,1,2,dt,med_cell,med_tria6,
323 & user_mode,med_allentities_profile,gauss1_1,
324 & user_interlace,1,nent1_1,valr1_1,ret)
326 if (ret .ne. 0 )
then
327 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5'
333 call mpfprw(fid,nomprofil1,1,profil1,ret)
335 if (ret .ne. 0 )
then
336 print *,
'Erreur à la création du profil : ', nomprofil1
347 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
348 & user_mode, nomprofil1, med_no_localization,
349 & user_interlace,med_all_constituent,
350 & nval1_3,valr1_3p,ret)
352 if (ret .ne. 0 )
then
353 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6'
362 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
363 & user_mode, nomprofil1, gauss1_2,
364 & user_interlace,med_all_constituent,
365 & nent1_2,valr1_2p,ret)
367 if (ret .ne. 0 )
then
368 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7'
379 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
380 & user_mode, nomprofil1, med_no_localization,
382 & nent1_3,valr1_3p,ret)
384 if (ret .ne. 0 )
then
385 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8a'
395 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
396 & user_mode, nomprofil1, med_no_localization,
398 & nent1_3,valr1_3p,ret)
400 if (ret .ne. 0 )
then
401 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8b'
410 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
411 & med_descending_edge,med_seg2,user_interlace,
414 if (ret .ne. 0 )
then
415 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1'
424 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
425 & med_node,med_none,user_interlace,
428 if (ret .ne. 0 )
then
429 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2'
439 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
440 & med_descending_face,med_tria6,user_interlace,
443 if (ret .ne. 0 )
then
444 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3'
450 call mpfprw(fid,
"PROFIL(champ2)",3,profil2,ret)
452 if (ret .ne. 0 )
then
453 print *,
'Erreur à l''écriture du profil : ',
465 call mfdipw(fid,nomcha2,med_no_dt,med_no_it,dt,
466 & med_cell,med_tria6,user_mode,
"PROFIL(champ2)",
467 & med_no_localization,user_interlace,3,
470 if (ret .ne. 0 )
then
471 print *,
'Erreur à l''écriture du profil : ',
480 if (ret .ne. 0 )
then
481 print *,
'Erreur à la création du champ : ', nomcha3
490 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
491 & med_cell,med_quad4,user_interlace,
494 if (ret .ne. 0 )
then
495 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.1'
504 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
505 & med_node_element,med_quad4,user_interlace,
506 & med_all_constituent,nent3,valr3,ret)
508 if (ret .ne. 0 )
then
509 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.2'
523 call mfdipw(fid,nomcha3,med_no_dt,med_no_it,dt,
524 & med_node_element,med_quad4,user_mode,
525 &
"PROFIL(champ2)",med_no_localization,
526 & user_interlace,med_all_constituent,
529 if (ret .ne. 0 )
then
530 print *,
'Erreur à l''écriture du profil : ',
537 if (ret .ne. 0 )
then
538 print *,
'Erreur à la fermeture du fichier : '
542 print *,
"Le code retour : ",ret
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
subroutine mfdrpw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
Cette fonction permet d'écrire les valeurs d'un champ définies sur des entités d'un maillage pour une...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mlclow(fid, lname, gtype, sdim, ecoo, swm, nip, ipcoo, wght, giname, isname, cret)
Cette routine permet l'écriture d'une localisation localizationname de points d'intégration dans/auto...
subroutine mlnliw(fid, mname, lname, cret)
Cette routine permet d'écrire un lien dans un fichier MED.
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
subroutine mfdivw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
Cette fonction permet d'écrire les valeurs d'un champ définies sur des entités d'un maillage pour une...
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
Cette fonction crée un champ dans un fichier.
subroutine mfdipw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
Cette fonction permet d'écrire les valeurs d'un champ définies sur des entités d'un maillage pour une...
subroutine mfivop(fid, name, access, major, minor, rel, cret)
Ouverture d'un fichier MED en indiquant la version du modèle à utiliser en cas de création d'un nouve...