32 parameter(fname =
"Unittest_MEDstructElement_1.med")
33 character*64 mname1, mname2, mname3
34 parameter(mname1 =
"model name 1")
35 parameter(mname2 =
"model name 2")
36 parameter(mname3 =
"model name 3")
37 integer dim1, dim2, dim3
42 parameter(smname1=med_no_name)
44 parameter(smname2=
"support mesh name")
46 parameter(setype1=med_none)
48 parameter(setype2=med_node)
50 parameter(setype3=med_cell)
52 parameter(sgtype1=med_no_geotype)
54 parameter(sgtype2=med_no_geotype)
56 parameter(sgtype3=med_seg2)
57 integer mtype1,mtype2,mtype3
68 integer ncatt1,profile1,nvatt1
73 integer mgtype,mdim,setype,snnode,sncell
74 integer sgtype,ncatt,nvatt,profile
79 call mfiope(fid,fname,med_acc_rdonly,cret)
80 print *,
'Open file',cret
81 if (cret .ne. 0 )
then
82 print *,
'ERROR : file creation'
89 call msesin(fid,mname1,mgtype,mdim,smname,
90 & setype,snnode,sncell,sgtype,
91 & ncatt,profile,nvatt,cret)
92 print *,
'Read information about struct element (by name)',cret
93 if (cret .ne. 0 )
then
94 print *,
'ERROR : information about struct element (by name) '
97 if ( (mgtype .ne. mtype1) .or.
98 & (mdim .ne. dim1) .or.
99 & (smname .ne. smname1) .or.
100 & (setype .ne. setype1) .or.
101 & (snnode .ne. nnode1) .or.
102 & (sncell .ne. ncell1) .or.
103 & (sgtype .ne. sgtype1) .or.
104 & (ncatt .ne. ncatt1) .or.
105 & (profile .ne. profile1) .or.
106 & (nvatt .ne. nvatt1)
108 print *,
'ERROR : information about struct element (by name) '
114 call msesin(fid,mname2,mgtype,mdim,smname,
115 & setype,snnode,sncell,sgtype,
116 & ncatt,profile,nvatt,cret)
117 print *,
'Read information about struct element (by name)',cret
118 if (cret .ne. 0 )
then
119 print *,
'ERROR : information about struct element (by name) '
122 if ( (mgtype .ne. mtype2) .or.
123 & (mdim .ne. dim2) .or.
124 & (smname .ne. smname2) .or.
125 & (setype .ne. setype2) .or.
126 & (snnode .ne. nnode2) .or.
127 & (sncell .ne. ncell1) .or.
128 & (sgtype .ne. sgtype2) .or.
129 & (ncatt .ne. ncatt1) .or.
130 & (profile .ne. profile1) .or.
131 & (nvatt .ne. nvatt1)
133 print *,
'ERROR : information about struct element (by name) '
139 call msesin(fid,mname3,mgtype,mdim,smname,
140 & setype,snnode,sncell,sgtype,
141 & ncatt,profile,nvatt,cret)
142 print *,
'Read information about struct element (by name)',cret
143 if (cret .ne. 0 )
then
144 print *,
'ERROR : information about struct element (by name) '
147 if ( (mgtype .ne. mtype3) .or.
148 & (mdim .ne. dim3) .or.
149 & (smname .ne. smname2) .or.
150 & (setype .ne. setype3) .or.
151 & (snnode .ne. nnode2) .or.
152 & (sncell .ne. ncell2) .or.
153 & (sgtype .ne. sgtype3) .or.
154 & (ncatt .ne. ncatt1) .or.
155 & (profile .ne. profile1) .or.
156 & (nvatt .ne. nvatt1)
158 print *,
'ERROR : information about struct element (by name) '
164 call msesgt(fid,mname1,mgtype,cret)
165 print *,
'Read struct element type (by name)',cret
166 if (cret .ne. 0 )
then
167 print *,
'ERROR : struct element type (by name)'
170 if (mgtype .ne. mtype1)
then
171 print *,
'ERROR : struct element type (by name)'
177 call msesgt(fid,mname2,mgtype,cret)
178 print *,
'Read struct element type (by name)',cret
179 if (cret .ne. 0 )
then
180 print *,
'ERROR : struct element type (by name)'
183 if (mgtype .ne. mtype2)
then
184 print *,
'ERROR : struct element type (by name)'
190 call msesgt(fid,mname3,mgtype,cret)
191 print *,
'Read struct element type (by name)',cret
192 if (cret .ne. 0 )
then
193 print *,
'ERROR : struct element type (by name)'
196 if (mgtype .ne. mtype3)
then
197 print *,
'ERROR : struct element type (by name)'
204 print *,
'Close file',cret
205 if (cret .ne. 0 )
then
206 print *,
'ERROR : close file'
program medstructelement2
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
Cette routine décrit les caractéristiques d'un modèle d'élément de structure à partir de son nom.
subroutine msesgt(fid, mname, gtype, cret)
Cette routine renvoie le type géométrique mgeotype associé au modèle d'éléments de structure de nom m...