OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcs1.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!|| bcs1v ../engine/source/constraints/general/bcs/bcs1.F
25!||--- called by ------------------------------------------------------
26!|| bcs10 ../engine/source/constraints/general/bcs/bcs10.F
27!||====================================================================
28 SUBROUTINE bcs1v(NINDX,INDX,ISKEW,ICODT,A,
29 . SKEW ,V )
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 "com04_c.inc"
38#include "param_c.inc"
39#include "tabsiz_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER NINDX, INDX(NINDX), ISKEW(SISKEW), ICODT(SICODT)
44 my_real a(3,numnod), v(3,numnod), skew(lskew,sskew/lskew)
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48 INTEGER K, L, ISK, LCOD
49 my_real aa, vv
50C-----------------------------------------------
51#include "vectorize.inc"
52 DO k = 1, nindx
53 l = indx(k)
54 isk =iskew(l)
55 lcod=icodt(l)
56 IF(isk==1) THEN
57C------------------
58C GLOBAL SYSTEM
59C------------------
60 IF(lcod==1)THEN
61 v(3,l)=zero
62 a(3,l)=zero
63 ELSEIF(lcod==2)THEN
64 v(2,l)=zero
65 a(2,l)=zero
66 ELSEIF(lcod==3)THEN
67 v(2,l)=zero
68 v(3,l)=zero
69 a(2,l)=zero
70 a(3,l)=zero
71 ELSEIF(lcod==4)THEN
72 v(1,l)=zero
73 a(1,l)=zero
74 ELSEIF(lcod==5)THEN
75 v(1,l)=zero
76 v(3,l)=zero
77 a(1,l)=zero
78 a(3,l)=zero
79 ELSEIF(lcod==6)THEN
80 v(1,l)=zero
81 v(2,l)=zero
82 a(1,l)=zero
83 a(2,l)=zero
84 ELSEIF(lcod==7)THEN
85 v(1,l)=zero
86 v(2,l)=zero
87 v(3,l)=zero
88 a(1,l)=zero
89 a(2,l)=zero
90 a(3,l)=zero
91 ENDIF
92C
93 ELSE
94C-------------------
95C USER SYSTEM
96C-------------------
97 IF(lcod==1)THEN
98 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
99 vv =skew(7,isk)*v(1,l)+skew(8,isk)*v(2,l)+skew(9,isk)*v(3,l)
100 a(1,l)=a(1,l)-skew(7,isk)*aa
101 a(2,l)=a(2,l)-skew(8,isk)*aa
102 a(3,l)=a(3,l)-skew(9,isk)*aa
103 v(1,l)=v(1,l)-skew(7,isk)*vv
104 v(2,l)=v(2,l)-skew(8,isk)*vv
105 v(3,l)=v(3,l)-skew(9,isk)*vv
106 ELSEIF(lcod==2)THEN
107 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
108 vv =skew(4,isk)*v(1,l)+skew(5,isk)*v(2,l)+skew(6,isk)*v(3,l)
109 a(1,l)=a(1,l)-skew(4,isk)*aa
110 a(2,l)=a(2,l)-skew(5,isk)*aa
111 a(3,l)=a(3,l)-skew(6,isk)*aa
112 v(1,l)=v(1,l)-skew(4,isk)*vv
113 v(2,l)=v(2,l)-skew(5,isk)*vv
114 v(3,l)=v(3,l)-skew(6,isk)*vv
115 ELSEIF(lcod==3)THEN
116 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
117 vv =skew(7,isk)*v(1,l)+skew(8,isk)*v(2,l)+skew(9,isk)*v(3,l)
118 a(1,l)=a(1,l)-skew(7,isk)*aa
119 a(2,l)=a(2,l)-skew(8,isk)*aa
120 a(3,l)=a(3,l)-skew(9,isk)*aa
121 v(1,l)=v(1,l)-skew(7,isk)*vv
122 v(2,l)=v(2,l)-skew(8,isk)*vv
123 v(3,l)=v(3,l)-skew(9,isk)*vv
124 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
125 vv =skew(4,isk)*v(1,l)+skew(5,isk)*v(2,l)+skew(6,isk)*v(3,l)
126 a(1,l)=a(1,l)-skew(4,isk)*aa
127 a(2,l)=a(2,l)-skew(5,isk)*aa
128 a(3,l)=a(3,l)-skew(6,isk)*aa
129 v(1,l)=v(1,l)-skew(4,isk)*vv
130 v(2,l)=v(2,l)-skew(5,isk)*vv
131 v(3,l)=v(3,l)-skew(6,isk)*vv
132 ELSEIF(lcod==4)THEN
133 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
134 vv =skew(1,isk)*v(1,l)+skew(2,isk)*v(2,l)+skew(3,isk)*v(3,l)
135 a(1,l)=a(1,l)-skew(1,isk)*aa
136 a(2,l)=a(2,l)-skew(2,isk)*aa
137 a(3,l)=a(3,l)-skew(3,isk)*aa
138 v(1,l)=v(1,l)-skew(1,isk)*vv
139 v(2,l)=v(2,l)-skew(2,isk)*vv
140 v(3,l)=v(3,l)-skew(3,isk)*vv
141 ELSEIF(lcod==5)THEN
142 aa =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
143 vv =skew(7,isk)*v(1,l)+skew(8,isk)*v(2,l)+skew(9,isk)*v(3,l)
144 a(1,l)=a(1,l)-skew(7,isk)*aa
145 a(2,l)=a(2,l)-skew(8,isk)*aa
146 a(3,l)=a(3,l)-skew(9,isk)*aa
147 v(1,l)=v(1,l)-skew(7,isk)*vv
148 v(2,l)=v(2,l)-skew(8,isk)*vv
149 v(3,l)=v(3,l)-skew(9,isk)*vv
150 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
151 vv =skew(1,isk)*v(1,l)+skew(2,isk)*v(2,l)+skew(3,isk)*v(3,l)
152 a(1,l)=a(1,l)-skew(1,isk)*aa
153 a(2,l)=a(2,l)-skew(2,isk)*aa
154 a(3,l)=a(3,l)-skew(3,isk)*aa
155 v(1,l)=v(1,l)-skew(1,isk)*vv
156 v(2,l)=v(2,l)-skew(2,isk)*vv
157 v(3,l)=v(3,l)-skew(3,isk)*vv
158 ELSEIF(lcod==6)THEN
159 aa =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
160 vv =skew(1,isk)*v(1,l)+skew(2,isk)*v(2,l)+skew(3,isk)*v(3,l)
161 a(1,l)=a(1,l)-skew(1,isk)*aa
162 a(2,l)=a(2,l)-skew(2,isk)*aa
163 a(3,l)=a(3,l)-skew(3,isk)*aa
164 v(1,l)=v(1,l)-skew(1,isk)*vv
165 v(2,l)=v(2,l)-skew(2,isk)*vv
166 v(3,l)=v(3,l)-skew(3,isk)*vv
167 aa =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
168 vv =skew(4,isk)*v(1,l)+skew(5,isk)*v(2,l)+skew(6,isk)*v(3,l)
169 a(1,l)=a(1,l)-skew(4,isk)*aa
170 a(2,l)=a(2,l)-skew(5,isk)*aa
171 a(3,l)=a(3,l)-skew(6,isk)*aa
172 v(1,l)=v(1,l)-skew(4,isk)*vv
173 v(2,l)=v(2,l)-skew(5,isk)*vv
174 v(3,l)=v(3,l)-skew(6,isk)*vv
175 ELSEIF(lcod==7)THEN
176 a(1,l)=zero
177 a(2,l)=zero
178 a(3,l)=zero
179 v(1,l)=zero
180 v(2,l)=zero
181 v(3,l)=zero
182 ENDIF
183C
184 END IF
185C
186 ENDDO
187C
188 RETURN
189 END
bcs1v
subroutine bcs1v(nindx, indx, iskew, icodt, a, skew, v)
Definition bcs1.F:30
my_real
#define my_real
Definition cppsort.cpp:32