00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement1
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       integer sdim1
00058       parameter (sdim1=2)
00059       character*200 description1
00060       parameter (description1="support mesh1 description")
00061       character*16 nomcoo2D(2)
00062       character*16 unicoo2D(2)
00063       data  nomcoo2D /"x","y"/, unicoo2D /"cm","cm"/
00064       real*8 coo(2*3)
00065       data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
00066       integer nnode
00067       parameter (nnode=3)
00068       integer nseg2
00069       parameter (nseg2=2)
00070       integer seg2(4)
00071       data seg2 /1,2, 2,3/
00072 
00073 
00074 
00075       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00076       print *,'Open file',cret
00077       if (cret .ne. 0 ) then
00078          print *,'ERROR : file creation'
00079          call efexit(-1)
00080       endif 
00081 
00082 
00083 
00084       call msecre(fid,mname1,dim1,smname1,setype1,
00085      &            sgtype1,mtype1, cret)
00086       print *,'Create struct element',mtype1, cret
00087       if ((cret .ne. 0) .or. (mtype1 .lt. 0) ) then
00088          print *,'ERROR : struct element creation'
00089          call efexit(-1)
00090       endif 
00091 
00092 
00093 
00094       call msmcre(fid,smname2,dim2,dim2,description1,
00095      &            MED_CARTESIAN,nomcoo2D,unicoo2D,cret)
00096       print *,'Support mesh creation : 2D space dimension',cret
00097       if (cret .ne. 0 ) then
00098          print *,'ERROR : support mesh creation'
00099         call efexit(-1)
00100       endif   
00101 
00102       call mmhcow(fid,smname2,MED_NO_DT,MED_NO_IT, 
00103      &            MED_UNDEF_DT,MED_FULL_INTERLACE, 
00104      &            nnode,coo,cret)
00105 
00106       call mmhcyw(fid,smname2,MED_NO_DT,MED_NO_IT,
00107      &            MED_UNDEF_DT,MED_CELL,MED_SEG2, 
00108      &            MED_NODAL,MED_FULL_INTERLACE,
00109      &            nseg2,seg2,cret)
00110 
00111 
00112 
00113       call msecre(fid,mname2,dim2,smname2,setype2,
00114      &            sgtype2,mtype2,cret)
00115       print *,'Create struct element',mtype2, cret
00116       if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
00117          print *,'ERROR : struct element creation'
00118          call efexit(-1)
00119       endif  
00120 
00121 
00122 
00123       call msecre(fid,mname3,dim3,smname2,setype3,
00124      &            sgtype3,mtype3,cret)
00125       print *,'Create struct element',mtype3, cret
00126       if ((cret .ne. 0) .or. (mtype3 .lt. 0) ) then
00127          print *,'ERROR : struct element creation'
00128          call efexit(-1)
00129       endif  
00130 
00131 
00132 
00133       call mficlo(fid,cret)
00134       print *,'Close file',cret
00135       if (cret .ne. 0 ) then
00136          print *,'ERROR :  close file'
00137          call efexit(-1)
00138       endif  
00139 
00140 
00141 
00142       end
00143