MED fichier
Unittest_MEDstructElement_8.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_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 /
72c
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)
80C
81C
82C 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
89C
90C read information about struct model
91C
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
100C
101C read constant attribute
102C with a direct access by name
103C
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
120c 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
135c
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
152c 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
165c
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
182c 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
195C
196C
197C 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
204C
205C
206C
207 end
208
program medstructelement8
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mseiar(fid, mname, aname, val, cret)
subroutine mserar(fid, mname, aname, val, cret)
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
subroutine msesar(fid, mname, aname, val, cret)
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)