MED fichier
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 - 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 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 *****************************************************************************
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
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
program usescase_medmesh_6
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
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
Definition: medprofile.f:21
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
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:96
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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