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