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'
00235          call efexit(-1)
00236       endif
00237 
00238 
00239 
00240       call mficlo(fid,cret)
00241       print *,'Close file',cret
00242       if (cret .ne. 0 ) then
00243          print *,'ERROR :  close file'
00244          call efexit(-1)
00245       endif  
00246 
00247 
00248 
00249       end
00250