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 - 2016 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 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)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
program medstructelement3
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
subroutine msesen(fid, mgtype, mname, cret)
Cette routine renvoie le nom du modèle d'éléments de structure associé au type mgeotype.
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.