OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2surfs.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2surfs (x, nsv, area, nsn, itab, ixc, ixtg, ixs, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ilev, id, titr)

Function/Subroutine Documentation

◆ i2surfs()

subroutine i2surfs ( x,
integer, dimension(*) nsv,
area,
integer nsn,
integer, dimension(*) itab,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixs,*) ixs,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) nod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2eltg,
integer ilev,
integer id,
character(len=nchartitle) titr )

Definition at line 33 of file i2surfs.F.

38 USE message_mod
39 USE names_and_titles_mod , ONLY : nchartitle
40 use element_mod , only :nixs,nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NSN,ILEV
49 INTEGER NSV(*),IXC(NIXC,*),IXTG(NIXTG,*),IXS(NIXS,*),ITAB(*),
50 . KNOD2ELC(*),KNOD2ELTG(*),KNOD2ELS(*),NOD2ELC(*),
51 . NOD2ELTG(*),NOD2ELS(*)
52 my_real
53 . x(3,*),area(*)
54 INTEGER ID
55 CHARACTER(LEN=NCHARTITLE) :: TITR
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, K, N, IAD, IS, IEL, ICOQ, ISOL,
60 . N1,N2,N3,N4,N5,N6,N7,N8
61C REAL
62 my_real
63 . ex,ey,ez,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
64 . x5,y5,z5,x6,y6,z6,x7,y7,z7,x8,y8,z8,
65 . x12,y12,z12,x13,y13,z13,x24,y24,z24,i1,i2,i3,area0
66 my_real
67 . face(6)
68 my_real :: xx1(4), xx2(4),xx3(4)
69C=======================================================================
70 icoq = 1
71 isol = 1
72 IF (ilev == 11 .OR. ilev == 21) isol = 0
73 IF (ilev == 12 .OR. ilev == 22) icoq = 0
74 DO i=1,nsn
75 area0 = area(i)
76 area(i) = zero
77 is = nsv(i)
78 IF (icoq == 1) THEN
79C- 4n coats
80 DO iad = knod2elc(is)+1,knod2elc(is+1)
81 iel = nod2elc(iad)
82 n1 = ixc(2,iel)
83 n2 = ixc(3,iel)
84 n3 = ixc(4,iel)
85 n4 = ixc(5,iel)
86 x1 = x(1,n1)
87 y1 = x(2,n1)
88 z1 = x(3,n1)
89 x2 = x(1,n2)
90 y2 = x(2,n2)
91 z2 = x(3,n2)
92 x3 = x(1,n3)
93 y3 = x(2,n3)
94 z3 = x(3,n3)
95 x4 = x(1,n4)
96 y4 = x(2,n4)
97 z4 = x(3,n4)
98 x12 = x2 - x1
99 y12 = y2 - y1
100 z12 = z2 - z1
101 x13 = x3 - x1
102 y13 = y3 - y1
103 z13 = z3 - z1
104 x24 = x4 - x2
105 y24 = y4 - y2
106 z24 = z4 - z2
107 ex = y13*z24 - z13*y24
108 ey = z13*x24 - x13*z24
109 ez = x13*y24 - y13*x24
110 area(i) = area(i) + sqrt(ex*ex+ey*ey+ez*ez)*half*fourth
111 ENDDO
112C- 3N coats
113 DO iad = knod2eltg(is)+1,knod2eltg(is+1)
114 iel = nod2eltg(iad)
115 n1 = ixtg(2,iel)
116 n2 = ixtg(3,iel)
117 n3 = ixtg(4,iel)
118 x1 = x(1,n1)
119 y1 = x(2,n1)
120 z1 = x(3,n1)
121 x2 = x(1,n2)
122 y2 = x(2,n2)
123 z2 = x(3,n2)
124 x3 = x(1,n3)
125 y3 = x(2,n3)
126 z3 = x(3,n3)
127 x13 = x3 - x1
128 y13 = y3 - y1
129 z13 = z3 - z1
130 x12 = x2 - x1
131 y12 = y2 - y1
132 z12 = z2 - z1
133 ex = y12*z13 - z12*y13
134 ey = z12*x13 - x12*z13
135 ez = x12*y13 - y12*x13
136 area(i) = area(i) + sqrt(ex*ex+ey*ey+ez*ez)*half*third
137 ENDDO
138 ENDIF
139 IF (isol == 1) THEN
140C-- Solides 8n
141 DO iad = knod2els(is)+1,knod2els(is+1)
142 iel = nod2els(iad)
143 n1 = ixs(2,iel)
144 n2 = ixs(3,iel)
145 n3 = ixs(4,iel)
146 n4 = ixs(5,iel)
147 n5 = ixs(6,iel)
148 n6 = ixs(7,iel)
149 n7 = ixs(8,iel)
150 n8 = ixs(9,iel)
151 x1=x(1,n1)
152 y1=x(2,n1)
153 z1=x(3,n1)
154 x2=x(1,n2)
155 y2=x(2,n2)
156 z2=x(3,n2)
157 x3=x(1,n3)
158 y3=x(2,n3)
159 z3=x(3,n3)
160 x4=x(1,n4)
161 y4=x(2,n4)
162 z4=x(3,n4)
163 x5=x(1,n5)
164 y5=x(2,n5)
165 z5=x(3,n5)
166 x6=x(1,n6)
167 y6=x(2,n6)
168 z6=x(3,n6)
169 x7=x(1,n7)
170 y7=x(2,n7)
171 z7=x(3,n7)
172 x8=x(1,n8)
173 y8=x(2,n8)
174 z8=x(3,n8)
175C----
176c face 1234
177 xx1(1)=x1
178 xx2(1)=y1
179 xx3(1)=z1
180 xx1(2)=x2
181 xx2(2)=y2
182 xx3(2)=z2
183 xx1(3)=x3
184 xx2(3)=y3
185 xx3(3)=z3
186 xx1(4)=x4
187 xx2(4)=y4
188 xx3(4)=z4
189 CALL norma1(i1,i2,i3,face(1),xx1,xx2,xx3)
190c face 5678
191 xx1(1)=x5
192 xx2(1)=y5
193 xx3(1)=z5
194 xx1(2)=x6
195 xx2(2)=y6
196 xx3(2)=z6
197 xx1(3)=x7
198 xx2(3)=y7
199 xx3(3)=z7
200 xx1(4)=x8
201 xx2(4)=y8
202 xx3(4)=z8
203 CALL norma1(i1,i2,i3,face(2),xx1,xx2,xx3)
204c face 2376
205 xx1(1)=x2
206 xx2(1)=y2
207 xx3(1)=z2
208 xx1(2)=x3
209 xx2(2)=y3
210 xx3(2)=z3
211 xx1(3)=x7
212 xx2(3)=y7
213 xx3(3)=z7
214 xx1(4)=x6
215 xx2(4)=y6
216 xx3(4)=z6
217 CALL norma1(i1,i2,i3,face(3),xx1,xx2,xx3)
218c face 1485
219 xx1(1)=x1
220 xx2(1)=y1
221 xx3(1)=z1
222 xx1(2)=x4
223 xx2(2)=y4
224 xx3(2)=z4
225 xx1(3)=x8
226 xx2(3)=y8
227 xx3(3)=z8
228 xx1(4)=x5
229 xx2(4)=y5
230 xx3(4)=z5
231 CALL norma1(i1,i2,i3,face(4),xx1,xx2,xx3)
232c face 1265
233 xx1(1)=x1
234 xx2(1)=y1
235 xx3(1)=z1
236 xx1(2)=x2
237 xx2(2)=y2
238 xx3(2)=z2
239 xx1(3)=x6
240 xx2(3)=y6
241 xx3(3)=z6
242 xx1(4)=x5
243 xx2(4)=y5
244 xx3(4)=z5
245 CALL norma1(i1,i2,i3,face(5),xx1,xx2,xx3)
246c face 4378
247 xx1(1)=x4
248 xx2(1)=y4
249 xx3(1)=z4
250 xx1(2)=x3
251 xx2(2)=y3
252 xx3(2)=z3
253 xx1(3)=x7
254 xx2(3)=y7
255 xx3(3)=z7
256 xx1(4)=x8
257 xx2(4)=y8
258 xx3(4)=z8
259 CALL norma1(i1,i2,i3,face(6),xx1,xx2,xx3)
260C----
261 DO k=1,8
262 n = ixs(k+1,iel)
263 IF (n == is) THEN
264 IF (k == 1) THEN
265 area(i) = area(i) + (face(1)+face(4)+face(5))*one_over_12
266 ELSEIF (k == 2) THEN
267 area(i) = area(i) + (face(1)+face(3)+face(5))*one_over_12
268 ELSEIF (k == 3) THEN
269 area(i) = area(i) + (face(1)+face(3)+face(6))*one_over_12
270 ELSEIF (k == 4) THEN
271 area(i) = area(i) + (face(1)+face(4)+face(6))*one_over_12
272 ELSEIF (k == 5) THEN
273 area(i) = area(i) + (face(2)+face(4)+face(5))*one_over_12
274 ELSEIF (k == 6) THEN
275 area(i) = area(i) + (face(2)+face(3)+face(5))*one_over_12
276 ELSEIF (k == 7) THEN
277 area(i) = area(i) + (face(2)+face(3)+face(6))*one_over_12
278 ELSEIF (k == 8) THEN
279 area(i) = area(i) + (face(2)+face(4)+face(6))*one_over_12
280 ENDIF
281 ENDIF
282 ENDDO
283 ENDDO
284 ENDIF
285C----
286 IF (area(i) == zero) area(i) = area0
287 IF (area(i) == zero) THEN
288 CALL ancmsg(msgid=670,
289 . msgtype=msgerror,
290 . anmode=aninfo,
291 . i1=id,
292 . c1=titr,
293 . i2=itab(is))
294 ENDIF
295C----
296 ENDDO
297C----------
298 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
norma1
subroutine norma1(n1, n2, n3, area, xx1, xx2, xx3)
Definition norma1.F:38
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895