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