00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement3
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_1.med")
00032       character*64  mname1, mname2, mname3
00033       parameter (mname1 = "model name 1")
00034       parameter (mname2 = "model name 2")
00035       parameter (mname3 = "model name 3")
00036       integer dim1, dim2, dim3
00037       parameter (dim1=2)
00038       parameter (dim2=2)
00039       parameter (dim3=2)
00040       character*64  smname1
00041       parameter (smname1=MED_NO_NAME)
00042       character*64  smname2
00043       parameter (smname2="support mesh name")
00044       integer setype1
00045       parameter (setype1=MED_NONE)
00046       integer setype2
00047       parameter (setype2=MED_NODE)
00048       integer setype3
00049       parameter (setype3=MED_CELL)
00050       integer sgtype1
00051       parameter (sgtype1=MED_NO_GEOTYPE)
00052       integer sgtype2
00053       parameter (sgtype2=MED_NO_GEOTYPE)
00054       integer sgtype3
00055       parameter (sgtype3=MED_SEG2)
00056       integer mtype1,mtype2,mtype3
00057       parameter (mtype1=601)
00058       parameter (mtype2=602)
00059       parameter (mtype3=603)
00060       integer nnode1,nnode2
00061       parameter (nnode1=1)
00062       parameter (nnode2=3)
00063       integer ncell2
00064       parameter (ncell2=2)
00065       integer ncell1
00066       parameter (ncell1=0)
00067       integer ncatt1,profile1,nvatt1
00068       parameter (ncatt1=0)
00069       parameter (nvatt1=0)
00070       parameter (profile1=0)
00071       integer nsm
00072       parameter (nsm=3)
00073 
00074       integer it,nsmr
00075       integer mgtype,mdim,setype,snnode,sncell
00076       integer sgtype,ncatt,nvatt,profile
00077       character*64 smname,mname
00078 
00079 
00080 
00081       call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00082       print *,'Open file',cret
00083       if (cret .ne. 0 ) then
00084          print *,'ERROR : file creation'
00085          call efexit(-1)
00086       endif 
00087 
00088 
00089 
00090       call msense(fid,nsmr,cret)
00091       print *,'Read number of struct model',nsmr,cret
00092       if (cret .ne. 0 ) then
00093          print *,'ERROR : number of struct model'
00094          call efexit(-1)
00095       endif 
00096       if (nsmr .ne. nsm) then
00097          print *,'ERROR : number of struct model'
00098          call efexit(-1)
00099       endif
00100 
00101 
00102 
00103       do it=1,nsmr
00104 
00105          call  msesei(fid,it,mname,mgtype,mdim,smname,
00106      &        setype,snnode,sncell,sgtype,
00107      &        ncatt,profile,nvatt,cret)
00108          print *,'Read information about struct element',cret
00109          if (cret .ne. 0 ) then
00110             print *,'ERROR : information about struct element'
00111             call efexit(-1)
00112          endif 
00113 
00114          if (it .eq. 1) then
00115             if ( (mname .ne. mname1) .or.
00116      &           (mgtype .ne. mtype1) .or.
00117      &           (mdim .ne. dim1) .or.
00118      &           (smname .ne. smname1) .or.
00119      &           (setype .ne. setype1) .or.
00120      &           (snnode .ne. nnode1) .or.
00121      &           (sncell .ne. ncell1) .or.
00122      &           (sgtype .ne. sgtype1) .or.
00123      &           (ncatt .ne. ncatt1) .or.
00124      &           (profile .ne. profile1) .or.
00125      &           (nvatt .ne. nvatt1) 
00126      &           )  then
00127                print *,'ERROR : information about struct element'
00128                call efexit(-1)
00129             endif 
00130          endif
00131 
00132          if (it .eq. 2) then
00133             if ( (mname .ne. mname2) .or.
00134      &           (mgtype .ne. mtype2) .or.
00135      &           (mdim .ne. dim2) .or.
00136      &           (smname .ne. smname2) .or.
00137      &           (setype .ne. setype2) .or.
00138      &           (snnode .ne. nnode2) .or.
00139      &           (sncell .ne. ncell1) .or.
00140      &           (sgtype .ne. sgtype2) .or.
00141      &           (ncatt .ne. ncatt1) .or.
00142      &           (profile .ne. profile1) .or.
00143      &           (nvatt .ne. nvatt1) 
00144      &    )  then
00145          print *,'ERROR : information about struct element '
00146          call efexit(-1)
00147       endif 
00148          endif
00149 
00150          if (it .eq. 3)  then
00151             if ( (mname .ne. mname3) .or.
00152      &           (mgtype .ne. mtype3) .or.
00153      &           (mdim .ne. dim3) .or.
00154      &           (smname .ne. smname2) .or.
00155      &           (setype .ne. setype3) .or.
00156      &           (snnode .ne. nnode2) .or.
00157      &           (sncell .ne. ncell2) .or.
00158      &           (sgtype .ne. sgtype3) .or.
00159      &           (ncatt .ne. ncatt1) .or.
00160      &           (profile .ne. profile1) .or.
00161      &           (nvatt .ne. nvatt1) 
00162      &           )  then
00163                print *,'ERROR : information about struct element'
00164                call efexit(-1)
00165             endif 
00166          endif
00167 
00168       enddo
00169 
00170 
00171 
00172       call msesen(fid,mtype1,mname,cret)
00173       print *,'Read struct element name from the type',cret
00174       if (cret .ne. 0 ) then
00175          print *,'ERROR : struct element name from the type'
00176          call efexit(-1)
00177       endif 
00178       if (mname .ne. mname1)  then
00179          print *,'ERROR : struct element name from the type'
00180          call efexit(-1)
00181       endif 
00182 
00183       call msesen(fid,mtype2,mname,cret)
00184       print *,'Read struct element name from the type',cret
00185       if (cret .ne. 0 ) then
00186          print *,'ERROR : struct element name from the type'
00187          call efexit(-1)
00188       endif 
00189       if (mname .ne. mname2)  then
00190          print *,'ERROR : struct element name from the type'
00191          call efexit(-1)
00192       endif 
00193 
00194       call msesen(fid,mtype3,mname,cret)
00195       print *,'Read struct element name from the type',cret
00196       if (cret .ne. 0 ) then
00197          print *,'ERROR : struct element name from the type'
00198          call efexit(-1)
00199       endif 
00200       if (mname .ne. mname3)  then
00201          print *,'ERROR : struct element name from the type'
00202          call efexit(-1)
00203       endif 
00204 
00205 
00206 
00207       call mficlo(fid,cret)
00208       print *,'Close file',cret
00209       if (cret .ne. 0 ) then
00210          print *,'ERROR :  close file'
00211          call efexit(-1)
00212       endif  
00213 
00214 
00215 
00216       end
00217