32 parameter(fname =
"Unittest_MEDstructElement_9.med")
34 parameter(mname2 =
"model name 2")
36 character*64 aname1, aname2, aname3
37 parameter(aname1=
"integer attribute name")
38 parameter(aname2=
"real attribute name")
39 parameter(aname3=
"string attribute name")
40 integer atype1,atype2,atype3
41 parameter(atype1=med_att_int)
42 parameter(atype2=med_att_float64)
43 parameter(atype3=med_att_name)
44 integer anc1,anc2,anc3
53 data aval3 /
"VAL1",
"VAL2"/
54 character*64 pname,cname
55 parameter(cname=
"computation mesh")
66 call mfiope(fid,fname,med_acc_rdonly,cret)
67 print *,
'Open file',cret
68 if (cret .ne. 0 )
then 69 print *,
'ERROR : file creation' 75 call msevni(fid,mname2,aname1,atype,anc,cret)
76 print *,
'Read information about attribute',aname1, cret
78 print *,
'ERROR : attribute infromation' 81 if ( (atype .ne. atype1) .or.
84 print *,
'ERROR : attribute information' 88 call msevni(fid,mname2,aname2,atype,anc,cret)
89 print *,
'Read information about attribute',aname2, cret
91 print *,
'ERROR : attribute infromation' 94 if ( (atype .ne. atype2) .or.
97 print *,
'ERROR : attribute information' 101 call msevni(fid,mname2,aname3,atype,anc,cret)
102 print *,
'Read information about attribute',aname3, cret
103 if (cret .ne. 0)
then 104 print *,
'ERROR : attribute information' 107 if ( (atype .ne. atype3) .or.
110 print *,
'ERROR : attribute information' 117 call msesgt(fid,mname2,mtype2,cret)
118 print *,
'Read struct element type (by name) : ',mtype2, cret
119 if (cret .ne. 0 )
then 120 print *,
'ERROR : struct element type (by name)' 124 call mmhiar(fid,cname,med_no_dt,med_no_it,
125 & mtype2,aname1,rval1,cret)
126 print *,
'Read attribute values',cret
127 if (cret .ne. 0)
then 128 print *,
'ERROR : read attribute values' 131 if ( (aval1(1) .ne. rval1(1)) .or.
132 & (aval1(2) .ne. rval1(2))
134 print *,
'ERROR : attribute information' 138 call mmhrar(fid,cname,med_no_dt,med_no_it,
139 & mtype2,aname2,rval2,cret)
140 print *,
'Read attribute values',cret
141 if (cret .ne. 0)
then 142 print *,
'ERROR : read attribute values' 145 if ( (aval2(1) .ne. rval2(1))
147 print *,
'ERROR : attribute information' 151 call mmhsar(fid,cname,med_no_dt,med_no_it,
152 & mtype2,aname3,rval3,cret)
153 print *,
'Read attribute values',cret
154 if (cret .ne. 0)
then 155 print *,
'ERROR : read attribute values' 158 if ( (aval3(1) .ne. rval3(1)) .or.
159 & (aval3(2) .ne. rval3(2))
161 print *,
'ERROR : attribute information' 168 print *,
'Close file',cret
169 if (cret .ne. 0 )
then 170 print *,
'ERROR : close file' subroutine msevni(fid, mname, aname, atype, anc, cret)
subroutine msesgt(fid, mname, gtype, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
program medstructelement10
subroutine mficlo(fid, cret)