MED fichier
Unittest_MEDstructElement_3.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_1.med")
33 character*64 mname1, mname2, mname3
34 parameter(mname1 = "model name 1")
35 parameter(mname2 = "model name 2")
36 parameter(mname3 = "model name 3")
37 integer dim1, dim2, dim3
38 parameter(dim1=2)
39 parameter(dim2=2)
40 parameter(dim3=2)
41 character*64 smname1
42 parameter(smname1=med_no_name)
43 character*64 smname2
44 parameter(smname2="support mesh name")
45 integer setype1
46 parameter(setype1=med_none)
47 integer setype2
48 parameter(setype2=med_node)
49 integer setype3
50 parameter(setype3=med_cell)
51 integer sgtype1
52 parameter(sgtype1=med_no_geotype)
53 integer sgtype2
54 parameter(sgtype2=med_no_geotype)
55 integer sgtype3
56 parameter(sgtype3=med_seg2)
57 integer mtype1,mtype2,mtype3
58 parameter(mtype1=601)
59 parameter(mtype2=602)
60 parameter(mtype3=603)
61 integer nnode1,nnode2
62 parameter(nnode1=1)
63 parameter(nnode2=3)
64 integer ncell2
65 parameter(ncell2=2)
66 integer ncell1
67 parameter(ncell1=0)
68 integer ncatt1,profile1,nvatt1
69 parameter(ncatt1=0)
70 parameter(nvatt1=0)
71 parameter(profile1=0)
72 integer nsm
73 parameter(nsm=3)
74c
75 integer it,nsmr
76 integer mgtype,mdim,setype,snnode,sncell
77 integer sgtype,ncatt,nvatt,profile
78 character*64 smname,mname
79C
80C
81C open file
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
88C
89C
90C read number of struct model
91 call msense(fid,nsmr,cret)
92 print *,'Read number of struct model',nsmr,cret
93 if (cret .ne. 0 ) then
94 print *,'ERROR : number of struct model'
95 call efexit(-1)
96 endif
97 if (nsmr .ne. nsm) then
98 print *,'ERROR : number of struct model'
99 call efexit(-1)
100 endif
101C
102C
103C Read informations by iteration
104 do it=1,nsmr
105c
106 call msesei(fid,it,mname,mgtype,mdim,smname,
107 & setype,snnode,sncell,sgtype,
108 & ncatt,profile,nvatt,cret)
109 print *,'Read information about struct element',cret
110 if (cret .ne. 0 ) then
111 print *,'ERROR : information about struct element'
112 call efexit(-1)
113 endif
114c
115 if (it .eq. 1) then
116 if ( (mname .ne. mname1) .or.
117 & (mgtype .ne. mtype1) .or.
118 & (mdim .ne. dim1) .or.
119 & (smname .ne. smname1) .or.
120 & (setype .ne. setype1) .or.
121 & (snnode .ne. nnode1) .or.
122 & (sncell .ne. ncell1) .or.
123 & (sgtype .ne. sgtype1) .or.
124 & (ncatt .ne. ncatt1) .or.
125 & (profile .ne. profile1) .or.
126 & (nvatt .ne. nvatt1)
127 & ) then
128 print *,'ERROR : information about struct element'
129 call efexit(-1)
130 endif
131 endif
132c
133 if (it .eq. 2) then
134 if ( (mname .ne. mname2) .or.
135 & (mgtype .ne. mtype2) .or.
136 & (mdim .ne. dim2) .or.
137 & (smname .ne. smname2) .or.
138 & (setype .ne. setype2) .or.
139 & (snnode .ne. nnode2) .or.
140 & (sncell .ne. ncell1) .or.
141 & (sgtype .ne. sgtype2) .or.
142 & (ncatt .ne. ncatt1) .or.
143 & (profile .ne. profile1) .or.
144 & (nvatt .ne. nvatt1)
145 & ) then
146 print *,'ERROR : information about struct element '
147 call efexit(-1)
148 endif
149 endif
150c
151 if (it .eq. 3) then
152 if ( (mname .ne. mname3) .or.
153 & (mgtype .ne. mtype3) .or.
154 & (mdim .ne. dim3) .or.
155 & (smname .ne. smname2) .or.
156 & (setype .ne. setype3) .or.
157 & (snnode .ne. nnode2) .or.
158 & (sncell .ne. ncell2) .or.
159 & (sgtype .ne. sgtype3) .or.
160 & (ncatt .ne. ncatt1) .or.
161 & (profile .ne. profile1) .or.
162 & (nvatt .ne. nvatt1)
163 & ) then
164 print *,'ERROR : information about struct element'
165 call efexit(-1)
166 endif
167 endif
168c
169 enddo
170C
171C
172C Read struct model name from type
173 call msesen(fid,mtype1,mname,cret)
174 print *,'Read struct element name from the type',cret
175 if (cret .ne. 0 ) then
176 print *,'ERROR : struct element name from the type'
177 call efexit(-1)
178 endif
179 if (mname .ne. mname1) then
180 print *,'ERROR : struct element name from the type'
181 call efexit(-1)
182 endif
183c
184 call msesen(fid,mtype2,mname,cret)
185 print *,'Read struct element name from the type',cret
186 if (cret .ne. 0 ) then
187 print *,'ERROR : struct element name from the type'
188 call efexit(-1)
189 endif
190 if (mname .ne. mname2) then
191 print *,'ERROR : struct element name from the type'
192 call efexit(-1)
193 endif
194c
195 call msesen(fid,mtype3,mname,cret)
196 print *,'Read struct element name from the type',cret
197 if (cret .ne. 0 ) then
198 print *,'ERROR : struct element name from the type'
199 call efexit(-1)
200 endif
201 if (mname .ne. mname3) then
202 print *,'ERROR : struct element name from the type'
203 call efexit(-1)
204 endif
205C
206C
207C close file
208 call mficlo(fid,cret)
209 print *,'Close file',cret
210 if (cret .ne. 0 ) then
211 print *,'ERROR : close file'
212 call efexit(-1)
213 endif
214C
215C
216C
217 end
218
program medstructelement3
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 msesen(fid, mgtype, mname, cret)
Cette routine renvoie le nom du modèle d'éléments de structure associé au type mgeotype.
subroutine msesei(fid, it, 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 par itération.
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.