OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcs3v.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!|| bcs3v ../engine/source/ale/inter/bcs3v.F
25!||--- called by ------------------------------------------------------
26!|| alesub1 ../engine/source/ale/subcycling/alesub1.F
27!|| alesub2 ../engine/source/ale/subcycling/alesub2.F
28!|| alewdx ../engine/source/ale/grid/alewdx.F
29!||====================================================================
30 SUBROUTINE bcs3v(NINDX,INDX,ISKEW,ICODT,W,V,B)
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 "param_c.inc"
39#include "com04_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER NINDX,INDX(*),ISKEW(*),ICODT(*)
44 my_real w(3,numnod), v(3,numnod), b(lskew,*)
45C-----------------------------------------------
46C L o c a l V a r i a b l e s
47C-----------------------------------------------
48 INTEGER N, K, ISK, LCOD
49 my_real aa
50C-----------------------------------------------
51C S o u r c e L i n e s
52C-----------------------------------------------
53#include "vectorize.inc"
54 DO k = 1, nindx
55 n = indx(k)
56 isk =iskew(n)
57 lcod=icodt(n)
58 IF(isk == 1) THEN
59C------------------
60C GLOBAL FRAME
61C------------------
62 IF(lcod == 1)THEN
63 w(3,n)=v(3,n)
64 ELSEIF(lcod == 2)THEN
65 w(2,n)=v(2,n)
66 ELSEIF(lcod == 3)THEN
67 w(2,n)=v(2,n)
68 w(3,n)=v(3,n)
69 ELSEIF(lcod == 4)THEN
70 w(1,n)=v(1,n)
71 ELSEIF(lcod == 5)THEN
72 w(1,n)=v(1,n)
73 w(3,n)=v(3,n)
74 ELSEIF(lcod == 6)THEN
75 w(1,n)=v(1,n)
76 w(2,n)=v(2,n)
77 ELSEIF(lcod == 7)THEN
78 w(1,n)=v(1,n)
79 w(2,n)=v(2,n)
80 w(3,n)=v(3,n)
81 ENDIF
82 ELSE
83C-------------------
84C OBLIQUE FRAME
85C-------------------
86 IF(lcod == 1)THEN
87 aa =b(7,isk)*(w(1,n)-v(1,n))+b(8,isk)*
88 . (w(2,n)-v(2,n))+b(9,isk)*(w(3,n)-v(3,n))
89 w(1,n)=w(1,n)-b(7,isk)*aa
90 w(2,n)=w(2,n)-b(8,isk)*aa
91 w(3,n)=w(3,n)-b(9,isk)*aa
92 ELSEIF(lcod == 2)THEN
93 aa=b(4,isk)*(w(1,n)-v(1,n))+b(5,isk)*
94 . (w(2,n)-v(2,n))+b(6,isk)*(w(3,n)-v(3,n))
95 w(1,n)=w(1,n)-b(4,isk)*aa
96 w(2,n)=w(2,n)-b(5,isk)*aa
97 w(3,n)=w(3,n)-b(6,isk)*aa
98 ELSEIF(lcod == 3)THEN
99 aa=b(7,isk)*(w(1,n)-v(1,n))+b(8,isk)*
100 . (w(2,n)-v(2,n))+b(9,isk)*(w(3,n)-v(3,n))
101 w(1,n)=w(1,n)-b(7,isk)*aa
102 w(2,n)=w(2,n)-b(8,isk)*aa
103 w(3,n)=w(3,n)-b(9,isk)*aa
104 aa=b(4,isk)*(w(1,n)-v(1,n))+b(5,isk)*
105 . (w(2,n)-v(2,n))+b(6,isk)*(w(3,n)-v(3,n))
106 w(1,n)=w(1,n)-b(4,isk)*aa
107 w(2,n)=w(2,n)-b(5,isk)*aa
108 w(3,n)=w(3,n)-b(6,isk)*aa
109 ELSEIF(lcod == 4)THEN
110 aa=b(1,isk)*(w(1,n)-v(1,n))+b(2,isk)*
111 . (w(2,n)-v(2,n))+b(3,isk)*(w(3,n)-v(3,n))
112 w(1,n)=w(1,n)-b(1,isk)*aa
113 w(2,n)=w(2,n)-b(2,isk)*aa
114 w(3,n)=w(3,n)-b(3,isk)*aa
115 ELSEIF(lcod == 5)THEN
116 aa=b(7,isk)*(w(1,n)-v(1,n))+b(8,isk)*
117 . (w(2,n)-v(2,n))+b(9,isk)*(w(3,n)-v(3,n))
118 w(1,n)=w(1,n)-b(7,isk)*aa
119 w(2,n)=w(2,n)-b(8,isk)*aa
120 w(3,n)=w(3,n)-b(9,isk)*aa
121 aa=b(1,isk)*(w(1,n)-v(1,n))+b(2,isk)*
122 . (w(2,n)-v(2,n))+b(3,isk)*(w(3,n)-v(3,n))
123 w(1,n)=w(1,n)-b(1,isk)*aa
124 w(2,n)=w(2,n)-b(2,isk)*aa
125 w(3,n)=w(3,n)-b(3,isk)*aa
126 ELSEIF(lcod == 6)THEN
127 aa=b(1,isk)*(w(1,n)-v(1,n))+b(2,isk)*
128 . (w(2,n)-v(2,n))+b(3,isk)*(w(3,n)-v(3,n))
129 w(1,n)=w(1,n)-b(1,isk)*aa
130 w(2,n)=w(2,n)-b(2,isk)*aa
131 w(3,n)=w(3,n)-b(3,isk)*aa
132 aa=b(4,isk)*(w(1,n)-v(1,n))+b(5,isk)*
133 . (w(2,n)-v(2,n))+b(6,isk)*(w(3,n)-v(3,n))
134 w(1,n)=w(1,n)-b(4,isk)*aa
135 w(2,n)=w(2,n)-b(5,isk)*aa
136 w(3,n)=w(3,n)-b(6,isk)*aa
137 ELSEIF(lcod == 7)THEN
138 w(1,n)=v(1,n)
139 w(2,n)=v(2,n)
140 w(3,n)=v(3,n)
141 ENDIF
142 END IF
143 ENDDO
144C
145 RETURN
146 END
bcs3v
subroutine bcs3v(nindx, indx, iskew, icodt, w, v, b)
Definition bcs3v.F:31
my_real
#define my_real
Definition cppsort.cpp:32