OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10jacob.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!|| s10jacob ../engine/source/elements/solid/solide10/s10jacob.F
25!||--- called by ------------------------------------------------------
26!|| s10deri3 ../engine/source/elements/solid/solide10/s10deri3.F
27!|| s10derit3 ../engine/source/elements/solid/solide10/s10derit3.F
28!||====================================================================
29 SUBROUTINE s10jacob(
30 1 ALPH, BETA, W, X1B,
31 2 X2B, X3B, X4A, X5B,
32 3 X6B, X7B, X8B, X9B,
33 4 X10B, X8A, X9A, X10A,
34 5 Y1B, Y2B, Y3B, Y4A,
35 6 Y5B, Y6B, Y7B, Y8B,
36 7 Y9B, Y10B, Y8A, Y9A,
37 8 Y10A, Z1B, Z2B, Z3B,
38 9 Z4A, Z5B, Z6B, Z7B,
39 A Z8B, Z9B, Z10B, Z8A,
40 B Z9A, Z10A, PX1, PX2,
41 C PX3, PX4, PX5, PX6,
42 D PX7, PX8, PX9, PX10,
43 E PY1, PY2, PY3, PY4,
44 F PY5, PY6, PY7, PY8,
45 G PY9, PY10, PZ1, PZ2,
46 H PZ3, PZ4, PZ5, PZ6,
47 I PZ7, PZ8, PZ9, PZ10,
48 J NX1, NX2, NX3, NX4,
49 K NX5, NX6, NX7, NX8,
50 L NX9, NX10, VOL, VOLDP,
51 M NEL, OFFG)
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63C REAL
64 double precision
65 . x1b(mvsiz),x2b(mvsiz),x3b(mvsiz),x4a(mvsiz),x5b(mvsiz),
66 . x6b(mvsiz),x7b(mvsiz),x8b(mvsiz),x9b(mvsiz),x10b(mvsiz),
67 . x8a(mvsiz),x9a(mvsiz),x10a(mvsiz),
68 . y1b(mvsiz),y2b(mvsiz),y3b(mvsiz),y4a(mvsiz),y5b(mvsiz),
69 . y6b(mvsiz),y7b(mvsiz),y8b(mvsiz),y9b(mvsiz),y10b(mvsiz),
70 . y8a(mvsiz),y9a(mvsiz),y10a(mvsiz),
71 . z1b(mvsiz),z2b(mvsiz),z3b(mvsiz),z4a(mvsiz),z5b(mvsiz),
72 . z6b(mvsiz),z7b(mvsiz),z8b(mvsiz),z9b(mvsiz),z10b(mvsiz),
73 . z8a(mvsiz),z9a(mvsiz),z10a(mvsiz),voldp(*)
74
75 INTEGER, INTENT(IN) :: NEL ! number of element in the current group
76 my_real, DIMENSION(NEL), INTENT(IN) :: OFFG ! off array : 0 if the element is deleted
77
78 my_real
79 . PX1(MVSIZ),PX2(MVSIZ),PX3(MVSIZ),PX4(MVSIZ),PX5(MVSIZ),
80 . PX6(MVSIZ),PX7(MVSIZ),PX8(MVSIZ),PX9(MVSIZ),PX10(MVSIZ),
81 . PY1(MVSIZ),PY2(MVSIZ),PY3(MVSIZ),PY4(MVSIZ),PY5(MVSIZ),
82 . PY6(MVSIZ),PY7(MVSIZ),PY8(MVSIZ),PY9(MVSIZ),PY10(MVSIZ),
83 . PZ1(MVSIZ),PZ2(MVSIZ),PZ3(MVSIZ),PZ4(MVSIZ),PZ5(MVSIZ),
84 . PZ6(MVSIZ),PZ7(MVSIZ),PZ8(MVSIZ),PZ9(MVSIZ),PZ10(MVSIZ),
85 . NX1(MVSIZ),NX2(MVSIZ),NX3(MVSIZ),NX4(MVSIZ),NX5(MVSIZ),
86 . nx6(mvsiz),nx7(mvsiz),nx8(mvsiz),nx9(mvsiz),nx10(mvsiz),
87 . vol(mvsiz),alph,beta,w
88C-----------------------------------------------
89C C o m m o n B l o c k s
90C-----------------------------------------------
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94 INTEGER I
95C REAL
96 DOUBLE PRECISION
97c my_real
98 . d,a4mb4,a4,b4,bb,ab,b2,a4_0,b4_0,
99 . dxdr,dxds,dxdt,dydr,dyds,dydt,dzdr,dzds,dzdt
100
101 DOUBLE PRECISION
102 . AA,A4M1,B4M1
103
104c my_real
105 DOUBLE PRECISION
106 . DRDX, DSDX, DTDX,
107 . DRDY, DSDY, DTDY,
108 . DRDZ, DSDZ, DTDZ,
109 . DET,WUNSIX
110C-----------------------------------------------
111c AA = (TWO*ALPH - ONE)*ALPH
112c BB = (TWO*BETA - ONE)*BETA
113c B2 = FOUR*BETA*BETA
114c AB = FOUR*ALPH*BETA
115cC-----------------------------------------------
116c DO I=1,NEL
117c NX1(I) = BB
118c NX2(I) = BB
119c NX3(I) = BB
120c NX4(I) = AA
121c NX5(I) = B2
122c NX6(I) = B2
123c NX7(I) = B2
124c NX8(I) = AB
125c NX9(I) = AB
126c NX10(I)= AB
127c ENDDO
128C
129 a4_0 = four * alph
130 b4_0 = four * beta
131 wunsix = w*one_over_6
132#include "nofusion.inc"
133 DO i=1,nel
134 aa = x5b(i) + x6b(i) + x7b(i)
135 . - x4a(i) - x8b(i) - x9b(i) - x10b(i)
136 dxdr = x1b(i) +x8a(i) - x6b(i) + aa
137 dxds = x2b(i) +x9a(i) - x7b(i) + aa
138 dxdt = x3b(i) +x10a(i)- x5b(i) + aa
139C
140 aa = y5b(i) + y6b(i) + y7b(i)
141 . - y4a(i) - y8b(i) - y9b(i) - y10b(i)
142 dydr = y1b(i) +y8a(i) - y6b(i) + aa
143 dyds = y2b(i) +y9a(i) - y7b(i) + aa
144 dydt = y3b(i) +y10a(i)- y5b(i) + aa
145C
146 aa = z5b(i) + z6b(i) + z7b(i)
147 . - z4a(i) - z8b(i) - z9b(i) - z10b(i)
148 dzdr = z1b(i) +z8a(i) - z6b(i) + aa
149 dzds = z2b(i) +z9a(i) - z7b(i) + aa
150 dzdt = z3b(i) +z10a(i)- z5b(i) + aa
151C
152 drdx=dyds*dzdt-dzds*dydt
153 dsdx=dydt*dzdr-dzdt*dydr
154 dtdx=dydr*dzds-dzdr*dyds
155C
156 drdy=dzds*dxdt-dxds*dzdt
157 dsdy=dzdt*dxdr-dxdt*dzdr
158 dtdy=dzdr*dxds-dxdr*dzds
159C
160 drdz=dxds*dydt-dyds*dxdt
161 dsdz=dxdt*dydr-dydt*dxdr
162 dtdz=dxdr*dyds-dydr*dxds
163C
164 det = dxdr * drdx + dydr * drdy + dzdr * drdz
165 ! check if the element is deleted : if it's true, need to force det to 1
166 IF(offg(i)==zero) det = one
167 d = one/max(em30,det)
168C
169c A4 = FOUR * ALPH
170c B4 = FOUR * BETA
171 a4m1 = d *(a4_0 - one)
172 b4m1 = d *(b4_0 - one)
173!
174 b4 = d * b4_0
175 a4 = d * a4_0
176 a4mb4 = a4 - b4
177 voldp(i) = wunsix * det
178 vol(i) = voldp(i)
179C
180 px1(i) = b4m1 * drdx
181 py1(i) = b4m1 * drdy
182 pz1(i) = b4m1 * drdz
183C
184 px2(i) = b4m1 * dsdx
185 py2(i) = b4m1 * dsdy
186 pz2(i) = b4m1 * dsdz
187C
188 px3(i) = b4m1 * dtdx
189 py3(i) = b4m1 * dtdy
190 pz3(i) = b4m1 * dtdz
191C
192 px4(i) =-a4m1 * (drdx+dsdx+dtdx)
193 py4(i) =-a4m1 * (drdy+dsdy+dtdy)
194 pz4(i) =-a4m1 * (drdz+dsdz+dtdz)
195C
196 px5(i) = b4 * (drdx+dsdx)
197 py5(i) = b4 * (drdy+dsdy)
198 pz5(i) = b4 * (drdz+dsdz)
199C
200 px6(i) = b4 * (dsdx+dtdx)
201 py6(i) = b4 * (dsdy+dtdy)
202 pz6(i) = b4 * (dsdz+dtdz)
203C
204 px7(i) = b4 * (dtdx+drdx)
205 py7(i) = b4 * (dtdy+drdy)
206 pz7(i) = b4 * (dtdz+drdz)
207C
208 px8(i) = a4mb4 * drdx - px6(i)
209 py8(i) = a4mb4 * drdy - py6(i)
210 pz8(i) = a4mb4 * drdz - pz6(i)
211C
212 px9(i) = a4mb4 * dsdx - px7(i)
213 py9(i) = a4mb4 * dsdy - py7(i)
214 pz9(i) = a4mb4 * dsdz - pz7(i)
215C
216 px10(i)= a4mb4 * dtdx - px5(i)
217 py10(i)= a4mb4 * dtdy - py5(i)
218 pz10(i)= a4mb4 * dtdz - pz5(i)
219C
220 ENDDO
221C
222 RETURN
223 END
#define max(a, b)
Definition macros.h:21
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, nel, offg)
Definition s10jacob.F:52