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