MED fichier
Unittest_MEDstructElement_8.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2020 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_7.med")
33  character*64 mname2
34  parameter(mname2 = "model name 2")
35  integer dim2
36  parameter(dim2=2)
37  character*64 smname2
38  parameter(smname2="support mesh name")
39  integer setype2
40  parameter(setype2=med_node)
41  integer sgtype2
42  parameter(sgtype2=med_no_geotype)
43  integer mtype2
44  integer sdim1
45  parameter(sdim1=2)
46  character*200 description1
47  parameter(description1="support mesh1 description")
48  character*64 aname1, aname2, aname3
49  parameter(aname1="integer constant attribute name")
50  parameter(aname2="real constant attribute name")
51  parameter(aname3="string constant attribute name")
52  integer atype1,atype2,atype3
53  parameter(atype1=med_att_int)
54  parameter(atype2=med_att_float64)
55  parameter(atype3=med_att_name)
56  integer anc1,anc2,anc3
57  parameter(anc1=2)
58  parameter(anc2=1)
59  parameter(anc3=1)
60  integer aval1(2*2)
61  data aval1 /1,2,5,6/
62  real*8 aval2(2*1)
63  data aval2 /1., 3. /
64  character*64 aval3(2*1)
65  data aval3 /"VAL1","VAL3"/
66  character*64 pname
67  parameter(pname="profil name")
68  integer psize
69  parameter(psize=2)
70  integer profil(2)
71  data profil / 1,3 /
72 c
73  integer mgtype,mdim,setype,snnode,sncell
74  integer sgtype,ncatt,nvatt,profile
75  character*64 rpname,smname
76  integer atype,anc,rpsize
77  integer val1(4)
78  real*8 val2(2)
79  character*64 val3(2)
80 C
81 C
82 C file creation
83  call mfiope(fid,fname,med_acc_rdonly,cret)
84  print *,'Open file',cret
85  if (cret .ne. 0 ) then
86  print *,'ERROR : file creation'
87  call efexit(-1)
88  endif
89 C
90 C read information about struct model
91 C
92  call msesin(fid,mname2,mgtype,mdim,smname,
93  & setype,snnode,sncell,sgtype,
94  & ncatt,profile,nvatt,cret)
95  print *,'Read information about struct element (by name)',cret
96  if (cret .ne. 0 ) then
97  print *,'ERROR : information about struct element (by name) '
98  call efexit(-1)
99  endif
100 C
101 C read constant attribute
102 C with a direct access by name
103 C
104  call msecni(fid,mname2,aname1,atype,anc,
105  & setype,rpname,rpsize,cret)
106  print *,'Read information about constant attribute: ',aname1,cret
107  if (cret .ne. 0 ) then
108  print *,'ERROR : information about attribute (by name)'
109  call efexit(-1)
110  endif
111  if ( (atype .ne. atype1) .or.
112  & (anc .ne. anc1) .or.
113  & (setype .ne. setype2) .or.
114  & (rpname .ne. pname) .or.
115  & (rpsize .ne. psize)
116  & ) then
117  print *,'ERROR : information about struct element (by name) '
118  call efexit(-1)
119  endif
120 c read values
121  call mseiar(fid,mname2,aname1,val1,cret)
122  print *,'Read attribute values: ',aname1,cret
123  if (cret .ne. 0 ) then
124  print *,'ERROR : attribute values'
125  call efexit(-1)
126  endif
127  if ((aval1(1) .ne. val1(1)) .or.
128  & (aval1(2) .ne. val1(2)) .or.
129  & (aval1(3) .ne. val1(3)) .or.
130  & (aval1(4) .ne. val1(4))
131  & ) then
132  print *,'ERROR : attribute values'
133  call efexit(-1)
134  endif
135 c
136  call msecni(fid,mname2,aname2,atype,anc,
137  & setype,rpname,rpsize,cret)
138  print *,'Read information about constant attribute:',aname2,cret
139  if (cret .ne. 0 ) then
140  print *,'ERROR : information about attribute (by name)'
141  call efexit(-1)
142  endif
143  if ( (atype .ne. atype2) .or.
144  & (anc .ne. anc2) .or.
145  & (setype .ne. setype2) .or.
146  & (rpname .ne. pname) .or.
147  & (rpsize .ne. psize)
148  & ) then
149  print *,'ERROR : information about struct element (by name) '
150  call efexit(-1)
151  endif
152 c read values
153  call mserar(fid,mname2,aname2,val2,cret)
154  print *,'Read attribute values: ',aname2,cret
155  if (cret .ne. 0 ) then
156  print *,'ERROR : attribute values'
157  call efexit(-1)
158  endif
159  if ((aval2(1) .ne. val2(1)) .or.
160  & (aval2(2) .ne. val2(2))
161  & ) then
162  print *,'ERROR : attribute values'
163  call efexit(-1)
164  endif
165 c
166  call msecni(fid,mname2,aname3,atype,anc,
167  & setype,rpname,rpsize,cret)
168  print *,'Read information about constant attribute:',aname3,cret
169  if (cret .ne. 0 ) then
170  print *,'ERROR : information about attribute (by name)'
171  call efexit(-1)
172  endif
173  if ( (atype .ne. atype3) .or.
174  & (anc .ne. anc3) .or.
175  & (setype .ne. setype2) .or.
176  & (rpname .ne. pname) .or.
177  & (rpsize .ne. psize)
178  & ) then
179  print *,'ERROR : information about struct element (by name) '
180  call efexit(-1)
181  endif
182 c read values
183  call msesar(fid,mname2,aname3,val3,cret)
184  print *,'Read attribute values: ',aname3,cret
185  if (cret .ne. 0 ) then
186  print *,'ERROR : attribute values'
187  call efexit(-1)
188  endif
189  if ((aval3(1) .ne. val3(1)) .or.
190  & (aval3(2) .ne. val3(2))
191  & ) then
192  print *,'ERROR : attribute values'
193  call efexit(-1)
194  endif
195 C
196 C
197 C close file
198  call mficlo(fid,cret)
199  print *,'Close file',cret
200  if (cret .ne. 0 ) then
201  print *,'ERROR : close file'
202  call efexit(-1)
203  endif
204 C
205 C
206 C
207  end
208 
program medstructelement8
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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.
subroutine msesar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)
Cette routine décrit les caractéristiques d'un attribut constant de modèle d'élément de structure à p...
subroutine mseiar(fid, mname, aname, val, cret)
subroutine mserar(fid, mname, aname, val, cret)