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'
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
Cette routine permet d'écrire les noms d'un type d'entité d'un maillage.
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet l'écriture des numéros de famille d'un type d'entité d'un maillage.
subroutine mmhphw(fid, name, numdt, numit, dt, entype, cmode, fisize, findex, nisize, nindex, con, cret)
Cette routine permet l'écriture dans un maillage des connectivités de polyèdres.
subroutine mficlo(fid, cret)
Fermeture d'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 mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet d'écrire les numéros d'un type d'entité d'un maillage.