MED fichier: Fichier source de UsesCase_MEDmesh_9.f

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 - 2023 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
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
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
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
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:99
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
usescase_medmesh_9
program usescase_medmesh_9
Definition: UsesCase_MEDmesh_9.f:25
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42