31 parameter(fname =
"Unittest_MEDstructElement_1.med")
32 character*64 mname1, mname2, mname3
33 parameter(mname1 =
"model name 1")
34 parameter(mname2 =
"model name 2")
35 parameter(mname3 =
"model name 3")
36 integer dim1, dim2, dim3
41 parameter(smname1=med_no_name)
43 parameter(smname2=
"support mesh name")
45 parameter(setype1=med_none)
47 parameter(setype2=med_node)
49 parameter(setype3=med_cell)
51 parameter(sgtype1=med_no_geotype)
53 parameter(sgtype2=med_no_geotype)
55 parameter(sgtype3=med_seg2)
56 integer mtype1,mtype2,mtype3
67 integer ncatt1,profile1,nvatt1
72 integer mgtype,mdim,setype,snnode,sncell
73 integer sgtype,ncatt,nvatt,profile
78 call mfiope(fid,fname,med_acc_rdonly,cret)
79 print *,
'Open file',cret
80 if (cret .ne. 0 )
then 81 print *,
'ERROR : file creation' 88 call msesin(fid,mname1,mgtype,mdim,smname,
89 & setype,snnode,sncell,sgtype,
90 & ncatt,profile,nvatt,cret)
91 print *,
'Read information about struct element (by name)',cret
92 if (cret .ne. 0 )
then 93 print *,
'ERROR : information about struct element (by name) ' 96 if ( (mgtype .ne. mtype1) .or.
97 & (mdim .ne. dim1) .or.
98 & (smname .ne. smname1) .or.
99 & (setype .ne. setype1) .or.
100 & (snnode .ne. nnode1) .or.
101 & (sncell .ne. ncell1) .or.
102 & (sgtype .ne. sgtype1) .or.
103 & (ncatt .ne. ncatt1) .or.
104 & (profile .ne. profile1) .or.
105 & (nvatt .ne. nvatt1)
107 print *,
'ERROR : information about struct element (by name) ' 113 call msesin(fid,mname2,mgtype,mdim,smname,
114 & setype,snnode,sncell,sgtype,
115 & ncatt,profile,nvatt,cret)
116 print *,
'Read information about struct element (by name)',cret
117 if (cret .ne. 0 )
then 118 print *,
'ERROR : information about struct element (by name) ' 121 if ( (mgtype .ne. mtype2) .or.
122 & (mdim .ne. dim2) .or.
123 & (smname .ne. smname2) .or.
124 & (setype .ne. setype2) .or.
125 & (snnode .ne. nnode2) .or.
126 & (sncell .ne. ncell1) .or.
127 & (sgtype .ne. sgtype2) .or.
128 & (ncatt .ne. ncatt1) .or.
129 & (profile .ne. profile1) .or.
130 & (nvatt .ne. nvatt1)
132 print *,
'ERROR : information about struct element (by name) ' 138 call msesin(fid,mname3,mgtype,mdim,smname,
139 & setype,snnode,sncell,sgtype,
140 & ncatt,profile,nvatt,cret)
141 print *,
'Read information about struct element (by name)',cret
142 if (cret .ne. 0 )
then 143 print *,
'ERROR : information about struct element (by name) ' 146 if ( (mgtype .ne. mtype3) .or.
147 & (mdim .ne. dim3) .or.
148 & (smname .ne. smname2) .or.
149 & (setype .ne. setype3) .or.
150 & (snnode .ne. nnode2) .or.
151 & (sncell .ne. ncell2) .or.
152 & (sgtype .ne. sgtype3) .or.
153 & (ncatt .ne. ncatt1) .or.
154 & (profile .ne. profile1) .or.
155 & (nvatt .ne. nvatt1)
157 print *,
'ERROR : information about struct element (by name) ' 163 call msesgt(fid,mname1,mgtype,cret)
164 print *,
'Read struct element type (by name)',cret
165 if (cret .ne. 0 )
then 166 print *,
'ERROR : struct element type (by name)' 169 if (mgtype .ne. mtype1)
then 170 print *,
'ERROR : struct element type (by name)' 176 call msesgt(fid,mname2,mgtype,cret)
177 print *,
'Read struct element type (by name)',cret
178 if (cret .ne. 0 )
then 179 print *,
'ERROR : struct element type (by name)' 182 if (mgtype .ne. mtype2)
then 183 print *,
'ERROR : struct element type (by name)' 189 call msesgt(fid,mname3,mgtype,cret)
190 print *,
'Read struct element type (by name)',cret
191 if (cret .ne. 0 )
then 192 print *,
'ERROR : struct element type (by name)' 195 if (mgtype .ne. mtype3)
then 196 print *,
'ERROR : struct element type (by name)' 203 print *,
'Close file',cret
204 if (cret .ne. 0 )
then 205 print *,
'ERROR : close file' program medstructelement2
subroutine mficlo(fid, cret)
subroutine msesgt(fid, mname, gtype, cret)
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
subroutine mfiope(fid, name, access, cret)