30 integer ret,USER_INTERLACE,USER_MODE
33 character*64 maa1,maa2,maa3
34 character*13 lien_maa2
35 character*16 nomcoo(3)
36 character*16 unicoo(3)
39 character*16 comp1(2), unit1(2)
40 character*16 dtunit1, nounit
45 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
46 integer nval1_1, nent1_1
51 real*8 gscoo1_2(6), wg1_2(3)
52 integer nval1_2, nent1_2
56 integer ngauss1_3,nval1_3, nent1_3
62 character*16 comp2(3), unit2(3)
64 integer valr2(5*3), valr2p(3*3)
68 character*16 comp3(2), unit3(2)
69 integer ncomp3, nval3, nent3
70 integer valr3(5*4*2), valr3p(3*4*2)
73 character*64 nomprofil1
74 integer profil1(2) , profil2(3)
76 parameter(user_interlace = med_full_interlace)
77 parameter(user_mode = med_compact_stmode )
78 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
79 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
81 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
82 parameter( lien_maa2=
"./testfoo.med" )
84 parameter( nomcha1 =
"champ reel" )
85 parameter( ncomp1 = 2 )
86 parameter( dtunit1 =
" ")
87 parameter( nounit =
" ")
89 parameter( gauss1_1 =
"Model n1" )
90 parameter( ngauss1_1 = 6 )
92 parameter( gauss1_2 =
"Model n2" )
93 parameter( ngauss1_2 = 3 )
95 parameter( ngauss1_3 = 6 )
96 parameter( nval1_3 = 6 )
98 parameter( nomcha2=
"champ entier")
99 parameter( ncomp2 = 3, nval2= 5 )
101 parameter( nomcha3=
"champ entier 3")
102 parameter( ncomp3 = 2, nval3= 5*4 )
104 parameter( nomprofil1 =
"PROFIL(champ(1))" )
108 data comp1 /
"comp1",
"comp2"/
109 data unit1 /
"unit1",
"unit2"/
113 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
114 1 0.0,-1.0, 0.0,0.0 /
115 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
116 1 20.0,21.0, 22.0,23.0/
119 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
120 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
121 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
124 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
125 1 20.0,21.0, 22.0,23.0 /
126 data valr1_3p / 2.0,3.0, 10.0,11.0 /
128 data comp2 /
"comp1",
"comp2",
"comp3"/
129 data unit2 /
"unit1",
"unit2",
"unit3"/
130 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
131 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
134 data comp3 /
"comp1",
"comp2"/
135 data unit3 /
"unit1",
"unit2"/
136 data valr3 / 0,1, 10,11, 20,21, 30,31,
137 1 40,41, 50,51, 60,61, 70,71,
138 1 80,81, 90,91, 100,101, 110,111,
139 1 120,121, 130,131, 140,141, 150,151,
140 1 160,161, 170,171, 180,181, 190,191 /
141 data valr3p / 0,1, 10,11, 20,21, 30,31,
142 1 80,81, 90,91, 100,101, 110,111,
143 1 160,161, 170,171, 180,181, 190,191 /
150 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
175 gscoo1_2(1) = -2.0d0/3
176 gscoo1_2(2) = 1.0d0/3
177 gscoo1_2(3) = -2.0d0/3
178 gscoo1_2(4) = -2.0d0/3
179 gscoo1_2(5) = 1.0d0/3
180 gscoo1_2(6) = -2.0d0/3
187 call mfivop(fid,
'test10.med', med_acc_rdwr,
188 & med_major_num, med_minor_num, med_release_num, ret)
190 if (ret .ne. 0 )
then 191 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med' 197 & med_unstructured_mesh,
'Maillage vide',
198 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
200 if (ret .ne. 0 )
then 201 print *,
'Erreur à la création du maillage : ', maa1
207 & med_unstructured_mesh,
'Maillage vide',
208 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
210 if (ret .ne. 0 )
then 211 print *,
'Erreur à la création du maillage : ', maa3
220 if (ret .ne. 0 )
then 221 print *,
'Erreur à la création du champ : ', nomcha1
229 if (ret .ne. 0 )
then 230 print *,
'Erreur à la création du champ : ', nomcha2
235 call mlnliw(fid,maa2,lien_maa2,ret)
237 if (ret .ne. 0 )
then 238 print *,
'Erreur à la création du lien : ', lien_maa2
244 call mlclow(fid,gauss1_1,med_tria6,2,refcoo1,user_interlace,
245 & ngauss1_1,gscoo1_1, wg1_1,med_no_interpolation,
246 & med_no_mesh_support, ret)
248 if (ret .ne. 0 )
then 249 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
254 call mlclow(fid,gauss1_2,med_tria6,2,refcoo1,user_interlace,
255 & ngauss1_2,gscoo1_2, wg1_2,med_no_interpolation,
256 & med_no_mesh_support, ret)
258 if (ret .ne. 0 )
then 259 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
268 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
269 & med_tria6,user_mode,med_allentities_profile,
270 & gauss1_1,user_interlace,2,nent1_1,valr1_1,ret)
272 if (ret .ne. 0 )
then 273 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1' 280 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
281 & med_tria6,user_mode,med_allentities_profile,
282 & gauss1_1,user_interlace,1,nent1_1,valr1_1,ret)
284 if (ret .ne. 0 )
then 285 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2' 295 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
296 & user_mode,med_allentities_profile,gauss1_2,
297 & user_interlace,1,nent1_2,valr1_2,ret)
299 if (ret .ne. 0 )
then 300 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3' 309 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
310 & user_mode,med_allentities_profile,gauss1_2,
311 & user_interlace,2,nent1_2,valr1_2,ret)
313 if (ret .ne. 0 )
then 314 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4' 323 call mfdrpw(fid,nomcha1,1,2,dt,med_cell,med_tria6,
324 & user_mode,med_allentities_profile,gauss1_1,
325 & user_interlace,1,nent1_1,valr1_1,ret)
327 if (ret .ne. 0 )
then 328 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5' 334 call mpfprw(fid,nomprofil1,1,profil1,ret)
336 if (ret .ne. 0 )
then 337 print *,
'Erreur à la création du profil : ', nomprofil1
348 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
349 & user_mode, nomprofil1, med_no_localization,
350 & user_interlace,med_all_constituent,
351 & nval1_3,valr1_3p,ret)
353 if (ret .ne. 0 )
then 354 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6' 363 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
364 & user_mode, nomprofil1, gauss1_2,
365 & user_interlace,med_all_constituent,
366 & nent1_2,valr1_2p,ret)
368 if (ret .ne. 0 )
then 369 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7' 380 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
381 & user_mode, nomprofil1, med_no_localization,
383 & nent1_3,valr1_3p,ret)
385 if (ret .ne. 0 )
then 386 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8a' 396 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
397 & user_mode, nomprofil1, med_no_localization,
399 & nent1_3,valr1_3p,ret)
401 if (ret .ne. 0 )
then 402 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8b' 411 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
412 & med_descending_edge,med_seg2,user_interlace,
415 if (ret .ne. 0 )
then 416 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1' 425 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
426 & med_node,med_none,user_interlace,
429 if (ret .ne. 0 )
then 430 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2' 440 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
441 & med_descending_face,med_tria6,user_interlace,
444 if (ret .ne. 0 )
then 445 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3' 451 call mpfprw(fid,
"PROFIL(champ2)",3,profil2,ret)
453 if (ret .ne. 0 )
then 454 print *,
'Erreur à l''écriture du profil : ',
466 call mfdipw(fid,nomcha2,med_no_dt,med_no_it,dt,
467 & med_cell,med_tria6,user_mode,
"PROFIL(champ2)",
468 & med_no_localization,user_interlace,3,
471 if (ret .ne. 0 )
then 472 print *,
'Erreur à l''écriture du profil : ',
481 if (ret .ne. 0 )
then 482 print *,
'Erreur à la création du champ : ', nomcha3
491 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
492 & med_cell,med_quad4,user_interlace,
495 if (ret .ne. 0 )
then 496 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.1' 505 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
506 & med_node_element,med_quad4,user_interlace,
507 & med_all_constituent,nent3,valr3,ret)
509 if (ret .ne. 0 )
then 510 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.2' 524 call mfdipw(fid,nomcha3,med_no_dt,med_no_it,dt,
525 & med_node_element,med_quad4,user_mode,
526 &
"PROFIL(champ2)",med_no_localization,
527 & user_interlace,med_all_constituent,
530 if (ret .ne. 0 )
then 531 print *,
'Erreur à l''écriture du profil : ',
538 if (ret .ne. 0 )
then 539 print *,
'Erreur à la fermeture du fichier : ' 543 print *,
"Le code retour : ",ret
subroutine mficlo(fid, cret)
subroutine mfdivw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
subroutine mfivop(fid, name, access, major, minor, rel, cret)
subroutine mlclow(fid, lname, gtype, sdim, ecoo, swm, nip, ipcoo, wght, giname, isname, cret)
subroutine mfdipw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mfdrpw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mlnliw(fid, mname, lname, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)