MED fichier: Fichier source de Unittest_MEDstructElement_2.f

MED fichier

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

Unittest_MEDstructElement_2.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 medstructelement2
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_1.med")
32 character*64 mname1, mname2, mname3
33 parameter(mname1 = "model name 1")
34 parameter(mname2 = "model name 2")
35 parameter(mname3 = "model name 3")
36 integer dim1, dim2, dim3
37 parameter(dim1=2)
38 parameter(dim2=2)
39 parameter(dim3=2)
40 character*64 smname1
41 parameter(smname1=med_no_name)
42 character*64 smname2
43 parameter(smname2="support mesh name")
44 integer setype1
45 parameter(setype1=med_none)
46 integer setype2
47 parameter(setype2=med_node)
48 integer setype3
49 parameter(setype3=med_cell)
50 integer sgtype1
51 parameter(sgtype1=med_no_geotype)
52 integer sgtype2
53 parameter(sgtype2=med_no_geotype)
54 integer sgtype3
55 parameter(sgtype3=med_seg2)
56 integer mtype1,mtype2,mtype3
57 parameter(mtype1=601)
58 parameter(mtype2=602)
59 parameter(mtype3=603)
60 integer nnode1,nnode2
61 parameter(nnode1=1)
62 parameter(nnode2=3)
63 integer ncell2
64 parameter(ncell2=2)
65 integer ncell1
66 parameter(ncell1=0)
67 integer ncatt1,profile1,nvatt1
68 parameter(ncatt1=0)
69 parameter(nvatt1=0)
70 parameter(profile1=0)
71 c
72 integer mgtype,mdim,setype,snnode,sncell
73 integer sgtype,ncatt,nvatt,profile
74 character*64 smname
75 C
76 C
77 C open file
78 call mfiope(fid,fname,med_acc_rdonly,cret)
79 print *,'Open file',cret
80 if (cret .ne. 0 ) then
81 print *,'ERROR : file creation'
82 call efexit(-1)
83 endif
84 C
85 C
86 C Read information about a struct element model
87 C Access by name
88 call msesin(fid,mname1,mgtype,mdim,smname,
89 & setype,snnode,sncell,sgtype,
90 & ncatt,profile,nvatt,cret)
91 print *,'Read information about struct element (by name)',cret
92 if (cret .ne. 0 ) then
93 print *,'ERROR : information about struct element (by name) '
94 call efexit(-1)
95 endif
96 if ( (mgtype .ne. mtype1) .or.
97 & (mdim .ne. dim1) .or.
98 & (smname .ne. smname1) .or.
99 & (setype .ne. setype1) .or.
100 & (snnode .ne. nnode1) .or.
101 & (sncell .ne. ncell1) .or.
102 & (sgtype .ne. sgtype1) .or.
103 & (ncatt .ne. ncatt1) .or.
104 & (profile .ne. profile1) .or.
105 & (nvatt .ne. nvatt1)
106 & ) then
107 print *,'ERROR : information about struct element (by name) '
108 call efexit(-1)
109 endif
110 C
111 C
112 C
113 call msesin(fid,mname2,mgtype,mdim,smname,
114 & setype,snnode,sncell,sgtype,
115 & ncatt,profile,nvatt,cret)
116 print *,'Read information about struct element (by name)',cret
117 if (cret .ne. 0 ) then
118 print *,'ERROR : information about struct element (by name) '
119 call efexit(-1)
120 endif
121 if ( (mgtype .ne. mtype2) .or.
122 & (mdim .ne. dim2) .or.
123 & (smname .ne. smname2) .or.
124 & (setype .ne. setype2) .or.
125 & (snnode .ne. nnode2) .or.
126 & (sncell .ne. ncell1) .or.
127 & (sgtype .ne. sgtype2) .or.
128 & (ncatt .ne. ncatt1) .or.
129 & (profile .ne. profile1) .or.
130 & (nvatt .ne. nvatt1)
131 & ) then
132 print *,'ERROR : information about struct element (by name) '
133 call efexit(-1)
134 endif
135 C
136 C
137 C
138 call msesin(fid,mname3,mgtype,mdim,smname,
139 & setype,snnode,sncell,sgtype,
140 & ncatt,profile,nvatt,cret)
141 print *,'Read information about struct element (by name)',cret
142 if (cret .ne. 0 ) then
143 print *,'ERROR : information about struct element (by name) '
144 call efexit(-1)
145 endif
146 if ( (mgtype .ne. mtype3) .or.
147 & (mdim .ne. dim3) .or.
148 & (smname .ne. smname2) .or.
149 & (setype .ne. setype3) .or.
150 & (snnode .ne. nnode2) .or.
151 & (sncell .ne. ncell2) .or.
152 & (sgtype .ne. sgtype3) .or.
153 & (ncatt .ne. ncatt1) .or.
154 & (profile .ne. profile1) .or.
155 & (nvatt .ne. nvatt1)
156 & ) then
157 print *,'ERROR : information about struct element (by name) '
158 call efexit(-1)
159 endif
160 C
161 C
162 C Read model type from the name
163 call msesgt(fid,mname1,mgtype,cret)
164 print *,'Read struct element type (by name)',cret
165 if (cret .ne. 0 ) then
166 print *,'ERROR : struct element type (by name)'
167 call efexit(-1)
168 endif
169 if (mgtype .ne. mtype1) then
170 print *,'ERROR : struct element type (by name)'
171 call efexit(-1)
172 endif
173 c
174 c
175 c Read model type from the name
176 call msesgt(fid,mname2,mgtype,cret)
177 print *,'Read struct element type (by name)',cret
178 if (cret .ne. 0 ) then
179 print *,'ERROR : struct element type (by name)'
180 call efexit(-1)
181 endif
182 if (mgtype .ne. mtype2) then
183 print *,'ERROR : struct element type (by name)'
184 call efexit(-1)
185 endif
186 c
187 c
188 c Read model type from the name
189 call msesgt(fid,mname3,mgtype,cret)
190 print *,'Read struct element type (by name)',cret
191 if (cret .ne. 0 ) then
192 print *,'ERROR : struct element type (by name)'
193 call efexit(-1)
194 endif
195 if (mgtype .ne. mtype3) then
196 print *,'ERROR : struct element type (by name)'
197 call efexit(-1)
198 endif
199 C
200 C
201 C close file
202 call mficlo(fid,cret)
203 print *,'Close file',cret
204 if (cret .ne. 0 ) then
205 print *,'ERROR : close file'
206 call efexit(-1)
207 endif
208 C
209 C
210 C
211 end
212
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
medstructelement2
program medstructelement2
Definition: Unittest_MEDstructElement_2.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
msesgt
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...
Definition: medstructelement.f:122
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41