MED fichier
Unittest_MEDstructElement_10.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C******************************************************************************
19C * Tests for struct element module
20C *
21C *****************************************************************************
23C
24 implicit none
25 include 'med.hf'
26C
27C
28 integer cret
29 integer*8 fid
30
31 character*64 fname
32 parameter(fname = "Unittest_MEDstructElement_9.med")
33 character*64 mname2
34 parameter(mname2 = "model name 2")
35 integer mtype2
36 character*64 aname1, aname2, aname3
37 parameter(aname1="integer attribute name")
38 parameter(aname2="real attribute name")
39 parameter(aname3="string attribute name")
40 integer atype1,atype2,atype3
41 parameter(atype1=med_att_int)
42 parameter(atype2=med_att_float64)
43 parameter(atype3=med_att_name)
44 integer anc1,anc2,anc3
45 parameter(anc1=2)
46 parameter(anc2=1)
47 parameter(anc3=2)
48 integer aval1(2)
49 data aval1 /1,2/
50 real*8 aval2(1)
51 data aval2 /1./
52 character*64 aval3(2)
53 data aval3 /"VAL1","VAL2"/
54 character*64 pname,cname
55 parameter(cname="computation mesh")
56 integer nentity
57 parameter(nentity=1)
58c
59 integer atype,anc
60 integer rval1(2)
61 real*8 rval2(1)
62 character*64 rval3(2)
63C
64C
65C open file
66 call mfiope(fid,fname,med_acc_rdonly,cret)
67 print *,'Open file',cret
68 if (cret .ne. 0 ) then
69 print *,'ERROR : file creation'
70 call efexit(-1)
71 endif
72C
73C informations about attributes
74C
75 call msevni(fid,mname2,aname1,atype,anc,cret)
76 print *,'Read information about attribute',aname1, cret
77 if (cret .ne. 0) then
78 print *,'ERROR : attribute infromation'
79 call efexit(-1)
80 endif
81 if ( (atype .ne. atype1) .or.
82 & (anc .ne. anc1)
83 & ) then
84 print *,'ERROR : attribute information'
85 call efexit(-1)
86 endif
87c
88 call msevni(fid,mname2,aname2,atype,anc,cret)
89 print *,'Read information about attribute',aname2, cret
90 if (cret .ne. 0) then
91 print *,'ERROR : attribute infromation'
92 call efexit(-1)
93 endif
94 if ( (atype .ne. atype2) .or.
95 & (anc .ne. anc2)
96 & ) then
97 print *,'ERROR : attribute information'
98 call efexit(-1)
99 endif
100c
101 call msevni(fid,mname2,aname3,atype,anc,cret)
102 print *,'Read information about attribute',aname3, cret
103 if (cret .ne. 0) then
104 print *,'ERROR : attribute information'
105 call efexit(-1)
106 endif
107 if ( (atype .ne. atype3) .or.
108 & (anc .ne. anc3)
109 & ) then
110 print *,'ERROR : attribute information'
111 call efexit(-1)
112 endif
113
114C
115C read attributes values
116C
117 call msesgt(fid,mname2,mtype2,cret)
118 print *,'Read struct element type (by name) : ',mtype2, cret
119 if (cret .ne. 0 ) then
120 print *,'ERROR : struct element type (by name)'
121 call efexit(-1)
122 endif
123c
124 call mmhiar(fid,cname,med_no_dt,med_no_it,
125 & mtype2,aname1,rval1,cret)
126 print *,'Read attribute values',cret
127 if (cret .ne. 0) then
128 print *,'ERROR : read attribute values'
129 call efexit(-1)
130 endif
131 if ( (aval1(1) .ne. rval1(1)) .or.
132 & (aval1(2) .ne. rval1(2))
133 & ) then
134 print *,'ERROR : attribute information'
135 call efexit(-1)
136 endif
137c
138 call mmhrar(fid,cname,med_no_dt,med_no_it,
139 & mtype2,aname2,rval2,cret)
140 print *,'Read attribute values',cret
141 if (cret .ne. 0) then
142 print *,'ERROR : read attribute values'
143 call efexit(-1)
144 endif
145 if ( (aval2(1) .ne. rval2(1))
146 & ) then
147 print *,'ERROR : attribute information'
148 call efexit(-1)
149 endif
150c
151 call mmhsar(fid,cname,med_no_dt,med_no_it,
152 & mtype2,aname3,rval3,cret)
153 print *,'Read attribute values',cret
154 if (cret .ne. 0) then
155 print *,'ERROR : read attribute values'
156 call efexit(-1)
157 endif
158 if ( (aval3(1) .ne. rval3(1)) .or.
159 & (aval3(2) .ne. rval3(2))
160 & ) then
161 print *,'ERROR : attribute information'
162 call efexit(-1)
163 endif
164C
165C
166C close file
167 call mficlo(fid,cret)
168 print *,'Close file',cret
169 if (cret .ne. 0 ) then
170 print *,'ERROR : close file'
171 call efexit(-1)
172 endif
173C
174C
175C
176 end
177
program medstructelement10
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition medmesh.f:1207
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition medmesh.f:1165
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition medmesh.f:1186
subroutine msesgt(fid, mname, gtype, cret)
subroutine msevni(fid, mname, aname, atype, anc, cret)