OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bcs1.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine bcs1v (nindx, indx, iskew, icodt, a, skew, v)

Function/Subroutine Documentation

◆ bcs1v()

subroutine bcs1v ( integer nindx,
integer, dimension(nindx) indx,
integer, dimension(siskew) iskew,
integer, dimension(sicodt) icodt,
a,
skew,
v )

Definition at line 28 of file bcs1.F.

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
my_real
#define my_real
Definition cppsort.cpp:32