MED fichier
Unittest_MEDstructElement_9.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C******************************************************************************
19C * Tests for struct element module
20C *
21C *****************************************************************************
23C
24 implicit none
25 include 'med.hf'
26C
27C
28 integer cret
29 integer*8 fid
30
31 character*64 fname
32 parameter(fname = "Unittest_MEDstructElement_9.med")
33 character*64 mname2
34 parameter(mname2 = "model name 2")
35 integer dim2
36 parameter(dim2=2)
37 character*64 smname2
38 parameter(smname2="support mesh name")
39 integer setype2
40 parameter(setype2=med_node)
41 integer sgtype2
42 parameter(sgtype2=med_no_geotype)
43 integer mtype2
44 integer sdim1
45 parameter(sdim1=2)
46 character*200 description1,description2
47 parameter(description1="support mesh1 description")
48 parameter(description2="computation mesh description")
49 character*16 nomcoo2d(2)
50 character*16 unicoo2d(2)
51 data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
52 real*8 coo(2*3), ccoo(2*3)
53 data coo /0.0, 0.0, 1.0,1.0, 2.0,2.0/
54 data ccoo /0.1, 0.1, 1.1,1.1, 2.1,2.1/
55 integer nnode
56 parameter(nnode=3)
57 integer nseg2
58 parameter(nseg2=2)
59 integer seg2(4), mcon(1)
60 data seg2 /1,2, 2,3/
61 data mcon /1/
62 character*64 aname1, aname2, aname3
63 parameter(aname1="integer attribute name")
64 parameter(aname2="real attribute name")
65 parameter(aname3="string attribute name")
66 integer atype1,atype2,atype3
67 parameter(atype1=med_att_int)
68 parameter(atype2=med_att_float64)
69 parameter(atype3=med_att_name)
70 integer anc1,anc2,anc3
71 parameter(anc1=2)
72 parameter(anc2=1)
73 parameter(anc3=2)
74 integer aval1(2)
75 data aval1 /1,2/
76 real*8 aval2(1)
77 data aval2 /1./
78 character*64 aval3(2)
79 data aval3 /"VAL1","VAL2"/
80 character*64 pname,cname
81 parameter(cname="computation mesh")
82 integer nentity
83 parameter(nentity=1)
84C
85C
86C file creation
87 call mfiope(fid,fname,med_acc_creat,cret)
88 print *,'Open file',cret
89 if (cret .ne. 0 ) then
90 print *,'ERROR : file creation'
91 call efexit(-1)
92 endif
93C
94C
95C support mesh creation : 2D
96 call msmcre(fid,smname2,dim2,dim2,description1,
97 & med_cartesian,nomcoo2d,unicoo2d,cret)
98 print *,'Support mesh creation : 2D space dimension',cret
99 if (cret .ne. 0 ) then
100 print *,'ERROR : support mesh creation'
101 call efexit(-1)
102 endif
103c
104 call mmhcow(fid,smname2,med_no_dt,med_no_it,
105 & med_undef_dt,med_full_interlace,
106 & nnode,coo,cret)
107c
108 call mmhcyw(fid,smname2,med_no_dt,med_no_it,
109 & med_undef_dt,med_cell,med_seg2,
110 & med_nodal,med_full_interlace,
111 & nseg2,seg2,cret)
112C
113C struct element creation
114C
115 call msecre(fid,mname2,dim2,smname2,setype2,
116 & sgtype2,mtype2,cret)
117 print *,'Create struct element',mtype2, cret
118 if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
119 print *,'ERROR : struct element creation'
120 call efexit(-1)
121 endif
122C
123C attribute creation
124C
125 call msevac(fid,mname2,aname1,atype1,anc1,cret)
126 print *,'Create attribute',aname1, cret
127 if (cret .ne. 0) then
128 print *,'ERROR : attribute creation'
129 call efexit(-1)
130 endif
131c
132 call msevac(fid,mname2,aname2,atype2,anc2,cret)
133 print *,'Create attribute',aname2, cret
134 if (cret .ne. 0) then
135 print *,'ERROR : attribute creation'
136 call efexit(-1)
137 endif
138c
139 call msevac(fid,mname2,aname3,atype3,anc3,cret)
140 print *,'Create attribute',aname3, cret
141 if (cret .ne. 0) then
142 print *,'ERROR : attribute creation'
143 call efexit(-1)
144 endif
145C
146C computation mesh creation
147C
148 call mmhcre(fid,cname,dim2,dim2,med_unstructured_mesh,
149 & description2,"",med_sort_dtit,med_cartesian,
150 & nomcoo2d,unicoo2d,cret)
151 print *,'Create computation mesh',cname, cret
152 if (cret .ne. 0) then
153 print *,'ERROR : computation mesh creation'
154 call efexit(-1)
155 endif
156c
157 call mmhcow(fid,cname,med_no_dt,med_no_it,med_undef_dt,
158 & med_full_interlace,nnode,ccoo,cret)
159 print *,'Write nodes coordinates',cret
160 if (cret .ne. 0) then
161 print *,'ERROR : write nodes coordinates'
162 call efexit(-1)
163 endif
164c
165 call mmhcyw(fid,cname,med_no_dt,med_no_it,med_undef_dt,
166 & med_struct_element,mtype2,med_nodal,
167 & med_no_interlace,nentity,mcon,cret)
168 print *,'Write cells connectivity',cret
169 if (cret .ne. 0) then
170 print *,'ERROR : write cells connectivity'
171 call efexit(-1)
172 endif
173C
174C write attributes values
175C
176 call mmhiaw(fid,cname,med_no_dt,med_no_it,
177 & mtype2,aname1,nentity,
178 & aval1,cret)
179 print *,'Write attribute values',cret
180 if (cret .ne. 0) then
181 print *,'ERROR : write attribute values'
182 call efexit(-1)
183 endif
184c
185 call mmhraw(fid,cname,med_no_dt,med_no_it,
186 & mtype2,aname2,nentity,
187 & aval2,cret)
188 print *,'Write attribute values',cret
189 if (cret .ne. 0) then
190 print *,'ERROR : write attribute values'
191 call efexit(-1)
192 endif
193c
194 call mmhsaw(fid,cname,med_no_dt,med_no_it,
195 & mtype2,aname3,nentity,
196 & aval3,cret)
197 print *,'Write attribute values',cret
198 if (cret .ne. 0) then
199 print *,'ERROR : write attribute values'
200 call efexit(-1)
201 endif
202C
203C
204C close file
205 call mficlo(fid,cret)
206 print *,'Close file',cret
207 if (cret .ne. 0 ) then
208 print *,'ERROR : close file'
209 call efexit(-1)
210 endif
211C
212C
213C
214 end
215
program medstructelement9
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition medfile.f:82
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 msevac(fid, mname, aname, atype, anc, cret)
Cette routine déclare la présence d'un attribut caractéristique variable attaché aux éléments de type...
subroutine mmhsaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
Definition medmesh.f:1142
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
Cette routine permet de créer un nouveau modèle d'éléments de structure dans un fichier MED.
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition medsupport.f:20
subroutine mmhiaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Definition medmesh.f:1119
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Definition medmesh.f:578
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Definition medmesh.f:1096
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Definition medmesh.f:299