00001 
00002 
00003 
00004 
00005 
00006 
00007 
00008 
00009 
00010 
00011 
00012 
00013 
00014 
00015 
00016 
00017 
00018 
00019 
00020 
00021 
00022       program MEDstructElement9
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_9.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,description2
00046       parameter (description1="support mesh1 description")
00047       parameter (description2="computation mesh description")
00048       character*16 nomcoo2D(2)
00049       character*16 unicoo2D(2)
00050       data  nomcoo2D /"x","y"/, unicoo2D /"cm","cm"/
00051       real*8 coo(2*3), ccoo(2*3)
00052       data coo /0.0, 0.0, 1.0,1.0, 2.0,2.0/
00053       data ccoo /0.1, 0.1, 1.1,1.1, 2.1,2.1/
00054       integer nnode
00055       parameter (nnode=3)
00056       integer nseg2
00057       parameter (nseg2=2)
00058       integer seg2(4), mcon(1)
00059       data seg2 /1,2, 2,3/
00060       data mcon /1/
00061       character*64 aname1, aname2, aname3
00062       parameter (aname1="integer attribute name")
00063       parameter (aname2="real attribute name")
00064       parameter (aname3="string attribute name")
00065       integer atype1,atype2,atype3
00066       parameter (atype1=MED_ATT_INT)
00067       parameter (atype2=MED_ATT_FLOAT64)
00068       parameter (atype3=MED_ATT_NAME)
00069       integer anc1,anc2,anc3
00070       parameter (anc1=2)
00071       parameter (anc2=1)
00072       parameter (anc3=2)
00073       integer aval1(2)
00074       data aval1 /1,2/
00075       real*8 aval2(1)
00076       data aval2 /1./
00077       character*64 aval3(2)
00078       data aval3 /"VAL1","VAL2"/
00079       character*64 pname,cname
00080       parameter (cname="computation mesh")
00081       integer nentity
00082       parameter (nentity=1)
00083 
00084 
00085 
00086       call mfiope(fid,fname,MED_ACC_CREAT,cret)
00087       print *,'Open file',cret
00088       if (cret .ne. 0 ) then
00089          print *,'ERROR : file creation'
00090          call efexit(-1)
00091       endif 
00092 
00093 
00094 
00095       call msmcre(fid,smname2,dim2,dim2,description1,
00096      &            MED_CARTESIAN,nomcoo2D,unicoo2D,cret)
00097       print *,'Support mesh creation : 2D space dimension',cret
00098       if (cret .ne. 0 ) then
00099          print *,'ERROR : support mesh creation'
00100         call efexit(-1)
00101       endif   
00102 
00103       call mmhcow(fid,smname2,MED_NO_DT,MED_NO_IT, 
00104      &            MED_UNDEF_DT,MED_FULL_INTERLACE, 
00105      &            nnode,coo,cret)
00106 
00107       call mmhcyw(fid,smname2,MED_NO_DT,MED_NO_IT,
00108      &            MED_UNDEF_DT,MED_CELL,MED_SEG2, 
00109      &            MED_NODAL,MED_FULL_INTERLACE,
00110      &            nseg2,seg2,cret)
00111 
00112 
00113 
00114       call msecre(fid,mname2,dim2,smname2,setype2,
00115      &            sgtype2,mtype2,cret)
00116       print *,'Create struct element',mtype2, cret
00117       if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
00118          print *,'ERROR : struct element creation'
00119          call efexit(-1)
00120       endif  
00121 
00122 
00123 
00124       call msevac(fid,mname2,aname1,atype1,anc1,cret)
00125       print *,'Create attribute',aname1, cret
00126       if (cret .ne. 0) then
00127          print *,'ERROR : attribute creation'
00128          call efexit(-1)
00129       endif
00130 
00131       call msevac(fid,mname2,aname2,atype2,anc2,cret)
00132       print *,'Create attribute',aname2, cret
00133       if (cret .ne. 0) then
00134          print *,'ERROR : attribute creation'
00135          call efexit(-1)
00136       endif
00137 
00138       call msevac(fid,mname2,aname3,atype3,anc3,cret)
00139       print *,'Create attribute',aname3, cret
00140       if (cret .ne. 0) then
00141          print *,'ERROR : attribute creation'
00142          call efexit(-1)
00143       endif
00144 
00145 
00146 
00147       call mmhcre(fid,cname,dim2,dim2,MED_UNSTRUCTURED_MESH,
00148      &            description2,"",MED_SORT_DTIT,MED_CARTESIAN,
00149      &            nomcoo2D,unicoo2D,cret)
00150       print *,'Create computation mesh',cname, cret
00151       if (cret .ne. 0) then
00152          print *,'ERROR : computation mesh creation'
00153          call efexit(-1)
00154       endif  
00155 
00156       call mmhcow(fid,cname,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00157      &            MED_FULL_INTERLACE,nnode,ccoo,cret)
00158       print *,'Write nodes coordinates',cret
00159       if (cret .ne. 0) then
00160          print *,'ERROR : write nodes coordinates'
00161          call efexit(-1)
00162       endif  
00163 
00164       call mmhcyw(fid,cname,MED_NO_DT,MED_NO_IT,MED_UNDEF_DT,
00165      &            MED_STRUCT_ELEMENT,mtype2,MED_NODAL,
00166      &            MED_NO_INTERLACE,nentity,mcon,cret)
00167       print *,'Write cells connectivity',cret
00168       if (cret .ne. 0) then
00169          print *,'ERROR : write cells connectivity'
00170          call efexit(-1)
00171       endif  
00172 
00173 
00174 
00175       call mmhiaw(fid,cname,MED_NO_DT,MED_NO_IT,
00176      &            mtype2,aname1,nentity,
00177      &            aval1,cret)
00178       print *,'Write attribute values',cret
00179       if (cret .ne. 0) then
00180          print *,'ERROR : write attribute values'
00181          call efexit(-1)
00182       endif  
00183 
00184       call mmhraw(fid,cname,MED_NO_DT,MED_NO_IT,
00185      &            mtype2,aname2,nentity,
00186      &            aval2,cret)
00187       print *,'Write attribute values',cret
00188       if (cret .ne. 0) then
00189          print *,'ERROR : write attribute values'
00190          call efexit(-1)
00191       endif  
00192 
00193       call mmhsaw(fid,cname,MED_NO_DT,MED_NO_IT,
00194      &            mtype2,aname3,nentity,
00195      &            aval3,cret)
00196       print *,'Write attribute values',cret
00197       if (cret .ne. 0) then
00198          print *,'ERROR : write attribute values'
00199          call efexit(-1)
00200       endif  
00201 
00202 
00203 
00204       call mficlo(fid,cret)
00205       print *,'Close file',cret
00206       if (cret .ne. 0 ) then
00207          print *,'ERROR :  close file'
00208          call efexit(-1)
00209       endif  
00210 
00211 
00212 
00213       end
00214