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 - 2019 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*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 C axis name
38 character*16 axname(2)
39 C unit name
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 C
64 C
65 C file creation
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 C
72 C
73 C mesh creation
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 C
81 C
82 C specify grid type
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 C
89 C
90 C write axis "X" and "Y" coordinates
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 C
108 C
109 C optionnal : names for nodes or elements
110 C In this case, a name is given to the cells of the mesh
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 C
118 C
119 C create family 0 : by default, all mesh entities family number is 0
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 C
126 C
127 C close file
128 call mficlo(fid,cret)
129 if (cret .ne. 0 ) then
130 print *,'ERROR : close file'
131 call efexit(-1)
132 endif
133 C
134 C
135 C
136 end
137 C