31 parameter(fname =
"Unittest_MEDstructElement_9.med")
33 parameter(mname2 =
"model name 2")
37 parameter(smname2=
"support mesh name")
39 parameter(setype2=med_node)
41 parameter(sgtype2=med_no_geotype)
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/
58 integer seg2(4), 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
78 data aval3 /
"VAL1",
"VAL2"/
79 character*64 pname,cname
80 parameter(cname=
"computation mesh")
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' 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' 103 call mmhcow(fid,smname2,med_no_dt,med_no_it,
104 & med_undef_dt,med_full_interlace,
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,
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' 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' 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' 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' 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' 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' 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' 175 call mmhiaw(fid,cname,med_no_dt,med_no_it,
176 & mtype2,aname1,nentity,
178 print *,
'Write attribute values',cret
179 if (cret .ne. 0)
then 180 print *,
'ERROR : write attribute values' 184 call mmhraw(fid,cname,med_no_dt,med_no_it,
185 & mtype2,aname2,nentity,
187 print *,
'Write attribute values',cret
188 if (cret .ne. 0)
then 189 print *,
'ERROR : write attribute values' 193 call mmhsaw(fid,cname,med_no_dt,med_no_it,
194 & mtype2,aname3,nentity,
196 print *,
'Write attribute values',cret
197 if (cret .ne. 0)
then 198 print *,
'ERROR : write attribute values' 205 print *,
'Close file',cret
206 if (cret .ne. 0 )
then 207 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, 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 mfiope(fid, name, access, cret)
subroutine msevac(fid, mname, aname, atype, anc, cret)
program medstructelement9
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)