OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sctorth3.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!||====================================================================
25!|| sctorth3 ../engine/source/elements/thickshell/solide8c/sctorth3.F
26!||--- called by ------------------------------------------------------
27!|| s8cforc3 ../engine/source/elements/thickshell/solide8c/s8cforc3.F
28!||====================================================================
29 SUBROUTINE sctorth3(
30 1 JFT, JLT, ICSTR, NEL,
31 2 RX, RY, RZ, SX,
32 3 SY, SZ, TX, TY,
33 4 TZ, E1X, E1Y, E1Z,
34 5 E2X, E2Y, E2Z, E3X,
35 6 E3Y, E3Z, G1X, G1Y,
36 7 G1Z, G2X, G2Y, G2Z,
37 8 G3X, G3Y, G3Z, GAMA,
38 9 IREP)
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER, INTENT(IN) :: IREP
51 INTEGER JFT, JLT,ICSTR,NEL
52C REAL
53 my_real
54 . RX(*) ,RY(*) ,RZ(*) ,SX(*) ,SY(*) ,SZ(*) ,TX(*) ,TY(*) ,TZ(*),
55 . E1X(*),E1Y(*),E1Z(*),E2X(*),E2Y(*),E2Z(*),E3X(*),E3Y(*),E3Z(*),
56 . G1X(*),G1Y(*),G1Z(*),
57 . G2X(*),G2Y(*),G2Z(*),G3X(*),G3Y(*),G3Z(*),GAMA(NEL,6)
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I
65C REAL
66 my_real
67 . V1,V2,V3,VR,VS,AA,BB,SUMA,CPN(MVSIZ),SPN(MVSIZ)
68C-----------------------------------------------
69 IF(IREP == 0) then
70 cpn(jft:jlt) = gama(jft:jlt,1)
71 spn(jft:jlt) = gama(jft:jlt,2)
72 ELSE
73 SELECT CASE (icstr)
74 CASE (1)
75 DO i=jft,jlt
76 aa = gama(i,1)
77 bb = gama(i,2)
78 v1 = aa*rx(i) + bb*sx(i)
79 v2 = aa*ry(i) + bb*sy(i)
80 v3 = aa*rz(i) + bb*sz(i)
81 vr=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
82 vs=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
83 suma=sqrt(vr*vr + vs*vs)
84 suma=one/max(em20,suma)
85 cpn(i) = vr*suma
86 spn(i) = vs*suma
87 ENDDO
88 CASE (100)
89 DO i=jft,jlt
90 aa = gama(i,1)
91 bb = gama(i,2)
92 v1 = aa*sx(i) + bb*tx(i)
93 v2 = aa*sy(i) + bb*ty(i)
94 v3 = aa*sz(i) + bb*tz(i)
95 vr=v1*e3x(i)+v2*e3y(i)+v3*e3z(i)
96 vs=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
97 suma=sqrt(vr*vr + vs*vs)
98 suma=one/max(em20,suma)
99 cpn(i) = vr*suma
100 spn(i) = vs*suma
101 ENDDO
102 CASE (10)
103 DO i=jft,jlt
104 aa = gama(i,1)
105 bb = gama(i,2)
106 v1 = aa*tx(i) + bb*rx(i)
107 v2 = aa*ty(i) + bb*ry(i)
108 v3 = aa*tz(i) + bb*rz(i)
109 vr=v1*e1x(i)+v2*e1y(i)+v3*e1z(i)
110 vs=v1*e2x(i)+v2*e2y(i)+v3*e2z(i)
111 suma=sqrt(vr*vr + vs*vs)
112 suma=one/max(em20,suma)
113 cpn(i) = vr*suma
114 spn(i) = vs*suma
115 ENDDO
116 END SELECT
117 ENDIF
118C
119 SELECT CASE (icstr)
120 CASE (1)
121 g1x(jft:jlt)=zero
122 g1y(jft:jlt)=cpn(jft:jlt)
123 g1z(jft:jlt)=spn(jft:jlt)
124 g2x(jft:jlt)=zero
125 g2y(jft:jlt)=-spn(jft:jlt)
126 g2z(jft:jlt)=cpn(jft:jlt)
127 g3x(jft:jlt)=one
128 g3y(jft:jlt)=zero
129 g3z(jft:jlt)=zero
130 CASE (100)
131 g1x(jft:jlt)=spn(jft:jlt)
132 g1y(jft:jlt)=zero
133 g1z(jft:jlt)=cpn(jft:jlt)
134 g2x(jft:jlt)=cpn(jft:jlt)
135 g2y(jft:jlt)=zero
136 g2z(jft:jlt)=-spn(jft:jlt)
137 g3x(jft:jlt)=zero
138 g3y(jft:jlt)=one
139 g3z(jft:jlt)=zero
140 CASE (10)
141 g1x(jft:jlt)=cpn(jft:jlt)
142 g1y(jft:jlt)=spn(jft:jlt)
143 g1z(jft:jlt)=zero
144 g2x(jft:jlt)=-spn(jft:jlt)
145 g2y(jft:jlt)=cpn(jft:jlt)
146 g2z(jft:jlt)= zero
147 g3x(jft:jlt)= zero
148 g3y(jft:jlt)= zero
149 g3z(jft:jlt)= one
150 END SELECT
151C----------
152 RETURN
153 END
max
#define max(a, b)
Definition macros.h:21
sctorth3
subroutine sctorth3(jft, jlt, icstr, nel, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, gama, irep)
Definition sctorth3.F:39