MED fichier: Fichier source de Unittest_MEDstructElement_10.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 - 2019 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 *****************************************************************************
22 program medstructelement10
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_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)
58 c
59 integer atype,anc
60 integer rval1(2)
61 real*8 rval2(1)
62 character*64 rval3(2)
63 C
64 C
65 C 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
72 C
73 C informations about attributes
74 C
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
87 c
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
100 c
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
114 C
115 C read attributes values
116 C
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
123 c
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
137 c
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
150 c
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
164 C
165 C
166 C 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
173 C
174 C
175 C
176 end
177
medstructelement10
program medstructelement10
Definition: Unittest_MEDstructElement_10.f:22
mmhsar
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1207
msevni
subroutine msevni(fid, mname, aname, atype, anc, cret)
Definition: medstructelement.f:169
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
msesgt
subroutine msesgt(fid, mname, gtype, cret)
Definition: medstructelement.f:127
mmhrar
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1165
mmhiar
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1186
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82