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

Go to the source code of this file.

Functions/Subroutines

subroutine q4kelijs2 (pyi, pzi, pyj, pzj, pyci, pzci, pycj, pzcj, ay, r22, r23, dd, gg, kij, kiju, kijl, is, nel, jcvt)

Function/Subroutine Documentation

◆ q4kelijs2()

subroutine q4kelijs2 ( pyi,
pzi,
pyj,
pzj,
pyci,
pzci,
pycj,
pzcj,
ay,
r22,
r23,
dd,
gg,
kij,
kiju,
kijl,
integer is,
integer, intent(in) nel,
integer, intent(in) jcvt )

Definition at line 28 of file q4kelijs2.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: NEL
50 INTEGER, INTENT(IN) :: JCVT
51 INTEGER IS
53 . pyi(*), pzi(*), pyj(*), pzj(*),
54 . pyci(*), pzci(*), pycj(*), pzcj(*), ay(*), r22(*), r23(*),
55 . dd(3,3,*), gg(*), kij(2,2,*), kiju(2,2,*), kijl(2,2,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER EP,IASY
61 . ays(mvsiz)
62C-----------------------------------------------
63C S o u r c e L i n e s
64C-----------------------------------------------
65 DO ep=1,nel
66 kij(1,1,ep) = kij(1,1,ep) +
67 . dd(1,1,ep)*pyi(ep)*pyj(ep) +
68 . gg(ep)*pzci(ep)*pzcj(ep)
69 kij(1,2,ep) = kij(1,2,ep) +
70 . dd(1,2,ep)*pyi(ep)*pzj(ep) +
71 . gg(ep)*pzci(ep)*pycj(ep)
72 kij(2,1,ep) = kij(2,1,ep) +
73 . dd(1,2,ep)*pzi(ep)*pyj(ep) +
74 . gg(ep)*pyci(ep)*pzcj(ep)
75 kij(2,2,ep) = kij(2,2,ep) +
76 . dd(2,2,ep)*pzi(ep)*pzj(ep) +
77 . gg(ep)*pyci(ep)*pycj(ep)
78 ENDDO
79C
80 IF (n2d==1) THEN
81 DO ep=1,nel
82 ays(ep) = ay(ep)*ay(ep)
83 ENDDO
84 IF (jcvt==0) THEN
85 DO ep=1,nel
86 kij(1,1,ep) = kij(1,1,ep) +
87 . dd(1,3,ep)*ay(ep)*(pyi(ep)+pyj(ep)) +
88 . dd(3,3,ep)*ays(ep)
89 kij(1,2,ep) = kij(1,2,ep) +
90 . dd(2,3,ep)*ay(ep)*pzj(ep)
91 kij(2,1,ep) = kij(2,1,ep) +
92 . dd(2,3,ep)*pzi(ep)*ay(ep)
93 ENDDO
94C asymmetric part
95C IASY = 0
96C IF (IASY/=0) THEN
97C DO EP=1,NEL
98C KIJU(1,1,EP) = KIJU(1,1,EP) -
99C . AY(EP)*(DD(1,1,EP)*PYJ(EP)+DD(1,3,EP)*AY(EP))
100C KIJU(1,2,EP) = KIJU(1,2,EP) - AY(EP)*DD(1,2,EP)*PZJ(EP)
101C KIJU(2,1,EP) = KIJU(2,1,EP) - AY(EP)*GG(EP)*PZCJ(EP)
102C KIJU(2,2,EP) = KIJU(2,2,EP) - AY(EP)*GG(EP)*PYCJ(EP)
103C KIJL(1,1,EP) = KIJL(1,1,EP) -
104C . AY(EP)*(DD(1,1,EP)*PYI(EP)+DD(1,3,EP)*AY(EP))
105C KIJL(1,2,EP) = KIJL(1,2,EP) - AY(EP)*GG(EP)*PZCI(EP)
106C KIJL(2,1,EP) = KIJL(2,1,EP) - AY(EP)*DD(1,2,EP)*PZI(EP)
107C KIJL(2,2,EP) = KIJL(2,2,EP) - AY(EP)*GG(EP)*PYCI(EP)
108C ENDDO
109C ENDIF
110 ELSE
111 DO ep=1,nel
112 kij(1,1,ep) = kij(1,1,ep) +
113 . dd(1,3,ep)*r22(ep)*ay(ep)*(pyi(ep)+pyj(ep)) +
114 . dd(3,3,ep)*r22(ep)*r22(ep)*ays(ep)
115 kij(1,2,ep) = kij(1,2,ep) +
116 . dd(1,3,ep)*r23(ep)*ay(ep)*pyi(ep) +
117 . dd(2,3,ep)*r22(ep)*ay(ep)*pzj(ep) +
118 . dd(3,3,ep)*r22(ep)*r23(ep)*ays(ep)
119 kij(2,1,ep) = kij(2,1,ep) +
120 . dd(1,3,ep)*r23(ep)*ay(ep)*pyj(ep) +
121 . dd(2,3,ep)*r22(ep)*ay(ep)*pzi(ep) +
122 . dd(3,3,ep)*r22(ep)*r23(ep)*ays(ep)
123 kij(2,2,ep) = kij(2,2,ep) +
124 . dd(2,3,ep)*r23(ep)*ay(ep)*(pzi(ep)+pzj(ep)) +
125 . dd(3,3,ep)*r23(ep)*r23(ep)*ays(ep)
126 ENDDO
127C asymmetric part
128C IASY = 0
129C IF (IASY/=0) THEN
130C ENDIF
131 ENDIF
132 ENDIF
133C
134 RETURN
#define my_real
Definition cppsort.cpp:32