1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
25
26 implicit none
27 include 'med.hf'
28
29 integer*8 fid
30 integer cret,mdim, sdim
31 parameter(mdim = 3, sdim = 3)
32 character*64 maa
33 integer n
34 parameter(n=2)
35
36 integer np,nf
37 parameter(nf=9,np=3)
38 integer indexp(np),indexf(nf)
39 integer conn(24)
40
41 integer np2,nf2
42 parameter(nf2=8,np2=3)
43 integer indexp2(np2),indexf2(nf2)
44 integer conn2(nf2)
45 character*16 nom(n)
46 integer num(n),fam(n)
47
48
49 character*16 nomcoo(3)
50 character*16 unicoo(3)
51
52 data indexp / 1,5,9 /
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 /
62 data maa /"maa1"/
63 data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
64
65
66 call mfiope(fid,
'test25.med',med_acc_rdwr, cret)
67 print *,cret
68 if (cret .ne. 0 ) then
69 print *,'Erreur creation du fichier'
70 call efexit(-1)
71 endif
72 print *,'Creation du fichier test25.med'
73
74
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'
80 call efexit(-1)
81 endif
82 print *,cret
83 print *,'Creation du maillage'
84
85
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)
88 print *,cret
89 if (cret .ne. 0 ) then
90 print *,'Erreur ecriture connectivite des polyedres'
91 call efexit(-1)
92 endif
93 print *,'Ecriture des connectivites des mailles
94 & de type MED_POLYEDRE'
95 print *,'Description nodale'
96
97
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)
100 print *,cret
101 if (cret .ne. 0 ) then
102 print *,'Erreur ecriture connectivite des polyedres'
103 call efexit(-1)
104 endif
105 print *,'Ecriture des connectivites des mailles
106 & de type MED_POLYEDRE'
107 print *,'Description descendante'
108
109
110 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
111 & med_polyhedron,n,nom,cret)
112 print *,cret
113 if (cret .ne. 0 ) then
114 print *,'Erreur ecriture noms des polyedres'
115 call efexit(-1)
116 endif
117 print *,'Ecriture des noms des polyedress'
118
119
120 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
121 & med_polyhedron,n,num,cret)
122 print *,cret
123 if (cret .ne. 0 ) then
124 print *,'Erreur ecriture numeros des polyedres'
125 call efexit(-1)
126 endif
127 print *,'Ecriture des numeros des polyedres'
128
129
130 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
131 & med_polyhedron,n,fam,cret)
132 print *,cret
133 if (cret .ne. 0 ) then
134 print *,'Erreur ecriture numeros de familles polyedres'
135 call efexit(-1)
136 endif
137 print *,'Ecriture des numeros de familles des polyedres'
138
139
141 print *,cret
142 if (cret .ne. 0 ) then
143 print *,'Erreur fermeture du fichier'
144 call efexit(-1)
145 endif
146 print *,'Fermeture du fichier'
147
148 end
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 mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhphw(fid, name, numdt, numit, dt, entype, cmode, fisize, findex, nisize, nindex, con, cret)