1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
26
27 implicit none
28 include 'med.hf'
29
30
31 integer*8 fid
32 integer cret
33
34 integer mdim,sdim
35
36 character*64 maa
37
38 integer nnoe
39
40 real*8 coo(8)
41 character*16 nomcoo(2), unicoo(2)
42 character*200 desc
43 integer strgri(2)
44
45 integer axe,nind
46 real*8 indice(4)
47
48
49
50 data coo /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
51 data nomcoo /"x","y"/, unicoo /"cm","cm"/
52
53
54 call mfiope(fid,
'test27.med',med_acc_rdwr, cret)
55 print *,cret
56 if (cret .ne. 0 ) then
57 print *,'Erreur creation du fichier'
58 call efexit(-1)
59 endif
60 print *,'Creation du fichier test27.med'
61
62
63 mdim = 2
64 sdim = 2
65 maa = 'maillage vide'
66 desc = 'un maillage vide'
67 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
68 & desc,"",med_sort_dtit,med_cartesian,
69 & 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 mdim = 2
78 maa = 'grille cartesienne'
79 desc = 'un exemple de grille cartesienne'
80 call mmhcre(fid,maa,mdim,sdim,med_structured_mesh,
81 & desc,"",med_sort_dtit,med_cartesian,
82 & nomcoo,unicoo,cret)
83 print *,cret
84 if (cret .ne. 0 ) then
85 print *,'Erreur creation du maillage'
86 call efexit(-1)
87 endif
88 print *,'Creation d un maillage MED_STRUCTURE'
89
90
91
92 call mmhgtw(fid,maa,med_cartesian_grid,cret)
93 print *,cret
94 print *,'On definit la nature de la grille :
95 & MED_GRILLE_CARTESIENNE'
96 if (cret .ne. 0 ) then
97 print *,'Erreur ecriture de la nature de la grille'
98 call efexit(-1)
99 endif
100
101
102 indice(1) = 1.1d0
103 indice(2) = 1.2d0
104 indice(3) = 1.3d0
105 indice(4) = 1.4d0
106 nind = 4
107 axe = 1
108 call mmhgcw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
109 & axe,nind,indice,cret)
110 print *,cret
111 if (cret .ne. 0 ) then
112 print *,'Erreur ecriture des indices'
113 call efexit(-1)
114 endif
115 print *,'Ecriture des indices des coordonnees selon axe X'
116
117 indice(1) = 2.1d0
118 indice(2) = 2.2d0
119 indice(3) = 2.3d0
120 indice(4) = 2.4d0
121 nind = 4
122 axe = 2
123 call mmhgcw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
124 & axe,nind,indice,cret)
125 print *,cret
126 if (cret .ne. 0 ) then
127 print *,'Erreur ecriture des indices'
128 call efexit(-1)
129 endif
130 print *,'Ecriture des indices des coordonnees selon axe Y'
131
132
133 maa = 'grille curviligne'
134 mdim = 2
135 desc = 'un exemple de grille curviligne'
136 call mmhcre(fid,maa,mdim,sdim,med_structured_mesh,
137 & desc,"",med_sort_dtit,med_cartesian,
138 & nomcoo,unicoo,cret)
139 print *,cret
140 if (cret .ne. 0 ) then
141 print *,'Erreur creation de maillage'
142 call efexit(-1)
143 endif
144 print *,'Nouveau maillage MED_STRUCTURE'
145
146 call mmhgtw(fid,maa,med_curvilinear_grid,cret)
147 print *,cret
148 if (cret .ne. 0 ) then
149 print *,'Erreur ecriture de la nature de la grille'
150 call efexit(-1)
151 endif
152 print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
153
154
155 nnoe = 4
156 call mmhcow(fid,maa,med_no_dt,med_no_it,med_undef_dt,
157 & med_full_interlace,nnoe,coo,cret)
158 print *,cret
159 if (cret .ne. 0 ) then
160 print *,'Erreur ecriture des coordonnees des noeuds'
161 call efexit(-1)
162 endif
163 print *,'Ecriture des coordonnees de la grille'
164
165
166 strgri(1) = 2
167 strgri(2) = 2
168 call mmhgsw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
169 & strgri,cret)
170 print *,cret
171 if (cret .ne. 0 ) then
172 print *,'Erreur ecriture de la structure'
173 call efexit(-1)
174 endif
175 print *,'Ecriture de la structure de la grille : / 2,2 /'
176
177
179 print *,cret
180 if (cret .ne. 0 ) then
181 print *,'Erreur fermeture du fichier'
182 call efexit(-1)
183 endif
184 print *,'Fermeture du fichier'
185
186 end
187
188
189
190
191
192
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhgtw(fid, name, gtype, cret)
Cette routine permet de définir le type d'un maillage structuré (MED_STRUCTURED_MESH).
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 mmhgsw(fid, name, numdt, numit, dt, st, cret)
subroutine mmhgcw(fid, name, numdt, numit, dt, axis, size, index, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)