32 parameter(fname =
"Unittest_MEDstructElement_1.med")
33 character*64 mname1, mname2, mname3
34 parameter(mname1 =
"model name 1")
35 parameter(mname2 =
"model name 2")
36 parameter(mname3 =
"model name 3")
37 integer dim1, dim2, dim3
42 parameter(smname1=med_no_name)
44 parameter(smname2=
"support mesh name")
46 parameter(setype1=med_none)
48 parameter(setype2=med_node)
50 parameter(setype3=med_cell)
52 parameter(sgtype1=med_no_geotype)
54 parameter(sgtype2=med_no_geotype)
56 parameter(sgtype3=med_seg2)
57 integer mtype1,mtype2,mtype3
68 integer ncatt1,profile1,nvatt1
73 integer mgtype,mdim,setype,snnode,sncell
74 integer sgtype,ncatt,nvatt,profile
79 call mfiope(fid,fname,med_acc_rdonly,cret)
80 print *,
'Open file',cret
81 if (cret .ne. 0 )
then
82 print *,
'ERROR : file creation'
89 call msesin(fid,mname1,mgtype,mdim,smname,
90 & setype,snnode,sncell,sgtype,
91 & ncatt,profile,nvatt,cret)
92 print *,
'Read information about struct element (by name)',cret
93 if (cret .ne. 0 )
then
94 print *,
'ERROR : information about struct element (by name) '
97 if ( (mgtype .ne. mtype1) .or.
98 & (mdim .ne. dim1) .or.
99 & (smname .ne. smname1) .or.
100 & (setype .ne. setype1) .or.
101 & (snnode .ne. nnode1) .or.
102 & (sncell .ne. ncell1) .or.
103 & (sgtype .ne. sgtype1) .or.
104 & (ncatt .ne. ncatt1) .or.
105 & (profile .ne. profile1) .or.
106 & (nvatt .ne. nvatt1)
108 print *,
'ERROR : information about struct element (by name) '
114 call msesin(fid,mname2,mgtype,mdim,smname,
115 & setype,snnode,sncell,sgtype,
116 & ncatt,profile,nvatt,cret)
117 print *,
'Read information about struct element (by name)',cret
118 if (cret .ne. 0 )
then
119 print *,
'ERROR : information about struct element (by name) '
122 if ( (mgtype .ne. mtype2) .or.
123 & (mdim .ne. dim2) .or.
124 & (smname .ne. smname2) .or.
125 & (setype .ne. setype2) .or.
126 & (snnode .ne. nnode2) .or.
127 & (sncell .ne. ncell1) .or.
128 & (sgtype .ne. sgtype2) .or.
129 & (ncatt .ne. ncatt1) .or.
130 & (profile .ne. profile1) .or.
131 & (nvatt .ne. nvatt1)
133 print *,
'ERROR : information about struct element (by name) '
139 call msesin(fid,mname3,mgtype,mdim,smname,
140 & setype,snnode,sncell,sgtype,
141 & ncatt,profile,nvatt,cret)
142 print *,
'Read information about struct element (by name)',cret
143 if (cret .ne. 0 )
then
144 print *,
'ERROR : information about struct element (by name) '
147 if ( (mgtype .ne. mtype3) .or.
148 & (mdim .ne. dim3) .or.
149 & (smname .ne. smname2) .or.
150 & (setype .ne. setype3) .or.
151 & (snnode .ne. nnode2) .or.
152 & (sncell .ne. ncell2) .or.
153 & (sgtype .ne. sgtype3) .or.
154 & (ncatt .ne. ncatt1) .or.
155 & (profile .ne. profile1) .or.
156 & (nvatt .ne. nvatt1)
158 print *,
'ERROR : information about struct element (by name) '
164 call msesgt(fid,mname1,mgtype,cret)
165 print *,
'Read struct element type (by name)',cret
166 if (cret .ne. 0 )
then
167 print *,
'ERROR : struct element type (by name)'
170 if (mgtype .ne. mtype1)
then
171 print *,
'ERROR : struct element type (by name)'
177 call msesgt(fid,mname2,mgtype,cret)
178 print *,
'Read struct element type (by name)',cret
179 if (cret .ne. 0 )
then
180 print *,
'ERROR : struct element type (by name)'
183 if (mgtype .ne. mtype2)
then
184 print *,
'ERROR : struct element type (by name)'
190 call msesgt(fid,mname3,mgtype,cret)
191 print *,
'Read struct element type (by name)',cret
192 if (cret .ne. 0 )
then
193 print *,
'ERROR : struct element type (by name)'
196 if (mgtype .ne. mtype3)
then
197 print *,
'ERROR : struct element type (by name)'
204 print *,
'Close file',cret
205 if (cret .ne. 0 )
then
206 print *,
'ERROR : close file'