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' subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
program medstructelement2
subroutine msesgt(fid, mname, gtype, cret)