32 parameter(fname =
"Unittest_MEDstructElement_9.med")
34 parameter(mname2 =
"model name 2")
38 parameter(smname2=
"support mesh name")
40 parameter(setype2=med_node)
42 parameter(sgtype2=med_no_geotype)
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/
59 integer seg2(4), 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
79 data aval3 /
"VAL1",
"VAL2"/
80 character*64 pname,cname
81 parameter(cname=
"computation mesh")
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'
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'
104 call mmhcow(fid,smname2,med_no_dt,med_no_it,
105 & med_undef_dt,med_full_interlace,
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,
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'
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'
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'
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'
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'
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'
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'
176 call mmhiaw(fid,cname,med_no_dt,med_no_it,
177 & mtype2,aname1,nentity,
179 print *,
'Write attribute values',cret
180 if (cret .ne. 0)
then
181 print *,
'ERROR : write attribute values'
185 call mmhraw(fid,cname,med_no_dt,med_no_it,
186 & mtype2,aname2,nentity,
188 print *,
'Write attribute values',cret
189 if (cret .ne. 0)
then
190 print *,
'ERROR : write attribute values'
194 call mmhsaw(fid,cname,med_no_dt,med_no_it,
195 & mtype2,aname3,nentity,
197 print *,
'Write attribute values',cret
198 if (cret .ne. 0)
then
199 print *,
'ERROR : write attribute values'
206 print *,
'Close file',cret
207 if (cret .ne. 0 )
then
208 print *,
'ERROR : close file'
program medstructelement9
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhiaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mmhsaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
subroutine msevac(fid, mname, aname, atype, anc, cret)
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)