1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
24
25 implicit none
26 include 'med.hf77'
27
28
29 integer cret
30 integer*8 fid
31
32 integer sdim, mdim, stype, mtype, atype
33 integer axis, isize, entype, nquad4
34 character*200 mdesc
35 character*64 fname
36 character*64 mname
37
38 character*16 axname(2)
39
40 character*16 unname(2)
41 character*16 dtunit
42 character*16 cnames(8)
43 real*8 dt
44 real*8 cooxaxis(5)
45 real*8 cooyaxis(3)
46 parameter(fname = "UsesCase_MEDmesh_4.med")
47 parameter(mdesc = "A 2D structured mesh")
48 parameter(mname = "2D structured mesh")
49 parameter(sdim = 2, mdim = 2)
50 parameter(stype=med_sort_dtit, mtype=med_structured_mesh)
51 parameter(atype=med_cartesian_grid)
52 parameter(nquad4=8)
53 parameter(dt=0.0d0)
54 data dtunit /" "/
55 data axname /"x" ,"y"/
56 data unname /"cm","cm"/
57 data cnames /"CELL_1","CELL_2",
58 & "CELL_3","CELL_4",
59 & "CELL_5","CELL_6",
60 & "CELL_7","CELL_8"/
61 data cooxaxis /1.,2.,3.,4.,5./
62 data cooyaxis /1.,2.,3./
63
64
65
66 call mfiope(fid,fname,med_acc_creat,cret)
67 if (cret .ne. 0 ) then
68 print *,'ERROR : file creation'
69 call efexit(-1)
70 endif
71
72
73
74 call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
75 & dtunit, stype, atype, axname, unname, cret)
76 if (cret .ne. 0 ) then
77 print *,'ERROR : mesh creation'
78 call efexit(-1)
79 endif
80
81
82
83 call mmhgtw(fid,mname,med_cartesian_grid,cret)
84 if (cret .ne. 0 ) then
85 print *,'ERROR : write grid type'
86 call efexit(-1)
87 endif
88
89
90
91 axis = 1
92 isize = 5
93 call mmhgcw(fid,mname,med_no_dt,med_no_it,dt,
94 & axis,isize,cooxaxis,cret)
95 if (cret .ne. 0 ) then
96 print *,'ERROR : write X coordinates'
97 call efexit(-1)
98 endif
99 axis = 2
100 isize = 3
101 call mmhgcw(fid,mname,med_no_dt,med_no_it,dt,
102 & axis,isize,cooyaxis,cret)
103 if (cret .ne. 0 ) then
104 print *,'ERROR : write Y coordinates'
105 call efexit(-1)
106 endif
107
108
109
110
111 call mmheaw(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,
112 & nquad4,cnames,cret)
113 if (cret .ne. 0 ) then
114 print *,'ERROR : write names for elements'
115 call efexit(-1)
116 endif
117
118
119
120 call mfacre(fid,mname,med_no_name,0,0,med_no_group,cret)
121 if (cret .ne. 0 ) then
122 print *,'ERROR : create family 0'
123 call efexit(-1)
124 endif
125
126
127
129 if (cret .ne. 0 ) then
130 print *,'ERROR : close file'
131 call efexit(-1)
132 endif
133
134
135
136 end
137
program usescase_medmesh_4
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
Cette routine permet la création d'une famille portant sur les entités d'un maillage.
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 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 mmhgcw(fid, name, numdt, numit, dt, axis, size, index, cret)