32 parameter(fname =
"Unittest_MEDstructElement_4.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
47 parameter(description1=
"support mesh1 description")
48 character*16 nomcoo2d(2)
49 character*16 unicoo2d(2)
50 data nomcoo2d /
"x",
"y"/, unicoo2d /
"cm",
"cm"/
52 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
59 character*64 aname1, aname2, aname3
60 parameter(aname1=
"integer constant attribute name")
61 parameter(aname2=
"real constant attribute name")
62 parameter(aname3=
"string constant attribute name")
63 integer atype1,atype2,atype3
64 parameter(atype1=med_att_int)
65 parameter(atype2=med_att_float64)
66 parameter(atype3=med_att_name)
67 integer anc1,anc2,anc3
72 data aval1 /1,2,3,4,5,6/
74 data aval2 /1., 2., 3. /
76 data aval3 /
"VAL1",
"VAL2",
"VAL3"/
77 integer itsize,ftsize,stsize
82 integer mgtype,mdim,setype,snnode,sncell
83 integer sgtype,ncatt,nvatt,profile
84 character*64 pname,smname
85 integer atype,anc,psize,tsize
92 call mfiope(fid,fname,med_acc_rdonly,cret)
93 print *,
'Open file',cret
94 if (cret .ne. 0 )
then
95 print *,
'ERROR : file creation'
101 call msesin(fid,mname2,mgtype,mdim,smname,
102 & setype,snnode,sncell,sgtype,
103 & ncatt,profile,nvatt,cret)
104 print *,
'Read information about struct element (by name)',cret
105 if (cret .ne. 0 )
then
106 print *,
'ERROR : information about struct element (by name) '
113 call msecni(fid,mname2,aname1,atype,anc,
114 & setype,pname,psize,cret)
115 print *,
'Read information about constant attribute: ',aname1,cret
116 if (cret .ne. 0 )
then
117 print *,
'ERROR : information about attribute (by name)'
120 if ( (atype .ne. atype1) .or.
121 & (anc .ne. anc1) .or.
122 & (setype .ne. setype2) .or.
123 & (pname .ne. med_no_profile) .or.
126 print *,
'ERROR : information about struct element (by name) '
130 call mseasz(atype,tsize,cret)
131 print *,
'Read information type size: ',tsize,cret
132 if (cret .ne. 0 )
then
133 print *,
'ERROR : information about type size'
138 call mseiar(fid,mname2,aname1,val1,cret)
139 print *,
'Read attribute values: ',aname1,cret
140 if (cret .ne. 0 )
then
141 print *,
'ERROR : attribute values'
144 if ((aval1(1) .ne. val1(1)) .or.
145 & (aval1(2) .ne. val1(2)) .or.
146 & (aval1(3) .ne. val1(3)) .or.
147 & (aval1(4) .ne. val1(4)) .or.
148 & (aval1(5) .ne. val1(5)) .or.
149 & (aval1(6) .ne. val1(6))
151 print *,
'ERROR : attribute values'
155 call msecni(fid,mname2,aname2,atype,anc,
156 & setype,pname,psize,cret)
157 print *,
'Read information about constant attribute:',aname2,cret
158 if (cret .ne. 0 )
then
159 print *,
'ERROR : information about attribute (by name)'
162 if ( (atype .ne. atype2) .or.
163 & (anc .ne. anc2) .or.
164 & (setype .ne. setype2) .or.
165 & (pname .ne. med_no_profile) .or.
168 print *,
'ERROR : information about struct element (by name) '
172 call mseasz(atype,tsize,cret)
173 print *,
'Read information type size: ',tsize,cret
174 if (cret .ne. 0 )
then
175 print *,
'ERROR : information about type size'
178 if (tsize .ne. ftsize)
then
179 print *,
'ERROR : information about type size'
183 call mserar(fid,mname2,aname2,val2,cret)
184 print *,
'Read attribute values: ',aname2,cret
185 if (cret .ne. 0 )
then
186 print *,
'ERROR : attribute values'
189 if ((aval2(1) .ne. val2(1)) .or.
190 & (aval2(2) .ne. val2(2)) .or.
191 & (aval2(3) .ne. val2(3))
193 print *,
'ERROR : attribute values'
197 call msecni(fid,mname2,aname3,atype,anc,
198 & setype,pname,psize,cret)
199 print *,
'Read information about constant attribute:',aname3,cret
200 if (cret .ne. 0 )
then
201 print *,
'ERROR : information about attribute (by name)'
204 if ( (atype .ne. atype3) .or.
205 & (anc .ne. anc3) .or.
206 & (setype .ne. setype2) .or.
207 & (pname .ne. med_no_profile) .or.
210 print *,
'ERROR : information about struct element (by name) '
214 call mseasz(atype,tsize,cret)
215 print *,
'Read information type size: ',tsize,cret
216 if (cret .ne. 0 )
then
217 print *,
'ERROR : information about type size'
220 if (tsize .ne. stsize)
then
221 print *,
'ERROR : information about type size'
225 call msesar(fid,mname2,aname3,val3,cret)
226 print *,
'Read attribute values: ',aname3,cret
227 if (cret .ne. 0 )
then
228 print *,
'ERROR : attribute values'
231 if ((aval3(1) .ne. val3(1)) .or.
232 & (aval3(2) .ne. val3(2)) .or.
233 & (aval3(3) .ne. val3(3))
235 print *,
'ERROR : attribute values |',aval3(1),
'|',aval3(2),
237 print *,
'ERROR : attribute values |',val3(1),
'|',val3(2),
245 print *,
'Close file',cret
246 if (cret .ne. 0 )
then
247 print *,
'ERROR : close file'