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 30 of file sectarea.F.

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