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' subroutine mseasz(atype, size, cret)
Cette routine renvoie la taille en octets du type élémentaire atttype.
subroutine mserar(fid, mname, aname, val, cret)
subroutine msesar(fid, mname, aname, val, cret)
subroutine mfiope(fid, name, access, 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)
program medstructelement5
subroutine mficlo(fid, cret)
subroutine mseiar(fid, mname, aname, val, cret)