00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement7
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*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(2*2)
00071       data aval1 /1,2,5,6/
00072       real*8 aval2(2*1)
00073       data aval2 /1., 3. /
00074       character*64 aval3(2*1)
00075       data aval3 /"VAL1","VAL3"/
00076       character*64 pname
00077       parameter (pname="profil name")
00078       integer psize
00079       parameter (psize=2)
00080       integer profil(2)
00081       data profil / 1,3 /
00082 
00083 
00084 
00085       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00086       print *,'Open file',cret
00087       if (cret .ne. 0 ) then
00088          print *,'ERROR : file 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 mpfprw(fid,pname,psize,profil,cret)
00124       print *,'Create a profile : ',pname, cret
00125       if (cret .ne. 0) then
00126          print *,'ERROR : profile creation'
00127          call efexit(-1)
00128       endif  
00129 
00130 
00131 
00132       call  mseipw(fid,mname2,aname1,atype1,anc1,
00133      &             setype2,pname,aval1,cret)
00134       print *,'Create a constant attribute with profile : ',aname1, cret
00135       if (cret .ne. 0) then
00136          print *,'ERROR : constant attribute with profile creation'
00137          call efexit(-1)
00138       endif  
00139 
00140       call  mserpw(fid,mname2,aname2,atype2,anc2,
00141      &             setype2,pname,aval2,cret)
00142       print *,'Create a constant attribute with profile : ',aname2, cret
00143       if (cret .ne. 0) then
00144          print *,'ERROR : constant attribute with profile creation'
00145          call efexit(-1)
00146       endif  
00147 
00148       call  msespw(fid,mname2,aname3,atype3,anc3,
00149      &             setype2,pname,aval3,cret)
00150       print *,'Create a constant attribute with profile : ',aname3, cret
00151       if (cret .ne. 0) then
00152          print *,'ERROR : constant attribute with profile creation'
00153          call efexit(-1)
00154       endif  
00155 
00156 
00157 
00158       call mficlo(fid,cret)
00159       print *,'Close file',cret
00160       if (cret .ne. 0 ) then
00161          print *,'ERROR :  close file'
00162          call efexit(-1)
00163       endif  
00164 
00165 
00166 
00167       end
00168