MED fichier: Fichier source de Unittest_MEDstructElement_9.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 - 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 * 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 fid
30 character*64 fname
31 parameter(fname = "Unittest_MEDstructElement_9.med")
32 character*64 mname2
33 parameter(mname2 = "model name 2")
34 integer dim2
35 parameter(dim2=2)
36 character*64 smname2
37 parameter(smname2="support mesh name")
38 integer setype2
39 parameter(setype2=med_node)
40 integer sgtype2
41 parameter(sgtype2=med_no_geotype)
42 integer mtype2
43 integer sdim1
44 parameter(sdim1=2)
45 character*200 description1,description2
46 parameter(description1="support mesh1 description")
47 parameter(description2="computation mesh description")
48 character*16 nomcoo2D(2)
49 character*16 unicoo2D(2)
50 data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
51 real*8 coo(2*3), ccoo(2*3)
52 data coo /0.0, 0.0, 1.0,1.0, 2.0,2.0/
53 data ccoo /0.1, 0.1, 1.1,1.1, 2.1,2.1/
54 integer nnode
55 parameter(nnode=3)
56 integer nseg2
57 parameter(nseg2=2)
58 integer seg2(4), mcon(1)
59 data seg2 /1,2, 2,3/
60 data mcon /1/
61 character*64 aname1, aname2, aname3
62 parameter(aname1="integer attribute name")
63 parameter(aname2="real attribute name")
64 parameter(aname3="string attribute name")
65 integer atype1,atype2,atype3
66 parameter(atype1=med_att_int)
67 parameter(atype2=med_att_float64)
68 parameter(atype3=med_att_name)
69 integer anc1,anc2,anc3
70 parameter(anc1=2)
71 parameter(anc2=1)
72 parameter(anc3=2)
73 integer aval1(2)
74 data aval1 /1,2/
75 real*8 aval2(1)
76 data aval2 /1./
77 character*64 aval3(2)
78 data aval3 /"VAL1","VAL2"/
79 character*64 pname,cname
80 parameter(cname="computation mesh")
81 integer nentity
82 parameter(nentity=1)
83 C
84 C
85 C file creation
86 call mfiope(fid,fname,med_acc_creat,cret)
87 print *,'Open file',cret
88 if (cret .ne. 0 ) then
89 print *,'ERROR : file creation'
90 call efexit(-1)
91 endif
92 C
93 C
94 C support mesh creation : 2D
95 call msmcre(fid,smname2,dim2,dim2,description1,
96 & med_cartesian,nomcoo2d,unicoo2d,cret)
97 print *,'Support mesh creation : 2D space dimension',cret
98 if (cret .ne. 0 ) then
99 print *,'ERROR : support mesh creation'
100 call efexit(-1)
101 endif
102 c
103 call mmhcow(fid,smname2,med_no_dt,med_no_it,
104 & med_undef_dt,med_full_interlace,
105 & nnode,coo,cret)
106 c
107 call mmhcyw(fid,smname2,med_no_dt,med_no_it,
108 & med_undef_dt,med_cell,med_seg2,
109 & med_nodal,med_full_interlace,
110 & nseg2,seg2,cret)
111 C
112 C struct element creation
113 C
114 call msecre(fid,mname2,dim2,smname2,setype2,
115 & sgtype2,mtype2,cret)
116 print *,'Create struct element',mtype2, cret
117 if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
118 print *,'ERROR : struct element creation'
119 call efexit(-1)
120 endif
121 C
122 C attribute creation
123 C
124 call msevac(fid,mname2,aname1,atype1,anc1,cret)
125 print *,'Create attribute',aname1, cret
126 if (cret .ne. 0) then
127 print *,'ERROR : attribute creation'
128 call efexit(-1)
129 endif
130 c
131 call msevac(fid,mname2,aname2,atype2,anc2,cret)
132 print *,'Create attribute',aname2, cret
133 if (cret .ne. 0) then
134 print *,'ERROR : attribute creation'
135 call efexit(-1)
136 endif
137 c
138 call msevac(fid,mname2,aname3,atype3,anc3,cret)
139 print *,'Create attribute',aname3, cret
140 if (cret .ne. 0) then
141 print *,'ERROR : attribute creation'
142 call efexit(-1)
143 endif
144 C
145 C computation mesh creation
146 C
147 call mmhcre(fid,cname,dim2,dim2,med_unstructured_mesh,
148 & description2,"",med_sort_dtit,med_cartesian,
149 & nomcoo2d,unicoo2d,cret)
150 print *,'Create computation mesh',cname, cret
151 if (cret .ne. 0) then
152 print *,'ERROR : computation mesh creation'
153 call efexit(-1)
154 endif
155 c
156 call mmhcow(fid,cname,med_no_dt,med_no_it,med_undef_dt,
157 & med_full_interlace,nnode,ccoo,cret)
158 print *,'Write nodes coordinates',cret
159 if (cret .ne. 0) then
160 print *,'ERROR : write nodes coordinates'
161 call efexit(-1)
162 endif
163 c
164 call mmhcyw(fid,cname,med_no_dt,med_no_it,med_undef_dt,
165 & med_struct_element,mtype2,med_nodal,
166 & med_no_interlace,nentity,mcon,cret)
167 print *,'Write cells connectivity',cret
168 if (cret .ne. 0) then
169 print *,'ERROR : write cells connectivity'
170 call efexit(-1)
171 endif
172 C
173 C write attributes values
174 C
175 call mmhiaw(fid,cname,med_no_dt,med_no_it,
176 & mtype2,aname1,nentity,
177 & aval1,cret)
178 print *,'Write attribute values',cret
179 if (cret .ne. 0) then
180 print *,'ERROR : write attribute values'
181 call efexit(-1)
182 endif
183 c
184 call mmhraw(fid,cname,med_no_dt,med_no_it,
185 & mtype2,aname2,nentity,
186 & aval2,cret)
187 print *,'Write attribute values',cret
188 if (cret .ne. 0) then
189 print *,'ERROR : write attribute values'
190 call efexit(-1)
191 endif
192 c
193 call mmhsaw(fid,cname,med_no_dt,med_no_it,
194 & mtype2,aname3,nentity,
195 & aval3,cret)
196 print *,'Write attribute values',cret
197 if (cret .ne. 0) then
198 print *,'ERROR : write attribute values'
199 call efexit(-1)
200 endif
201 C
202 C
203 C close file
204 call mficlo(fid,cret)
205 print *,'Close file',cret
206 if (cret .ne. 0 ) then
207 print *,'ERROR : close file'
208 call efexit(-1)
209 endif
210 C
211 C
212 C
213 end
214
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:1090
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:1046
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
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
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:551
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:1068
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:144
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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, selon une séquence de calcul donnée.
Definition: medmesh.f:285