00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDstructElement2
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
00072 integer mgtype,mdim,setype,snnode,sncell
00073 integer sgtype,ncatt,nvatt,profile
00074 character*64 smname
00075
00076
00077
00078 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00079 print *,'Open file',cret
00080 if (cret .ne. 0 ) then
00081 print *,'ERROR : file creation'
00082 call efexit(-1)
00083 endif
00084
00085
00086
00087
00088 call msesin(fid,mname1,mgtype,mdim,smname,
00089 & setype,snnode,sncell,sgtype,
00090 & ncatt,profile,nvatt,cret)
00091 print *,'Read information about struct element (by name)',cret
00092 if (cret .ne. 0 ) then
00093 print *,'ERROR : information about struct element (by name) '
00094 call efexit(-1)
00095 endif
00096 if ( (mgtype .ne. mtype1) .or.
00097 & (mdim .ne. dim1) .or.
00098 & (smname .ne. smname1) .or.
00099 & (setype .ne. setype1) .or.
00100 & (snnode .ne. nnode1) .or.
00101 & (sncell .ne. ncell1) .or.
00102 & (sgtype .ne. sgtype1) .or.
00103 & (ncatt .ne. ncatt1) .or.
00104 & (profile .ne. profile1) .or.
00105 & (nvatt .ne. nvatt1)
00106 & ) then
00107 print *,'ERROR : information about struct element (by name) '
00108 call efexit(-1)
00109 endif
00110
00111
00112
00113 call msesin(fid,mname2,mgtype,mdim,smname,
00114 & setype,snnode,sncell,sgtype,
00115 & ncatt,profile,nvatt,cret)
00116 print *,'Read information about struct element (by name)',cret
00117 if (cret .ne. 0 ) then
00118 print *,'ERROR : information about struct element (by name) '
00119 call efexit(-1)
00120 endif
00121 if ( (mgtype .ne. mtype2) .or.
00122 & (mdim .ne. dim2) .or.
00123 & (smname .ne. smname2) .or.
00124 & (setype .ne. setype2) .or.
00125 & (snnode .ne. nnode2) .or.
00126 & (sncell .ne. ncell1) .or.
00127 & (sgtype .ne. sgtype2) .or.
00128 & (ncatt .ne. ncatt1) .or.
00129 & (profile .ne. profile1) .or.
00130 & (nvatt .ne. nvatt1)
00131 & ) then
00132 print *,'ERROR : information about struct element (by name) '
00133 call efexit(-1)
00134 endif
00135
00136
00137
00138 call msesin(fid,mname3,mgtype,mdim,smname,
00139 & setype,snnode,sncell,sgtype,
00140 & ncatt,profile,nvatt,cret)
00141 print *,'Read information about struct element (by name)',cret
00142 if (cret .ne. 0 ) then
00143 print *,'ERROR : information about struct element (by name) '
00144 call efexit(-1)
00145 endif
00146 if ( (mgtype .ne. mtype3) .or.
00147 & (mdim .ne. dim3) .or.
00148 & (smname .ne. smname2) .or.
00149 & (setype .ne. setype3) .or.
00150 & (snnode .ne. nnode2) .or.
00151 & (sncell .ne. ncell2) .or.
00152 & (sgtype .ne. sgtype3) .or.
00153 & (ncatt .ne. ncatt1) .or.
00154 & (profile .ne. profile1) .or.
00155 & (nvatt .ne. nvatt1)
00156 & ) then
00157 print *,'ERROR : information about struct element (by name) '
00158 call efexit(-1)
00159 endif
00160
00161
00162
00163 call msesgt(fid,mname1,mgtype,cret)
00164 print *,'Read struct element type (by name)',cret
00165 if (cret .ne. 0 ) then
00166 print *,'ERROR : struct element type (by name)'
00167 call efexit(-1)
00168 endif
00169 if (mgtype .ne. mtype1) then
00170 print *,'ERROR : struct element type (by name)'
00171 call efexit(-1)
00172 endif
00173
00174
00175
00176 call msesgt(fid,mname2,mgtype,cret)
00177 print *,'Read struct element type (by name)',cret
00178 if (cret .ne. 0 ) then
00179 print *,'ERROR : struct element type (by name)'
00180 call efexit(-1)
00181 endif
00182 if (mgtype .ne. mtype2) then
00183 print *,'ERROR : struct element type (by name)'
00184 call efexit(-1)
00185 endif
00186
00187
00188
00189 call msesgt(fid,mname3,mgtype,cret)
00190 print *,'Read struct element type (by name)',cret
00191 if (cret .ne. 0 ) then
00192 print *,'ERROR : struct element type (by name)'
00193 call efexit(-1)
00194 endif
00195 if (mgtype .ne. mtype3) then
00196 print *,'ERROR : struct element type (by name)'
00197 call efexit(-1)
00198 endif
00199
00200
00201
00202 call mficlo(fid,cret)
00203 print *,'Close file',cret
00204 if (cret .ne. 0 ) then
00205 print *,'ERROR : close file'
00206 call efexit(-1)
00207 endif
00208
00209
00210
00211 end
00212