MED fichier
usecases/f/UsesCase_MEDmesh_9.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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 9 : 2D unstructured mesh with moving grid transformation
22 C *
23 C *
24 C *****************************************************************************
25  program usescase_medmesh_9
26 C
27  implicit none
28  include 'med.hf77'
29 C
30 C
31  integer cret
32  integer*8 fid
33 
34 C
35  character (MED_NAME_SIZE) mname
36  character (MED_NAME_SIZE) fname
37  character (MED_COMMENT_SIZE) cmt1,mdesc
38  integer sdim, mdim
39 C axis name
40  character (MED_SNAME_SIZE) axname(2)
41 C unit name
42  character (MED_SNAME_SIZE) unname(2)
43  real*8 inicoo(30)
44  integer nnodes, ntria3, nquad4
45 C tria connectivity
46  integer triacy(24)
47 C quad connectivity
48  integer quadcy(16)
49 C transformation matrix step 1
50  real*8 trama1(7)
51 C transformation matrix step 2
52  real*8 trama2(7)
53 
54  parameter(fname = "UsesCase_MEDmesh_9.med")
55  parameter(cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
56  parameter(mdesc = "A 2D unstructured mesh")
57  parameter(mname="2D unstructured mesh")
58  parameter(sdim=2, mdim=2)
59  parameter(nnodes=15,ntria3=8,nquad4=4)
60 
61  data axname /"x", "y"/
62  data unname /"cm", "cm"/
63  data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
64  & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
65  & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
66  data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
67  & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
68  data quadcy /3,4,9,8, 4,5,10,9,
69  & 15,14,9,10, 13,8,9,14/
70 C transformation matrix (step 1) : rotation about the Y-axis : 45 degrees
71  data trama1 /0.0, 0.0, 0.0, 0.92388, 0.0, 0.38268, 0.0/
72 C transformation matrix (step 2) : rotation about the Y-axis : 90 degrees
73  data trama2 /0.0, 0.0, 0.0, 0.707, 0.0, 0.707, 0.0/
74 C
75 C file creation
76  call mfiope(fid,fname,med_acc_creat,cret)
77  if (cret .ne. 0 ) then
78  print *,"ERROR : file creation"
79  call efexit(-1)
80  endif
81 C
82 C write a comment in the file
83  call mficow(fid,cmt1,cret)
84  if (cret .ne. 0 ) then
85  print *,"ERROR : write file description"
86  call efexit(-1)
87  endif
88 C
89 C mesh creation : a 2D unstructured mesh
90  call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
91  & "", med_sort_dtit, med_cartesian, axname, unname, cret)
92  if (cret .ne. 0 ) then
93  print *,"ERROR : mesh creation"
94  call efexit(-1)
95  endif
96 C
97 C
98 C initial nodes coordinates in a cartesian axis in full interlace mode
99 C (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
100  call mmhcpw(fid, mname, med_no_dt, med_no_it, 0.0d0,
101  & med_compact_stmode, med_no_profile,
102  & med_full_interlace, med_all_constituent,
103  & nnodes, inicoo, cret)
104  if (cret .ne. 0 ) then
105  print *,"ERROR : nodes coordinates"
106  call efexit(-1)
107  endif
108 C
109 C
110 C cells connectivity is defined in nodal mode
111  call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
112  & med_cell, med_tria3, med_nodal,
113  & med_compact_stmode, med_no_profile,
114  & med_full_interlace, med_all_constituent,
115  & ntria3, triacy, cret)
116  if (cret .ne. 0 ) then
117  print *,"ERROR : triangular cells connectivity"
118  call efexit(-1)
119  endif
120 C
121 C
122  call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
123  & med_cell, med_quad4, med_nodal,
124  & med_compact_stmode, med_no_profile,
125  & med_full_interlace, med_all_constituent,
126  & nquad4, quadcy, cret)
127  if (cret .ne. 0 ) then
128  print *,"ERROR : quadrangular cells connectivity"
129  call efexit(-1)
130  endif
131 C
132 C
133 C Mesh deformation (nodes coordinates) in 2 steps
134 C A rotation by step for each node
135 C
136 C STEP 1 : dt1 = 5.5, it = 1
137  call mmhtfw(fid, mname, 1, 1, 5.5d0, trama1, cret)
138 C
139 C
140 C STEP 2 : dt2 = 8.9, it = 1
141  call mmhtfw(fid, mname, 2, 1, 8.9d0, trama2, cret)
142 C
143 C
144 C create family 0 : by default, all mesh entities family number is 0
145  call mfacre(fid, mname,med_no_name, 0, 0, med_no_group, cret)
146  if (cret .ne. 0 ) then
147  print *,"ERROR : create family 0"
148  call efexit(-1)
149  endif
150 C
151 C
152 C close file
153  call mficlo(fid,cret)
154  if (cret .ne. 0 ) then
155  print *,"ERROR : close file"
156  call efexit(-1)
157  endif
158 C
159 C
160  end
161 C
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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:621
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
usescase_medmesh_9
program usescase_medmesh_9
Definition: UsesCase_MEDmesh_9.f:25
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,...
Definition: medmesh.f:340
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:99
mmhtfw
subroutine mmhtfw(fid, name, numdt, numit, dt, tsf, cret)
Cette routine définit les paramètres de translation rotation à appliquer aux noeuds de l'étape de cal...
Definition: medmesh.f:1249