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 mficlo(fid, cret)
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
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)
subroutine mfiope(fid, name, access, cret)