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 - 2016 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 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 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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 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
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
program medstructelement9
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 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
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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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 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