00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement6
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*64 aname1, aname2, aname3
00048       parameter (aname1="integer constant attribute name")
00049       parameter (aname2="real constant attribute name")
00050       parameter (aname3="string constant attribute name")
00051       integer atype1,atype2,atype3
00052       parameter (atype1=MED_ATT_INT)
00053       parameter (atype2=MED_ATT_FLOAT64)
00054       parameter (atype3=MED_ATT_NAME)
00055       integer anc1,anc2,anc3
00056       parameter (anc1=2)
00057       parameter (anc2=1)
00058       parameter (anc3=1)
00059 
00060       integer mgtype,mdim,setype,snnode,sncell
00061       integer sgtype,ncatt,nvatt,profile
00062       character*64 pname,smname,aname
00063       integer      atype,anc,psize
00064       integer i
00065 
00066 
00067 
00068       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00069       print *,'Open file',cret
00070       if (cret .ne. 0 ) then
00071          print *,'ERROR : file creation'
00072          call efexit(-1)
00073       endif 
00074 
00075 
00076 
00077       call msesin(fid,mname2,mgtype,mdim,smname,
00078      &            setype,snnode,sncell,sgtype,
00079      &            ncatt,profile,nvatt,cret)
00080       print *,'Read information about struct element (by name)',cret
00081       if (cret .ne. 0 ) then
00082          print *,'ERROR : information about struct element (by name) '
00083          call efexit(-1)
00084       endif 
00085 
00086 
00087 
00088       do i=1,ncatt
00089 
00090 
00091 
00092 
00093       call msecai(fid,mname2,i,aname,atype,anc,
00094      &            setype,pname,psize,cret)
00095       print *,'Read information about constant attribute: ',aname1,cret
00096       if (cret .ne. 0 ) then
00097          print *,'ERROR : information about attribute'
00098          call efexit(-1)
00099       endif
00100 
00101       if (i. eq. 1) then
00102          if ( (atype .ne. atype1) .or.
00103      &        (anc .ne. anc1) .or.
00104      &        (setype .ne. setype2) .or.
00105      &        (pname .ne. MED_NO_PROFILE) .or.
00106      &        (psize .ne. 0)
00107      &       )  then
00108             print *,'ERROR : information about constant attribute '
00109             call efexit(-1)
00110          endif 
00111       endif
00112 
00113       if (i .eq. 2) then
00114          if ( (atype .ne. atype2) .or.
00115      &        (anc .ne. anc2) .or.
00116      &        (setype .ne. setype2) .or.
00117      &        (pname .ne. MED_NO_PROFILE) .or.
00118      &        (psize .ne. 0)
00119      &        )  then
00120             print *,'ERROR : information about constant attribute'
00121             call efexit(-1)
00122          endif
00123       endif
00124 
00125       if (i .eq. 3) then
00126          if ( (atype .ne. atype3) .or.
00127      &        (anc .ne. anc3) .or.
00128      &        (setype .ne. setype2) .or.
00129      &        (pname .ne. MED_NO_PROFILE) .or.
00130      &        (psize .ne. 0)
00131      &        )  then
00132             print *,'ERROR : information about constant attribute'
00133             call efexit(-1)
00134          endif 
00135       endif
00136 
00137       enddo
00138 
00139 
00140 
00141       call mficlo(fid,cret)
00142       print *,'Close file',cret
00143       if (cret .ne. 0 ) then
00144          print *,'ERROR :  close file'
00145          call efexit(-1)
00146       endif  
00147 
00148 
00149 
00150       end
00151