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