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)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
Cette routine lit les valeurs d'un attribut caractéristique variable sur les éléments de structure d'...
Definition: medmesh.f:1207
subroutine msesgt(fid, mname, gtype, cret)
Cette routine renvoie le type géométrique mgeotype associé au modèle d'éléments de structure de nom m...
subroutine msevni(fid, mname, aname, atype, anc, cret)
Cette routine décrit les caractéristiques d'un attribut variable de modèle d'élément de structure à p...
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