MED fichier: Fichier source de Unittest_MEDstructElement_2.f

MED fichier

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