00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDstructElement3
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_1.med")
00032 character*64 mname1, mname2, mname3
00033 parameter (mname1 = "model name 1")
00034 parameter (mname2 = "model name 2")
00035 parameter (mname3 = "model name 3")
00036 integer dim1, dim2, dim3
00037 parameter (dim1=2)
00038 parameter (dim2=2)
00039 parameter (dim3=2)
00040 character*64 smname1
00041 parameter (smname1=MED_NO_NAME)
00042 character*64 smname2
00043 parameter (smname2="support mesh name")
00044 integer setype1
00045 parameter (setype1=MED_NONE)
00046 integer setype2
00047 parameter (setype2=MED_NODE)
00048 integer setype3
00049 parameter (setype3=MED_CELL)
00050 integer sgtype1
00051 parameter (sgtype1=MED_NO_GEOTYPE)
00052 integer sgtype2
00053 parameter (sgtype2=MED_NO_GEOTYPE)
00054 integer sgtype3
00055 parameter (sgtype3=MED_SEG2)
00056 integer mtype1,mtype2,mtype3
00057 parameter (mtype1=601)
00058 parameter (mtype2=602)
00059 parameter (mtype3=603)
00060 integer nnode1,nnode2
00061 parameter (nnode1=1)
00062 parameter (nnode2=3)
00063 integer ncell2
00064 parameter (ncell2=2)
00065 integer ncell1
00066 parameter (ncell1=0)
00067 integer ncatt1,profile1,nvatt1
00068 parameter (ncatt1=0)
00069 parameter (nvatt1=0)
00070 parameter (profile1=0)
00071 integer nsm
00072 parameter (nsm=3)
00073
00074 integer it,nsmr
00075 integer mgtype,mdim,setype,snnode,sncell
00076 integer sgtype,ncatt,nvatt,profile
00077 character*64 smname,mname
00078
00079
00080
00081 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00082 print *,'Open file',cret
00083 if (cret .ne. 0 ) then
00084 print *,'ERROR : file creation'
00085 call efexit(-1)
00086 endif
00087
00088
00089
00090 call msense(fid,nsmr,cret)
00091 print *,'Read number of struct model',nsmr,cret
00092 if (cret .ne. 0 ) then
00093 print *,'ERROR : number of struct model'
00094 call efexit(-1)
00095 endif
00096 if (nsmr .ne. nsm) then
00097 print *,'ERROR : number of struct model'
00098 call efexit(-1)
00099 endif
00100
00101
00102
00103 do it=1,nsmr
00104
00105 call msesei(fid,it,mname,mgtype,mdim,smname,
00106 & setype,snnode,sncell,sgtype,
00107 & ncatt,profile,nvatt,cret)
00108 print *,'Read information about struct element',cret
00109 if (cret .ne. 0 ) then
00110 print *,'ERROR : information about struct element'
00111 call efexit(-1)
00112 endif
00113
00114 if (it .eq. 1) then
00115 if ( (mname .ne. mname1) .or.
00116 & (mgtype .ne. mtype1) .or.
00117 & (mdim .ne. dim1) .or.
00118 & (smname .ne. smname1) .or.
00119 & (setype .ne. setype1) .or.
00120 & (snnode .ne. nnode1) .or.
00121 & (sncell .ne. ncell1) .or.
00122 & (sgtype .ne. sgtype1) .or.
00123 & (ncatt .ne. ncatt1) .or.
00124 & (profile .ne. profile1) .or.
00125 & (nvatt .ne. nvatt1)
00126 & ) then
00127 print *,'ERROR : information about struct element'
00128 call efexit(-1)
00129 endif
00130 endif
00131
00132 if (it .eq. 2) then
00133 if ( (mname .ne. mname2) .or.
00134 & (mgtype .ne. mtype2) .or.
00135 & (mdim .ne. dim2) .or.
00136 & (smname .ne. smname2) .or.
00137 & (setype .ne. setype2) .or.
00138 & (snnode .ne. nnode2) .or.
00139 & (sncell .ne. ncell1) .or.
00140 & (sgtype .ne. sgtype2) .or.
00141 & (ncatt .ne. ncatt1) .or.
00142 & (profile .ne. profile1) .or.
00143 & (nvatt .ne. nvatt1)
00144 & ) then
00145 print *,'ERROR : information about struct element '
00146 call efexit(-1)
00147 endif
00148 endif
00149
00150 if (it .eq. 3) then
00151 if ( (mname .ne. mname3) .or.
00152 & (mgtype .ne. mtype3) .or.
00153 & (mdim .ne. dim3) .or.
00154 & (smname .ne. smname2) .or.
00155 & (setype .ne. setype3) .or.
00156 & (snnode .ne. nnode2) .or.
00157 & (sncell .ne. ncell2) .or.
00158 & (sgtype .ne. sgtype3) .or.
00159 & (ncatt .ne. ncatt1) .or.
00160 & (profile .ne. profile1) .or.
00161 & (nvatt .ne. nvatt1)
00162 & ) then
00163 print *,'ERROR : information about struct element'
00164 call efexit(-1)
00165 endif
00166 endif
00167
00168 enddo
00169
00170
00171
00172 call msesen(fid,mtype1,mname,cret)
00173 print *,'Read struct element name from the type',cret
00174 if (cret .ne. 0 ) then
00175 print *,'ERROR : struct element name from the type'
00176 call efexit(-1)
00177 endif
00178 if (mname .ne. mname1) then
00179 print *,'ERROR : struct element name from the type'
00180 call efexit(-1)
00181 endif
00182
00183 call msesen(fid,mtype2,mname,cret)
00184 print *,'Read struct element name from the type',cret
00185 if (cret .ne. 0 ) then
00186 print *,'ERROR : struct element name from the type'
00187 call efexit(-1)
00188 endif
00189 if (mname .ne. mname2) then
00190 print *,'ERROR : struct element name from the type'
00191 call efexit(-1)
00192 endif
00193
00194 call msesen(fid,mtype3,mname,cret)
00195 print *,'Read struct element name from the type',cret
00196 if (cret .ne. 0 ) then
00197 print *,'ERROR : struct element name from the type'
00198 call efexit(-1)
00199 endif
00200 if (mname .ne. mname3) then
00201 print *,'ERROR : struct element name from the type'
00202 call efexit(-1)
00203 endif
00204
00205
00206
00207 call mficlo(fid,cret)
00208 print *,'Close file',cret
00209 if (cret .ne. 0 ) then
00210 print *,'ERROR : close file'
00211 call efexit(-1)
00212 endif
00213
00214
00215
00216 end
00217