MED fichier: Fichier source de Unittest_MEDstructElement_3.f

MED fichier

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

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 - 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 medstructelement3
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 integer nsm
72 parameter(nsm=3)
73 c
74 integer it,nsmr
75 integer mgtype,mdim,setype,snnode,sncell
76 integer sgtype,ncatt,nvatt,profile
77 character*64 smname,mname
78 C
79 C
80 C open file
81 call mfiope(fid,fname,med_acc_rdonly,cret)
82 print *,'Open file',cret
83 if (cret .ne. 0 ) then
84 print *,'ERROR : file creation'
85 call efexit(-1)
86 endif
87 C
88 C
89 C read number of struct model
90 call msense(fid,nsmr,cret)
91 print *,'Read number of struct model',nsmr,cret
92 if (cret .ne. 0 ) then
93 print *,'ERROR : number of struct model'
94 call efexit(-1)
95 endif
96 if (nsmr .ne. nsm) then
97 print *,'ERROR : number of struct model'
98 call efexit(-1)
99 endif
100 C
101 C
102 C Read informations by iteration
103 do it=1,nsmr
104 c
105 call msesei(fid,it,mname,mgtype,mdim,smname,
106 & setype,snnode,sncell,sgtype,
107 & ncatt,profile,nvatt,cret)
108 print *,'Read information about struct element',cret
109 if (cret .ne. 0 ) then
110 print *,'ERROR : information about struct element'
111 call efexit(-1)
112 endif
113 c
114 if (it .eq. 1) then
115 if ( (mname .ne. mname1) .or.
116 & (mgtype .ne. mtype1) .or.
117 & (mdim .ne. dim1) .or.
118 & (smname .ne. smname1) .or.
119 & (setype .ne. setype1) .or.
120 & (snnode .ne. nnode1) .or.
121 & (sncell .ne. ncell1) .or.
122 & (sgtype .ne. sgtype1) .or.
123 & (ncatt .ne. ncatt1) .or.
124 & (profile .ne. profile1) .or.
125 & (nvatt .ne. nvatt1)
126 & ) then
127 print *,'ERROR : information about struct element'
128 call efexit(-1)
129 endif
130 endif
131 c
132 if (it .eq. 2) then
133 if ( (mname .ne. mname2) .or.
134 & (mgtype .ne. mtype2) .or.
135 & (mdim .ne. dim2) .or.
136 & (smname .ne. smname2) .or.
137 & (setype .ne. setype2) .or.
138 & (snnode .ne. nnode2) .or.
139 & (sncell .ne. ncell1) .or.
140 & (sgtype .ne. sgtype2) .or.
141 & (ncatt .ne. ncatt1) .or.
142 & (profile .ne. profile1) .or.
143 & (nvatt .ne. nvatt1)
144 & ) then
145 print *,'ERROR : information about struct element '
146 call efexit(-1)
147 endif
148 endif
149 c
150 if (it .eq. 3) then
151 if ( (mname .ne. mname3) .or.
152 & (mgtype .ne. mtype3) .or.
153 & (mdim .ne. dim3) .or.
154 & (smname .ne. smname2) .or.
155 & (setype .ne. setype3) .or.
156 & (snnode .ne. nnode2) .or.
157 & (sncell .ne. ncell2) .or.
158 & (sgtype .ne. sgtype3) .or.
159 & (ncatt .ne. ncatt1) .or.
160 & (profile .ne. profile1) .or.
161 & (nvatt .ne. nvatt1)
162 & ) then
163 print *,'ERROR : information about struct element'
164 call efexit(-1)
165 endif
166 endif
167 c
168 enddo
169 C
170 C
171 C Read struct model name from type
172 call msesen(fid,mtype1,mname,cret)
173 print *,'Read struct element name from the type',cret
174 if (cret .ne. 0 ) then
175 print *,'ERROR : struct element name from the type'
176 call efexit(-1)
177 endif
178 if (mname .ne. mname1) then
179 print *,'ERROR : struct element name from the type'
180 call efexit(-1)
181 endif
182 c
183 call msesen(fid,mtype2,mname,cret)
184 print *,'Read struct element name from the type',cret
185 if (cret .ne. 0 ) then
186 print *,'ERROR : struct element name from the type'
187 call efexit(-1)
188 endif
189 if (mname .ne. mname2) then
190 print *,'ERROR : struct element name from the type'
191 call efexit(-1)
192 endif
193 c
194 call msesen(fid,mtype3,mname,cret)
195 print *,'Read struct element name from the type',cret
196 if (cret .ne. 0 ) then
197 print *,'ERROR : struct element name from the type'
198 call efexit(-1)
199 endif
200 if (mname .ne. mname3) then
201 print *,'ERROR : struct element name from the type'
202 call efexit(-1)
203 endif
204 C
205 C
206 C close file
207 call mficlo(fid,cret)
208 print *,'Close file',cret
209 if (cret .ne. 0 ) then
210 print *,'ERROR : close file'
211 call efexit(-1)
212 endif
213 C
214 C
215 C
216 end
217
msense
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
Definition: medstructelement.f:43
medstructelement3
program medstructelement3
Definition: Unittest_MEDstructElement_3.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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:106
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:66
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41