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