00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement4
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       character*64 pname
00077 
00078 
00079 
00080       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00081       print *,'Open file',cret
00082       if (cret .ne. 0 ) then
00083          print *,'ERROR : file creation'
00084          call efexit(-1)
00085       endif 
00086 
00087 
00088 
00089       call msmcre(fid,smname2,dim2,dim2,description1,
00090      &            MED_CARTESIAN,nomcoo2D,unicoo2D,cret)
00091       print *,'Support mesh creation : 2D space dimension',cret
00092       if (cret .ne. 0 ) then
00093          print *,'ERROR : support mesh creation'
00094         call efexit(-1)
00095       endif   
00096 
00097       call mmhcow(fid,smname2,MED_NO_DT,MED_NO_IT, 
00098      &            MED_UNDEF_DT,MED_FULL_INTERLACE, 
00099      &            nnode,coo,cret)
00100 
00101       call mmhcyw(fid,smname2,MED_NO_DT,MED_NO_IT,
00102      &            MED_UNDEF_DT,MED_CELL,MED_SEG2, 
00103      &            MED_NODAL,MED_FULL_INTERLACE,
00104      &            nseg2,seg2,cret)
00105 
00106 
00107 
00108       call msecre(fid,mname2,dim2,smname2,setype2,
00109      &            sgtype2,mtype2,cret)
00110       print *,'Create struct element',mtype2, cret
00111       if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
00112          print *,'ERROR : struct element creation'
00113          call efexit(-1)
00114       endif  
00115 
00116 
00117 
00118       call  mseiaw(fid,mname2,aname1,atype1,anc1,
00119      &             setype2,aval1,cret)
00120       print *,'Create a constant attribute : ',aname1, cret
00121       if (cret .ne. 0) then
00122          print *,'ERROR : constant attribute creation'
00123          call efexit(-1)
00124       endif  
00125 
00126       call  mseraw(fid,mname2,aname2,atype2,anc2,
00127      &             setype2,aval2,cret)
00128       print *,'Create a constant attribute : ',aname2, cret
00129       if (cret .ne. 0) then
00130          print *,'ERROR : constant attribute creation'
00131          call efexit(-1)
00132       endif  
00133 
00134       call  msesaw(fid,mname2,aname3,atype3,anc3,
00135      &             setype2,aval3,cret)
00136       print *,'Create a constant attribute : ',aname3, cret
00137       if (cret .ne. 0) then
00138          print *,'ERROR : constant attribute creation'
00139          call efexit(-1)
00140       endif  
00141 
00142 
00143 
00144       call mficlo(fid,cret)
00145       print *,'Close file',cret
00146       if (cret .ne. 0 ) then
00147          print *,'ERROR :  close file'
00148          call efexit(-1)
00149       endif  
00150 
00151 
00152 
00153       end
00154