MED fichier
Unittest_MEDstructElement_3.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C******************************************************************************
19C * Tests for struct element module
20C *
21C *****************************************************************************
23C
24 implicit none
25 include 'med.hf'
26C
27C
28 integer cret
29 integer*8 fid
30
31 character*64 fname
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
38 parameter(dim1=2)
39 parameter(dim2=2)
40 parameter(dim3=2)
41 character*64 smname1
42 parameter(smname1=med_no_name)
43 character*64 smname2
44 parameter(smname2="support mesh name")
45 integer setype1
46 parameter(setype1=med_none)
47 integer setype2
48 parameter(setype2=med_node)
49 integer setype3
50 parameter(setype3=med_cell)
51 integer sgtype1
52 parameter(sgtype1=med_no_geotype)
53 integer sgtype2
54 parameter(sgtype2=med_no_geotype)
55 integer sgtype3
56 parameter(sgtype3=med_seg2)
57 integer mtype1,mtype2,mtype3
58 parameter(mtype1=601)
59 parameter(mtype2=602)
60 parameter(mtype3=603)
61 integer nnode1,nnode2
62 parameter(nnode1=1)
63 parameter(nnode2=3)
64 integer ncell2
65 parameter(ncell2=2)
66 integer ncell1
67 parameter(ncell1=0)
68 integer ncatt1,profile1,nvatt1
69 parameter(ncatt1=0)
70 parameter(nvatt1=0)
71 parameter(profile1=0)
72 integer nsm
73 parameter(nsm=3)
74c
75 integer it,nsmr
76 integer mgtype,mdim,setype,snnode,sncell
77 integer sgtype,ncatt,nvatt,profile
78 character*64 smname,mname
79C
80C
81C open file
82 call mfiope(fid,fname,med_acc_rdonly,cret)
83 print *,'Open file',cret
84 if (cret .ne. 0 ) then
85 print *,'ERROR : file creation'
86 call efexit(-1)
87 endif
88C
89C
90C read number of struct model
91 call msense(fid,nsmr,cret)
92 print *,'Read number of struct model',nsmr,cret
93 if (cret .ne. 0 ) then
94 print *,'ERROR : number of struct model'
95 call efexit(-1)
96 endif
97 if (nsmr .ne. nsm) then
98 print *,'ERROR : number of struct model'
99 call efexit(-1)
100 endif
101C
102C
103C Read informations by iteration
104 do it=1,nsmr
105c
106 call msesei(fid,it,mname,mgtype,mdim,smname,
107 & setype,snnode,sncell,sgtype,
108 & ncatt,profile,nvatt,cret)
109 print *,'Read information about struct element',cret
110 if (cret .ne. 0 ) then
111 print *,'ERROR : information about struct element'
112 call efexit(-1)
113 endif
114c
115 if (it .eq. 1) then
116 if ( (mname .ne. mname1) .or.
117 & (mgtype .ne. mtype1) .or.
118 & (mdim .ne. dim1) .or.
119 & (smname .ne. smname1) .or.
120 & (setype .ne. setype1) .or.
121 & (snnode .ne. nnode1) .or.
122 & (sncell .ne. ncell1) .or.
123 & (sgtype .ne. sgtype1) .or.
124 & (ncatt .ne. ncatt1) .or.
125 & (profile .ne. profile1) .or.
126 & (nvatt .ne. nvatt1)
127 & ) then
128 print *,'ERROR : information about struct element'
129 call efexit(-1)
130 endif
131 endif
132c
133 if (it .eq. 2) then
134 if ( (mname .ne. mname2) .or.
135 & (mgtype .ne. mtype2) .or.
136 & (mdim .ne. dim2) .or.
137 & (smname .ne. smname2) .or.
138 & (setype .ne. setype2) .or.
139 & (snnode .ne. nnode2) .or.
140 & (sncell .ne. ncell1) .or.
141 & (sgtype .ne. sgtype2) .or.
142 & (ncatt .ne. ncatt1) .or.
143 & (profile .ne. profile1) .or.
144 & (nvatt .ne. nvatt1)
145 & ) then
146 print *,'ERROR : information about struct element '
147 call efexit(-1)
148 endif
149 endif
150c
151 if (it .eq. 3) then
152 if ( (mname .ne. mname3) .or.
153 & (mgtype .ne. mtype3) .or.
154 & (mdim .ne. dim3) .or.
155 & (smname .ne. smname2) .or.
156 & (setype .ne. setype3) .or.
157 & (snnode .ne. nnode2) .or.
158 & (sncell .ne. ncell2) .or.
159 & (sgtype .ne. sgtype3) .or.
160 & (ncatt .ne. ncatt1) .or.
161 & (profile .ne. profile1) .or.
162 & (nvatt .ne. nvatt1)
163 & ) then
164 print *,'ERROR : information about struct element'
165 call efexit(-1)
166 endif
167 endif
168c
169 enddo
170C
171C
172C Read struct model name from type
173 call msesen(fid,mtype1,mname,cret)
174 print *,'Read struct element name from the type',cret
175 if (cret .ne. 0 ) then
176 print *,'ERROR : struct element name from the type'
177 call efexit(-1)
178 endif
179 if (mname .ne. mname1) then
180 print *,'ERROR : struct element name from the type'
181 call efexit(-1)
182 endif
183c
184 call msesen(fid,mtype2,mname,cret)
185 print *,'Read struct element name from the type',cret
186 if (cret .ne. 0 ) then
187 print *,'ERROR : struct element name from the type'
188 call efexit(-1)
189 endif
190 if (mname .ne. mname2) then
191 print *,'ERROR : struct element name from the type'
192 call efexit(-1)
193 endif
194c
195 call msesen(fid,mtype3,mname,cret)
196 print *,'Read struct element name from the type',cret
197 if (cret .ne. 0 ) then
198 print *,'ERROR : struct element name from the type'
199 call efexit(-1)
200 endif
201 if (mname .ne. mname3) then
202 print *,'ERROR : struct element name from the type'
203 call efexit(-1)
204 endif
205C
206C
207C close file
208 call mficlo(fid,cret)
209 print *,'Close file',cret
210 if (cret .ne. 0 ) then
211 print *,'ERROR : close file'
212 call efexit(-1)
213 endif
214C
215C
216C
217 end
218
program medstructelement3
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine msesen(fid, mgtype, mname, cret)
subroutine msesei(fid, it, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
subroutine msense(fid, n, cret)