33 integer mdim,nse2,ntr3,sdim
34 parameter(nse2=5, ntr3=2, mdim=2, sdim=2)
36 character*16 nomse2(nse2)
37 integer numse2(nse2),nufase2(nse2)
39 character*16 nomcoo(2)
40 character*16 unicoo(2)
44 character*16 nomtr3(ntr3)
45 integer numtr3(ntr3), nufatr3(ntr3)
50 data nomcoo /
"x",
"y"/, unicoo /
"cm",
"cm"/
51 data se2 / 1,2,1,3,2,4,3,4,2,3 /
52 data nomse2 /
"se1",
"se2",
"se3",
"se4",
"se5" /
53 data numse2 / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
54 data tr3 /1,2,-5,-5,3,-4 /, nomtr3 /
"tr1",
"tr2"/,
56 data nufatr3 /0,-1/, maa /
"maa1"/
59 call mfiope(fid,
'test6.med',med_acc_rdwr, cret)
61 if (cret .ne. 0 )
then
62 print *,
'Erreur creation du fichier'
67 call mmhcre(fid,maa,mdim,sdim,
68 & med_unstructured_mesh,
'un maillage pour test6',
69 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
71 if (cret .ne. 0 )
then
72 print *,
'Erreur creation du maillage'
77 call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
78 & med_descending_edge,med_seg2,med_descending,
79 & med_no_interlace,nse2,se2,cret)
81 if (cret .ne. 0 )
then
82 print *,
'Erreur ecriture de la connectivite'
87 call mmheaw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
88 & med_seg2,nse2,nomse2,cret)
90 if (cret .ne. 0 )
then
91 print *,
'Erreur ecriture des noms'
96 call mmhenw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
97 & med_seg2,nse2,numse2,cret)
99 if (cret .ne. 0 )
then
100 print *,
'Erreur ecriture des numeros'
105 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
106 & med_seg2,nse2,nufase2,cret)
108 if (cret .ne. 0 )
then
109 print *,
'Erreur ecriture des numéros de famille'
114 call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
115 & med_cell,med_tria3,med_descending,
116 & med_no_interlace,ntr3,tr3,cret)
118 if (cret .ne. 0 )
then
119 print *,
'Erreur ecriture de la connectivite'
124 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
125 & med_tria3,ntr3,nomtr3,cret)
127 if (cret .ne. 0 )
then
128 print *,
'Erreur ecriture des noms'
133 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
134 & med_tria3,ntr3,numtr3,cret)
136 if (cret .ne. 0 )
then
137 print *,
'Erreur ecriture des numeros'
142 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
143 & med_tria3,ntr3,nufatr3,cret)
145 if (cret .ne. 0 )
then
146 print *,
'Erreur ecriture des numeros de famille'
153 if (cret .ne. 0 )
then
154 print *,
'Erreur a la fermeture du fichier'
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
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 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 mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)