MED fichier
Unittest_MEDstructElement_2.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 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 c
72  integer mgtype,mdim,setype,snnode,sncell
73  integer sgtype,ncatt,nvatt,profile
74  character*64 smname
75 C
76 C
77 C open file
78  call mfiope(fid,fname,med_acc_rdonly,cret)
79  print *,'Open file',cret
80  if (cret .ne. 0 ) then
81  print *,'ERROR : file creation'
82  call efexit(-1)
83  endif
84 C
85 C
86 C Read information about a struct element model
87 C Access by name
88  call msesin(fid,mname1,mgtype,mdim,smname,
89  & setype,snnode,sncell,sgtype,
90  & ncatt,profile,nvatt,cret)
91  print *,'Read information about struct element (by name)',cret
92  if (cret .ne. 0 ) then
93  print *,'ERROR : information about struct element (by name) '
94  call efexit(-1)
95  endif
96  if ( (mgtype .ne. mtype1) .or.
97  & (mdim .ne. dim1) .or.
98  & (smname .ne. smname1) .or.
99  & (setype .ne. setype1) .or.
100  & (snnode .ne. nnode1) .or.
101  & (sncell .ne. ncell1) .or.
102  & (sgtype .ne. sgtype1) .or.
103  & (ncatt .ne. ncatt1) .or.
104  & (profile .ne. profile1) .or.
105  & (nvatt .ne. nvatt1)
106  & ) then
107  print *,'ERROR : information about struct element (by name) '
108  call efexit(-1)
109  endif
110 C
111 C
112 C
113  call msesin(fid,mname2,mgtype,mdim,smname,
114  & setype,snnode,sncell,sgtype,
115  & ncatt,profile,nvatt,cret)
116  print *,'Read information about struct element (by name)',cret
117  if (cret .ne. 0 ) then
118  print *,'ERROR : information about struct element (by name) '
119  call efexit(-1)
120  endif
121  if ( (mgtype .ne. mtype2) .or.
122  & (mdim .ne. dim2) .or.
123  & (smname .ne. smname2) .or.
124  & (setype .ne. setype2) .or.
125  & (snnode .ne. nnode2) .or.
126  & (sncell .ne. ncell1) .or.
127  & (sgtype .ne. sgtype2) .or.
128  & (ncatt .ne. ncatt1) .or.
129  & (profile .ne. profile1) .or.
130  & (nvatt .ne. nvatt1)
131  & ) then
132  print *,'ERROR : information about struct element (by name) '
133  call efexit(-1)
134  endif
135 C
136 C
137 C
138  call msesin(fid,mname3,mgtype,mdim,smname,
139  & setype,snnode,sncell,sgtype,
140  & ncatt,profile,nvatt,cret)
141  print *,'Read information about struct element (by name)',cret
142  if (cret .ne. 0 ) then
143  print *,'ERROR : information about struct element (by name) '
144  call efexit(-1)
145  endif
146  if ( (mgtype .ne. mtype3) .or.
147  & (mdim .ne. dim3) .or.
148  & (smname .ne. smname2) .or.
149  & (setype .ne. setype3) .or.
150  & (snnode .ne. nnode2) .or.
151  & (sncell .ne. ncell2) .or.
152  & (sgtype .ne. sgtype3) .or.
153  & (ncatt .ne. ncatt1) .or.
154  & (profile .ne. profile1) .or.
155  & (nvatt .ne. nvatt1)
156  & ) then
157  print *,'ERROR : information about struct element (by name) '
158  call efexit(-1)
159  endif
160 C
161 C
162 C Read model type from the name
163  call msesgt(fid,mname1,mgtype,cret)
164  print *,'Read struct element type (by name)',cret
165  if (cret .ne. 0 ) then
166  print *,'ERROR : struct element type (by name)'
167  call efexit(-1)
168  endif
169  if (mgtype .ne. mtype1) then
170  print *,'ERROR : struct element type (by name)'
171  call efexit(-1)
172  endif
173 c
174 c
175 c Read model type from the name
176  call msesgt(fid,mname2,mgtype,cret)
177  print *,'Read struct element type (by name)',cret
178  if (cret .ne. 0 ) then
179  print *,'ERROR : struct element type (by name)'
180  call efexit(-1)
181  endif
182  if (mgtype .ne. mtype2) then
183  print *,'ERROR : struct element type (by name)'
184  call efexit(-1)
185  endif
186 c
187 c
188 c Read model type from the name
189  call msesgt(fid,mname3,mgtype,cret)
190  print *,'Read struct element type (by name)',cret
191  if (cret .ne. 0 ) then
192  print *,'ERROR : struct element type (by name)'
193  call efexit(-1)
194  endif
195  if (mgtype .ne. mtype3) then
196  print *,'ERROR : struct element type (by name)'
197  call efexit(-1)
198  endif
199 C
200 C
201 C close file
202  call mficlo(fid,cret)
203  print *,'Close file',cret
204  if (cret .ne. 0 ) then
205  print *,'ERROR : close file'
206  call efexit(-1)
207  endif
208 C
209 C
210 C
211  end
212 
subroutine msesin(fid, 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 à partir de son nom...
program medstructelement2
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine msesgt(fid, mname, gtype, cret)
Cette routine renvoie le type géométrique mgeotype associé au modèle d'éléments de structure de nom m...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41