30 integer cret,mdim, sdim
31 parameter(mdim = 3, sdim = 3)
38 integer indexp(np),indexf(nf)
42 parameter(nf2=8,np2=3)
43 integer indexp2(np2),indexf2(nf2)
49 character*16 nomcoo(3)
50 character*16 unicoo(3)
53 data indexf / 1,4,7,10,13,16,19,22,25 /
54 data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
55 & 15,16,17,18,19,20,21,22,23,24 /
56 data indexp2 / 1,5,9 /
57 data indexf2 / med_tria3,med_tria3,med_tria3,med_tria3,
58 & med_tria3,med_tria3,med_tria3,med_tria3 /
59 data conn2 / 1,2,3,4,5,6,7,8 /
60 data nom /
"poly1",
"poly2"/
61 data num / 1,2 /, fam / 0,-1 /
63 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
66 call mfiope(fid,
'test25.med',med_acc_rdwr, cret)
68 if (cret .ne. 0 )
then
69 print *,
'Erreur creation du fichier'
72 print *,
'Creation du fichier test25.med'
75 call mmhcre(fid,maa,mdim,sdim,
76 & med_unstructured_mesh,
'un maillage pour test 25',
77 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
78 if (cret .ne. 0 )
then
79 print *,
'Erreur creation du maillage'
83 print *,
'Creation du maillage'
86 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
87 & med_nodal,np,indexp,nf,indexf,conn,cret)
89 if (cret .ne. 0 )
then
90 print *,
'Erreur ecriture connectivite des polyedres'
93 print *,
'Ecriture des connectivites des mailles
94 & de type MED_POLYEDRE'
95 print *,
'Description nodale'
98 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
99 & med_descending,np2,indexp2,nf2,indexf2,conn2,cret)
101 if (cret .ne. 0 )
then
102 print *,
'Erreur ecriture connectivite des polyedres'
105 print *,
'Ecriture des connectivites des mailles
106 & de type MED_POLYEDRE'
107 print *,
'Description descendante'
110 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
111 & med_polyhedron,n,nom,cret)
113 if (cret .ne. 0 )
then
114 print *,
'Erreur ecriture noms des polyedres'
117 print *,
'Ecriture des noms des polyedress'
120 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
121 & med_polyhedron,n,num,cret)
123 if (cret .ne. 0 )
then
124 print *,
'Erreur ecriture numeros des polyedres'
127 print *,
'Ecriture des numeros des polyedres'
130 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
131 & med_polyhedron,n,fam,cret)
133 if (cret .ne. 0 )
then
134 print *,
'Erreur ecriture numeros de familles polyedres'
137 print *,
'Ecriture des numeros de familles des polyedres'
142 if (cret .ne. 0 )
then
143 print *,
'Erreur fermeture du fichier'
146 print *,
'Fermeture du fichier'