MED fichier
Unittest_MEDstructElement_10.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*8 fid
30  character*64 fname
31  parameter(fname = "Unittest_MEDstructElement_9.med")
32  character*64 mname2
33  parameter(mname2 = "model name 2")
34  integer mtype2
35  character*64 aname1, aname2, aname3
36  parameter(aname1="integer attribute name")
37  parameter(aname2="real attribute name")
38  parameter(aname3="string attribute name")
39  integer atype1,atype2,atype3
40  parameter(atype1=med_att_int)
41  parameter(atype2=med_att_float64)
42  parameter(atype3=med_att_name)
43  integer anc1,anc2,anc3
44  parameter(anc1=2)
45  parameter(anc2=1)
46  parameter(anc3=2)
47  integer aval1(2)
48  data aval1 /1,2/
49  real*8 aval2(1)
50  data aval2 /1./
51  character*64 aval3(2)
52  data aval3 /"VAL1","VAL2"/
53  character*64 pname,cname
54  parameter(cname="computation mesh")
55  integer nentity
56  parameter(nentity=1)
57 c
58  integer atype,anc
59  integer rval1(2)
60  real*8 rval2(1)
61  character*64 rval3(2)
62 C
63 C
64 C open file
65  call mfiope(fid,fname,med_acc_rdonly,cret)
66  print *,'Open file',cret
67  if (cret .ne. 0 ) then
68  print *,'ERROR : file creation'
69  call efexit(-1)
70  endif
71 C
72 C informations about attributes
73 C
74  call msevni(fid,mname2,aname1,atype,anc,cret)
75  print *,'Read information about attribute',aname1, cret
76  if (cret .ne. 0) then
77  print *,'ERROR : attribute infromation'
78  call efexit(-1)
79  endif
80  if ( (atype .ne. atype1) .or.
81  & (anc .ne. anc1)
82  & ) then
83  print *,'ERROR : attribute information'
84  call efexit(-1)
85  endif
86 c
87  call msevni(fid,mname2,aname2,atype,anc,cret)
88  print *,'Read information about attribute',aname2, cret
89  if (cret .ne. 0) then
90  print *,'ERROR : attribute infromation'
91  call efexit(-1)
92  endif
93  if ( (atype .ne. atype2) .or.
94  & (anc .ne. anc2)
95  & ) then
96  print *,'ERROR : attribute information'
97  call efexit(-1)
98  endif
99 c
100  call msevni(fid,mname2,aname3,atype,anc,cret)
101  print *,'Read information about attribute',aname3, cret
102  if (cret .ne. 0) then
103  print *,'ERROR : attribute information'
104  call efexit(-1)
105  endif
106  if ( (atype .ne. atype3) .or.
107  & (anc .ne. anc3)
108  & ) then
109  print *,'ERROR : attribute information'
110  call efexit(-1)
111  endif
112 
113 C
114 C read attributes values
115 C
116  call msesgt(fid,mname2,mtype2,cret)
117  print *,'Read struct element type (by name) : ',mtype2, cret
118  if (cret .ne. 0 ) then
119  print *,'ERROR : struct element type (by name)'
120  call efexit(-1)
121  endif
122 c
123  call mmhiar(fid,cname,med_no_dt,med_no_it,
124  & mtype2,aname1,rval1,cret)
125  print *,'Read attribute values',cret
126  if (cret .ne. 0) then
127  print *,'ERROR : read attribute values'
128  call efexit(-1)
129  endif
130  if ( (aval1(1) .ne. rval1(1)) .or.
131  & (aval1(2) .ne. rval1(2))
132  & ) then
133  print *,'ERROR : attribute information'
134  call efexit(-1)
135  endif
136 c
137  call mmhrar(fid,cname,med_no_dt,med_no_it,
138  & mtype2,aname2,rval2,cret)
139  print *,'Read attribute values',cret
140  if (cret .ne. 0) then
141  print *,'ERROR : read attribute values'
142  call efexit(-1)
143  endif
144  if ( (aval2(1) .ne. rval2(1))
145  & ) then
146  print *,'ERROR : attribute information'
147  call efexit(-1)
148  endif
149 c
150  call mmhsar(fid,cname,med_no_dt,med_no_it,
151  & mtype2,aname3,rval3,cret)
152  print *,'Read attribute values',cret
153  if (cret .ne. 0) then
154  print *,'ERROR : read attribute values'
155  call efexit(-1)
156  endif
157  if ( (aval3(1) .ne. rval3(1)) .or.
158  & (aval3(2) .ne. rval3(2))
159  & ) then
160  print *,'ERROR : attribute information'
161  call efexit(-1)
162  endif
163 C
164 C
165 C close file
166  call mficlo(fid,cret)
167  print *,'Close file',cret
168  if (cret .ne. 0 ) then
169  print *,'ERROR : close file'
170  call efexit(-1)
171  endif
172 C
173 C
174 C
175  end
176 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine msesgt(fid, mname, gtype, cret)
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1165
subroutine msevni(fid, mname, aname, atype, anc, cret)
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1186
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:41
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1207
program medstructelement10