MED fichier: Fichier source de Unittest_MEDstructElement_9.f

MED fichier

Unittest_MEDstructElement_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 * Tests for struct element module
20 C *
21 C *****************************************************************************
22 program medstructelement9
23 C
24 implicit none
25 include 'med.hf'
26 C
27 C
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)
84 C
85 C
86 C 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
93 C
94 C
95 C 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
103 c
104 call mmhcow(fid,smname2,med_no_dt,med_no_it,
105 & med_undef_dt,med_full_interlace,
106 & nnode,coo,cret)
107 c
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)
112 C
113 C struct element creation
114 C
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
122 C
123 C attribute creation
124 C
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
131 c
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
138 c
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
145 C
146 C computation mesh creation
147 C
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
156 c
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
164 c
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
173 C
174 C write attributes values
175 C
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
184 c
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
193 c
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
202 C
203 C
204 C 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
211 C
212 C
213 C
214 end
215
mmhcyw
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, 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:578
msecre
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.
Definition: medstructelement.f:20
msmcre
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition: medsupport.f:20
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
mmhiaw
subroutine mmhiaw(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:1119
medstructelement9
program medstructelement9
Definition: Unittest_MEDstructElement_9.f:22
mmhraw
subroutine mmhraw(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:1096
msevac
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...
Definition: medstructelement.f:150
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhsaw
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
mmhcow
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:299
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42