31 parameter(fname =
"Unittest_MEDstructElement_4.med")
33 parameter(mname2 =
"model name 2")
37 parameter(smname2=
"support mesh name")
39 parameter(setype2=med_node)
41 parameter(sgtype2=med_no_geotype)
45 character*200 description1
46 parameter(description1=
"support mesh1 description")
47 character*16 nomcoo2D(2)
48 character*16 unicoo2D(2)
49 data nomcoo2d /
"x",
"y"/, unicoo2d /
"cm",
"cm"/
51 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
58 character*64 aname1, aname2, aname3
59 parameter(aname1=
"integer constant attribute name")
60 parameter(aname2=
"real constant attribute name")
61 parameter(aname3=
"string constant attribute name")
62 integer atype1,atype2,atype3
63 parameter(atype1=med_att_int)
64 parameter(atype2=med_att_float64)
65 parameter(atype3=med_att_name)
66 integer anc1,anc2,anc3
71 data aval1 /1,2,3,4,5,6/
73 data aval2 /1., 2., 3. /
75 data aval3 /
"VAL1",
"VAL2",
"VAL3"/
76 integer itsize,ftsize,stsize
81 integer mgtype,mdim,setype,snnode,sncell
82 integer sgtype,ncatt,nvatt,profile
83 character*64 pname,smname
84 integer atype,anc,psize,tsize
91 call mfiope(fid,fname,med_acc_rdonly,cret)
92 print *,
'Open file',cret
93 if (cret .ne. 0 )
then 94 print *,
'ERROR : file creation' 100 call msesin(fid,mname2,mgtype,mdim,smname,
101 & setype,snnode,sncell,sgtype,
102 & ncatt,profile,nvatt,cret)
103 print *,
'Read information about struct element (by name)',cret
104 if (cret .ne. 0 )
then 105 print *,
'ERROR : information about struct element (by name) ' 112 call msecni(fid,mname2,aname1,atype,anc,
113 & setype,pname,psize,cret)
114 print *,
'Read information about constant attribute: ',aname1,cret
115 if (cret .ne. 0 )
then 116 print *,
'ERROR : information about attribute (by name)' 119 if ( (atype .ne. atype1) .or.
120 & (anc .ne. anc1) .or.
121 & (setype .ne. setype2) .or.
122 & (pname .ne. med_no_profile) .or.
125 print *,
'ERROR : information about struct element (by name) ' 129 call mseasz(atype,tsize,cret)
130 print *,
'Read information type size: ',tsize,cret
131 if (cret .ne. 0 )
then 132 print *,
'ERROR : information about type size' 137 call mseiar(fid,mname2,aname1,val1,cret)
138 print *,
'Read attribute values: ',aname1,cret
139 if (cret .ne. 0 )
then 140 print *,
'ERROR : attribute values' 143 if ((aval1(1) .ne. val1(1)) .or.
144 & (aval1(2) .ne. val1(2)) .or.
145 & (aval1(3) .ne. val1(3)) .or.
146 & (aval1(4) .ne. val1(4)) .or.
147 & (aval1(5) .ne. val1(5)) .or.
148 & (aval1(6) .ne. val1(6))
150 print *,
'ERROR : attribute values' 154 call msecni(fid,mname2,aname2,atype,anc,
155 & setype,pname,psize,cret)
156 print *,
'Read information about constant attribute:',aname2,cret
157 if (cret .ne. 0 )
then 158 print *,
'ERROR : information about attribute (by name)' 161 if ( (atype .ne. atype2) .or.
162 & (anc .ne. anc2) .or.
163 & (setype .ne. setype2) .or.
164 & (pname .ne. med_no_profile) .or.
167 print *,
'ERROR : information about struct element (by name) ' 171 call mseasz(atype,tsize,cret)
172 print *,
'Read information type size: ',tsize,cret
173 if (cret .ne. 0 )
then 174 print *,
'ERROR : information about type size' 177 if (tsize .ne. ftsize)
then 178 print *,
'ERROR : information about type size' 182 call mserar(fid,mname2,aname2,val2,cret)
183 print *,
'Read attribute values: ',aname2,cret
184 if (cret .ne. 0 )
then 185 print *,
'ERROR : attribute values' 188 if ((aval2(1) .ne. val2(1)) .or.
189 & (aval2(2) .ne. val2(2)) .or.
190 & (aval2(3) .ne. val2(3))
192 print *,
'ERROR : attribute values' 196 call msecni(fid,mname2,aname3,atype,anc,
197 & setype,pname,psize,cret)
198 print *,
'Read information about constant attribute:',aname3,cret
199 if (cret .ne. 0 )
then 200 print *,
'ERROR : information about attribute (by name)' 203 if ( (atype .ne. atype3) .or.
204 & (anc .ne. anc3) .or.
205 & (setype .ne. setype2) .or.
206 & (pname .ne. med_no_profile) .or.
209 print *,
'ERROR : information about struct element (by name) ' 213 call mseasz(atype,tsize,cret)
214 print *,
'Read information type size: ',tsize,cret
215 if (cret .ne. 0 )
then 216 print *,
'ERROR : information about type size' 219 if (tsize .ne. stsize)
then 220 print *,
'ERROR : information about type size' 224 call msesar(fid,mname2,aname3,val3,cret)
225 print *,
'Read attribute values: ',aname3,cret
226 if (cret .ne. 0 )
then 227 print *,
'ERROR : attribute values' 230 if ((aval3(1) .ne. val3(1)) .or.
231 & (aval3(2) .ne. val3(2)) .or.
232 & (aval3(3) .ne. val3(3))
234 print *,
'ERROR : attribute values |',aval3(1),
'|',aval3(2),
236 print *,
'ERROR : attribute values |',val3(1),
'|',val3(2),
244 print *,
'Close file',cret
245 if (cret .ne. 0 )
then 246 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
program medstructelement5
subroutine mseasz(atype, size, cret)
Cette routine renvoie la taille en octets du type élémentaire atttype.
subroutine mseiar(fid, mname, aname, val, cret)
subroutine msesar(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 mfiope(fid, name, access, cret)
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)