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

Go to the source code of this file.

Functions/Subroutines

subroutine sectarea (ixs, ixs10, x, ibuf, nele, isolnod, area, itab)

Function/Subroutine Documentation

◆ sectarea()

subroutine sectarea ( integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
x,
integer, dimension(2,*) ibuf,
integer nele,
integer, dimension(*) isolnod,
area,
integer, dimension(*) itab )

Definition at line 31 of file sectarea.F.

32 use element_mod , only : nixs
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "com04_c.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER IXS(NIXS,*),IXS10(6,*),IBUF(2,*),ISOLNOD(*) ,ITAB(*)
45 INTEGER NELE
47 . area,x(3,*)
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER IE, II, I, J, IN1, IN2, IN3, I10
52 INTEGER NODE(10)
54 . x1,y1,z1,x2,y2,z2,x3,y3,z3,n3
55C=======================================================================
56
57 area = zero
58 DO ie=1,nele
59 j=0
60 ii=ibuf(1,ie)
61 node(1:10) = 0
62 IF(ii<=numels8)THEN
63 IF(isolnod(ii) == 4) THEN ! Case of tetra4
64 DO i=0,6,2
65 IF(btest(ibuf(2,ie),i)) THEN
66 j=j+1
67 node(j)=ixs(i+2,ii)
68 ENDIF
69 ENDDO
70 ELSE IF (isolnod(ii) == 8) THEN
71 DO i=0,7
72 IF(btest(ibuf(2,ie),i)) THEN
73 j=j+1
74 node(j)=ixs(i+2,ii)
75 ENDIF
76 ENDDO
77 ENDIF
78
79 IF(j>=3)THEN
80 in1 = node(1)
81 in2 = node(2)
82 in3 = node(3)
83 x1=x(1,in1)-x(1,in2)
84 y1=x(2,in1)-x(2,in2)
85 z1=x(3,in1)-x(3,in2)
86 x2=x(1,in3)-x(1,in2)
87 y2=x(2,in3)-x(2,in2)
88 z2=x(3,in3)-x(3,in2)
89 x3=y1*z2-z1*y2
90 y3=z1*x2-z2*x1
91 z3=x1*y2-x2*y1
92 n3=x3*x3+y3*y3+z3*z3
93 area=area+half*sqrt(n3)
94 IF(j==4)THEN
95 in2 = node(4)
96 x1=x(1,in1)-x(1,in2)
97 y1=x(2,in1)-x(2,in2)
98 z1=x(3,in1)-x(3,in2)
99 x2=x(1,in3)-x(1,in2)
100 y2=x(2,in3)-x(2,in2)
101 z2=x(3,in3)-x(3,in2)
102 x3=y1*z2-z1*y2
103 y3=z1*x2-z2*x1
104 z3=x1*y2-x2*y1
105 n3=x3*x3+y3*y3+z3*z3
106 area=area+half*sqrt(n3)
107 ENDIF
108 ENDIF
109
110 ELSE
111 i10=ii-numels8
112 IF(i10<=numels10) THEN
113 !IF(ISOLNOD(II) == 10) THEN ! Cas du tetra10
114 DO i=0,6,2
115 IF(btest(ibuf(2,ie),i)) THEN
116 j=j+1
117 node(j)=ixs(i+2,ii)
118 ENDIF
119 ENDDO
120 DO i=8,13
121 IF(btest(ibuf(2,ie),i)) THEN
122 j=j+1
123 node(j)=ixs10(i-7,i10)
124 ENDIF
125 ENDDO
126
127 IF(j==6)THEN
128 in1 = node(1)
129 in2 = node(2)
130 in3 = node(3)
131 x1=x(1,in2)-x(1,in1)
132 y1=x(2,in2)-x(2,in1)
133 z1=x(3,in2)-x(3,in1)
134 x2=x(1,in3)-x(1,in1)
135 y2=x(2,in3)-x(2,in1)
136 z2=x(3,in3)-x(3,in1)
137 x3=y1*z2-z1*y2
138 y3=z1*x2-z2*x1
139 z3=x1*y2-x2*y1
140 n3=x3*x3+y3*y3+z3*z3
141 area=area+half*sqrt(n3)
142 ENDIF
143 ENDIF
144 ENDIF
145 ENDDO
146
147 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)