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' subroutine mmhphw(fid, name, numdt, numit, dt, entype, cmode, fisize, findex, nisize, nindex, con, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
subroutine mficlo(fid, cret)