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