31 parameter(fname =
"Unittest_MEDstructElement_9.med")
33 parameter(mname2 =
"model name 2")
35 character*64 aname1, aname2, aname3
36 parameter(aname1=
"integer attribute name")
37 parameter(aname2=
"real attribute name")
38 parameter(aname3=
"string attribute name")
39 integer atype1,atype2,atype3
40 parameter(atype1=med_att_int)
41 parameter(atype2=med_att_float64)
42 parameter(atype3=med_att_name)
43 integer anc1,anc2,anc3
52 data aval3 /
"VAL1",
"VAL2"/
53 character*64 pname,cname
54 parameter(cname=
"computation mesh")
65 call mfiope(fid,fname,med_acc_rdonly,cret)
66 print *,
'Open file',cret
67 if (cret .ne. 0 )
then 68 print *,
'ERROR : file creation' 74 call msevni(fid,mname2,aname1,atype,anc,cret)
75 print *,
'Read information about attribute',aname1, cret
77 print *,
'ERROR : attribute infromation' 80 if ( (atype .ne. atype1) .or.
83 print *,
'ERROR : attribute information' 87 call msevni(fid,mname2,aname2,atype,anc,cret)
88 print *,
'Read information about attribute',aname2, cret
90 print *,
'ERROR : attribute infromation' 93 if ( (atype .ne. atype2) .or.
96 print *,
'ERROR : attribute information' 100 call msevni(fid,mname2,aname3,atype,anc,cret)
101 print *,
'Read information about attribute',aname3, cret
102 if (cret .ne. 0)
then 103 print *,
'ERROR : attribute information' 106 if ( (atype .ne. atype3) .or.
109 print *,
'ERROR : attribute information' 116 call msesgt(fid,mname2,mtype2,cret)
117 print *,
'Read struct element type (by name) : ',mtype2, cret
118 if (cret .ne. 0 )
then 119 print *,
'ERROR : struct element type (by name)' 123 call mmhiar(fid,cname,med_no_dt,med_no_it,
124 & mtype2,aname1,rval1,cret)
125 print *,
'Read attribute values',cret
126 if (cret .ne. 0)
then 127 print *,
'ERROR : read attribute values' 130 if ( (aval1(1) .ne. rval1(1)) .or.
131 & (aval1(2) .ne. rval1(2))
133 print *,
'ERROR : attribute information' 137 call mmhrar(fid,cname,med_no_dt,med_no_it,
138 & mtype2,aname2,rval2,cret)
139 print *,
'Read attribute values',cret
140 if (cret .ne. 0)
then 141 print *,
'ERROR : read attribute values' 144 if ( (aval2(1) .ne. rval2(1))
146 print *,
'ERROR : attribute information' 150 call mmhsar(fid,cname,med_no_dt,med_no_it,
151 & mtype2,aname3,rval3,cret)
152 print *,
'Read attribute values',cret
153 if (cret .ne. 0)
then 154 print *,
'ERROR : read attribute values' 157 if ( (aval3(1) .ne. rval3(1)) .or.
158 & (aval3(2) .ne. rval3(2))
160 print *,
'ERROR : attribute information' 167 print *,
'Close file',cret
168 if (cret .ne. 0 )
then 169 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine msesgt(fid, mname, gtype, cret)
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
subroutine msevni(fid, mname, aname, atype, anc, cret)
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
program medstructelement10