OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
q4kelij2.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 q4kelij2 (pyi, pzi, pyj, pzj, pyci, pzci, pycj, pzcj, ay, r22, r23, dd, dg, g33, kij, is, nel, jcvt)

Function/Subroutine Documentation

◆ q4kelij2()

subroutine q4kelij2 ( pyi,
pzi,
pyj,
pzj,
pyci,
pzci,
pycj,
pzcj,
ay,
r22,
r23,
dd,
dg,
g33,
kij,
integer is,
integer, intent(in) nel,
integer, intent(in) jcvt )

Definition at line 28 of file q4kelij2.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,*), dg(3,3,*), g33(3,3,*), kij(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 . dg(1,1,ep)*(pyi(ep)*pzcj(ep)+pzci(ep)*pyj(ep)) +
69 . g33(1,1,ep)*(pzci(ep)*pzcj(ep))
70 kij(1,2,ep) = kij(1,2,ep) +
71 . dd(1,2,ep)*pyi(ep)*pzj(ep) +
72 . dg(1,1,ep)*pyi(ep)*pycj(ep) +
73 . dg(2,1,ep)*pzci(ep)*pzj(ep) +
74 . g33(1,1,ep)*pzci(ep)*pycj(ep)
75 kij(2,1,ep) = kij(2,1,ep) +
76 . dd(1,2,ep)*pzi(ep)*pyj(ep) +
77 . dg(1,1,ep)*pyci(ep)*pyj(ep) +
78 . dg(2,1,ep)*pzi(ep)*pzcj(ep) +
79 . g33(1,1,ep)*pyci(ep)*pzcj(ep)
80 kij(2,2,ep) = kij(2,2,ep) +
81 . dd(2,2,ep)*pzi(ep)*pzj(ep) +
82 . dg(2,1,ep)*(pyci(ep)*pzj(ep)+pzi(ep)*pycj(ep)) +
83 . g33(1,1,ep)*pyci(ep)*pycj(ep)
84 ENDDO
85C
86 IF (n2d==1) THEN
87 DO ep=1,nel
88 ays(ep) = ay(ep)*ay(ep)
89 ENDDO
90 IF (jcvt==0) THEN
91 DO ep=1,nel
92 kij(1,1,ep) = kij(1,1,ep) +
93 . dd(1,3,ep)*ay(ep)*(pyi(ep)+pyj(ep)) +
94 . dd(3,3,ep)*ays(ep) +
95 . dg(3,1,ep)*ay(ep)*(pyci(ep)+pzcj(ep))
96 kij(1,2,ep) = kij(1,2,ep) +
97 . dd(2,3,ep)*ay(ep)*pzj(ep) +
98 . dg(3,1,ep)*ay(ep)*pycj(ep)
99 kij(2,1,ep) = kij(2,1,ep) +
100 . dd(2,3,ep)*pzi(ep)*ay(ep) +
101 . dg(3,1,ep)*pyci(ep)*ay(ep)
102 ENDDO
103C asymmetric part
104C IASY = 0
105C IF (IASY/=0) THEN
106C ENDIF
107 ELSE
108 DO ep=1,nel
109 kij(1,1,ep) = kij(1,1,ep) +
110 . dd(1,3,ep)*r22(ep)*ay(ep)*(pyi(ep)+pyj(ep)) +
111 . dd(3,3,ep)*r22(ep)*r22(ep)*ays(ep) +
112 . dg(3,1,ep)*ay(ep)*r22(ep)*(pyci(ep)+pzcj(ep))
113 kij(1,2,ep) = kij(1,2,ep) +
114 . dd(1,3,ep)*r23(ep)*ay(ep)*pyi(ep) +
115 . dd(2,3,ep)*r22(ep)*ay(ep)*pzj(ep) +
116 . dd(3,3,ep)*r22(ep)*r23(ep)*ays(ep) +
117 . dg(3,1,ep)*ay(ep)*(r22(ep)*pycj(ep)+r23(ep)*pzci(ep))
118 kij(2,1,ep) = kij(2,1,ep) +
119 . dd(1,3,ep)*r23(ep)*ay(ep)*pyj(ep) +
120 . dd(2,3,ep)*r22(ep)*ay(ep)*pzi(ep) +
121 . dd(3,3,ep)*r22(ep)*r23(ep)*ays(ep) +
122 . dg(3,1,ep)*ay(ep)*(r23(ep)*pzcj(ep)+r22(ep)*pyci(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 . dg(3,1,ep)*ay(ep)*r23(ep)*(pyci(ep)+pzcj(ep))
127 ENDDO
128C asymmetric part
129C IASY = 0
130C IF (IASY/=0) THEN
131C ENDIF
132 ENDIF
133 ENDIF
134C
135 RETURN
#define my_real
Definition cppsort.cpp:32