00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDstructElement5
00023
00024 implicit none
00025 include 'med.hf'
00026
00027
00028 integer cret
00029 integer fid
00030 character*64 fname
00031 parameter (fname = "Unittest_MEDstructElement_4.med")
00032 character*64 mname2
00033 parameter (mname2 = "model name 2")
00034 integer dim2
00035 parameter (dim2=2)
00036 character*64 smname2
00037 parameter (smname2="support mesh name")
00038 integer setype2
00039 parameter (setype2=MED_NODE)
00040 integer sgtype2
00041 parameter (sgtype2=MED_NO_GEOTYPE)
00042 integer mtype2
00043 integer sdim1
00044 parameter (sdim1=2)
00045 character*200 description1
00046 parameter (description1="support mesh1 description")
00047 character*16 nomcoo2D(2)
00048 character*16 unicoo2D(2)
00049 data nomcoo2D /"x","y"/, unicoo2D /"cm","cm"/
00050 real*8 coo(2*3)
00051 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
00052 integer nnode
00053 parameter (nnode=3)
00054 integer nseg2
00055 parameter (nseg2=2)
00056 integer seg2(4)
00057 data seg2 /1,2, 2,3/
00058 character*64 aname1, aname2, aname3
00059 parameter (aname1="integer constant attribute name")
00060 parameter (aname2="real constant attribute name")
00061 parameter (aname3="string constant attribute name")
00062 integer atype1,atype2,atype3
00063 parameter (atype1=MED_ATT_INT)
00064 parameter (atype2=MED_ATT_FLOAT64)
00065 parameter (atype3=MED_ATT_NAME)
00066 integer anc1,anc2,anc3
00067 parameter (anc1=2)
00068 parameter (anc2=1)
00069 parameter (anc3=1)
00070 integer aval1(3*2)
00071 data aval1 /1,2,3,4,5,6/
00072 real*8 aval2(3)
00073 data aval2 /1., 2., 3. /
00074 character*64 aval3(3)
00075 data aval3 /"VAL1","VAL2","VAL3"/
00076 integer itsize,ftsize,stsize
00077 parameter (itsize=4)
00078 parameter (ftsize=8)
00079 parameter (stsize=64)
00080
00081 integer mgtype,mdim,setype,snnode,sncell
00082 integer sgtype,ncatt,nvatt,profile
00083 character*64 pname,smname
00084 integer atype,anc,psize,tsize
00085 integer val1(2*3)
00086 real*8 val2(3)
00087 character*64 val3(3)
00088
00089
00090
00091 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00092 print *,'Open file',cret
00093 if (cret .ne. 0 ) then
00094 print *,'ERROR : file creation'
00095 call efexit(-1)
00096 endif
00097
00098
00099
00100 call msesin(fid,mname2,mgtype,mdim,smname,
00101 & setype,snnode,sncell,sgtype,
00102 & ncatt,profile,nvatt,cret)
00103 print *,'Read information about struct element (by name)',cret
00104 if (cret .ne. 0 ) then
00105 print *,'ERROR : information about struct element (by name) '
00106 call efexit(-1)
00107 endif
00108
00109
00110
00111
00112 call msecni(fid,mname2,aname1,atype,anc,
00113 & setype,pname,psize,cret)
00114 print *,'Read information about constant attribute: ',aname1,cret
00115 if (cret .ne. 0 ) then
00116 print *,'ERROR : information about attribute (by name)'
00117 call efexit(-1)
00118 endif
00119 if ( (atype .ne. atype1) .or.
00120 & (anc .ne. anc1) .or.
00121 & (setype .ne. setype2) .or.
00122 & (pname .ne. MED_NO_PROFILE) .or.
00123 & (psize .ne. 0)
00124 & ) then
00125 print *,'ERROR : information about struct element (by name) '
00126 call efexit(-1)
00127 endif
00128
00129 call mseasz(atype,tsize,cret)
00130 print *,'Read information type size: ',tsize,cret
00131 if (cret .ne. 0 ) then
00132 print *,'ERROR : information about type size'
00133 call efexit(-1)
00134 endif
00135
00136
00137 call mseiar(fid,mname2,aname1,val1,cret)
00138 print *,'Read attribute values: ',aname1,cret
00139 if (cret .ne. 0 ) then
00140 print *,'ERROR : attribute values'
00141 call efexit(-1)
00142 endif
00143 if ((aval1(1) .ne. val1(1)) .or.
00144 & (aval1(2) .ne. val1(2)) .or.
00145 & (aval1(3) .ne. val1(3)) .or.
00146 & (aval1(4) .ne. val1(4)) .or.
00147 & (aval1(5) .ne. val1(5)) .or.
00148 & (aval1(6) .ne. val1(6))
00149 & ) then
00150 print *,'ERROR : attribute values'
00151 call efexit(-1)
00152 endif
00153
00154 call msecni(fid,mname2,aname2,atype,anc,
00155 & setype,pname,psize,cret)
00156 print *,'Read information about constant attribute:',aname2,cret
00157 if (cret .ne. 0 ) then
00158 print *,'ERROR : information about attribute (by name)'
00159 call efexit(-1)
00160 endif
00161 if ( (atype .ne. atype2) .or.
00162 & (anc .ne. anc2) .or.
00163 & (setype .ne. setype2) .or.
00164 & (pname .ne. MED_NO_PROFILE) .or.
00165 & (psize .ne. 0)
00166 & ) then
00167 print *,'ERROR : information about struct element (by name) '
00168 call efexit(-1)
00169 endif
00170
00171 call mseasz(atype,tsize,cret)
00172 print *,'Read information type size: ',tsize,cret
00173 if (cret .ne. 0 ) then
00174 print *,'ERROR : information about type size'
00175 call efexit(-1)
00176 endif
00177 if (tsize .ne. ftsize) then
00178 print *,'ERROR : information about type size'
00179 call efexit(-1)
00180 endif
00181
00182 call mserar(fid,mname2,aname2,val2,cret)
00183 print *,'Read attribute values: ',aname2,cret
00184 if (cret .ne. 0 ) then
00185 print *,'ERROR : attribute values'
00186 call efexit(-1)
00187 endif
00188 if ((aval2(1) .ne. val2(1)) .or.
00189 & (aval2(2) .ne. val2(2)) .or.
00190 & (aval2(3) .ne. val2(3))
00191 & ) then
00192 print *,'ERROR : attribute values'
00193 call efexit(-1)
00194 endif
00195
00196 call msecni(fid,mname2,aname3,atype,anc,
00197 & setype,pname,psize,cret)
00198 print *,'Read information about constant attribute:',aname3,cret
00199 if (cret .ne. 0 ) then
00200 print *,'ERROR : information about attribute (by name)'
00201 call efexit(-1)
00202 endif
00203 if ( (atype .ne. atype3) .or.
00204 & (anc .ne. anc3) .or.
00205 & (setype .ne. setype2) .or.
00206 & (pname .ne. MED_NO_PROFILE) .or.
00207 & (psize .ne. 0)
00208 & ) then
00209 print *,'ERROR : information about struct element (by name) '
00210 call efexit(-1)
00211 endif
00212
00213 call mseasz(atype,tsize,cret)
00214 print *,'Read information type size: ',tsize,cret
00215 if (cret .ne. 0 ) then
00216 print *,'ERROR : information about type size'
00217 call efexit(-1)
00218 endif
00219 if (tsize .ne. stsize) then
00220 print *,'ERROR : information about type size'
00221 call efexit(-1)
00222 endif
00223
00224 call msesar(fid,mname2,aname3,val3,cret)
00225 print *,'Read attribute values: ',aname3,cret
00226 if (cret .ne. 0 ) then
00227 print *,'ERROR : attribute values'
00228 call efexit(-1)
00229 endif
00230 if ((aval3(1) .ne. val3(1)) .or.
00231 & (aval3(2) .ne. val3(2)) .or.
00232 & (aval3(3) .ne. val3(3))
00233 & ) then
00234 print *,'ERROR : attribute values |',aval3(1),'|',aval3(2),
00235 & '|',aval3(3),'|'
00236 print *,'ERROR : attribute values |',val3(1),'|',val3(2),
00237 & '|',val3(3),'|'
00238 call efexit(-1)
00239 endif
00240
00241
00242
00243 call mficlo(fid,cret)
00244 print *,'Close file',cret
00245 if (cret .ne. 0 ) then
00246 print *,'ERROR : close file'
00247 call efexit(-1)
00248 endif
00249
00250
00251
00252 end
00253