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
30 integer*8 fid
31 integer cret
32
33 integer mdim,nse2,ntr3,sdim
34 parameter(nse2=5, ntr3=2, mdim=2, sdim=2)
35 integer se2 (2*nse2)
36 character*16 nomse2(nse2)
37 integer numse2(nse2),nufase2(nse2)
38
39 character*16 nomcoo(2)
40 character*16 unicoo(2)
41
42
43 integer tr3 (3*ntr3)
44 character*16 nomtr3(ntr3)
45 integer numtr3(ntr3), nufatr3(ntr3)
46 character*64 maa
47 real*8 dt
48 parameter(dt = 0.0)
49
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"/,
55 & numtr3 /4,5/
56 data nufatr3 /0,-1/, maa /"maa1"/
57
58
59 call mfiope(fid,
'test6.med',med_acc_rdwr, cret)
60 print *,cret
61 if (cret .ne. 0 ) then
62 print *,'Erreur creation du fichier'
63 call efexit(-1)
64 endif
65
66
67 call mmhcre(fid,maa,mdim,sdim,
68 & med_unstructured_mesh,'un maillage pour test6',
69 & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
70 print *,cret
71 if (cret .ne. 0 ) then
72 print *,'Erreur creation du maillage'
73 call efexit(-1)
74 endif
75
76
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)
80 print *,cret
81 if (cret .ne. 0 ) then
82 print *,'Erreur ecriture de la connectivite'
83 call efexit(-1)
84 endif
85
86
87 call mmheaw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
88 & med_seg2,nse2,nomse2,cret)
89 print *,cret
90 if (cret .ne. 0 ) then
91 print *,'Erreur ecriture des noms'
92 call efexit(-1)
93 endif
94
95
96 call mmhenw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
97 & med_seg2,nse2,numse2,cret)
98 print *,cret
99 if (cret .ne. 0 ) then
100 print *,'Erreur ecriture des numeros'
101 call efexit(-1)
102 endif
103
104
105 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
106 & med_seg2,nse2,nufase2,cret)
107 print *,cret
108 if (cret .ne. 0 ) then
109 print *,é'Erreur ecriture des numros de famille'
110 call efexit(-1)
111 endif
112
113
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)
117 print *,cret
118 if (cret .ne. 0 ) then
119 print *,'Erreur ecriture de la connectivite'
120 call efexit(-1)
121 endif
122
123
124 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
125 & med_tria3,ntr3,nomtr3,cret)
126 print *,cret
127 if (cret .ne. 0 ) then
128 print *,'Erreur ecriture des noms'
129 call efexit(-1)
130 endif
131
132
133 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
134 & med_tria3,ntr3,numtr3,cret)
135 print *,cret
136 if (cret .ne. 0 ) then
137 print *,'Erreur ecriture des numeros'
138 call efexit(-1)
139 endif
140
141
142 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
143 & med_tria3,ntr3,nufatr3,cret)
144 print *,cret
145 if (cret .ne. 0 ) then
146 print *,'Erreur ecriture des numeros de famille'
147 call efexit(-1)
148 endif
149
150
152 print *,cret
153 if (cret .ne. 0 ) then
154 print *,'Erreur a la fermeture du fichier'
155 call efexit(-1)
156 endif
157
158 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 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)