MED fichier: Fichier source de UsesCase_MEDmesh_6.f

MED fichier

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

UsesCase_MEDmesh_6.f
Aller à la documentation de ce fichier.
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 unstructured mesh
20 C *
21 C * Use case 6 : a 2D unstructured mesh with the following features
22 C * computing steps, profiles and nodes coordinates evolution.
23 C *
24 C *****************************************************************************
25 program usescase_medmesh_6
26 C
27 implicit none
28 include 'med.hf77'
29 C
30 C
31 integer cret
32 integer fid
33 C
34 character (MED_NAME_SIZE) mname
35 character (MED_NAME_SIZE) fname
36 character (MED_COMMENT_SIZE) cmt1,mdesc
37 integer sdim, mdim
38 C axis name
39 character (MED_SNAME_SIZE) axname(2)
40 C unit name
41 character (MED_SNAME_SIZE) unname(2)
42 real*8 inicoo(30)
43 integer nnodes, ntria3, nquad4
44 C tria connectivity
45 integer triacy(24)
46 C quad connectivity
47 integer quadcy(16)
48 C new_coordinates_step1
49 real*8 nwcos1(6)
50 C profile1name
51 character (MED_NAME_SIZE) prof1n
52 C profile1
53 integer profi1(3)
54 C profile1size
55 integer pro1sz
56 C new_coordinates_step2
57 real*8 nwcos2(6)
58 C profile2name
59 character (MED_NAME_SIZE) prof2n
60 C profile2
61 integer profi2(3)
62 C profile2size
63 integer pro2sz
64
65 parameter(fname = "UsesCase_MEDmesh_6.med")
66 parameter(cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
67 parameter(mdesc = "A 2D unstructured mesh")
68 parameter(mname="2D unstructured mesh")
69 parameter(sdim=2, mdim=2)
70 parameter(nnodes=15,ntria3=8,nquad4=4)
71
72 data axname /"x", "y"/
73 data unname /"cm", "cm"/
74 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
75 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
76 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
77 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
78 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
79 data quadcy /3,4,9,8, 4,5,10,9,
80 & 15,14,9,10, 13,8,9,14/
81
82 C new coordinates (step 1) for nodes 13, 14 and 15
83 data nwcos1 /12.,15., 17.,15., 22.,15./
84 parameter(prof1n="UPPER_QUAD4_PROFILE")
85 data profi1 /13, 14, 15/
86 parameter(pro1sz=3)
87
88 C new coordinates (step 2) for nodes 8, 9 and 10
89 data nwcos2 /12.,10., 17.,10., 22.,10./
90 parameter(prof2n="MIDDLE_QUAD4_PROFILE")
91 data profi2 /8, 9, 10/
92 parameter(pro2sz=3)
93 C
94 C file creation
95 call mfiope(fid,fname,med_acc_creat,cret)
96 if (cret .ne. 0 ) then
97 print *,"ERROR : file creation"
98 call efexit(-1)
99 endif
100 C
101 C write a comment in the file
102 call mficow(fid,cmt1,cret)
103 if (cret .ne. 0 ) then
104 print *,"ERROR : write file description"
105 call efexit(-1)
106 endif
107 C
108 C create the profiles in the file
109 call mpfprw(fid,prof1n,pro1sz,profi1,cret)
110 if (cret .ne. 0 ) then
111 print *,"ERROR : create profile"
112 call efexit(-1)
113 endif
114 C
115 C create the profiles in the file
116 call mpfprw(fid,prof2n,pro2sz,profi2,cret)
117 if (cret .ne. 0 ) then
118 print *,"ERROR : create profile"
119 call efexit(-1)
120 endif
121 C
122 C mesh creation : a 2D unstructured mesh
123 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
124 & "", med_sort_dtit, med_cartesian, axname, unname, cret)
125 if (cret .ne. 0 ) then
126 print *,"ERROR : mesh creation"
127 call efexit(-1)
128 endif
129 C
130 C
131 C initial nodes coordinates in a cartesian axis in full interlace mode
132 C (X1,Y1, X2,Y2, X3,Y3, ...)
133 call mmhcpw(fid, mname, med_no_dt, med_no_it, 0.0d0,
134 & med_compact_stmode, med_no_profile,
135 & med_full_interlace, med_all_constituent,
136 & nnodes, inicoo, cret)
137 if (cret .ne. 0 ) then
138 print *,"ERROR : nodes coordinates"
139 call efexit(-1)
140 endif
141 C
142 C
143 C cells connectivity is defined in nodal mode
144 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
145 & med_cell, med_tria3, med_nodal,
146 & med_compact_stmode, med_no_profile,
147 & med_full_interlace, med_all_constituent,
148 & ntria3, triacy, cret)
149 if (cret .ne. 0 ) then
150 print *,"ERROR : triangular cells connectivity"
151 call efexit(-1)
152 endif
153 C
154 C
155 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
156 & med_cell, med_quad4, med_nodal,
157 & med_compact_stmode, med_no_profile,
158 & med_full_interlace, med_all_constituent,
159 & nquad4, quadcy, cret)
160 if (cret .ne. 0 ) then
161 print *,"ERROR : quadrangular cells connectivity"
162 call efexit(-1)
163 endif
164 C
165 C
166 C Mesh deformation (nodes coordinates) in 2 steps
167 C The nodes modified are identified by a profile
168 C
169 C STEP 1 : dt1 = 5.5, it = 1
170 call mmhcpw(fid, mname, 1, 1, 5.5d0,
171 & med_compact_stmode, prof1n,
172 & med_full_interlace, med_all_constituent,
173 & nnodes, nwcos1, cret)
174 if (cret .ne. 0 ) then
175 print *,"ERROR : nodes coordinates"
176 call efexit(-1)
177 endif
178 C
179 C
180 C STEP 2 : dt2 = 8.9, it = 1
181 call mmhcpw(fid, mname, 2, 1, 8.9d0,
182 & med_compact_stmode, prof2n,
183 & med_full_interlace, med_all_constituent,
184 & nnodes, nwcos2, cret)
185 if (cret .ne. 0 ) then
186 print *,"ERROR : nodes coordinates"
187 call efexit(-1)
188 endif
189 C
190 C
191 C create family 0 : by default, all mesh entities family number is 0
192 call mfacre(fid, mname,med_no_name, 0, 0, med_no_group, cret)
193 if (cret .ne. 0 ) then
194 print *,"ERROR : create family 0"
195 call efexit(-1)
196 endif
197 C
198 C
199 C close file
200 call mficlo(fid,cret)
201 if (cret .ne. 0 ) then
202 print *,"ERROR : close file"
203 call efexit(-1)
204 endif
205 C
206 C
207 end
208 C
mpfprw
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
Definition: medprofile.f:21
usescase_medmesh_6
program usescase_medmesh_6
Definition: UsesCase_MEDmesh_6.f:25
mfacre
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.
Definition: medfamily.f:19
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:96
mmhcpw
subroutine mmhcpw(fid, name, numdt, numit, dt, stm, pname, swm, dim, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée et un profil donnés.
Definition: medmesh.f:324
mmhcre
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.
Definition: medmesh.f:20
mmhypw
subroutine mmhypw(fid, name, numdt, numit, dt, entype, geotype, cmode, stmode, pname, swm, dim, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:592
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41