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 - 2021 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 
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
medstructelement3
program medstructelement3
Definition: Unittest_MEDstructElement_3.f:22
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