MED fichier: usecases/f/UsesCase_MEDmesh_4.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

usecases/f/UsesCase_MEDmesh_4.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 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