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 msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
Cette routine décrit les caractéristiques d'un modèle d'élément de structure à partir de son nom...
subroutine mseasz(atype, size, cret)
Cette routine renvoie la taille en octets du type élémentaire atttype.
subroutine mserar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
program medstructelement5
subroutine msesar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)
Cette routine décrit les caractéristiques d'un attribut constant de modèle d'élément de structure à p...
subroutine mseiar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.