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'