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