MED fichier
usecases/f/UsesCase_MEDmesh_4.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2016 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C******************************************************************************
19 C * How to create an structured mesh
20 C * Use case 4 : write a 2D structured mesh (5x3 cartesian grid)
21 C *
22 C *****************************************************************************
23  program usescase_medmesh_4
24 C
25  implicit none
26  include 'med.hf77'
27 C
28 C
29  integer cret
30  integer fid
31  integer sdim, mdim, stype, mtype, atype
32  integer axis, isize, entype, nquad4
33  character*200 mdesc
34  character*64 fname
35  character*64 mname
36 C axis name
37  character*16 axname(2)
38 C unit name
39  character*16 unname(2)
40  character*16 dtunit
41  character*16 cnames(8)
42  real*8 dt
43  real*8 cooxaxis(5)
44  real*8 cooyaxis(3)
45  parameter(fname = "UsesCase_MEDmesh_4.med")
46  parameter(mdesc = "A 2D structured mesh")
47  parameter(mname = "2D structured mesh")
48  parameter(sdim = 2, mdim = 2)
49  parameter(stype=med_sort_dtit, mtype=med_structured_mesh)
50  parameter(atype=med_cartesian_grid)
51  parameter(nquad4=8)
52  parameter(dt=0.0d0)
53  data dtunit /" "/
54  data axname /"x" ,"y"/
55  data unname /"cm","cm"/
56  data cnames /"CELL_1","CELL_2",
57  & "CELL_3","CELL_4",
58  & "CELL_5","CELL_6",
59  & "CELL_7","CELL_8"/
60  data cooxaxis /1.,2.,3.,4.,5./
61  data cooyaxis /1.,2.,3./
62 C
63 C
64 C file creation
65  call mfiope(fid,fname,med_acc_creat,cret)
66  if (cret .ne. 0 ) then
67  print *,'ERROR : file creation'
68  call efexit(-1)
69  endif
70 C
71 C
72 C mesh creation
73  call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
74  & dtunit, stype, atype, axname, unname, cret)
75  if (cret .ne. 0 ) then
76  print *,'ERROR : mesh creation'
77  call efexit(-1)
78  endif
79 C
80 C
81 C specify grid type
82  call mmhgtw(fid,mname,med_cartesian_grid,cret)
83  if (cret .ne. 0 ) then
84  print *,'ERROR : write grid type'
85  call efexit(-1)
86  endif
87 C
88 C
89 C write axis "X" and "Y" coordinates
90  axis = 1
91  isize = 5
92  call mmhgcw(fid,mname,med_no_dt,med_no_it,dt,
93  & axis,isize,cooxaxis,cret)
94  if (cret .ne. 0 ) then
95  print *,'ERROR : write X coordinates'
96  call efexit(-1)
97  endif
98  axis = 2
99  isize = 3
100  call mmhgcw(fid,mname,med_no_dt,med_no_it,dt,
101  & axis,isize,cooyaxis,cret)
102  if (cret .ne. 0 ) then
103  print *,'ERROR : write Y coordinates'
104  call efexit(-1)
105  endif
106 C
107 C
108 C optionnal : names for nodes or elements
109 C In this case, a name is given to the cells of the mesh
110  call mmheaw(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,
111  & nquad4,cnames,cret)
112  if (cret .ne. 0 ) then
113  print *,'ERROR : write names for elements'
114  call efexit(-1)
115  endif
116 C
117 C
118 C create family 0 : by default, all mesh entities family number is 0
119  call mfacre(fid,mname,med_no_name,0,0,med_no_group,cret)
120  if (cret .ne. 0 ) then
121  print *,'ERROR : create family 0'
122  call efexit(-1)
123  endif
124 C
125 C
126 C close file
127  call mficlo(fid,cret)
128  if (cret .ne. 0 ) then
129  print *,'ERROR : close file'
130  call efexit(-1)
131  endif
132 C
133 C
134 C
135  end
136 C