32 parameter(fname =
"Unittest_MEDstructElement_7.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*64 aname1, aname2, aname3
49 parameter(aname1=
"integer constant attribute name")
50 parameter(aname2=
"real constant attribute name")
51 parameter(aname3=
"string constant attribute name")
52 integer atype1,atype2,atype3
53 parameter(atype1=med_att_int)
54 parameter(atype2=med_att_float64)
55 parameter(atype3=med_att_name)
56 integer anc1,anc2,anc3
64 character*64 aval3(2*1)
65 data aval3 /
"VAL1",
"VAL3"/
67 parameter(pname=
"profil name")
73 integer mgtype,mdim,setype,snnode,sncell
74 integer sgtype,ncatt,nvatt,profile
75 character*64 rpname,smname
76 integer atype,anc,rpsize
83 call mfiope(fid,fname,med_acc_rdonly,cret)
84 print *,
'Open file',cret
85 if (cret .ne. 0 )
then
86 print *,
'ERROR : file creation'
92 call msesin(fid,mname2,mgtype,mdim,smname,
93 & setype,snnode,sncell,sgtype,
94 & ncatt,profile,nvatt,cret)
95 print *,
'Read information about struct element (by name)',cret
96 if (cret .ne. 0 )
then
97 print *,
'ERROR : information about struct element (by name) '
104 call msecni(fid,mname2,aname1,atype,anc,
105 & setype,rpname,rpsize,cret)
106 print *,
'Read information about constant attribute: ',aname1,cret
107 if (cret .ne. 0 )
then
108 print *,
'ERROR : information about attribute (by name)'
111 if ( (atype .ne. atype1) .or.
112 & (anc .ne. anc1) .or.
113 & (setype .ne. setype2) .or.
114 & (rpname .ne. pname) .or.
115 & (rpsize .ne. psize)
117 print *,
'ERROR : information about struct element (by name) '
121 call mseiar(fid,mname2,aname1,val1,cret)
122 print *,
'Read attribute values: ',aname1,cret
123 if (cret .ne. 0 )
then
124 print *,
'ERROR : attribute values'
127 if ((aval1(1) .ne. val1(1)) .or.
128 & (aval1(2) .ne. val1(2)) .or.
129 & (aval1(3) .ne. val1(3)) .or.
130 & (aval1(4) .ne. val1(4))
132 print *,
'ERROR : attribute values'
136 call msecni(fid,mname2,aname2,atype,anc,
137 & setype,rpname,rpsize,cret)
138 print *,
'Read information about constant attribute:',aname2,cret
139 if (cret .ne. 0 )
then
140 print *,
'ERROR : information about attribute (by name)'
143 if ( (atype .ne. atype2) .or.
144 & (anc .ne. anc2) .or.
145 & (setype .ne. setype2) .or.
146 & (rpname .ne. pname) .or.
147 & (rpsize .ne. psize)
149 print *,
'ERROR : information about struct element (by name) '
153 call mserar(fid,mname2,aname2,val2,cret)
154 print *,
'Read attribute values: ',aname2,cret
155 if (cret .ne. 0 )
then
156 print *,
'ERROR : attribute values'
159 if ((aval2(1) .ne. val2(1)) .or.
160 & (aval2(2) .ne. val2(2))
162 print *,
'ERROR : attribute values'
166 call msecni(fid,mname2,aname3,atype,anc,
167 & setype,rpname,rpsize,cret)
168 print *,
'Read information about constant attribute:',aname3,cret
169 if (cret .ne. 0 )
then
170 print *,
'ERROR : information about attribute (by name)'
173 if ( (atype .ne. atype3) .or.
174 & (anc .ne. anc3) .or.
175 & (setype .ne. setype2) .or.
176 & (rpname .ne. pname) .or.
177 & (rpsize .ne. psize)
179 print *,
'ERROR : information about struct element (by name) '
183 call msesar(fid,mname2,aname3,val3,cret)
184 print *,
'Read attribute values: ',aname3,cret
185 if (cret .ne. 0 )
then
186 print *,
'ERROR : attribute values'
189 if ((aval3(1) .ne. val3(1)) .or.
190 & (aval3(2) .ne. val3(2))
192 print *,
'ERROR : attribute values'
199 print *,
'Close file',cret
200 if (cret .ne. 0 )
then
201 print *,
'ERROR : close file'
subroutine mserar(fid, mname, aname, val, cret)
subroutine mseiar(fid, mname, aname, val, cret)
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
subroutine mfiope(fid, name, access, cret)
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)
subroutine msesar(fid, mname, aname, val, cret)
program medstructelement8
subroutine mficlo(fid, cret)