30 integer ret,USER_INTERLACE,USER_MODE
34 character*64 maa1,maa2,maa3
35 character*13 lien_maa2
36 character*16 nomcoo(3)
37 character*16 unicoo(3)
40 character*16 comp1(2), unit1(2)
41 character*16 dtunit1, nounit
46 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6)
47 integer nval1_1, nent1_1
52 real*8 gscoo1_2(6), wg1_2(3)
53 integer nval1_2, nent1_2
57 integer ngauss1_3,nval1_3, nent1_3
63 character*16 comp2(3), unit2(3)
65 integer valr2(5*3), valr2p(3*3)
69 character*16 comp3(2), unit3(2)
70 integer ncomp3, nval3, nent3
71 integer valr3(5*4*2), valr3p(3*4*2)
74 character*64 nomprofil1
75 integer profil1(2) , profil2(3)
77 parameter(user_interlace = med_full_interlace)
78 parameter(user_mode = med_compact_stmode )
80 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
81 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
83 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
84 parameter( lien_maa2=
"./testfoo.med" )
86 parameter( nomcha1 =
"champ reel" )
87 parameter( ncomp1 = 2 )
88 parameter( dtunit1 =
" ")
89 parameter( nounit =
" ")
91 parameter( gauss1_1 =
"Model n1" )
92 parameter( ngauss1_1 = 6 )
94 parameter( gauss1_2 =
"Model n2" )
95 parameter( ngauss1_2 = 3 )
97 parameter( ngauss1_3 = 6 )
98 parameter( nval1_3 = 6 )
100 parameter( nomcha2=
"champ entier")
101 parameter( ncomp2 = 3, nval2= 5 )
103 parameter( nomcha3=
"champ entier 3")
104 parameter( ncomp3 = 2, nval3= 5*4 )
106 parameter( nomprofil1 =
"PROFIL(champ(1))" )
110 data comp1 /
"comp1",
"comp2"/
111 data unit1 /
"unit1",
"unit2"/
115 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
116 1 0.0,-1.0, 0.0,0.0 /
117 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
118 1 20.0,21.0, 22.0,23.0/
121 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
122 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
123 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
126 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
127 1 20.0,21.0, 22.0,23.0 /
128 data valr1_3p / 2.0,3.0, 10.0,11.0 /
130 data comp2 /
"comp1",
"comp2",
"comp3"/
131 data unit2 /
"unit1",
"unit2",
"unit3"/
132 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
133 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
136 data comp3 /
"comp1",
"comp2"/
137 data unit3 /
"unit1",
"unit2"/
138 data valr3 / 0,1, 10,11, 20,21, 30,31,
139 1 40,41, 50,51, 60,61, 70,71,
140 1 80,81, 90,91, 100,101, 110,111,
141 1 120,121, 130,131, 140,141, 150,151,
142 1 160,161, 170,171, 180,181, 190,191 /
143 data valr3p / 0,1, 10,11, 20,21, 30,31,
144 1 80,81, 90,91, 100,101, 110,111,
145 1 160,161, 170,171, 180,181, 190,191 /
152 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
177 gscoo1_2(1) = -2.0d0/3
178 gscoo1_2(2) = 1.0d0/3
179 gscoo1_2(3) = -2.0d0/3
180 gscoo1_2(4) = -2.0d0/3
181 gscoo1_2(5) = 1.0d0/3
182 gscoo1_2(6) = -2.0d0/3
189 call mfivop(fid,
'test10f.med', med_acc_rdwr,
190 & med_major_num, med_minor_num, med_release_num, ret)
192 if (ret .ne. 0 )
then 193 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med' 199 & med_unstructured_mesh,
'Maillage vide',
200 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
202 if (ret .ne. 0 )
then 203 print *,
'Erreur à la création du maillage : ', maa1
209 & med_unstructured_mesh,
'Maillage vide',
210 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
212 if (ret .ne. 0 )
then 213 print *,
'Erreur à la création du maillage : ', maa3
219 call mfdcre(fid,nomcha1,ftypecha,ncomp1,comp1,unit1,
222 if (ret .ne. 0 )
then 223 print *,
'Erreur à la création du champ : ', nomcha1
231 if (ret .ne. 0 )
then 232 print *,
'Erreur à la création du champ : ', nomcha2
237 call mlnliw(fid,maa2,lien_maa2,ret)
239 if (ret .ne. 0 )
then 240 print *,
'Erreur à la création du lien : ', lien_maa2
246 call mlclow(fid,gauss1_1,med_tria6,2,refcoo1,user_interlace,
247 & ngauss1_1,gscoo1_1, wg1_1,med_no_interpolation,
248 & med_no_mesh_support, ret)
250 if (ret .ne. 0 )
then 251 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
256 call mlclow(fid,gauss1_2,med_tria6,2,refcoo1,user_interlace,
257 & ngauss1_2,gscoo1_2, wg1_2,med_no_interpolation,
258 & med_no_mesh_support, ret)
260 if (ret .ne. 0 )
then 261 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
270 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
271 & med_tria6,user_mode,med_allentities_profile,
272 & gauss1_1,user_interlace,2,nent1_1,valr1_1,ret)
274 if (ret .ne. 0 )
then 275 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1' 282 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
283 & med_tria6,user_mode,med_allentities_profile,
284 & gauss1_1,user_interlace,1,nent1_1,valr1_1,ret)
286 if (ret .ne. 0 )
then 287 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2' 297 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
298 & user_mode,med_allentities_profile,gauss1_2,
299 & user_interlace,1,nent1_2,valr1_2,ret)
301 if (ret .ne. 0 )
then 302 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3' 311 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
312 & user_mode,med_allentities_profile,gauss1_2,
313 & user_interlace,2,nent1_2,valr1_2,ret)
315 if (ret .ne. 0 )
then 316 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4' 325 call mfdrpw(fid,nomcha1,1,2,dt,med_cell,med_tria6,
326 & user_mode,med_allentities_profile,gauss1_1,
327 & user_interlace,1,nent1_1,valr1_1,ret)
329 if (ret .ne. 0 )
then 330 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5' 336 call mpfprw(fid,nomprofil1,1,profil1,ret)
338 if (ret .ne. 0 )
then 339 print *,
'Erreur à la création du profil : ', nomprofil1
350 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
351 & user_mode, nomprofil1, med_no_localization,
352 & user_interlace,med_all_constituent,
353 & nval1_3,valr1_3p,ret)
355 if (ret .ne. 0 )
then 356 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6' 365 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
366 & user_mode, nomprofil1, gauss1_2,
367 & user_interlace,med_all_constituent,
368 & nent1_2,valr1_2p,ret)
370 if (ret .ne. 0 )
then 371 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7' 382 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
383 & user_mode, nomprofil1, med_no_localization,
385 & nent1_3,valr1_3p,ret)
387 if (ret .ne. 0 )
then 388 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8a' 398 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
399 & user_mode, nomprofil1, med_no_localization,
401 & nent1_3,valr1_3p,ret)
403 if (ret .ne. 0 )
then 404 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8b' 413 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
414 & med_descending_edge,med_seg2,user_interlace,
417 if (ret .ne. 0 )
then 418 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1' 427 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
428 & med_node,med_none,user_interlace,
431 if (ret .ne. 0 )
then 432 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2' 442 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
443 & med_descending_face,med_tria6,user_interlace,
446 if (ret .ne. 0 )
then 447 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3' 453 call mpfprw(fid,
"PROFIL(champ2)",3,profil2,ret)
455 if (ret .ne. 0 )
then 456 print *,
'Erreur à l''écriture du profil : ',
468 call mfdipw(fid,nomcha2,med_no_dt,med_no_it,dt,
469 & med_cell,med_tria6,user_mode,
"PROFIL(champ2)",
470 & med_no_localization,user_interlace,3,
473 if (ret .ne. 0 )
then 474 print *,
'Erreur à l''écriture du profil : ',
483 if (ret .ne. 0 )
then 484 print *,
'Erreur à la création du champ : ', nomcha3
493 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
494 & med_cell,med_quad4,user_interlace,
497 if (ret .ne. 0 )
then 498 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.1' 507 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
508 & med_node_element,med_quad4,user_interlace,
509 & med_all_constituent,nent3,valr3,ret)
511 if (ret .ne. 0 )
then 512 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.2' 526 call mfdipw(fid,nomcha3,med_no_dt,med_no_it,dt,
527 & med_node_element,med_quad4,user_mode,
528 &
"PROFIL(champ2)",med_no_localization,
529 & user_interlace,med_all_constituent,
532 if (ret .ne. 0 )
then 533 print *,
'Erreur à l''écriture du profil : ',
540 if (ret .ne. 0 )
then 541 print *,
'Erreur à la fermeture du fichier : ' 545 print *,
"Le code retour : ",ret
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mfdrpw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mficlo(fid, cret)
subroutine mfdipw(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 mlnliw(fid, mname, lname, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)
subroutine mlclow(fid, lname, gtype, sdim, ecoo, swm, nip, ipcoo, wght, giname, isname, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)