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 cration 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 cration du maillage : ', maa3
219 call mfdcre(fid,nomcha1,ftypecha,ncomp1,comp1,unit1,
222 if (ret .ne. 0 )
then
223 print *,àé
'Erreur la cration du champ : ', nomcha1
231 if (ret .ne. 0 )
then
232 print *,àé
'Erreur la cration du champ : ', nomcha2
237 call mlnliw(fid,maa2,lien_maa2,ret)
239 if (ret .ne. 0 )
then
240 print *,àé
'Erreur la cration 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 cration du modle n1 : ', 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 cration du modle n2 : ', 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 cration 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 cration 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 mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
Cette fonction crée un champ dans un fichier.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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...
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 mfdrpw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mfdipw(fid, fname, numdt, numit, dt, etype, gtype, stm, pname, lname, swm, cs, n, val, cret)
subroutine mfdivw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
subroutine mlclow(fid, lname, gtype, sdim, ecoo, swm, nip, ipcoo, wght, giname, isname, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)