MED fichier: Fichier source de Unittest_MEDstructElement_8.f

MED fichier

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

Unittest_MEDstructElement_8.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 *****************************************************************************
22 program medstructelement8
23 C
24 implicit none
25 include 'med.hf'
26 C
27 C
28 integer cret
29 integer fid
30 character*64 fname
31 parameter(fname = "Unittest_MEDstructElement_7.med")
32 character*64 mname2
33 parameter(mname2 = "model name 2")
34 integer dim2
35 parameter(dim2=2)
36 character*64 smname2
37 parameter(smname2="support mesh name")
38 integer setype2
39 parameter(setype2=med_node)
40 integer sgtype2
41 parameter(sgtype2=med_no_geotype)
42 integer mtype2
43 integer sdim1
44 parameter(sdim1=2)
45 character*200 description1
46 parameter(description1="support mesh1 description")
47 character*64 aname1, aname2, aname3
48 parameter(aname1="integer constant attribute name")
49 parameter(aname2="real constant attribute name")
50 parameter(aname3="string constant attribute name")
51 integer atype1,atype2,atype3
52 parameter(atype1=med_att_int)
53 parameter(atype2=med_att_float64)
54 parameter(atype3=med_att_name)
55 integer anc1,anc2,anc3
56 parameter(anc1=2)
57 parameter(anc2=1)
58 parameter(anc3=1)
59 integer aval1(2*2)
60 data aval1 /1,2,5,6/
61 real*8 aval2(2*1)
62 data aval2 /1., 3. /
63 character*64 aval3(2*1)
64 data aval3 /"VAL1","VAL3"/
65 character*64 pname
66 parameter(pname="profil name")
67 integer psize
68 parameter(psize=2)
69 integer profil(2)
70 data profil / 1,3 /
71 c
72 integer mgtype,mdim,setype,snnode,sncell
73 integer sgtype,ncatt,nvatt,profile
74 character*64 rpname,smname
75 integer atype,anc,rpsize
76 integer val1(4)
77 real*8 val2(2)
78 character*64 val3(2)
79 C
80 C
81 C file creation
82 call mfiope(fid,fname,med_acc_rdonly,cret)
83 print *,'Open file',cret
84 if (cret .ne. 0 ) then
85 print *,'ERROR : file creation'
86 call efexit(-1)
87 endif
88 C
89 C read information about struct model
90 C
91 call msesin(fid,mname2,mgtype,mdim,smname,
92 & setype,snnode,sncell,sgtype,
93 & ncatt,profile,nvatt,cret)
94 print *,'Read information about struct element (by name)',cret
95 if (cret .ne. 0 ) then
96 print *,'ERROR : information about struct element (by name) '
97 call efexit(-1)
98 endif
99 C
100 C read constant attribute
101 C with a direct access by name
102 C
103 call msecni(fid,mname2,aname1,atype,anc,
104 & setype,rpname,rpsize,cret)
105 print *,'Read information about constant attribute: ',aname1,cret
106 if (cret .ne. 0 ) then
107 print *,'ERROR : information about attribute (by name)'
108 call efexit(-1)
109 endif
110 if ( (atype .ne. atype1) .or.
111 & (anc .ne. anc1) .or.
112 & (setype .ne. setype2) .or.
113 & (rpname .ne. pname) .or.
114 & (rpsize .ne. psize)
115 & ) then
116 print *,'ERROR : information about struct element (by name) '
117 call efexit(-1)
118 endif
119 c read values
120 call mseiar(fid,mname2,aname1,val1,cret)
121 print *,'Read attribute values: ',aname1,cret
122 if (cret .ne. 0 ) then
123 print *,'ERROR : attribute values'
124 call efexit(-1)
125 endif
126 if ((aval1(1) .ne. val1(1)) .or.
127 & (aval1(2) .ne. val1(2)) .or.
128 & (aval1(3) .ne. val1(3)) .or.
129 & (aval1(4) .ne. val1(4))
130 & ) then
131 print *,'ERROR : attribute values'
132 call efexit(-1)
133 endif
134 c
135 call msecni(fid,mname2,aname2,atype,anc,
136 & setype,rpname,rpsize,cret)
137 print *,'Read information about constant attribute:',aname2,cret
138 if (cret .ne. 0 ) then
139 print *,'ERROR : information about attribute (by name)'
140 call efexit(-1)
141 endif
142 if ( (atype .ne. atype2) .or.
143 & (anc .ne. anc2) .or.
144 & (setype .ne. setype2) .or.
145 & (rpname .ne. pname) .or.
146 & (rpsize .ne. psize)
147 & ) then
148 print *,'ERROR : information about struct element (by name) '
149 call efexit(-1)
150 endif
151 c read values
152 call mserar(fid,mname2,aname2,val2,cret)
153 print *,'Read attribute values: ',aname2,cret
154 if (cret .ne. 0 ) then
155 print *,'ERROR : attribute values'
156 call efexit(-1)
157 endif
158 if ((aval2(1) .ne. val2(1)) .or.
159 & (aval2(2) .ne. val2(2))
160 & ) then
161 print *,'ERROR : attribute values'
162 call efexit(-1)
163 endif
164 c
165 call msecni(fid,mname2,aname3,atype,anc,
166 & setype,rpname,rpsize,cret)
167 print *,'Read information about constant attribute:',aname3,cret
168 if (cret .ne. 0 ) then
169 print *,'ERROR : information about attribute (by name)'
170 call efexit(-1)
171 endif
172 if ( (atype .ne. atype3) .or.
173 & (anc .ne. anc3) .or.
174 & (setype .ne. setype2) .or.
175 & (rpname .ne. pname) .or.
176 & (rpsize .ne. psize)
177 & ) then
178 print *,'ERROR : information about struct element (by name) '
179 call efexit(-1)
180 endif
181 c read values
182 call msesar(fid,mname2,aname3,val3,cret)
183 print *,'Read attribute values: ',aname3,cret
184 if (cret .ne. 0 ) then
185 print *,'ERROR : attribute values'
186 call efexit(-1)
187 endif
188 if ((aval3(1) .ne. val3(1)) .or.
189 & (aval3(2) .ne. val3(2))
190 & ) then
191 print *,'ERROR : attribute values'
192 call efexit(-1)
193 endif
194 C
195 C
196 C close file
197 call mficlo(fid,cret)
198 print *,'Close file',cret
199 if (cret .ne. 0 ) then
200 print *,'ERROR : close file'
201 call efexit(-1)
202 endif
203 C
204 C
205 C
206 end
207
msesin
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
Cette routine décrit les caractéristiques d'un modèle d'élément de structure à partir de son nom...
Definition: medstructelement.f:87
mserar
subroutine mserar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
Definition: medstructelement.f:379
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
msesar
subroutine msesar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
Definition: medstructelement.f:415
msecni
subroutine msecni(fid, mname, aname, atype, anc, setype, pname, psize, cret)
Cette routine décrit les caractéristiques d'un attribut constant de modèle d'élément de structure à p...
Definition: medstructelement.f:342
medstructelement8
program medstructelement8
Definition: Unittest_MEDstructElement_8.f:22
mseiar
subroutine mseiar(fid, mname, aname, val, cret)
Cette routine lit la valeur d'un attribut caractéristique constant d'un modèle d'éléments de structur...
Definition: medstructelement.f:397
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41