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

Go to the source code of this file.

Functions/Subroutines

subroutine s6ccumg3 (r11, r21, r31, r12, r22, r32, r13, r23, r33, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, nel)

Function/Subroutine Documentation

◆ s6ccumg3()

subroutine s6ccumg3 ( r11,
r21,
r31,
r12,
r22,
r32,
r13,
r23,
r33,
k11,
k12,
k13,
k14,
k15,
k16,
k22,
k23,
k24,
k25,
k26,
k33,
k34,
k35,
k36,
k44,
k45,
k46,
k55,
k56,
k66,
x1,
x2,
x3,
x4,
x5,
x6,
y1,
y2,
y3,
y4,
y5,
y6,
z1,
z2,
z3,
z4,
z5,
z6,
integer, intent(in) nel )

Definition at line 32 of file s6ccumg3.F.

46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER, INTENT(IN) :: NEL
58C REAL
60 . r11(*), r12(*), r13(*),
61 . r21(*), r22(*), r23(*),
62 . r31(*), r32(*), r33(*),
63 . k11(9,*) ,k12(9,*) ,k13(9,*) ,k14(9,*) ,k15(9,*) ,
64 . k16(9,*) ,k22(9,*) ,k23(9,*) ,k24(9,*) ,k25(9,*) ,
65 . k26(9,*) ,k33(9,*) ,k34(9,*) ,k35(9,*) ,k36(9,*) ,
66 . k44(9,*) ,k45(9,*) ,k46(9,*) ,k55(9,*) ,k56(9,*) ,
67 . k66(9,*)
69 . x1(*), x2(*), x3(*), x4(*),x5(*), x6(*),
70 . y1(*), y2(*), y3(*), y4(*),y5(*), y6(*),
71 . z1(*), z2(*), z3(*), z4(*),z5(*), z6(*)
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,ISYM,L,J
79C REAL
81 . q(3,3,mvsiz)
83 . dr(3,3,mvsiz),
84 . r1(3,3,mvsiz),r2(3,3,mvsiz),r3(3,3,mvsiz),r4(3,3,mvsiz),
85 . r5(3,3,mvsiz),r6(3,3,mvsiz),di(6),xx,yy,zz,xy,xz,yz,rtr(6),
86 . abc,xxyz2,zzxy2,yyxz2,deta
87C-----------------------------------------------
88C-----PROJECTION----
89 DO i=1,nel
90 xx = x1(i)*x1(i)+x2(i)*x2(i)+x3(i)*x3(i)
91 1 +x4(i)*x4(i)+x5(i)*x5(i)+x6(i)*x6(i)
92 yy = y1(i)*y1(i)+y2(i)*y2(i)+y3(i)*y3(i)
93 1 +y4(i)*y4(i)+y5(i)*y5(i)+y6(i)*y6(i)
94 xy = x1(i)*y1(i)+x2(i)*y2(i)+x3(i)*y3(i)
95 1 +x4(i)*y4(i)+x5(i)*y5(i)+x6(i)*y6(i)
96 xz = x1(i)*z1(i)+x2(i)*z2(i)+x3(i)*z3(i)
97 1 +x4(i)*z4(i)+x5(i)*z5(i)+x6(i)*z6(i)
98 yz = y1(i)*z1(i)+y2(i)*z2(i)+y3(i)*z3(i)
99 1 +y4(i)*z4(i)+y5(i)*z5(i)+y6(i)*z6(i)
100 zz = z1(i)*z1(i)+z2(i)*z2(i)+z3(i)*z3(i)
101 1 +z4(i)*z4(i)+z5(i)*z5(i)+z6(i)*z6(i)
102 rtr(1)= yy+zz
103 rtr(2)= xx+zz
104 rtr(3)= xx+yy
105 rtr(4)= -xy
106 rtr(5)= -xz
107 rtr(6)= -yz
108C
109 abc = rtr(1)*rtr(2)*rtr(3)
110 xxyz2 = rtr(1)*rtr(6)*rtr(6)
111 yyxz2 = rtr(2)*rtr(5)*rtr(5)
112 zzxy2 = rtr(3)*rtr(4)*rtr(4)
113 deta = abc + two*rtr(4)*rtr(5)*rtr(6)-xxyz2-yyxz2-zzxy2
114 IF (deta<em20) THEN
115 deta=one
116 ELSE
117 deta=one/deta
118 ENDIF
119 di(1) = (abc-xxyz2)*deta/rtr(1)
120 di(2) = (abc-yyxz2)*deta/rtr(2)
121 di(3) = (abc-zzxy2)*deta/rtr(3)
122 di(4) = (rtr(5)*rtr(6)-rtr(4)*rtr(3))*deta
123 di(5) = (rtr(6)*rtr(4)-rtr(5)*rtr(2))*deta
124 di(6) = (rtr(4)*rtr(5)-rtr(6)*rtr(1))*deta
125 dr(1,1,i)= di(1)
126 dr(2,2,i)= di(2)
127 dr(3,3,i)= di(3)
128 dr(1,2,i)= di(4)
129 dr(1,3,i)= di(5)
130 dr(2,3,i)= di(6)
131 dr(2,1,i)= dr(1,2,i)
132 dr(3,1,i)= dr(1,3,i)
133 dr(3,2,i)= dr(2,3,i)
134 ENDDO
135C--------ini-RJ---------
136 DO i=1,nel
137 DO l=1,3
138 DO j=1,3
139 r1(l,j,i)=zero
140 r2(l,j,i)=zero
141 r3(l,j,i)=zero
142 r4(l,j,i)=zero
143 r5(l,j,i)=zero
144 r6(l,j,i)=zero
145 ENDDO
146 ENDDO
147 END DO
148C-------------Q<-Q^t---------------
149 DO i=1,nel
150 q(1,1,i)=r11(i)
151 q(1,2,i)=r21(i)
152 q(1,3,i)=r31(i)
153 q(2,1,i)=r12(i)
154 q(2,2,i)=r22(i)
155 q(2,3,i)=r32(i)
156 q(3,1,i)=r13(i)
157 q(3,2,i)=r23(i)
158 q(3,3,i)=r33(i)
159 ENDDO
160C
161 CALL set_ri33(x1 ,y1, z1 ,r1 ,1,nel)
162 CALL set_ri33(x2 ,y2, z2 ,r2 ,1,nel)
163 CALL set_ri33(x3 ,y3, z3 ,r3 ,1,nel)
164 CALL set_ri33(x4 ,y4, z4 ,r4 ,1,nel)
165 CALL set_ri33(x5 ,y5, z5 ,r5 ,1,nel)
166 CALL set_ri33(x6 ,y6, z6 ,r6 ,1,nel)
167 CALL setprojks6(dr ,r1 ,r2 ,r3 ,r4 ,
168 1 r5 ,r6 ,
169 2 k11,k12,k13,k14,k15,k16,k22,k23,
170 3 k24,k25,k26,k33,k34,k35,k36,k44,
171 4 k45,k46,k55,k56,k66,
172 5 q ,1,nel )
173C
174 RETURN
175C----------no projection ---------
176 DO i=1,nel
177 q(1,1,i)=r11(i)
178 q(2,1,i)=r21(i)
179 q(3,1,i)=r31(i)
180 q(1,2,i)=r12(i)
181 q(2,2,i)=r22(i)
182 q(3,2,i)=r32(i)
183 q(1,3,i)=r13(i)
184 q(2,3,i)=r23(i)
185 q(3,3,i)=r33(i)
186 ENDDO
187 isym=1
188C------------QKQ^t
189 CALL systran3(1,nel,q,k11,isym)
190 CALL systran3(1,nel,q,k22,isym)
191 CALL systran3(1,nel,q,k33,isym)
192 CALL systran3(1,nel,q,k44,isym)
193 CALL systran3(1,nel,q,k55,isym)
194 CALL systran3(1,nel,q,k66,isym)
195 isym=0
196 CALL systran3(1,nel,q,k12,isym)
197 CALL systran3(1,nel,q,k13,isym)
198 CALL systran3(1,nel,q,k14,isym)
199 CALL systran3(1,nel,q,k15,isym)
200 CALL systran3(1,nel,q,k16,isym)
201 CALL systran3(1,nel,q,k23,isym)
202 CALL systran3(1,nel,q,k24,isym)
203 CALL systran3(1,nel,q,k25,isym)
204 CALL systran3(1,nel,q,k26,isym)
205 CALL systran3(1,nel,q,k34,isym)
206 CALL systran3(1,nel,q,k35,isym)
207 CALL systran3(1,nel,q,k36,isym)
208 CALL systran3(1,nel,q,k45,isym)
209 CALL systran3(1,nel,q,k46,isym)
210 CALL systran3(1,nel,q,k56,isym)
211C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
212 RETURN
subroutine set_ri33(xi, yi, zi, ri, jft, jlt)
Definition cbasumg3.F:903
#define my_real
Definition cppsort.cpp:32
subroutine setprojks6(dr, r1, r2, r3, r4, r5, r6, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, vq, jft, jlt)
Definition setprojks6.F:39
subroutine systran3(jft, jlt, vq, kk, isym)
Definition systran3.F:30