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