OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_bcs1th.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!|| sms_bcs1th ../engine/source/ams/sms_bcs1th.F
25!||--- called by ------------------------------------------------------
26!|| sms_thbcs ../engine/source/ams/sms_thbcs.F
27!||====================================================================
28 SUBROUTINE sms_bcs1th(NINDX ,INDX ,ISKEW ,ICODT ,A ,
29 2 SKEW ,FTHREAC,NODREAC,FLAG )
30C
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33#include "implicit_f.inc"
34C-----------------------------------------------
35C C o m m o n B l o c k s
36C-----------------------------------------------
37#include "com08_c.inc"
38#include "param_c.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER NINDX, INDX(*), ISKEW(*), ICODT(*),NODREAC(*), FLAG
43 my_real
44 . a(3,*), skew(lskew,*),fthreac(6,*)
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48 INTEGER N, K, L, ISK, LCOD
49 my_real
50 . aa,fthreac0(6)
51C-----------------------------------------------
52 IF (flag == 0) n = 0
53 IF (flag == 1) n = 3
54C
55#include "vectorize.inc"
56 DO k = 1, nindx
57 l = indx(k)
58 isk = iskew(l)
59 lcod = icodt(l)
60 fthreac0 = zero
61C
62 IF(isk==1) THEN
63C------------------
64C REPERE GLOBAL
65C------------------
66 IF(lcod==1)THEN
67 fthreac0(n+3) = - a(3,l)
68 ELSEIF(lcod==2)THEN
69 fthreac0(n+2) = - a(2,l)
70 ELSEIF(lcod==3)THEN
71 fthreac0(n+2) = - a(2,l)
72 fthreac0(n+3) = - a(3,l)
73 ELSEIF(lcod==4)THEN
74 fthreac0(n+1) = - a(1,l)
75 ELSEIF(lcod==5)THEN
76 fthreac0(n+1) = - a(1,l)
77 fthreac0(n+3) = - a(3,l)
78 ELSEIF(lcod==6)THEN
79 fthreac0(n+1) = - a(1,l)
80 fthreac0(n+2) = - a(2,l)
81 ELSEIF(lcod==7)THEN
82 fthreac0(n+1) = - a(1,l)
83 fthreac0(n+2) = - a(2,l)
84 fthreac0(n+3) = - a(3,l)
85 ENDIF
86C
87 ELSE
88C-------------------
89C REPERE OBLIQUE
90C-------------------
91 IF(lcod==1)THEN
92 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
93 fthreac0(n+1)=-skew(7,isk)*aa
94 fthreac0(n+2)=-skew(8,isk)*aa
95 fthreac0(n+3)=-skew(9,isk)*aa
96 ELSEIF(lcod==2)THEN
97 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
98 fthreac0(n+1)=-skew(4,isk)*aa
99 fthreac0(n+2)=-skew(5,isk)*aa
100 fthreac0(n+3)=-skew(6,isk)*aa
101 ELSEIF(lcod==3)THEN
102 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
103 fthreac0(n+1)=-skew(7,isk)*aa
104 fthreac0(n+2)=-skew(8,isk)*aa
105 fthreac0(n+3)=-skew(9,isk)*aa
106 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
107 fthreac0(n+1)=fthreac(n+1,nodreac(l))-skew(4,isk)*aa
108 fthreac0(n+2)=fthreac(n+2,nodreac(l))-skew(5,isk)*aa
109 fthreac0(n+3)=fthreac(n+3,nodreac(l))-skew(6,isk)*aa
110 ELSEIF(lcod==4)THEN
111 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
112 fthreac0(n+1)=-skew(1,isk)*aa
113 fthreac0(n+2)=-skew(2,isk)*aa
114 fthreac0(n+3)=-skew(3,isk)*aa
115 ELSEIF(lcod==5)THEN
116 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
117 fthreac0(n+1)=-skew(7,isk)*aa
118 fthreac0(n+2)=-skew(8,isk)*aa
119 fthreac0(n+3)=-skew(9,isk)*aa
120 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
121 fthreac0(n+1)=fthreac(n+1,nodreac(l))-skew(1,isk)*aa
122 fthreac0(n+2)=fthreac(n+2,nodreac(l))-skew(2,isk)*aa
123 fthreac0(n+3)=fthreac(n+3,nodreac(l))-skew(3,isk)*aa
124 ELSEIF(lcod==6)THEN
125 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
126 fthreac0(n+1)=-skew(1,isk)*aa
127 fthreac0(n+2)=-skew(2,isk)*aa
128 fthreac0(n+3)=-skew(3,isk)*aa
129 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
130 fthreac0(n+1)=fthreac(n+1,nodreac(l))-skew(4,isk)*aa
131 fthreac0(n+2)=fthreac(n+2,nodreac(l))-skew(5,isk)*aa
132 fthreac0(n+3)=fthreac(n+3,nodreac(l))-skew(6,isk)*aa
133 ELSEIF(lcod==7)THEN
134 fthreac0(n+1) = - a(1,l)
135 fthreac0(n+2) = - a(2,l)
136 fthreac0(n+3) = - a(3,l)
137 ENDIF
138C
139 ENDIF
140C
141 fthreac(n+1,nodreac(l)) = fthreac(n+1,nodreac(l))
142 . + fthreac0(n+1)*dt12
143 fthreac(n+2,nodreac(l)) = fthreac(n+2,nodreac(l))
144 . + fthreac0(n+2)*dt12
145 fthreac(n+3,nodreac(l)) = fthreac(n+3,nodreac(l))
146 . + fthreac0(n+3)*dt12
147C
148 ENDDO
149C
150 RETURN
151 END
152C
153!||====================================================================
154!|| sms_bcs1an ../engine/source/ams/sms_bcs1th.F
155!||====================================================================
156 SUBROUTINE sms_bcs1an(NINDX ,INDX ,ISKEW ,ICODT ,A ,
157 2 SKEW ,FANREAC,FLAG )
158
159C I m p l i c i t T y p e s
160C-----------------------------------------------
161#include "implicit_f.inc"
162C-----------------------------------------------
163C D u m m y A r g u m e n t s
164C-----------------------------------------------
165 INTEGER NINDX, INDX(*), ISKEW(*), ICODT(*), FLAG
166 my_real
167 . a(3,*), skew(lskew,*),fanreac(6,*)
168C-----------------------------------------------
169C C o m m o n B l o c k s
170C-----------------------------------------------
171#include "param_c.inc"
172C-----------------------------------------------
173C L o c a l V a r i a b l e s
174C-----------------------------------------------
175 INTEGER N, K, L, ISK, LCOD
176 my_real
177 . aa,fanreac0(6)
178C-----------------------------------------------
179C
180 IF (flag == 0) n = 0
181 IF (flag == 1) n = 3
182C
183#include "vectorize.inc"
184 DO k = 1, nindx
185 l = indx(k)
186 isk = iskew(l)
187 lcod = icodt(l)
188 fanreac0 = zero
189C
190 IF(isk==1) THEN
191C------------------
192C REPERE GLOBAL
193C------------------
194 IF(lcod==1)THEN
195 fanreac0(n+3) = - a(3,l)
196 ELSEIF(lcod==2)THEN
197 fanreac0(2) = - a(2,l)
198 ELSEIF(lcod==3)THEN
199 fanreac0(n+2) = - a(2,l)
200 fanreac0(n+3) = - a(3,l)
201 ELSEIF(lcod==4)THEN
202 fanreac0(n+1) = - a(1,l)
203 ELSEIF(lcod==5)THEN
204 fanreac0(n+1) = - a(1,l)
205 fanreac0(n+3) = - a(3,l)
206 ELSEIF(lcod==6)THEN
207 fanreac0(n+1) = - a(1,l)
208 fanreac0(n+2) = - a(2,l)
209 ELSEIF(lcod==7)THEN
210 fanreac0(n+1) = - a(1,l)
211 fanreac0(n+2) = - a(2,l)
212 fanreac0(n+3) = - a(3,l)
213 ENDIF
214C
215 ELSE
216C-------------------
217C REPERE OBLIQUE
218C-------------------
219 IF(lcod==1)THEN
220 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
221 fanreac0(n+1)=-skew(7,isk)*aa
222 fanreac0(n+2)=-skew(8,isk)*aa
223 fanreac0(n+3)=-skew(9,isk)*aa
224 ELSEIF(lcod==2)THEN
225 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
226 fanreac0(n+1)=-skew(4,isk)*aa
227 fanreac0(n+2)=-skew(5,isk)*aa
228 fanreac0(n+3)=-skew(6,isk)*aa
229 ELSEIF(lcod==3)THEN
230 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
231 fanreac0(n+1)=-skew(7,isk)*aa
232 fanreac0(n+2)=-skew(8,isk)*aa
233 fanreac0(n+3)=-skew(9,isk)*aa
234 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
235 fanreac0(n+1)=fanreac0(n+1)-skew(4,isk)*aa
236 fanreac0(n+2)=fanreac0(n+2)-skew(5,isk)*aa
237 fanreac0(n+3)=fanreac0(n+3)-skew(6,isk)*aa
238 ELSEIF(lcod==4)THEN
239 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
240 fanreac0(n+1)=-skew(1,isk)*aa
241 fanreac0(n+2)=-skew(2,isk)*aa
242 fanreac0(n+3)=-skew(3,isk)*aa
243 ELSEIF(lcod==5)THEN
244 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
245 fanreac0(n+1)=-skew(7,isk)*aa
246 fanreac0(n+2)=-skew(8,isk)*aa
247 fanreac0(n+3)=-skew(9,isk)*aa
248 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
249 fanreac0(n+1)=fanreac0(n+1)-skew(1,isk)*aa
250 fanreac0(n+2)=fanreac0(n+2)-skew(2,isk)*aa
251 fanreac0(n+3)=fanreac0(n+3)-skew(3,isk)*aa
252 ELSEIF(lcod==6)THEN
253 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
254 fanreac0(n+1)=-skew(1,isk)*aa
255 fanreac0(n+2)=-skew(2,isk)*aa
256 fanreac0(n+3)=-skew(3,isk)*aa
257 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
258 fanreac0(n+1)=fanreac0(n+1)-skew(4,isk)*aa
259 fanreac0(n+2)=fanreac0(n+2)-skew(5,isk)*aa
260 fanreac0(n+3)=fanreac0(n+3)-skew(6,isk)*aa
261 ELSEIF(lcod==7)THEN
262 fanreac0(n+1) = - a(1,l)
263 fanreac0(n+2) = - a(2,l)
264 fanreac0(n+3) = - a(3,l)
265 ENDIF
266C
267 ENDIF
268C
269 fanreac(n+1,l) = fanreac(n+1,l) + fanreac0(n+1)
270 fanreac(n+2,l) = fanreac(n+2,l) + fanreac0(n+2)
271 fanreac(n+3,l) = fanreac(n+3,l) + fanreac0(n+3)
272C
273 ENDDO
274C
275 RETURN
276 END
277
278
279
my_real
#define my_real
Definition cppsort.cpp:32
sms_bcs1th
subroutine sms_bcs1th(nindx, indx, iskew, icodt, a, skew, fthreac, nodreac, flag)
Definition sms_bcs1th.F:30
sms_bcs1an
subroutine sms_bcs1an(nindx, indx, iskew, icodt, a, skew, fanreac, flag)
Definition sms_bcs1th.F:158