MED fichier: Fichier source de Unittest_MEDstructElement_3.f

MED fichier

Unittest_MEDstructElement_3.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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 medstructelement3
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_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)
74 c
75 integer it,nsmr
76 integer mgtype,mdim,setype,snnode,sncell
77 integer sgtype,ncatt,nvatt,profile
78 character*64 smname,mname
79 C
80 C
81 C 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
88 C
89 C
90 C 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
101 C
102 C
103 C Read informations by iteration
104 do it=1,nsmr
105 c
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
114 c
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
132 c
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
150 c
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
168 c
169 enddo
170 C
171 C
172 C 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
183 c
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
194 c
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
205 C
206 C
207 C 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
214 C
215 C
216 C
217 end
218
msesei
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.
Definition: medstructelement.f:68
msense
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
Definition: medstructelement.f:44
msesen
subroutine msesen(fid, mgtype, mname, cret)
Cette routine renvoie le nom du modèle d'éléments de structure associé au type mgeotype.
Definition: medstructelement.f:110
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
medstructelement3
program medstructelement3
Definition: Unittest_MEDstructElement_3.f:22
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42