29 integer ret,fid,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 )
79 parameter( a=0.446948490915965d0, b=0.091576213509771d0 )
80 parameter( p1=0.11169079483905d0, p2=0.0549758718227661d0 )
82 parameter( maa1 =
"maa1", maa2 =
"maa2", maa3 =
"maa3" )
83 parameter( lien_maa2=
"./testfoo.med" )
85 parameter( nomcha1 =
"champ reel" )
86 parameter( ncomp1 = 2 )
87 parameter( dtunit1 =
" ")
88 parameter( nounit =
" ")
90 parameter( gauss1_1 =
"Model n1" )
91 parameter( ngauss1_1 = 6 )
93 parameter( gauss1_2 =
"Model n2" )
94 parameter( ngauss1_2 = 3 )
96 parameter( ngauss1_3 = 6 )
97 parameter( nval1_3 = 6 )
99 parameter( nomcha2=
"champ entier")
100 parameter( ncomp2 = 3, nval2= 5 )
102 parameter( nomcha3=
"champ entier 3")
103 parameter( ncomp3 = 2, nval3= 5*4 )
105 parameter( nomprofil1 =
"PROFIL(champ(1))" )
109 data comp1 /
"comp1",
"comp2"/
110 data unit1 /
"unit1",
"unit2"/
114 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0,
115 1 0.0,-1.0, 0.0,0.0 /
116 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
117 1 20.0,21.0, 22.0,23.0/
120 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0,
121 1 12.0,13.0, 20.0,21.0, 22.0,23.0 /
122 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 /
125 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0,
126 1 20.0,21.0, 22.0,23.0 /
127 data valr1_3p / 2.0,3.0, 10.0,11.0 /
129 data comp2 /
"comp1",
"comp2",
"comp3"/
130 data unit2 /
"unit1",
"unit2",
"unit3"/
131 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 /
132 data valr2p / 0,1,2, 20,21,22, 40,41,42 /
135 data comp3 /
"comp1",
"comp2"/
136 data unit3 /
"unit1",
"unit2"/
137 data valr3 / 0,1, 10,11, 20,21, 30,31,
138 1 40,41, 50,51, 60,61, 70,71,
139 1 80,81, 90,91, 100,101, 110,111,
140 1 120,121, 130,131, 140,141, 150,151,
141 1 160,161, 170,171, 180,181, 190,191 /
142 data valr3p / 0,1, 10,11, 20,21, 30,31,
143 1 80,81, 90,91, 100,101, 110,111,
144 1 160,161, 170,171, 180,181, 190,191 /
151 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
176 gscoo1_2(1) = -2.0d0/3
177 gscoo1_2(2) = 1.0d0/3
178 gscoo1_2(3) = -2.0d0/3
179 gscoo1_2(4) = -2.0d0/3
180 gscoo1_2(5) = 1.0d0/3
181 gscoo1_2(6) = -2.0d0/3
188 call mfivop(fid,
'test10f.med', med_acc_rdwr,
189 & med_major_num, med_minor_num, med_release_num, ret)
191 if (ret .ne. 0 )
then
192 print *,
'Erreur à l''ouverture du fichier : ',
'test10.med'
198 & med_unstructured_mesh,
'Maillage vide',
199 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
201 if (ret .ne. 0 )
then
202 print *,
'Erreur à la création du maillage : ', maa1
208 & med_unstructured_mesh,
'Maillage vide',
209 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,ret)
211 if (ret .ne. 0 )
then
212 print *,
'Erreur à la création du maillage : ', maa3
218 call mfdcre(fid,nomcha1,ftypecha,ncomp1,comp1,unit1,
221 if (ret .ne. 0 )
then
222 print *,
'Erreur à la création du champ : ', nomcha1
230 if (ret .ne. 0 )
then
231 print *,
'Erreur à la création du champ : ', nomcha2
236 call mlnliw(fid,maa2,lien_maa2,ret)
238 if (ret .ne. 0 )
then
239 print *,
'Erreur à la création du lien : ', lien_maa2
245 call mlclow(fid,gauss1_1,med_tria6,2,refcoo1,user_interlace,
246 & ngauss1_1,gscoo1_1, wg1_1,med_no_interpolation,
247 & med_no_mesh_support, ret)
249 if (ret .ne. 0 )
then
250 print *,
'Erreur à la création du modèle n°1 : ', gauss1_1
255 call mlclow(fid,gauss1_2,med_tria6,2,refcoo1,user_interlace,
256 & ngauss1_2,gscoo1_2, wg1_2,med_no_interpolation,
257 & med_no_mesh_support, ret)
259 if (ret .ne. 0 )
then
260 print *,
'Erreur à la création du modèle n°2 : ', gauss1_2
269 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
270 & med_tria6,user_mode,med_allentities_profile,
271 & gauss1_1,user_interlace,2,nent1_1,valr1_1,ret)
273 if (ret .ne. 0 )
then
274 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.1'
281 call mfdrpw(fid,nomcha1,med_no_dt,med_no_it,dt,med_cell,
282 & med_tria6,user_mode,med_allentities_profile,
283 & gauss1_1,user_interlace,1,nent1_1,valr1_1,ret)
285 if (ret .ne. 0 )
then
286 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.2'
296 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
297 & user_mode,med_allentities_profile,gauss1_2,
298 & user_interlace,1,nent1_2,valr1_2,ret)
300 if (ret .ne. 0 )
then
301 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.3'
310 call mfdrpw(fid,nomcha1,1,med_no_it,dt,med_cell,med_tria6,
311 & user_mode,med_allentities_profile,gauss1_2,
312 & user_interlace,2,nent1_2,valr1_2,ret)
314 if (ret .ne. 0 )
then
315 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.4'
324 call mfdrpw(fid,nomcha1,1,2,dt,med_cell,med_tria6,
325 & user_mode,med_allentities_profile,gauss1_1,
326 & user_interlace,1,nent1_1,valr1_1,ret)
328 if (ret .ne. 0 )
then
329 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.5'
335 call mpfprw(fid,nomprofil1,1,profil1,ret)
337 if (ret .ne. 0 )
then
338 print *,
'Erreur à la création du profil : ', nomprofil1
349 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
350 & user_mode, nomprofil1, med_no_localization,
351 & user_interlace,med_all_constituent,
352 & nval1_3,valr1_3p,ret)
354 if (ret .ne. 0 )
then
355 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.6'
364 call mfdrpw(fid,nomcha1,2,2,dt,med_cell,med_tria6,
365 & user_mode, nomprofil1, gauss1_2,
366 & user_interlace,med_all_constituent,
367 & nent1_2,valr1_2p,ret)
369 if (ret .ne. 0 )
then
370 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.7'
381 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
382 & user_mode, nomprofil1, med_no_localization,
384 & nent1_3,valr1_3p,ret)
386 if (ret .ne. 0 )
then
387 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8a'
397 call mfdrpw(fid,nomcha1,3,2,dt,med_cell,med_tria6,
398 & user_mode, nomprofil1, med_no_localization,
400 & nent1_3,valr1_3p,ret)
402 if (ret .ne. 0 )
then
403 print *,
'Erreur à l''écriture du champ : ', nomcha1,
'et.8b'
412 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
413 & med_descending_edge,med_seg2,user_interlace,
416 if (ret .ne. 0 )
then
417 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.1'
426 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
427 & med_node,med_none,user_interlace,
430 if (ret .ne. 0 )
then
431 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.2'
441 call mfdivw(fid,nomcha2,med_no_dt,med_no_it,dt,
442 & med_descending_face,med_tria6,user_interlace,
445 if (ret .ne. 0 )
then
446 print *,
'Erreur à l''écriture du champ : ', nomcha2,
'et.3'
452 call mpfprw(fid,
"PROFIL(champ2)",3,profil2,ret)
454 if (ret .ne. 0 )
then
455 print *,
'Erreur à l''écriture du profil : ',
467 call mfdipw(fid,nomcha2,med_no_dt,med_no_it,dt,
468 & med_cell,med_tria6,user_mode,
"PROFIL(champ2)",
469 & med_no_localization,user_interlace,3,
472 if (ret .ne. 0 )
then
473 print *,
'Erreur à l''écriture du profil : ',
482 if (ret .ne. 0 )
then
483 print *,
'Erreur à la création du champ : ', nomcha3
492 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
493 & med_cell,med_quad4,user_interlace,
496 if (ret .ne. 0 )
then
497 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.1'
506 call mfdivw(fid,nomcha3,med_no_dt,med_no_it,dt,
507 & med_node_element,med_quad4,user_interlace,
508 & med_all_constituent,nent3,valr3,ret)
510 if (ret .ne. 0 )
then
511 print *,
'Erreur à l''écriture du champ : ', nomcha3,
'et.2'
525 call mfdipw(fid,nomcha3,med_no_dt,med_no_it,dt,
526 & med_node_element,med_quad4,user_mode,
527 &
"PROFIL(champ2)",med_no_localization,
528 & user_interlace,med_all_constituent,
531 if (ret .ne. 0 )
then
532 print *,
'Erreur à l''écriture du profil : ',
539 if (ret .ne. 0 )
then
540 print *,
'Erreur à la fermeture du fichier : '
544 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...