00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement8
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_7.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       integer aval1(2*2)
00060       data aval1 /1,2,5,6/
00061       real*8 aval2(2*1)
00062       data aval2 /1., 3. /
00063       character*64 aval3(2*1)
00064       data aval3 /"VAL1","VAL3"/
00065       character*64 pname
00066       parameter (pname="profil name")
00067       integer psize
00068       parameter (psize=2)
00069       integer profil(2)
00070       data profil / 1,3 /
00071 
00072       integer mgtype,mdim,setype,snnode,sncell
00073       integer sgtype,ncatt,nvatt,profile
00074       character*64 rpname,smname
00075       integer      atype,anc,rpsize
00076       integer val1(4)
00077       real*8 val2(2)
00078       character*64 val3(2)
00079 
00080 
00081 
00082       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00083       print *,'Open file',cret
00084       if (cret .ne. 0 ) then
00085          print *,'ERROR : file creation'
00086          call efexit(-1)
00087       endif 
00088 
00089 
00090 
00091       call msesin(fid,mname2,mgtype,mdim,smname,
00092      &            setype,snnode,sncell,sgtype,
00093      &            ncatt,profile,nvatt,cret)
00094       print *,'Read information about struct element (by name)',cret
00095       if (cret .ne. 0 ) then
00096          print *,'ERROR : information about struct element (by name) '
00097          call efexit(-1)
00098       endif 
00099 
00100 
00101 
00102 
00103       call msecni(fid,mname2,aname1,atype,anc,
00104      &            setype,rpname,rpsize,cret)
00105       print *,'Read information about constant attribute: ',aname1,cret
00106       if (cret .ne. 0 ) then
00107          print *,'ERROR : information about attribute (by name)'
00108          call efexit(-1)
00109       endif
00110       if ( (atype .ne. atype1) .or.
00111      &     (anc .ne. anc1) .or.
00112      &     (setype .ne. setype2) .or.
00113      &     (rpname .ne. pname) .or.
00114      &     (rpsize .ne. psize)
00115      &    )  then
00116          print *,'ERROR : information about struct element (by name) '
00117          call efexit(-1)
00118       endif 
00119 
00120       call mseiar(fid,mname2,aname1,val1,cret)
00121       print *,'Read attribute values: ',aname1,cret
00122       if (cret .ne. 0 ) then
00123          print *,'ERROR : attribute values'
00124          call efexit(-1)
00125       endif
00126       if ((aval1(1) .ne. val1(1)) .or.
00127      &    (aval1(2) .ne. val1(2)) .or.
00128      &    (aval1(3) .ne. val1(3)) .or.
00129      &    (aval1(4) .ne. val1(4))
00130      &   ) then
00131           print *,'ERROR : attribute values'
00132          call efexit(-1)
00133       endif
00134 
00135       call msecni(fid,mname2,aname2,atype,anc,
00136      &           setype,rpname,rpsize,cret)
00137       print *,'Read information about constant attribute:',aname2,cret
00138       if (cret .ne. 0 ) then
00139          print *,'ERROR : information about attribute (by name)'
00140          call efexit(-1)
00141       endif
00142       if ( (atype .ne. atype2) .or.
00143      &     (anc .ne. anc2) .or.
00144      &     (setype .ne. setype2) .or.
00145      &     (rpname .ne. pname) .or.
00146      &     (rpsize .ne. psize)
00147      &    )  then
00148          print *,'ERROR : information about struct element (by name) '
00149          call efexit(-1)
00150       endif
00151 
00152       call mserar(fid,mname2,aname2,val2,cret)
00153       print *,'Read attribute values: ',aname2,cret
00154       if (cret .ne. 0 ) then
00155          print *,'ERROR : attribute values'
00156          call efexit(-1)
00157       endif
00158       if ((aval2(1) .ne. val2(1)) .or.
00159      &    (aval2(2) .ne. val2(2)) 
00160      &   ) then
00161           print *,'ERROR : attribute values'
00162          call efexit(-1)
00163       endif
00164 
00165       call msecni(fid,mname2,aname3,atype,anc,
00166      &            setype,rpname,rpsize,cret)
00167       print *,'Read information about constant attribute:',aname3,cret
00168       if (cret .ne. 0 ) then
00169          print *,'ERROR : information about attribute (by name)'
00170          call efexit(-1)
00171       endif
00172       if ( (atype .ne. atype3) .or.
00173      &     (anc .ne. anc3) .or.
00174      &     (setype .ne. setype2) .or.
00175      &     (rpname .ne. pname) .or.
00176      &     (rpsize .ne. psize)
00177      &    )  then
00178          print *,'ERROR : information about struct element (by name) '
00179          call efexit(-1)
00180       endif 
00181 
00182       call msesar(fid,mname2,aname3,val3,cret)
00183       print *,'Read attribute values: ',aname3,cret
00184       if (cret .ne. 0 ) then
00185          print *,'ERROR : attribute values'
00186          call efexit(-1)
00187       endif
00188       if ((aval3(1) .ne. val3(1)) .or.
00189      &    (aval3(2) .ne. val3(2))
00190      &   ) then
00191           print *,'ERROR : attribute values'
00192          call efexit(-1)
00193       endif
00194 
00195 
00196 
00197       call mficlo(fid,cret)
00198       print *,'Close file',cret
00199       if (cret .ne. 0 ) then
00200          print *,'ERROR :  close file'
00201          call efexit(-1)
00202       endif  
00203 
00204 
00205 
00206       end
00207