OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
kine_seatbelt_vel.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr05_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine kine_seatbelt_vel (a, v, x, xdp)

Function/Subroutine Documentation

◆ kine_seatbelt_vel()

subroutine kine_seatbelt_vel ( dimension(3,numnod), intent(inout) a,
dimension(3,numnod), intent(inout) v,
dimension(3,numnod), intent(inout) x,
double precision, dimension(3,numnod), intent(inout) xdp )

Definition at line 31 of file kine_seatbelt_vel.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE elbufdef_mod
36 USE seatbelt_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "scr05_c.inc"
46#include "param_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 my_real, INTENT(INOUT) :: a(3,numnod),v(3,numnod),x(3,numnod)
51 DOUBLE PRECISION, INTENT(INOUT) :: XDP(3,NUMNOD)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I,J,K,L,NODE1,NODE2,NODE3,ANCHOR_NODE,NODE2_N,ORIENTATION_NODE,SWIP,INDEX
56 my_real nn(3),norm,scal,n1(3),n2(3),n3(3)
57C---------------------------------------------------------
58C
59C----------------------------------------------------------
60C- KINEMATIC CONDITION OF SLIPRING - FORCE TRANSFER
61C----------------------------------------------------------
62
63 DO i=1,nslipring
64C
65 DO j=1,slipring(i)%NFRAM
66C
67 anchor_node = slipring(i)%FRAM(j)%ANCHOR_NODE
68 orientation_node = slipring(i)%FRAM(j)%ORIENTATION_NODE
69 node1 = slipring(i)%FRAM(j)%NODE(1)
70 node2 = slipring(i)%FRAM(j)%NODE(2)
71 node3 = slipring(i)%FRAM(j)%NODE(3)
72C
73 IF (orientation_node > 0) THEN
74C--- update of orientation angle
75 nn(1) = x(1,orientation_node) - x(1,anchor_node)
76 nn(2) = x(2,orientation_node) - x(2,anchor_node)
77 nn(3) = x(3,orientation_node) - x(3,anchor_node)
78 norm = sqrt(max(em30,nn(1)*nn(1)+nn(2)*nn(2)+nn(3)*nn(3)))
79 nn(1) = nn(1) / norm
80 nn(2) = nn(2) / norm
81 nn(3) = nn(3) / norm
82C
83 n1(1) = x(1,node1) - x(1,node2)
84 n1(2) = x(2,node1) - x(2,node2)
85 n1(3) = x(3,node1) - x(3,node2)
86 norm = sqrt(max(em30,n1(1)*n1(1)+n1(2)*n1(2)+n1(3)*n1(3)))
87 n1(1) = n1(1) / norm
88 n1(2) = n1(2) / norm
89 n1(3) = n1(3) / norm
90C
91 n2(1) = x(1,node3) - x(1,node2)
92 n2(2) = x(2,node3) - x(2,node2)
93 n2(3) = x(3,node3) - x(3,node2)
94 norm = sqrt(max(em30,n2(1)*n2(1)+n2(2)*n2(2)+n2(3)*n2(3)))
95 n2(1) = n2(1) / norm
96 n2(2) = n2(2) / norm
97 n2(3) = n2(3) / norm
98C
99 n3(1) = n1(2)*n2(3)-n1(3)*n2(2)
100 n3(2) = n1(3)*n2(1)-n1(1)*n2(3)
101 n3(3) = n1(1)*n2(2)-n1(2)*n2(1)
102 norm = sqrt(max(em30,n3(1)*n3(1)+n3(2)*n3(2)+n3(3)*n3(3)))
103 n3(1) = n3(1) / norm
104 n3(2) = n3(2) / norm
105 n3(3) = n3(3) / norm
106C
107 scal = abs(n3(1)*nn(1)+n3(2)*nn(2)+n3(3)*nn(3))
108 slipring(i)%FRAM(j)%ORIENTATION_ANGLE = acos(scal)
109 ENDIF
110C
111 IF(slipring(i)%FRAM(j)%UPDATE < zero) THEN
112C
113 v(1,node2)=v(1,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(1)
114 v(2,node2)=v(2,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(2)
115 v(3,node2)=v(3,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(3)
116C
117 v(1,node3)=v(1,anchor_node)
118 v(2,node3)=v(2,anchor_node)
119 v(3,node3)=v(3,anchor_node)
120C
121 a(1,node3)=a(1,anchor_node)
122 a(2,node3)=a(2,anchor_node)
123 a(3,node3)=a(3,anchor_node)
124C
125 x(1,node3)=x(1,anchor_node)
126 x(2,node3)=x(2,anchor_node)
127 x(3,node3)=x(3,anchor_node)
128C
129 IF (iresp == 1) THEN
130 xdp(1,node3)=xdp(1,anchor_node)
131 xdp(2,node3)=xdp(2,anchor_node)
132 xdp(3,node3)=xdp(3,anchor_node)
133 ENDIF
134C
135 ELSEIF(slipring(i)%FRAM(j)%UPDATE > zero) THEN
136
137 v(1,node2)=v(1,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(4)
138 v(2,node2)=v(2,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(5)
139 v(3,node2)=v(3,anchor_node)-slipring(i)%FRAM(j)%MATERIAL_FLOW*slipring(i)%FRAM(j)%VECTOR(6)
140C
141 v(1,node1)=v(1,anchor_node)
142 v(2,node1)=v(2,anchor_node)
143 v(3,node1)=v(3,anchor_node)
144
145 a(1,node1)=a(1,anchor_node)
146 a(2,node1)=a(2,anchor_node)
147 a(3,node1)=a(3,anchor_node)
148
149 x(1,node1)=x(1,anchor_node)
150 x(2,node1)=x(2,anchor_node)
151 x(3,node1)=x(3,anchor_node)
152C
153 IF (iresp == 1) THEN
154 xdp(1,node1)=xdp(1,anchor_node)
155 xdp(2,node1)=xdp(2,anchor_node)
156 xdp(3,node1)=xdp(3,anchor_node)
157 ENDIF
158C
159 ELSE
160
161 v(1,node2)=v(1,anchor_node)
162 v(2,node2)=v(2,anchor_node)
163 v(3,node2)=v(3,anchor_node)
164
165 a(1,node2)=a(1,anchor_node)
166 a(2,node2)=a(2,anchor_node)
167 a(3,node2)=a(3,anchor_node)
168
169 ENDIF
170C
171 ENDDO
172C
173 ENDDO
174
175C----------------------------------------------------------
176C- KINEMATIC CONDITION OF RETRACTOR - FORCE TRANSFER
177C----------------------------------------------------------
178
179 DO i=1,nretractor
180C
181 anchor_node = retractor(i)%ANCHOR_NODE
182 node1 = retractor(i)%NODE(1)
183 node2 = retractor(i)%NODE(2)
184 node2_n = retractor(i)%NODE_NEXT(2)
185C
186 IF (retractor(i)%UPDATE > 0) THEN
187C-- release of new node
188 v(1,node2)=v(1,anchor_node)+retractor(i)%MATERIAL_FLOW*retractor(i)%VECTOR(1)
189 v(2,node2)=v(2,anchor_node)+retractor(i)%MATERIAL_FLOW*retractor(i)%VECTOR(2)
190 v(3,node2)=v(3,anchor_node)+retractor(i)%MATERIAL_FLOW*retractor(i)%VECTOR(3)
191C
192 v(1,node2_n)=v(1,anchor_node)
193 v(2,node2_n)=v(2,anchor_node)
194 v(3,node2_n)=v(3,anchor_node)
195
196 a(1,node2_n)=a(1,anchor_node)
197 a(2,node2_n)=a(2,anchor_node)
198 a(3,node2_n)=a(3,anchor_node)
199C
200 swip = 0
201 DO k=1,retractor(i)%INACTI_NNOD
202 IF (retractor(i)%INACTI_NODE(k)==node2) swip = 1
203 IF (swip == 1) retractor(i)%INACTI_NODE(k) = retractor(i)%INACTI_NODE(k+1)
204 ENDDO
205 retractor(i)%INACTI_NNOD = retractor(i)%INACTI_NNOD - 1
206C
207 ELSEIF (retractor(i)%UPDATE < 0) THEN
208C-- node will enter retractor
209 v(1,node2)=v(1,anchor_node)
210 v(2,node2)=v(2,anchor_node)
211 v(3,node2)=v(3,anchor_node)
212C
213 v(1,node1)=v(1,anchor_node)
214 v(2,node1)=v(2,anchor_node)
215 v(3,node1)=v(3,anchor_node)
216
217 a(1,node1)=a(1,anchor_node)
218 a(2,node1)=a(2,anchor_node)
219 a(3,node1)=a(3,anchor_node)
220
221 x(1,node1)=x(1,anchor_node)
222 x(2,node1)=x(2,anchor_node)
223 x(3,node1)=x(3,anchor_node)
224C
225 IF (iresp == 1) THEN
226 xdp(1,node1)=xdp(1,anchor_node)
227 xdp(2,node1)=xdp(2,anchor_node)
228 xdp(3,node1)=xdp(3,anchor_node)
229 ENDIF
230C
231 index = retractor(i)%INACTI_NNOD
232 retractor(i)%INACTI_NODE(index+1) = node2
233 retractor(i)%INACTI_NNOD = retractor(i)%INACTI_NNOD + 1
234C
235 ELSE
236
237 v(1,node2)=v(1,anchor_node)
238 v(2,node2)=v(2,anchor_node)
239 v(3,node2)=v(3,anchor_node)
240
241 a(1,node2)=a(1,anchor_node)
242 a(2,node2)=a(2,anchor_node)
243 a(3,node2)=a(3,anchor_node)
244
245 ENDIF
246C
247C Temporary
248C
249 DO k=1,retractor(i)%INACTI_NNOD
250 l = retractor(i)%INACTI_NODE(k)
251 v(1,l)=v(1,anchor_node)
252 v(2,l)=v(2,anchor_node)
253 v(3,l)=v(3,anchor_node)
254
255 a(1,l)=a(1,anchor_node)
256 a(2,l)=a(2,anchor_node)
257 a(3,l)=a(3,anchor_node)
258 ENDDO
259C
260 ENDDO
261
262C----------------------------------------------------------
263C
264
265C----------------------------------------------------------
266C
267 RETURN
268
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
max
#define max(a, b)
Definition macros.h:21
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110