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 - 2021 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 *****************************************************************************
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 
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
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
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
medstructelement9
program medstructelement9
Definition: Unittest_MEDstructElement_9.f:22
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
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
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
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