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 mfdipw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
subroutine mfdrpw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mfivop(fid, name, access, major, minor, rel, cret)
subroutine mfdivw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mlclow(fid, lname, gtype, sdim, ecoo, swm, nip, ipcoo, wght, giname, isname, cret)
subroutine mlnliw(fid, mname, lname, cret)
subroutine mficlo(fid, cret)