00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 program MEDstructElement6
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_4.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
00060 integer mgtype,mdim,setype,snnode,sncell
00061 integer sgtype,ncatt,nvatt,profile
00062 character*64 pname,smname,aname
00063 integer atype,anc,psize
00064 integer i
00065
00066
00067
00068 call mfiope(fid,fname,MED_ACC_RDONLY,cret)
00069 print *,'Open file',cret
00070 if (cret .ne. 0 ) then
00071 print *,'ERROR : file creation'
00072 call efexit(-1)
00073 endif
00074
00075
00076
00077 call msesin(fid,mname2,mgtype,mdim,smname,
00078 & setype,snnode,sncell,sgtype,
00079 & ncatt,profile,nvatt,cret)
00080 print *,'Read information about struct element (by name)',cret
00081 if (cret .ne. 0 ) then
00082 print *,'ERROR : information about struct element (by name) '
00083 call efexit(-1)
00084 endif
00085
00086
00087
00088 do i=1,ncatt
00089
00090
00091
00092
00093 call msecai(fid,mname2,i,aname,atype,anc,
00094 & setype,pname,psize,cret)
00095 print *,'Read information about constant attribute: ',aname1,cret
00096 if (cret .ne. 0 ) then
00097 print *,'ERROR : information about attribute'
00098 call efexit(-1)
00099 endif
00100
00101 if (i. eq. 1) then
00102 if ( (atype .ne. atype1) .or.
00103 & (anc .ne. anc1) .or.
00104 & (setype .ne. setype2) .or.
00105 & (pname .ne. MED_NO_PROFILE) .or.
00106 & (psize .ne. 0)
00107 & ) then
00108 print *,'ERROR : information about constant attribute '
00109 call efexit(-1)
00110 endif
00111 endif
00112
00113 if (i .eq. 2) then
00114 if ( (atype .ne. atype2) .or.
00115 & (anc .ne. anc2) .or.
00116 & (setype .ne. setype2) .or.
00117 & (pname .ne. MED_NO_PROFILE) .or.
00118 & (psize .ne. 0)
00119 & ) then
00120 print *,'ERROR : information about constant attribute'
00121 call efexit(-1)
00122 endif
00123 endif
00124
00125 if (i .eq. 3) then
00126 if ( (atype .ne. atype3) .or.
00127 & (anc .ne. anc3) .or.
00128 & (setype .ne. setype2) .or.
00129 & (pname .ne. MED_NO_PROFILE) .or.
00130 & (psize .ne. 0)
00131 & ) then
00132 print *,'ERROR : information about constant attribute'
00133 call efexit(-1)
00134 endif
00135 endif
00136
00137 enddo
00138
00139
00140
00141 call mficlo(fid,cret)
00142 print *,'Close file',cret
00143 if (cret .ne. 0 ) then
00144 print *,'ERROR : close file'
00145 call efexit(-1)
00146 endif
00147
00148
00149
00150 end
00151