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