00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDstructElement8
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*64 aname1, aname2, aname3
00048 parameter (aname1="integer constant attribute name")
00049 parameter (aname2="real constant attribute name")
00050 parameter (aname3="string constant attribute name")
00051 integer atype1,atype2,atype3
00052 parameter (atype1=MED_ATT_INT)
00053 parameter (atype2=MED_ATT_FLOAT64)
00054 parameter (atype3=MED_ATT_NAME)
00055 integer anc1,anc2,anc3
00056 parameter (anc1=2)
00057 parameter (anc2=1)
00058 parameter (anc3=1)
00059 integer aval1(2*2)
00060 data aval1 /1,2,5,6/
00061 real*8 aval2(2*1)
00062 data aval2 /1., 3. /
00063 character*64 aval3(2*1)
00064 data aval3 /"VAL1","VAL3"/
00065 character*64 pname
00066 parameter (pname="profil name")
00067 integer psize
00068 parameter (psize=2)
00069 integer profil(2)
00070 data profil / 1,3 /
00071
00072 integer mgtype,mdim,setype,snnode,sncell
00073 integer sgtype,ncatt,nvatt,profile
00074 character*64 rpname,smname
00075 integer atype,anc,rpsize
00076 integer val1(4)
00077 real*8 val2(2)
00078 character*64 val3(2)
00079
00080
00081
00082 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00083 print *,'Open file',cret
00084 if (cret .ne. 0 ) then
00085 print *,'ERROR : file creation'
00086 call efexit(-1)
00087 endif
00088
00089
00090
00091 call msesin(fid,mname2,mgtype,mdim,smname,
00092 & setype,snnode,sncell,sgtype,
00093 & ncatt,profile,nvatt,cret)
00094 print *,'Read information about struct element (by name)',cret
00095 if (cret .ne. 0 ) then
00096 print *,'ERROR : information about struct element (by name) '
00097 call efexit(-1)
00098 endif
00099
00100
00101
00102
00103 call msecni(fid,mname2,aname1,atype,anc,
00104 & setype,rpname,rpsize,cret)
00105 print *,'Read information about constant attribute: ',aname1,cret
00106 if (cret .ne. 0 ) then
00107 print *,'ERROR : information about attribute (by name)'
00108 call efexit(-1)
00109 endif
00110 if ( (atype .ne. atype1) .or.
00111 & (anc .ne. anc1) .or.
00112 & (setype .ne. setype2) .or.
00113 & (rpname .ne. pname) .or.
00114 & (rpsize .ne. psize)
00115 & ) then
00116 print *,'ERROR : information about struct element (by name) '
00117 call efexit(-1)
00118 endif
00119
00120 call mseiar(fid,mname2,aname1,val1,cret)
00121 print *,'Read attribute values: ',aname1,cret
00122 if (cret .ne. 0 ) then
00123 print *,'ERROR : attribute values'
00124 call efexit(-1)
00125 endif
00126 if ((aval1(1) .ne. val1(1)) .or.
00127 & (aval1(2) .ne. val1(2)) .or.
00128 & (aval1(3) .ne. val1(3)) .or.
00129 & (aval1(4) .ne. val1(4))
00130 & ) then
00131 print *,'ERROR : attribute values'
00132 call efexit(-1)
00133 endif
00134
00135 call msecni(fid,mname2,aname2,atype,anc,
00136 & setype,rpname,rpsize,cret)
00137 print *,'Read information about constant attribute:',aname2,cret
00138 if (cret .ne. 0 ) then
00139 print *,'ERROR : information about attribute (by name)'
00140 call efexit(-1)
00141 endif
00142 if ( (atype .ne. atype2) .or.
00143 & (anc .ne. anc2) .or.
00144 & (setype .ne. setype2) .or.
00145 & (rpname .ne. pname) .or.
00146 & (rpsize .ne. psize)
00147 & ) then
00148 print *,'ERROR : information about struct element (by name) '
00149 call efexit(-1)
00150 endif
00151
00152 call mserar(fid,mname2,aname2,val2,cret)
00153 print *,'Read attribute values: ',aname2,cret
00154 if (cret .ne. 0 ) then
00155 print *,'ERROR : attribute values'
00156 call efexit(-1)
00157 endif
00158 if ((aval2(1) .ne. val2(1)) .or.
00159 & (aval2(2) .ne. val2(2))
00160 & ) then
00161 print *,'ERROR : attribute values'
00162 call efexit(-1)
00163 endif
00164
00165 call msecni(fid,mname2,aname3,atype,anc,
00166 & setype,rpname,rpsize,cret)
00167 print *,'Read information about constant attribute:',aname3,cret
00168 if (cret .ne. 0 ) then
00169 print *,'ERROR : information about attribute (by name)'
00170 call efexit(-1)
00171 endif
00172 if ( (atype .ne. atype3) .or.
00173 & (anc .ne. anc3) .or.
00174 & (setype .ne. setype2) .or.
00175 & (rpname .ne. pname) .or.
00176 & (rpsize .ne. psize)
00177 & ) then
00178 print *,'ERROR : information about struct element (by name) '
00179 call efexit(-1)
00180 endif
00181
00182 call msesar(fid,mname2,aname3,val3,cret)
00183 print *,'Read attribute values: ',aname3,cret
00184 if (cret .ne. 0 ) then
00185 print *,'ERROR : attribute values'
00186 call efexit(-1)
00187 endif
00188 if ((aval3(1) .ne. val3(1)) .or.
00189 & (aval3(2) .ne. val3(2))
00190 & ) then
00191 print *,'ERROR : attribute values'
00192 call efexit(-1)
00193 endif
00194
00195
00196
00197 call mficlo(fid,cret)
00198 print *,'Close file',cret
00199 if (cret .ne. 0 ) then
00200 print *,'ERROR : close file'
00201 call efexit(-1)
00202 endif
00203
00204
00205
00206 end
00207