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' 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 mfiope(fid, name, access, cret)
subroutine msevac(fid, mname, aname, atype, anc, cret)
program medstructelement9
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
subroutine mmhsaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mficlo(fid, cret)