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'
program medstructelement5
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mseiar(fid, mname, aname, val, cret)
subroutine mserar(fid, mname, aname, val, cret)
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
subroutine msesar(fid, mname, aname, val, cret)
subroutine mseasz(atype, size, cret)
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)