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 - 2023 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 
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)
74 c
75  integer it,nsmr
76  integer mgtype,mdim,setype,snnode,sncell
77  integer sgtype,ncatt,nvatt,profile
78  character*64 smname,mname
79 C
80 C
81 C 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
88 C
89 C
90 C 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
101 C
102 C
103 C Read informations by iteration
104  do it=1,nsmr
105 c
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
114 c
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
132 c
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
150 c
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
168 c
169  enddo
170 C
171 C
172 C 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
183 c
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
194 c
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
205 C
206 C
207 C 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
214 C
215 C
216 C
217  end
218 
msesei
subroutine msesei(fid, it, 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 par itération.
Definition: medstructelement.f:68
msense
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
Definition: medstructelement.f:44
msesen
subroutine msesen(fid, mgtype, mname, cret)
Cette routine renvoie le nom du modèle d'éléments de structure associé au type mgeotype.
Definition: medstructelement.f:110
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
medstructelement3
program medstructelement3
Definition: Unittest_MEDstructElement_3.f:22
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42