29 integer cret, fid,mdim, sdim
30 parameter(mdim = 3, sdim = 3)
37 integer indexp(np),indexf(nf)
41 parameter(nf2=8,np2=3)
42 integer indexp2(np2),indexf2(nf2)
48 character*16 nomcoo(3)
49 character*16 unicoo(3)
52 data indexf / 1,4,7,10,13,16,19,22,25 /
53 data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
54 & 15,16,17,18,19,20,21,22,23,24 /
55 data indexp2 / 1,5,9 /
56 data indexf2 / med_tria3,med_tria3,med_tria3,med_tria3,
57 & med_tria3,med_tria3,med_tria3,med_tria3 /
58 data conn2 / 1,2,3,4,5,6,7,8 /
59 data nom /
"poly1",
"poly2"/
60 data num / 1,2 /, fam / 0,-1 /
62 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
65 call mfiope(fid,
'test25.med',med_acc_rdwr, cret)
67 if (cret .ne. 0 )
then
68 print *,
'Erreur creation du fichier'
71 print *,
'Creation du fichier test25.med'
74 call mmhcre(fid,maa,mdim,sdim,
75 & med_unstructured_mesh,
'un maillage pour test 25',
76 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
77 if (cret .ne. 0 )
then
78 print *,
'Erreur creation du maillage'
82 print *,
'Creation du maillage'
85 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
86 & med_nodal,np,indexp,nf,indexf,conn,cret)
88 if (cret .ne. 0 )
then
89 print *,
'Erreur ecriture connectivite des polyedres'
92 print *,
'Ecriture des connectivites des mailles
93 & de type MED_POLYEDRE'
94 print *,
'Description nodale'
97 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
98 & med_descending,np2,indexp2,nf2,indexf2,conn2,cret)
100 if (cret .ne. 0 )
then
101 print *,
'Erreur ecriture connectivite des polyedres'
104 print *,
'Ecriture des connectivites des mailles
105 & de type MED_POLYEDRE'
106 print *,
'Description descendante'
109 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
110 & med_polyhedron,n,nom,cret)
112 if (cret .ne. 0 )
then
113 print *,
'Erreur ecriture noms des polyedres'
116 print *,
'Ecriture des noms des polyedress'
119 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
120 & med_polyhedron,n,num,cret)
122 if (cret .ne. 0 )
then
123 print *,
'Erreur ecriture numeros des polyedres'
126 print *,
'Ecriture des numeros des polyedres'
129 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
130 & med_polyhedron,n,fam,cret)
132 if (cret .ne. 0 )
then
133 print *,
'Erreur ecriture numeros de familles polyedres'
136 print *,
'Ecriture des numeros de familles des polyedres'
141 if (cret .ne. 0 )
then
142 print *,
'Erreur fermeture du fichier'
145 print *,
'Fermeture du fichier'