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