OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10jaci3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| s10jaci3 ../starter/source/elements/solid/solide10/s10jaci3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| s10jacob ../starter/source/elements/solid/solide10/s10deri3.F
29!|| s10pijsav ../starter/source/elements/solid/solide10/s10deri3.F
30!||--- uses -----------------------------------------------------
31!||====================================================================
32 SUBROUTINE s10jaci3(ELBUF_STR,SAV,NPT,NEL)
33C-----------------------------------------------
34 USE elbufdef_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER , INTENT(IN) :: NPT,NEL
47 DOUBLE PRECISION , DIMENSION(NEL,30),INTENT(IN) :: SAV
48 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER I,IP,N,K1,K2,K3,K4,K5,K6,K7,K8,K9,K10,
53 . M,IPERM(10,4)
54 double precision
55 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
56 double precision
57 . xa(mvsiz,10),ya(mvsiz,10),za(mvsiz,10),
58 . xb(mvsiz,10),yb(mvsiz,10),zb(mvsiz,10),
59 . a4,b4,a4m1,b4m1,aa
60 my_real
61 . vol(mvsiz,5),nx(mvsiz,10,5),
62 . px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5)
63 my_real
64 . alph,beta,w
65 TYPE(l_bufel_) ,POINTER :: LBUF
66 DATA iperm/
67 . 2, 4, 3, 1, 9,10, 6, 5, 8, 7,
68 . 4, 1, 3, 2, 8, 7,10, 9, 5, 6,
69 . 1, 4, 2, 3, 8, 9, 5, 7,10, 6,
70 . 1, 2, 3, 4, 5, 6, 7, 8, 9,10/
71C-----------------------------------------------
72 DO n=1,10
73 DO i=1,nel
74 xx(i,n) = sav(i,n)
75 yy(i,n) = sav(i,n+10)
76 zz(i,n) = sav(i,n+20)
77 ENDDO
78 END DO
79 IF(npt==4)THEN
80 alph = zep5854102
81 beta = zep1381966
82 w = fourth
83 ELSEIF(npt==5)THEN
84 alph = half
85 beta = one_over_6
86 w = nine_over_20
87 ENDIF
88 a4 = four * alph
89 b4 = four * beta
90 a4m1 = a4- one
91 b4m1 = b4- one
92C
93 DO n=1,4
94 DO i=1,nel
95 xa(i,n) = a4m1*xx(i,n)
96 ya(i,n) = a4m1*yy(i,n)
97 za(i,n) = a4m1*zz(i,n)
98C
99 xb(i,n) = b4m1*xx(i,n)
100 yb(i,n) = b4m1*yy(i,n)
101 zb(i,n) = b4m1*zz(i,n)
102 ENDDO
103 ENDDO
104C
105 DO n=5,10
106 DO i=1,nel
107 xa(i,n) = a4*xx(i,n)
108 ya(i,n) = a4*yy(i,n)
109 za(i,n) = a4*zz(i,n)
110C
111 xb(i,n) = b4*xx(i,n)
112 yb(i,n) = b4*yy(i,n)
113 zb(i,n) = b4*zz(i,n)
114 ENDDO
115 ENDDO
116C
117 DO ip=1,4
118 k1 = iperm(1,ip)
119 k2 = iperm(2,ip)
120 k3 = iperm(3,ip)
121 k4 = iperm(4,ip)
122 k5 = iperm(5,ip)
123 k6 = iperm(6,ip)
124 k7 = iperm(7,ip)
125 k8 = iperm(8,ip)
126 k9 = iperm(9,ip)
127 k10= iperm(10,ip)
128 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
129 CALL s10jacob(alph,beta,w,
130 . xb(1,k1),xb(1,k2),xb(1,k3),xa(1,k4),xb(1,k5),
131 . xb(1,k6),xb(1,k7),xb(1,k8),xb(1,k9),xb(1,k10),
132 . xa(1,k8),xa(1,k9),xa(1,k10),
133 . yb(1,k1),yb(1,k2),yb(1,k3),ya(1,k4),yb(1,k5),
134 . yb(1,k6),yb(1,k7),yb(1,k8),yb(1,k9),yb(1,k10),
135 . ya(1,k8),ya(1,k9),ya(1,k10),
136 . zb(1,k1),zb(1,k2),zb(1,k3),za(1,k4),zb(1,k5),
137 . zb(1,k6),zb(1,k7),zb(1,k8),zb(1,k9),zb(1,k10),
138 . za(1,k8),za(1,k9),za(1,k10),
139 . px(1,k1,ip) ,px(1,k2,ip),px(1,k3,ip),px(1,k4,ip),px(1,k5,ip),
140 . px(1,k6,ip) ,px(1,k7,ip),px(1,k8,ip),px(1,k9,ip),px(1,k10,ip),
141 . py(1,k1,ip) ,py(1,k2,ip),py(1,k3,ip),py(1,k4,ip),py(1,k5,ip),
142 . py(1,k6,ip) ,py(1,k7,ip),py(1,k8,ip),py(1,k9,ip),py(1,k10,ip),
143 . pz(1,k1,ip) ,pz(1,k2,ip),pz(1,k3,ip),pz(1,k4,ip),pz(1,k5,ip),
144 . pz(1,k6,ip) ,pz(1,k7,ip),pz(1,k8,ip),pz(1,k9,ip),pz(1,k10,ip),
145 . nx(1,k1,ip) ,nx(1,k2,ip),nx(1,k3,ip),nx(1,k4,ip),nx(1,k5,ip),
146 . nx(1,k6,ip) ,nx(1,k7,ip),nx(1,k8,ip),nx(1,k9,ip),nx(1,k10,ip),
147 . vol(1,ip) ,lbuf%VOL0DP)
148c
149 ENDDO
150C
151C
152 IF(npt==5)THEN
153 alph = fourth
154 beta = fourth
155 a4 = one
156 b4 = one
157 a4m1 = zero
158 b4m1 = zero
159 w = - four_over_5
160 ip = 5
161C
162 DO n=1,4
163 DO i=1,nel
164 xa(i,n) = zero
165 ya(i,n) = zero
166 za(i,n) = zero
167 ENDDO
168 ENDDO
169CC
170 lbuf => elbuf_str%BUFLY(1)%LBUF(npt,1,1)
171 CALL s10jacob(alph,beta,w,
172 . xa(1,k1),xa(1,k2),xa(1,k3),xa(1,k4),xx(1,k5),
173 . xx(1,k6),xx(1,k7),xx(1,k8),xx(1,k9),xx(1,k10),
174 . xx(1,k8),xx(1,k9),xx(1,k10),
175 . ya(1,k1),ya(1,k2),ya(1,k3),ya(1,k4),yy(1,k5),
176 . yy(1,k6),yy(1,k7),yy(1,k8),yy(1,k9),yy(1,k10),
177 . yy(1,k8),yy(1,k9),yy(1,k10),
178 . za(1,k1),za(1,k2),za(1,k3),za(1,k4),zz(1,k5),
179 . zz(1,k6),zz(1,k7),zz(1,k8),zz(1,k9),zz(1,k10),
180 . zz(1,k8),zz(1,k9),zz(1,k10),
181 . px(1,k1,ip) ,px(1,k2,ip),px(1,k3,ip),px(1,k4,ip),px(1,k5,ip),
182 . px(1,k6,ip) ,px(1,k7,ip),px(1,k8,ip),px(1,k9,ip),px(1,k10,ip),
183 . py(1,k1,ip) ,py(1,k2,ip),py(1,k3,ip),py(1,k4,ip),py(1,k5,ip),
184 . py(1,k6,ip) ,py(1,k7,ip),py(1,k8,ip),py(1,k9,ip),py(1,k10,ip),
185 . pz(1,k1,ip) ,pz(1,k2,ip),pz(1,k3,ip),pz(1,k4,ip),pz(1,k5,ip),
186 . pz(1,k6,ip) ,pz(1,k7,ip),pz(1,k8,ip),pz(1,k9,ip),pz(1,k10,ip),
187 . nx(1,k1,ip) ,nx(1,k2,ip),nx(1,k3,ip),nx(1,k4,ip),nx(1,k5,ip),
188 . nx(1,k6,ip) ,nx(1,k7,ip),nx(1,k8,ip),nx(1,k9,ip),nx(1,k10,ip),
189 . vol(1,ip) ,lbuf%VOL0DP)
190 ENDIF
191C
192 DO ip=1,npt
193 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
194 CALL s10pijsav(px(1,1,ip),py(1,1,ip),pz(1,1,ip),lbuf%PIJ,nel)
195 lbuf%VOL(1:nel)=vol(1:nel,ip)
196 ENDDO
197C
198 RETURN
199C
200 END
my_real
#define my_real
Definition cppsort.cpp:32
s10jaci3
subroutine s10jaci3(elbuf_str, sav, npt, nel)
Definition s10jaci3.F:33
s10jacob
subroutine s10jacob(alph, beta, w, x1b, x2b, x3b, x4a, x5b, x6b, x7b, x8b, x9b, x10b, x8a, x9a, x10a, y1b, y2b, y3b, y4a, y5b, y6b, y7b, y8b, y9b, y10b, y8a, y9a, y10a, z1b, z2b, z3b, z4a, z5b, z6b, z7b, z8b, z9b, z10b, z8a, z9a, z10a, px1, px2, px3, px4, px5, px6, px7, px8, px9, px10, py1, py2, py3, py4, py5, py6, py7, py8, py9, py10, pz1, pz2, pz3, pz4, pz5, pz6, pz7, pz8, pz9, pz10, nx1, nx2, nx3, nx4, nx5, nx6, nx7, nx8, nx9, nx10, vol, voldp)
Definition s10deri3.F:271
s10pijsav
subroutine s10pijsav(px, py, pz, pij, nel)
Definition s10deri3.F:480