OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbe2v.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!|| rbe2v ../engine/source/constraints/general/rbe2/rbe2v.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| prerbe2 ../engine/source/constraints/general/rbe2/rbe2f.F
29!|| rbe2v1 ../engine/source/constraints/general/rbe2/rbe2v.F
30!|| rbe2vl1 ../engine/source/constraints/general/rbe2/rbe2v.F
31!||====================================================================
32 SUBROUTINE rbe2v(IRBE2 ,LRBE2 ,X ,A ,AR ,
33 1 V ,VR ,SKEW )
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "com04_c.inc"
42#include "param_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IRBE2(NRBE2L,*),LRBE2(*)
47C REAL
48 my_real
49 . x(3,*), a(3,*), ar(3,*),v(3,*), vr(3,*),skew(lskew,*)
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,
54 . jt(3,nrbe2),jr(3,nrbe2),nm,nn,k,isk,nsn,irad,nsn_g
55C REAL
56C======================================================================|
57 CALL prerbe2(irbe2 ,jt ,jr )
58 DO n=nrbe2,1,-1
59 iad = irbe2(1,n)
60 m = irbe2(3,n)
61 nsn = irbe2(5,n)
62 isk = irbe2(7,n)
63 irad = irbe2(11,n)
64 nsn_g = irbe2(12,n)
65 IF (isk>1) THEN
66 CALL rbe2vl1(nsn ,lrbe2(iad+1),x ,a ,ar ,
67 1 v ,vr ,jt(1,n),jr(1,n),m ,
68 2 skew(1,isk),irad ,nsn_g)
69 ELSE
70 CALL rbe2v1(nsn ,lrbe2(iad+1),x ,a ,ar ,
71 1 v ,vr ,jt(1,n),jr(1,n),m ,irad ,nsn_g)
72 END IF
73 ENDDO
74C---
75 RETURN
76 END
77!||====================================================================
78!|| rbe2v0 ../engine/source/constraints/general/rbe2/rbe2v.F
79!||====================================================================
80 SUBROUTINE rbe2v0(NSL ,ISL ,X ,A ,AR ,
81 1 V ,VR ,JT ,JR ,M )
82C-----------------------------------------------
83C I m p l i c i t T y p e s
84C-----------------------------------------------
85#include "implicit_f.inc"
86C-----------------------------------------------
87C D u m m y A r g u m e n t s
88C-----------------------------------------------
89 INTEGER NSL,ISL(*),JT(3),JR(3),M
90C REAL
91 my_real
92 . x(3,*), a(3,*), ar(3,*), v(3,*), vr(3,*)
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER I, J, N, NS
97C REAL
98 my_real
99 . xs, ys, zs,vrm(3)
100C======================================================================|
101 DO j = 1,3
102 IF (jt(j)/=0) THEN
103 DO i=1,nsl
104 ns = isl(i)
105C V(J,NS)= V(J,M)
106 a(j,ns)= a(j,m)
107 ENDDO
108 ENDIF
109 ENDDO
110 IF ((jr(1)+jr(2)+jr(3))>0) THEN
111 DO j = 1,3
112 IF (jr(j)/=0) THEN
113 DO i=1,nsl
114 ns = isl(i)
115C VR(J,NS)= VR(J,M)
116 ar(j,ns)= ar(j,m)
117 ENDDO
118 ENDIF
119 vrm(j)= ar(j,m)*jr(j)
120 ENDDO
121 DO i=1,nsl
122 ns = isl(i)
123 xs=x(1,ns)-x(1,m)
124 ys=x(2,ns)-x(2,m)
125 zs=x(3,ns)-x(3,m)
126 a(1,ns)=a(1,ns)+vrm(2)*zs-vrm(3)*ys
127 a(2,ns)=a(2,ns)-vrm(1)*zs+vrm(3)*xs
128 a(3,ns)=a(3,ns)+vrm(1)*ys-vrm(2)*xs
129 ENDDO
130 END IF
131C---
132 RETURN
133 END
134!||====================================================================
135!|| rbe2vl ../engine/source/constraints/general/rbe2/rbe2v.F
136!||====================================================================
137 SUBROUTINE rbe2vl(NSN ,ISL ,X ,A ,AR ,
138 1 V ,VR ,JT ,JR ,M ,
139 2 SKEW )
140C-----------------------------------------------
141C I m p l i c i t T y p e s
142C-----------------------------------------------
143#include "implicit_f.inc"
144C-----------------------------------------------
145C D u m m y A r g u m e n t s
146C-----------------------------------------------
147 INTEGER NSN,ISL(*),JT(3),JR(3),M
148C REAL
149 my_real
150 . X(3,*), A(3,*), AR(3,*), V(3,*), VR(3,*),SKEW(*)
151C-----------------------------------------------
152C L o c a l V a r i a b l e s
153C-----------------------------------------------
154 INTEGER I, J, N, NS
155C REAL
156 my_real
157 . XS, YS, ZS,RX, RY,RZ,LRX, LRY,LRZ,RVX,RVY,RVZ,
158 . dvx,dvy,dvz,vvx,vvy,vvz,lxs(nsn), lys(nsn), lzs(nsn)
159C======================================================================|
160 DO i=1,nsn
161 ns = isl(i)
162 dvx =a(1,ns)-a(1,m)
163 dvy =a(2,ns)-a(2,m)
164 dvz =a(3,ns)-a(3,m)
165 vvx =jt(1)*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
166 vvy =jt(2)*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
167 vvz =jt(3)*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
168 a(1,ns) =a(1,ns)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
169 a(2,ns) =a(2,ns)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
170 a(3,ns) =a(3,ns)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
171 ENDDO
172 IF ((jr(1)+jr(2)+jr(3))>0) THEN
173 DO i=1,nsn
174 ns = isl(i)
175 xs=x(1,ns)-x(1,m)
176 ys=x(2,ns)-x(2,m)
177 zs=x(3,ns)-x(3,m)
178 lxs(i)=skew(1)*xs+skew(2)*ys+skew(3)*zs
179 lys(i)=skew(4)*xs+skew(5)*ys+skew(6)*zs
180 lzs(i)=skew(7)*xs+skew(8)*ys+skew(9)*zs
181 ENDDO
182 DO i=1,nsn
183 ns = isl(i)
184 dvx =ar(1,ns)-ar(1,m)
185 dvy =ar(2,ns)-ar(2,m)
186 dvz =ar(3,ns)-ar(3,m)
187 vvx =jr(1)*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
188 vvy =jr(2)*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
189 vvz =jr(3)*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
190 ar(1,ns) =ar(1,ns)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
191 ar(2,ns) =ar(2,ns)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
192 ar(3,ns) =ar(3,ns)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
193 rx=ar(1,m)
194 ry=ar(2,m)
195 rz=ar(3,m)
196 lrx =jr(1)*(skew(1)*rx+skew(2)*ry+skew(3)*rz)
197 lry =jr(2)*(skew(4)*rx+skew(5)*ry+skew(6)*rz)
198 lrz =jr(3)*(skew(7)*rx+skew(8)*ry+skew(9)*rz)
199 rvx=lry*lzs(i)-lrz*lys(i)
200 rvy=-lrx*lzs(i)+lrz*lxs(i)
201 rvz=lrx*lys(i)-lry*lxs(i)
202 a(1,ns) =a(1,ns)+rvx*skew(1)+rvy*skew(4)+rvz*skew(7)
203 a(2,ns) =a(2,ns)+rvx*skew(2)+rvy*skew(5)+rvz*skew(8)
204 a(3,ns) =a(3,ns)+rvx*skew(3)+rvy*skew(6)+rvz*skew(9)
205 ENDDO
206 END IF
207C---
208 RETURN
209 END
210!||====================================================================
211!|| rbe2_impd ../engine/source/constraints/general/rbe2/rbe2v.F
212!||--- called by ------------------------------------------------------
213!|| recukin ../engine/source/implicit/recudis.F
214!||--- calls -----------------------------------------------------
215!|| prerbe2 ../engine/source/constraints/general/rbe2/rbe2f.F
216!|| rbe2d0 ../engine/source/constraints/general/rbe2/rbe2v.F
217!|| rbe2dl2 ../engine/source/constraints/general/rbe2/rbe2v.F
218!|| rbe2dl3 ../engine/source/constraints/general/rbe2/rbe2v.F
219!||====================================================================
220 SUBROUTINE rbe2_impd(IRBE2 ,LRBE2 ,X ,D ,DR ,SKEW )
221C-----------------------------------------------
222C I m p l i c i t T y p e s
223C-----------------------------------------------
224#include "implicit_f.inc"
225C-----------------------------------------------
226C C o m m o n B l o c k s
227C-----------------------------------------------
228#include "com04_c.inc"
229#include "param_c.inc"
230#include "impl1_c.inc"
231C-----------------------------------------------
232C D u m m y A r g u m e n t s
233C-----------------------------------------------
234 INTEGER IRBE2(NRBE2L,*),LRBE2(*)
235C REAL
236 my_real
237 . X(3,*), D(3,*), DR(3,*),SKEW(LSKEW,*)
238C-----------------------------------------------
239C L o c a l V a r i a b l e s
240C-----------------------------------------------
241 INTEGER I, J, N, M, NS ,NML, IAD,JJ,ISK,
242 . JT(3,NRBE2),JR(3,NRBE2),NM,NN,K,NSL,IRAD
243C REAL
244C======================================================================|
245 CALL prerbe2(irbe2 ,jt ,jr )
246 DO n=nrbe2,1,-1
247 iad = irbe2(1,n)
248 m = irbe2(3,n)
249 nsl = irbe2(5,n)
250 isk = irbe2(7,n)
251 irad= irbe2(11,n)
252 IF (isk>1) THEN
253 IF( imp_lr == 0 ) THEN
254 CALL rbe2dl2(nsl ,lrbe2(iad+1),x ,d ,dr ,
255 1 jt(1,n),jr(1,n),m ,skew(1,isk),irad )
256 ELSE
257 CALL rbe2dl3(nsl ,lrbe2(iad+1),x ,d ,dr ,
258 1 jt(1,n),jr(1,n),m ,skew(1,isk),irad )
259 END IF
260 ELSE
261 CALL rbe2d0(nsl ,lrbe2(iad+1),x ,d ,dr ,
262 1 jt(1,n),jr(1,n),m ,irad )
263 END IF
264 ENDDO
265C---
266 RETURN
267 END
268!||====================================================================
269!|| rbe2d0 ../engine/source/constraints/general/rbe2/rbe2v.F
270!||--- called by ------------------------------------------------------
271!|| rbe2_impd ../engine/source/constraints/general/rbe2/rbe2v.F
272!||--- calls -----------------------------------------------------
273!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
274!||====================================================================
275 SUBROUTINE rbe2d0(NSL ,ISL ,X ,V ,VR ,
276 1 JT ,JR ,M ,IRAD )
277C-----------------------------------------------
278C I m p l i c i t T y p e s
279C-----------------------------------------------
280#include "implicit_f.inc"
281C-----------------------------------------------
282C G l o b a l P a r a m e t e r s
283C-----------------------------------------------
284#include "impl1_c.inc"
285C-----------------------------------------------
286C D u m m y A r g u m e n t s
287C-----------------------------------------------
288 INTEGER NSL,ISL(*),JT(3),JR(3),M,IRAD
289C REAL
290 my_real
291 . X(3,*), V(3,*), VR(3,*)
292C-----------------------------------------------
293C L o c a l V a r i a b l e s
294C-----------------------------------------------
295 INTEGER I, J, N, NS
296C REAL
297 my_real
298 . XS, YS, ZS,VRM(3),LSM(3),VS(3)
299C======================================================================|
300 DO j = 1,3
301 IF (jt(j)/=0) THEN
302 DO i=1,nsl
303 ns = isl(i)
304 v(j,ns)= v(j,m)
305 ENDDO
306 ENDIF
307 ENDDO
308 IF ((jr(1)+jr(2)+jr(3))>0) THEN
309 DO j = 1,3
310 IF (jr(j)/=0) THEN
311 DO i=1,nsl
312 ns = isl(i)
313 vr(j,ns)= vr(j,m)
314 ENDDO
315 ENDIF
316 ENDDO
317 END IF
318C
319 IF (irad==0) THEN
320 DO j = 1,3
321 vrm(j)= vr(j,m)
322 ENDDO
323 DO i=1,nsl
324 ns = isl(i)
325 xs=x(1,ns)-x(1,m)
326 ys=x(2,ns)-x(2,m)
327 zs=x(3,ns)-x(3,m)
328 IF( imp_lr == 0)THEN
329 IF (jt(1)/=0) v(1,ns)=v(1,ns)+vrm(2)*zs-vrm(3)*ys
330 IF (jt(2)/=0) v(2,ns)=v(2,ns)-vrm(1)*zs+vrm(3)*xs
331 IF (jt(3)/=0) v(3,ns)=v(3,ns)+vrm(1)*ys-vrm(2)*xs
332 ELSE
333 lsm(1) = xs
334 lsm(2) = ys
335 lsm(3) = zs
336 CALL velrot(vrm, lsm,vs)
337 IF (jt(1)/=0) v(1,ns)=v(1,ns) + vs(1)
338 IF (jt(2)/=0) v(2,ns)=v(2,ns) + vs(2)
339 IF (jt(3)/=0) v(3,ns)=v(3,ns) + vs(3)
340 END IF
341 ENDDO
342 ELSEIF ((jr(1)+jr(2)+jr(3))>0) THEN
343 DO j = 1,3
344 vrm(j)= vr(j,m)*jr(j)
345 ENDDO
346 DO i=1,nsl
347 ns = isl(i)
348 xs=x(1,ns)-x(1,m)
349 ys=x(2,ns)-x(2,m)
350 zs=x(3,ns)-x(3,m)
351 IF( imp_lr == 0 ) THEN
352 v(1,ns)=v(1,ns)+vrm(2)*zs-vrm(3)*ys
353 v(2,ns)=v(2,ns)-vrm(1)*zs+vrm(3)*xs
354 v(3,ns)=v(3,ns)+vrm(1)*ys-vrm(2)*xs
355 ELSE
356 lsm(1) = xs
357 lsm(2) = ys
358 lsm(3) = zs
359 CALL velrot(vrm, lsm,vs)
360 v(1,ns)=v(1,ns)+ vs(1)
361 v(2,ns)=v(2,ns)+ vs(2)
362 v(3,ns)=v(3,ns)+ vs(3)
363 END IF
364 ENDDO
365 END IF
366C---
367 RETURN
368 END
369!||====================================================================
370!|| rbe2dl ../engine/source/constraints/general/rbe2/rbe2v.F
371!||====================================================================
372 SUBROUTINE rbe2dl(NSN ,ISL ,X ,V ,VR ,
373 1 JT ,JR ,M ,SKEW )
374C-----------------------------------------------
375C I m p l i c i t T y p e s
376C-----------------------------------------------
377#include "implicit_f.inc"
378C-----------------------------------------------
379C D u m m y A r g u m e n t s
380C-----------------------------------------------
381 INTEGER NSN,ISL(*),JT(3),JR(3),M
382C REAL
383 my_real
384 . X(3,*), V(3,*), VR(3,*),SKEW(*)
385C-----------------------------------------------
386C L o c a l V a r i a b l e s
387C-----------------------------------------------
388 INTEGER I, NS
389C REAL
390 my_real
391 . xs, ys, zs,rx, ry,rz,lrx, lry,lrz,rvx,rvy,rvz,
392 . dvx,dvy,dvz,vvx,vvy,vvz,lxs(nsn), lys(nsn), lzs(nsn)
393C======================================================================|
394 DO i=1,nsn
395 ns = isl(i)
396 dvx =v(1,ns)-v(1,m)
397 dvy =v(2,ns)-v(2,m)
398 dvz =v(3,ns)-v(3,m)
399 vvx =jt(1)*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
400 vvy =jt(2)*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
401 vvz =jt(3)*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
402 v(1,ns) =v(1,ns)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
403 v(2,ns) =v(2,ns)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
404 v(3,ns) =v(3,ns)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
405 ENDDO
406 IF ((jr(1)+jr(2)+jr(3))>0) THEN
407 DO i=1,nsn
408 ns = isl(i)
409 xs=x(1,ns)-x(1,m)
410 ys=x(2,ns)-x(2,m)
411 zs=x(3,ns)-x(3,m)
412 lxs(i)=skew(1)*xs+skew(2)*ys+skew(3)*zs
413 lys(i)=skew(4)*xs+skew(5)*ys+skew(6)*zs
414 lzs(i)=skew(7)*xs+skew(8)*ys+skew(9)*zs
415 ENDDO
416 DO i=1,nsn
417 ns = isl(i)
418 dvx =vr(1,ns)-vr(1,m)
419 dvy =vr(2,ns)-vr(2,m)
420 dvz =vr(3,ns)-vr(3,m)
421 vvx =jr(1)*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
422 vvy =jr(2)*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
423 vvz =jr(3)*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
424 vr(1,ns) =vr(1,ns)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
425 vr(2,ns) =vr(2,ns)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
426 vr(3,ns) =vr(3,ns)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
427 rx=vr(1,m)
428 ry=vr(2,m)
429 rz=vr(3,m)
430 lrx =jr(1)*(skew(1)*rx+skew(2)*ry+skew(3)*rz)
431 lry =jr(2)*(skew(4)*rx+skew(5)*ry+skew(6)*rz)
432 lrz =jr(3)*(skew(7)*rx+skew(8)*ry+skew(9)*rz)
433 rvx=lry*lzs(i)-lrz*lys(i)
434 rvy=-lrx*lzs(i)+lrz*lxs(i)
435 rvz=lrx*lys(i)-lry*lxs(i)
436 v(1,ns) =v(1,ns)+rvx*skew(1)+rvy*skew(4)+rvz*skew(7)
437 v(2,ns) =v(2,ns)+rvx*skew(2)+rvy*skew(5)+rvz*skew(8)
438 v(3,ns) =v(3,ns)+rvx*skew(3)+rvy*skew(6)+rvz*skew(9)
439 ENDDO
440 END IF
441C---
442 RETURN
443 END
444!||====================================================================
445!|| rbe2dl2 ../engine/source/constraints/general/rbe2/rbe2v.F
446!||--- called by ------------------------------------------------------
447!|| rbe2_impd ../engine/source/constraints/general/rbe2/rbe2v.F
448!||--- calls -----------------------------------------------------
449!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
450!|| rbe2d_bcl ../engine/source/constraints/general/rbe2/rbe2v.F
451!||====================================================================
452 SUBROUTINE rbe2dl2(NSN ,ISL ,X ,V ,VR ,
453 1 JT ,JR ,M ,SKEW ,IRAD )
454C-----------------------------------------------
455C I m p l i c i t T y p e s
456C-----------------------------------------------
457#include "implicit_f.inc"
458C-----------------------------------------------
459C D u m m y A r g u m e n t s
460C-----------------------------------------------
461 INTEGER NSN,ISL(*),JT(3),JR(3),M,IRAD
462C REAL
463 my_real
464 . X(3,*), V(3,*), VR(3,*),SKEW(*)
465C-----------------------------------------------
466C L o c a l V a r i a b l e s
467C-----------------------------------------------
468 INTEGER I, NS ,NT,NR,ICT,ICR
469C REAL
470 my_real
471 . xs, ys, zs,rx, ry,rz,lrx, lry,lrz,rvx,rvy,rvz,
472 . dvx,dvy,dvz,vvx,vvy,vvz,ktr(3,3)
473C======================================================================|
474 nt=jt(1)+jt(2)+jt(3)
475 nr=jr(1)+jr(2)+jr(3)
476 ict=jt(1)*4 +jt(2)*2 +jt(3)
477 icr=jr(1)*4 +jr(2)*2 +jr(3)
478 IF (nt>0.AND.nt<3) THEN
479 CALL rbe2d_bcl(ict ,nsn ,isl ,m ,v ,
480 1 skew )
481 ELSEIF (nt==3) THEN
482 DO i=1,nsn
483 ns = isl(i)
484 v(1,ns)=v(1,m)
485 v(2,ns)=v(2,m)
486 v(3,ns)=v(3,m)
487 ENDDO
488 ENDIF
489C
490 IF (nr>0) THEN
491 IF (nr<3) THEN
492 CALL rbe2d_bcl(icr ,nsn ,isl ,m ,vr ,
493 1 skew )
494 ELSEIF (nr==3) THEN
495 DO i=1,nsn
496 ns = isl(i)
497 vr(1,ns)=vr(1,m)
498 vr(2,ns)=vr(2,m)
499 vr(3,ns)=vr(3,m)
500 ENDDO
501 ENDIF
502 END IF
503C
504 IF (irad==0.OR.nr>0) THEN
505 DO i=1,nsn
506 ns = isl(i)
507 rx=vr(1,m)
508 ry=vr(2,m)
509 rz=vr(3,m)
510 xs=x(1,ns)-x(1,m)
511 ys=x(2,ns)-x(2,m)
512 zs=x(3,ns)-x(3,m)
513 CALL cdi_bcn1(xs,ys,zs,jt,jr,skew,ktr,irad)
514 v(1,ns) =v(1,ns)+ktr(1,1)*rx+ktr(1,2)*ry+ktr(1,3)*rz
515 v(2,ns) =v(2,ns)+ktr(2,1)*rx+ktr(2,2)*ry+ktr(2,3)*rz
516 v(3,ns) =v(3,ns)+ktr(3,1)*rx+ktr(3,2)*ry+ktr(3,3)*rz
517 ENDDO
518 END IF
519C---
520 RETURN
521 END
522!||====================================================================
523!|| rbe2d_bcl ../engine/source/constraints/general/rbe2/rbe2v.F
524!||--- called by ------------------------------------------------------
525!|| rbe2_frd ../engine/source/constraints/general/rbe2/rbe2v.f
526!|| rbe2dl2 ../engine/source/constraints/general/rbe2/rbe2v.F
527!|| rbe2vl1 ../engine/source/constraints/general/rbe2/rbe2v.F
528!||--- calls -----------------------------------------------------
529!|| dir_rbe2 ../engine/source/constraints/general/rbe2/rbe2v.F
530!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.f
531!||====================================================================
532 SUBROUTINE rbe2d_bcl(ICT ,NSN ,ISL ,M ,V ,
533 1 SKEW )
534C-----------------------------------------------
535C I m p l i c i t T y p e s
536C-----------------------------------------------
537#include "implicit_f.inc"
538C-----------------------------------------------
539C C o m m o n B l o c k s
540C-----------------------------------------------
541#include "param_c.inc"
542C-----------------------------------------------
543C D u m m y A r g u m e n t s
544C-----------------------------------------------
545 INTEGER ICT,NSN ,ISL(*),M
546 my_real
547 . SKEW(LSKEW),V(3,*)
548C-----------------------------------------------
549C L o c a l V a r i a b l e s
550C-----------------------------------------------
551 INTEGER I,J,K,J1,L,NS
552 my_real
553 . vq(3,3),ej(3),ej1(3),vlm(3),vv(3),vls(3),s
554C----------------------------------------
555 DO i=1,3
556 vq(1,i)= skew(i)
557 vq(2,i)= skew(i+3)
558 vq(3,i)= skew(i+6)
559 ENDDO
560 vv(1) =v(1,m)
561 vv(2) =v(2,m)
562 vv(3) =v(3,m)
563 vlm(1) =skew(1)*vv(1)+skew(2)*vv(2)+skew(3)*vv(3)
564 vlm(2) =skew(4)*vv(1)+skew(5)*vv(2)+skew(6)*vv(3)
565 vlm(3) =skew(7)*vv(1)+skew(8)*vv(2)+skew(9)*vv(3)
566C-------------------100---------------------
567 IF (ict == 4 ) THEN
568 ej(1)=skew(1)
569 ej(2)=skew(2)
570 ej(3)=skew(3)
571 CALL l_dir(ej,j)
572 j1=0
573 CALL dir_rbe2(j ,j1 ,k )
574C-------------------010---------------------
575 ELSEIF (ict == 2) THEN
576 ej(1)=skew(4)
577 ej(2)=skew(5)
578 ej(3)=skew(6)
579 CALL l_dir(ej,j)
580 j1=0
581 CALL dir_rbe2(j ,j1 ,k )
582C-------------------001---------------------
583 ELSEIF (ict == 1) THEN
584 ej(1)=skew(7)
585 ej(2)=skew(8)
586 ej(3)=skew(9)
587 CALL l_dir(ej,j)
588 j1=0
589 CALL dir_rbe2(j ,j1 ,k )
590C-------------------011---------------------
591 ELSEIF (ict == 3) THEN
592 ej(1)=skew(7)
593 ej(2)=skew(8)
594 ej(3)=skew(9)
595 CALL l_dir(ej,j)
596 ej1(1)=skew(4)
597 ej1(2)=skew(5)
598 ej1(3)=skew(6)
599 CALL l_dir(ej1,j1)
600 IF (j1==j) THEN
601 ej1(j)=zero
602 CALL l_dir(ej1,j1)
603 ENDIF
604 vls(3)=vlm(3)
605 vls(2)=vlm(2)
606 CALL dir_rbe2(j ,j1 ,k )
607 IF (abs(vq(1,k))<em20) THEN
608 s= zero
609 ELSE
610 s= one/vq(1,k)
611 ENDIF
612C-------------------101---------------------
613 ELSEIF (ict == 5) THEN
614 ej(1)=skew(7)
615 ej(2)=skew(8)
616 ej(3)=skew(9)
617 CALL l_dir(ej,j)
618 ej1(1)=skew(1)
619 ej1(2)=skew(2)
620 ej1(3)=skew(3)
621 CALL l_dir(ej1,j1)
622 IF (j1==j) THEN
623 ej1(j)=zero
624 CALL l_dir(ej1,j1)
625 ENDIF
626 vls(3)=vlm(3)
627 vls(1)=vlm(1)
628 CALL dir_rbe2(j ,j1 ,k )
629 IF (abs(vq(2,k))<em20) THEN
630 s= zero
631 ELSE
632 s= one/vq(2,k)
633 ENDIF
634C-------------------110---------------------
635 ELSEIF (ict == 6) THEN
636 ej(1)=skew(4)
637 ej(2)=skew(5)
638 ej(3)=skew(6)
639 CALL l_dir(ej,j)
640 ej1(1)=skew(1)
641 ej1(2)=skew(2)
642 ej1(3)=skew(3)
643 CALL l_dir(ej1,j1)
644 IF (j1==j) THEN
645 ej1(j)=zero
646 CALL l_dir(ej1,j1)
647 ENDIF
648 vls(2)=vlm(2)
649 vls(1)=vlm(1)
650 CALL dir_rbe2(j ,j1 ,k )
651 IF (abs(vq(3,k))<em20) THEN
652 s= zero
653 ELSE
654 s= one/vq(3,k)
655 ENDIF
656 ENDIF
657 DO i=1,nsn
658 ns = isl(i)
659C-------------------100---------------------
660 IF (ict == 4 ) THEN
661 v(j,ns) = vlm(1)/skew(j)-ej(j1)*v(j1,ns)-ej(k)*v(k,ns)
662C-------------------010---------------------
663 ELSEIF (ict == 2) THEN
664 v(j,ns) = vlm(2)/skew(3+j)-ej(j1)*v(j1,ns)-ej(k)*v(k,ns)
665C-------------------001---------------------
666 ELSEIF (ict == 1) THEN
667 v(j,ns) = vlm(3)/skew(6+j)-ej(j1)*v(j1,ns)-ej(k)*v(k,ns)
668C-------------------011---------------------
669 ELSEIF (ict == 3) THEN
670 vls(1)=(v(k,ns)-vls(3)*vq(3,k)-vls(2)*vq(2,k))*s
671 v(1,ns) =vls(1)*skew(1)+vls(2)*skew(4)+vls(3)*skew(7)
672 v(2,ns) =vls(1)*skew(2)+vls(2)*skew(5)+vls(3)*skew(8)
673 v(3,ns) =vls(1)*skew(3)+vls(2)*skew(6)+vls(3)*skew(9)
674C-------------------101---------------------
675 ELSEIF (ict == 5) THEN
676 vls(2)=(v(k,ns)-vls(3)*vq(3,k)-vls(1)*vq(1,k))*s
677 v(1,ns) =vls(1)*skew(1)+vls(2)*skew(4)+vls(3)*skew(7)
678 v(2,ns) =vls(1)*skew(2)+vls(2)*skew(5)+vls(3)*skew(8)
679 v(3,ns) =vls(1)*skew(3)+vls(2)*skew(6)+vls(3)*skew(9)
680C-------------------110---------------------
681 ELSEIF (ict == 6) THEN
682 vls(3)=(v(k,ns)-vls(2)*vq(2,k)-vls(1)*vq(1,k))*s
683 v(1,ns) =vls(1)*skew(1)+vls(2)*skew(4)+vls(3)*skew(7)
684 v(2,ns) =vls(1)*skew(2)+vls(2)*skew(5)+vls(3)*skew(8)
685 v(3,ns) =vls(1)*skew(3)+vls(2)*skew(6)+vls(3)*skew(9)
686 ENDIF
687 ENDDO
688C
689 RETURN
690 END
691!||====================================================================
692!|| dir_rbe2 ../engine/source/constraints/general/rbe2/rbe2v.F
693!||--- called by ------------------------------------------------------
694!|| bc_fi2 ../engine/source/constraints/general/bcs/bc_imp0.F
695!|| bc_upd2d ../engine/source/constraints/general/bcs/bc_imp0.F
696!|| bc_updf2d ../engine/source/constraints/general/bcs/bc_imp0.F
697!|| bc_updfr2 ../engine/source/constraints/general/bcs/bc_imp0.F
698!|| bc_updk2d ../engine/source/constraints/general/bcs/bc_imp0.F
699!|| bcl_impd ../engine/source/constraints/general/bcs/bc_imp0.F
700!|| cdi_bcn ../engine/source/constraints/general/rbe2/rbe2_imp0.F
701!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
702!|| fv_updkd2 ../engine/source/constraints/general/bcs/bc_imp0.F
703!|| fvbc_compa0 ../engine/source/constraints/general/impvel/fv_imp0.F
704!|| getbcl_j ../engine/source/constraints/general/impvel/fv_imp0.F
705!|| gfvbc2_ind ../engine/source/constraints/general/impvel/fv_imp0.F
706!|| rbe2_bcl ../engine/source/constraints/general/rbe2/rbe2_imp0.F
707!|| rbe2d_bcl ../engine/source/constraints/general/rbe2/rbe2v.F
708!|| rbe2flsn ../engine/source/constraints/general/rbe2/rbe2f.F
709!|| rbe2flsnfr ../engine/source/constraints/general/rbe2/rbe2f.F
710!|| rbe2impbsn ../engine/source/constraints/general/rbe2/rbe2_imp0.F
711!|| select_dof ../engine/source/constraints/general/rbe2/rbe2v.F
712!||====================================================================
713 SUBROUTINE dir_rbe2(J ,J1 ,K )
714C-----------------------------------------------
715C I m p l i c i t T y p e s
716C-----------------------------------------------
717#include "implicit_f.inc"
718C-----------------------------------------------
719C D u m m y A r g u m e n t s
720C-----------------------------------------------
721 INTEGER K,J,J1
722C-----------------------------------------------
723C L o c a l V a r i a b l e s
724C-----------------------------------------------
725 K = j + 1
726 IF (k>3) k = k - 3
727 IF (j1==0) THEN
728 j1 = j + 2
729 IF (j1>3) j1 = j1 - 3
730 ELSEIF (k==j1) THEN
731 k = j + 2
732 IF (k>3) k = k - 3
733 ENDIF
734C
735 RETURN
736 END
737!||====================================================================
738!|| rbe2v1 ../engine/source/constraints/general/rbe2/rbe2v.F
739!||--- called by ------------------------------------------------------
740!|| rbe2v ../engine/source/constraints/general/rbe2/rbe2v.F
741!||--- calls -----------------------------------------------------
742!|| velrot_explicit ../engine/source/constraints/general/rbody/velrot_explicit.F90
743!||--- uses -----------------------------------------------------
744!|| velrot_explicit_mod ../engine/source/constraints/general/rbody/velrot_explicit.F90
745!||====================================================================
746 SUBROUTINE rbe2v1(NSL ,ISL ,X ,A ,AR ,
747 1 V ,VR ,JT ,JR ,M ,
748 2 IRAD ,NSL_G )
749C-----------------------------------------------
750C M o d u l e s
751C-----------------------------------------------
752 USE velrot_explicit_mod, ONLY : velrot_explicit
753C-----------------------------------------------
754C I m p l i c i t T y p e s
755C-----------------------------------------------
756#include "implicit_f.inc"
757C-----------------------------------------------
758C C o m m o n B l o c k s
759C-----------------------------------------------
760#include "com08_c.inc"
761C-----------------------------------------------
762C D u m m y A r g u m e n t s
763C-----------------------------------------------
764 INTEGER NSL,ISL(*),JT(3),JR(3),M,IRAD,NSL_G
765C REAL
766 my_real
767 . X(3,*), A(3,*), AR(3,*), V(3,*), VR(3,*)
768C-----------------------------------------------
769C L o c a l V a r i a b l e s
770C-----------------------------------------------
771 INTEGER I, J, NS
772C REAL
773 my_real
774 . v1x2, v2x1, v2x3, v3x2, v3x1, v1x3,usdt,dt05,
775 . vx1, vx2, vx3,vg(3),lsm(3),vs(3),as(3)
776C======================================================================|
777C-------change As=Am to Vs=Vm------
778 usdt = one/dt12
779 DO j = 1,3
780 IF (jt(j)/=0) THEN
781 DO i=1,nsl
782 ns = isl(i)
783 a(j,ns)= a(j,m)+(v(j,m)-v(j,ns))*usdt
784 ENDDO
785 ENDIF
786 ENDDO
787C
788 IF ((jr(1)+jr(2)+jr(3))>0.OR.irad==0) THEN
789 DO j = 1,3
790 vg(j)=vr(j,m)+ar(j,m)*dt12
791 IF (jr(j)/=0) THEN
792 DO i=1,nsl
793 ns = isl(i)
794 ar(j,ns)= (vg(j)-vr(j,ns)) * usdt
795 ENDDO
796 ENDIF
797 ENDDO
798 END IF
799C
800 IF (irad==0) THEN
801 dt05 = half*dt2
802 IF (nsl_g<=2) THEN
803 DO i=1,nsl
804 ns = isl(i)
805 lsm(1:3) = x(1:3,ns)-x(1:3,m)
806 CALL velrot_explicit(vg, lsm,vs,dt12)
807 as(1) = usdt*(vs(1)+dt05*(vg(2)*vs(3)-vg(3)*vs(2)))
808 as(2) = usdt*(vs(2)+dt05*(vg(3)*vs(1)-vg(1)*vs(3)))
809 as(3) = usdt*(vs(3)+dt05*(vg(1)*vs(2)-vg(2)*vs(1)))
810 a(1:3,ns)= a(1:3,ns)+as(1:3)*jt(1:3)
811 ENDDO
812 ELSE
813 DO i=1,nsl
814 ns = isl(i)
815 v1x2=vg(1)*(x(2,ns)-x(2,m))
816 v2x1=vg(2)*(x(1,ns)-x(1,m))
817 v2x3=vg(2)*(x(3,ns)-x(3,m))
818 v3x2=vg(3)*(x(2,ns)-x(2,m))
819 v3x1=vg(3)*(x(1,ns)-x(1,m))
820 v1x3=vg(1)*(x(3,ns)-x(3,m))
821C
822 vx1=v2x3-v3x2
823 vx2=v3x1-v1x3
824 vx3=v1x2-v2x1
825 IF (jt(1)/=0)
826 . a(1,ns)= a(1,ns)+(vx1+dt05*(vg(2)*vx3-vg(3)*vx2))*usdt
827 IF (jt(2)/=0)
828 . a(2,ns)= a(2,ns)+(vx2+dt05*(vg(3)*vx1-vg(1)*vx3))*usdt
829 IF (jt(3)/=0)
830 . a(3,ns)= a(3,ns)+(vx3+dt05*(vg(1)*vx2-vg(2)*vx1))*usdt
831 ENDDO
832 END IF !(NSL_G<=2) THEN
833 ELSEIF ((jr(1)+jr(2)+jr(3))>0) THEN
834 dt05 = half*dt2
835 DO j = 1,3
836 vg(j)=jr(j)*vg(j)
837 ENDDO
838 DO i=1,nsl
839 ns = isl(i)
840C
841 v1x2=vg(1)*(x(2,ns)-x(2,m))
842 v2x1=vg(2)*(x(1,ns)-x(1,m))
843 v2x3=vg(2)*(x(3,ns)-x(3,m))
844 v3x2=vg(3)*(x(2,ns)-x(2,m))
845 v3x1=vg(3)*(x(1,ns)-x(1,m))
846 v1x3=vg(1)*(x(3,ns)-x(3,m))
847C
848 vx1=v2x3-v3x2
849 vx2=v3x1-v1x3
850 vx3=v1x2-v2x1
851 a(1,ns)= a(1,ns)+(vx1+dt05*(vg(2)*vx3-vg(3)*vx2))*usdt
852 a(2,ns)= a(2,ns)+(vx2+dt05*(vg(3)*vx1-vg(1)*vx3))*usdt
853 a(3,ns)= a(3,ns)+(vx3+dt05*(vg(1)*vx2-vg(2)*vx1))*usdt
854 ENDDO
855 END IF
856C---
857 RETURN
858 END
859!||====================================================================
860!|| rbe2vl1 ../engine/source/constraints/general/rbe2/rbe2v.F
861!||--- called by ------------------------------------------------------
862!|| rbe2v ../engine/source/constraints/general/rbe2/rbe2v.F
863!||--- calls -----------------------------------------------------
864!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
865!|| rbe2d_bcl ../engine/source/constraints/general/rbe2/rbe2v.F
866!|| velrot_explicit ../engine/source/constraints/general/rbody/velrot_explicit.F90
867!||--- uses -----------------------------------------------------
868!|| velrot_explicit_mod ../engine/source/constraints/general/rbody/velrot_explicit.F90
869!||====================================================================
870 SUBROUTINE rbe2vl1(NSL ,ISL ,X ,A ,AR ,
871 1 V ,VR ,JT ,JR ,M ,
872 2 SKEW ,IRAD ,NSL_G )
873C-----------------------------------------------
874C M o d u l e s
875C-----------------------------------------------
876 USE velrot_explicit_mod, ONLY : velrot_explicit
877C-----------------------------------------------
878C I m p l i c i t T y p e s
879C-----------------------------------------------
880#include "implicit_f.inc"
881C-----------------------------------------------
882C C o m m o n B l o c k s
883C-----------------------------------------------
884#include "com08_c.inc"
885C-----------------------------------------------
886C D u m m y A r g u m e n t s
887C-----------------------------------------------
888 INTEGER NSL,ISL(*),JT(3),JR(3),M,IRAD,NSL_G
889C REAL
890 my_real
891 . X(3,*), A(3,*), AR(3,*), V(3,*), VR(3,*),SKEW(*)
892C-----------------------------------------------
893C L o c a l V a r i a b l e s
894C-----------------------------------------------
895 INTEGER I, J, N, NS,ICR
896C REAL
897 my_real
898 . XS, YS, ZS,RX, RY,RZ,LRX, LRY,LRZ,RVX,RVY,RVZ,
899 . DVX,DVY,DVZ,VVX,VVY,VVZ,LXS(NSL),LYS(NSL),LZS(NSL)
900 my_real
901 . v1x2, v2x1, v2x3, v3x2, v3x1, v1x3,usdt,dt05,
902 . vx1, vx2, vx3,vrg(3),vrl(3),usdt1(3),ktr(3,3),
903 . lsm(3),vs(3),as(3)
904C----we modify A,AR(*,NS) so that V,VR(*,NS) follow the constraint equations
905C======================================================================|
906 usdt = one/dt12
907 IF ((jt(1)+jt(2)+jt(3))==3) THEN
908 DO j = 1,3
909 DO i=1,nsl
910 ns = isl(i)
911 a(j,ns)= a(j,m)+(v(j,m)-v(j,ns))*usdt
912 ENDDO
913 ENDDO
914 ELSE
915 DO i=1,nsl
916 ns = isl(i)
917 dvx =a(1,ns)-(a(1,m)+(v(1,m)-v(1,ns))*usdt)
918 dvy =a(2,ns)-(a(2,m)+(v(2,m)-v(2,ns))*usdt)
919 dvz =a(3,ns)-(a(3,m)+(v(3,m)-v(3,ns))*usdt)
920 vvx =jt(1)*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
921 vvy =jt(2)*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
922 vvz =jt(3)*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
923 a(1,ns) =a(1,ns)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
924 a(2,ns) =a(2,ns)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
925 a(3,ns) =a(3,ns)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
926 ENDDO
927 END IF !((JT(1)+JT(2)+JT(3))==3) THEN
928C
929 IF ((jr(1)+jr(2)+jr(3)) >0.OR.irad ==0 ) THEN
930 IF ((jr(1)+jr(2)+jr(3)) >0 ) THEN
931 icr=jr(1)*4 +jr(2)*2 +jr(3)
932C---------save VR(*,M), VR(*,NS) before they are modified
933 DO j = 1,3
934 vrg(j)=vr(j,m)
935 ENDDO
936 DO i=1,nsl
937 ns = isl(i)
938 lxs(i)=vr(1,ns)
939 lys(i)=vr(2,ns)
940 lzs(i)=vr(3,ns)
941 vr(1:3,ns)=vr(1:3,ns)+ar(1:3,ns)*dt12
942 END DO !I=1,NSL
943C-----VR(t+dt)
944 vr(1:3,m)=vrg(1:3)+ar(1:3,m)*dt12
945 IF ((jr(1)+jr(2)+jr(3)) < 3) THEN
946 CALL rbe2d_bcl(icr ,nsl ,isl ,m ,vr ,
947 1 skew )
948 ELSE
949 DO i=1,nsl
950 ns = isl(i)
951 vr(1,ns)=vr(1,m)
952 vr(2,ns)=vr(2,m)
953 vr(3,ns)=vr(3,m)
954 ENDDO
955 ENDIF
956 DO i=1,nsl
957 ns = isl(i)
958 ar(1,ns)=(vr(1,ns)-lxs(i)) * usdt
959 ar(2,ns)=(vr(2,ns)-lys(i)) * usdt
960 ar(3,ns)=(vr(3,ns)-lzs(i)) * usdt
961 vr(1,ns)= lxs(i)
962 vr(2,ns)= lys(i)
963 vr(3,ns)= lzs(i)
964 END DO !I=1,NSL
965 vr(1:3,m)=vrg(1:3)
966 END IF !IF ((JR(1)+JR(2)+JR(3)) >0 )
967C
968 DO j = 1,3
969 vrg(j)=vr(j,m)+ar(j,m)*dt12
970 ENDDO
971 dt05 = half*dt2
972 IF (irad==0) THEN
973 DO j = 1,3
974 usdt1(j)=usdt*jt(j)
975 ENDDO
976 ELSE
977 DO j = 1,3
978 usdt1(j)=usdt
979 ENDDO
980 END IF
981 IF (irad ==0.AND.nsl_g<=2 .AND.(jt(1)+jt(2)+jt(3))==3) THEN
982! Nastran formulation uses all rot dofs for translation
983 DO i=1,nsl
984 ns = isl(i)
985 lsm(1:3) = x(1:3,ns)-x(1:3,m)
986 CALL velrot_explicit(vrg, lsm,vs,dt12)
987 as(1) = usdt*(vs(1)+dt05*(vrg(2)*vs(3)-vrg(3)*vs(2)))
988 as(2) = usdt*(vs(2)+dt05*(vrg(3)*vs(1)-vrg(1)*vs(3)))
989 as(3) = usdt*(vs(3)+dt05*(vrg(1)*vs(2)-vrg(2)*vs(1)))
990 a(1:3,ns)= a(1:3,ns)+as(1:3)
991 ENDDO
992 ELSE
993 DO i=1,nsl
994 ns = isl(i)
995 rx=vrg(1)
996 ry=vrg(2)
997 rz=vrg(3)
998 xs=x(1,ns)-x(1,m)
999 ys=x(2,ns)-x(2,m)
1000 zs=x(3,ns)-x(3,m)
1001 CALL cdi_bcn1(xs,ys,zs,jt,jr,skew,ktr,irad)
1002 vx1 =ktr(1,1)*rx+ktr(1,2)*ry+ktr(1,3)*rz
1003 vx2 =ktr(2,1)*rx+ktr(2,2)*ry+ktr(2,3)*rz
1004 vx3 =ktr(3,1)*rx+ktr(3,2)*ry+ktr(3,3)*rz
1005 a(1,ns) =a(1,ns)+(vx1+dt05*(vrg(2)*vx3-vrg(3)*vx2))*usdt1(1)
1006 a(2,ns) =a(2,ns)+(vx2+dt05*(vrg(3)*vx1-vrg(1)*vx3))*usdt1(2)
1007 a(3,ns) =a(3,ns)+(vx3+dt05*(vrg(1)*vx2-vrg(2)*vx1))*usdt1(3)
1008 ENDDO
1009 END IF
1010 END if! ((JR(1)+JR(2)+JR(3)) >0.OR.IRAD ==0 ) THEN
1011C---
1012 RETURN
1013 END
1014!||====================================================================
1015!|| rbe2_frd ../engine/source/constraints/general/rbe2/rbe2v.F
1016!||--- called by ------------------------------------------------------
1017!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.f
1018!|| imp3_u2x ../engine/source/airbag/monv_imp0.f
1019!||--- calls -----------------------------------------------------
1020!|| cdi_bcn1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
1021!|| rbe2d_bcl ../engine/source/constraints/general/rbe2/rbe2v.F
1022!||====================================================================
1023 SUBROUTINE rbe2_frd(NS ,M ,X ,V ,VR ,
1024 1 JT ,JR ,SKEW0 ,ISK ,IRAD )
1025C-----------------------------------------------
1026C I m p l i c i t T y p e s
1027C-----------------------------------------------
1028#include "implicit_f.inc"
1029C-----------------------------------------------
1030C C o m m o n B l o c k s
1031C-----------------------------------------------
1032#include "param_c.inc"
1033C-----------------------------------------------
1034C D u m m y A r g u m e n t s
1035C-----------------------------------------------
1036 INTEGER NS,JT(3),JR(3),M,IRAD,ISK
1037C REAL
1038 my_real
1039 . X(3,*), V(3,*), VR(3,*),SKEW0(*)
1040C-----------------------------------------------
1041C L o c a l V a r i a b l e s
1042C-----------------------------------------------
1043 INTEGER I, NT,NR,ICT,ICR,NSN,ISL(1),K
1044C REAL
1045 my_real
1046 . XS, YS, ZS,RX, RY,RZ,LRX, LRY,LRZ,RVX,RVY,RVZ,
1047 . DVX,DVY,DVZ,VVX,VVY,VVZ,KTR(3,3),SKEW(LSKEW)
1048C======================================================================|
1049 nt=jt(1)+jt(2)+jt(3)
1050 nr=jr(1)+jr(2)+jr(3)
1051 ict=jt(1)*4 +jt(2)*2 +jt(3)
1052 icr=jr(1)*4 +jr(2)*2 +jr(3)
1053 IF (isk>1) THEN
1054 DO k=1,lskew
1055 skew(k)=skew0(k)
1056 ENDDO
1057 ELSE
1058 DO k=1,lskew
1059 skew(k)=zero
1060 ENDDO
1061 skew(1)=one
1062 skew(5)=one
1063 skew(9)=one
1064 ENDIF
1065 IF (nt>0.AND.nt<3) THEN
1066 nsn=1
1067 isl(1)=ns
1068 CALL rbe2d_bcl(ict ,nsn ,isl ,m ,v ,
1069 1 skew )
1070 ELSEIF (nt==3) THEN
1071 v(1,ns)=v(1,m)
1072 v(2,ns)=v(2,m)
1073 v(3,ns)=v(3,m)
1074 ENDIF
1075C
1076 IF (nr>0) THEN
1077 IF (nr<3) THEN
1078 nsn=1
1079 isl(1)=ns
1080 CALL rbe2d_bcl(icr ,nsn ,isl ,m ,vr ,
1081 1 skew )
1082 ELSEIF (nr==3) THEN
1083 vr(1,ns)=vr(1,m)
1084 vr(2,ns)=vr(2,m)
1085 vr(3,ns)=vr(3,m)
1086 END IF
1087 END IF
1088C
1089 IF (irad==0.OR.nr>0) THEN
1090 rx=vr(1,m)
1091 ry=vr(2,m)
1092 rz=vr(3,m)
1093 xs=x(1,ns)-x(1,m)
1094 ys=x(2,ns)-x(2,m)
1095 zs=x(3,ns)-x(3,m)
1096 CALL cdi_bcn1(xs,ys,zs,jt,jr,skew,ktr,irad)
1097 v(1,ns) =v(1,ns)+ktr(1,1)*rx+ktr(1,2)*ry+ktr(1,3)*rz
1098 v(2,ns) =v(2,ns)+ktr(2,1)*rx+ktr(2,2)*ry+ktr(2,3)*rz
1099 v(3,ns) =v(3,ns)+ktr(3,1)*rx+ktr(3,2)*ry+ktr(3,3)*rz
1100 END IF
1101C---
1102 RETURN
1103 END
1104
1105!||====================================================================
1106!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
1107!||--- called by ------------------------------------------------------
1108!|| fv_imp ../engine/source/constraints/general/impvel/fv_imp0.F
1109!|| i2recu0 ../engine/source/interfaces/interf/i2_imp2.F
1110!|| i2recu2 ../engine/source/interfaces/interf/i2_imp2.F
1111!|| rbe2d0 ../engine/source/constraints/general/rbe2/rbe2v.F
1112!|| rbe2dl3 ../engine/source/constraints/general/rbe2/rbe2v.F
1113!|| rby_imp7 ../engine/source/constraints/general/rbody/rby_impd.F
1114!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
1115!||--- calls -----------------------------------------------------
1116!|| crossproduct ../engine/source/constraints/general/rbe2/rbe2v.f
1117!||====================================================================
1118 SUBROUTINE velrot(VRM,LSM,VS)
1119C-----------------------------------------------
1120C I m p l i c i t T y p e s
1121C-----------------------------------------------
1122#include "implicit_f.inc"
1123C-----------------------------------------------
1124C G l o b a l P a r a m e t e r s
1125C-----------------------------------------------
1126C PURPOSE: calculate displacement increment of secnd node by displacement increment of main node.
1127C the general ideal is that one local coordinate is created by W and the
1128C vector (LSM) pointing from main node to secnd node. The local coordinate
1129C can be expressed as
1130C Z = W,where W=(Wx, Wy, Wz)
1131C X = W CROSSPRODUCT LSM
1132C Y = Z CROSSPRODUCT X
1133C the problem can be describled as LSM rotate around local z axis, then the rotated
1134C vector is transformed back to global coordinate.
1135C-----------------------------------------------
1136C D u m m y A r g u m e n t s
1137C-----------------------------------------------
1138 my_real
1139 . vrm(*), lsm(*), vs(*)
1140C-----------------------------------------------
1141C L o c a l V a r i a b l e s
1142C-----------------------------------------------
1143
1144 INTEGER I , J , K
1145 my_real
1146 * ANGELV, RZ(3,3), LOCALZ(3), L, LOCALX(3), LSMUNI(3),TRANS(3,3),
1147 * LOCALY(3), LSMLOCAL(3), LSMLTR(3), LSMGTR(3)
1148
1149 DO I = 1 , 3
1150 vs(i) = zero
1151 END DO
1152
1153 l = zero
1154 DO i = 1 ,3
1155 l = l + lsm(i)*lsm(i)
1156 END DO
1157 l = sqrt(l)
1158 IF( l < em20) THEN
1159C SECND NODE COINCIDE WITH main NODE, NO VELICITY IS CAUSED BY ROTATION
1160 RETURN
1161 END IF
1162
1163 angelv = zero
1164 DO i = 1 , 3
1165 angelv = angelv + vrm(i)*vrm(i)
1166 END DO
1167 angelv = sqrt(angelv)
1168 IF( angelv <= em20) THEN
1169C NO ROTATION VELOCITY
1170 RETURN
1171 END IF
1172
1173 DO i = 1 , 3
1174 lsmuni(i) = lsm(i)/l
1175 END DO
1176
1177 DO i = 1 ,3
1178 localz(i ) = vrm(i)/angelv
1179 END DO
1180
1181 CALL crossproduct(localz,lsmuni,localx)
1182 l = 0
1183 DO i = 1 ,3
1184 l = l + localx(i)*localx(i)
1185 END DO
1186 l = sqrt(l)
1187 IF( l <= em20 )THEN
1188C ROTATION AXIS COINCIDIE WITH THE VECTOR POINTING FROM main TO SECND.
1189C SO NO VELOCITY WILL BE CAUSED BY THIS ROTATION
1190 RETURN
1191 END IF
1192 DO i = 1 , 3
1193 localx(i) = localx(i)/l
1194 END DO
1195
1196 CALL crossproduct(localz,localx,localy)
1197
1198 DO i = 1 ,3
1199 trans(1,i) = localx(i)
1200 trans(2,i) = localy(i)
1201 trans(3,i) = localz(i)
1202 END DO
1203
1204
1205 DO i = 1 ,3
1206 lsmlocal(i) = zero
1207 END DO
1208
1209 DO i = 1 ,3
1210 DO j = 1 , 3
1211 lsmlocal(i) = lsmlocal(i) + trans(i,j)*lsm(j)
1212 END DO
1213 END DO
1214
1215 DO i = 1 , 3
1216 DO j = 1 , 3
1217 rz(i,j) = zero
1218 END DO
1219 END DO
1220
1221 rz(1,1) = cos(angelv)
1222 rz(1,2) = sin(angelv)
1223 rz(2,1) = -sin(angelv)
1224 rz(2,2) = cos(angelv)
1225 rz(3,3) = one
1226
1227 DO i = 1,3
1228 lsmltr(i) = zero
1229 END DO
1230
1231 DO i = 1 , 3
1232 DO j = 1 , 3
1233 lsmltr(i) = lsmltr(i) + rz(j,i)*lsmlocal(j)
1234 END DO
1235 END DO
1236
1237 DO i = 1 , 3
1238 lsmgtr(i) = zero
1239 END DO
1240
1241 DO i = 1, 3
1242 DO j = 1 , 3
1243 lsmgtr(i) = lsmgtr(i) + trans(j,i)*lsmltr(j)
1244 END DO
1245 END DO
1246
1247 DO i = 1 , 3
1248 vs(i) = lsmgtr(i) - lsm(i)
1249 END DO
1250
1251 RETURN
1252
1253 END SUBROUTINE !VELROT
1254
1255
1256!||====================================================================
1257!|| crossproduct ../engine/source/constraints/general/rbe2/rbe2v.F
1258!||--- called by ------------------------------------------------------
1259!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
1260!||====================================================================
1261 SUBROUTINE crossproduct(X,Y,Z)
1262C-----------------------------------------------
1263C I m p l i c i t T y p e s
1264C-----------------------------------------------
1265#include "implicit_f.inc"
1266C-----------------------------------------------
1267C PURPOSE:
1268C CALCULATE CROSSPRODUCT Z = X (X) Y
1269
1270 my_real
1271 * x(*),y(*),z(*)
1272
1273 z(1) = x(2)*y(3) - y(2)*x(3)
1274 z(2) = -x(1)*y(3) + y(1)*x(3)
1275 z(3) = x(1)*y(2) - y(1)*x(2)
1276
1277 RETURN
1278
1279 END ! SUBROUTINE CROSSPRODUCT
1280
1281!||====================================================================
1282!|| rbe2dl3 ../engine/source/constraints/general/rbe2/rbe2v.F
1283!||--- called by ------------------------------------------------------
1284!|| rbe2_impd ../engine/source/constraints/general/rbe2/rbe2v.F
1285!||--- calls -----------------------------------------------------
1286!|| select_dof ../engine/source/constraints/general/rbe2/rbe2v.F
1287!|| update_globv ../engine/source/constraints/general/rbe2/rbe2v.F
1288!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
1289!||====================================================================
1290 SUBROUTINE rbe2dl3(NSN ,ISL ,X ,V ,VR ,
1291 1 JT ,JR ,M ,SKEW ,IRAD )
1292C-----------------------------------------------
1293C I m p l i c i t T y p e s
1294C-----------------------------------------------
1295#include "implicit_f.inc"
1296C-----------------------------------------------
1297C D u m m y A r g u m e n t s
1298C-----------------------------------------------
1299 INTEGER NSN,ISL(*),JT(3),JR(3),M,IRAD
1300C REAL
1301 my_real
1302 . X(3,*), V(3,*), VR(3,*),SKEW(*)
1303C-----------------------------------------------
1304C L o c a l V a r i a b l e s
1305C-----------------------------------------------
1306 INTEGER I, NS ,NT,NR,ICT,ICR , J , K,
1307 . TDOF1,TDOF2,TDOF3,RDOF1,RDOF2,RDOF3
1308C REAL
1309 my_real
1310 . RX, RY,RZ,LRX, LRY,LRZ,RVX,RVY,RVZ,
1311 . DVX,DVY,DVZ,VVX,VVY,VVZ,KTR(3,3), VLM(3),LOCALSM(3),GL0BLSM(3),
1312 . VLS(3), VRLM(3), VRLS(3),VSROT(3),VRTEMP(3)
1313
1314C======================================================================|
1315
1316
1317 nt=jt(1)+jt(2)+jt(3)
1318 nr=jr(1)+jr(2)+jr(3)
1319 ict=jt(1)*4 +jt(2)*2 +jt(3)
1320 icr=jr(1)*4 +jr(2)*2 +jr(3)
1321
1322 CALL select_dof(ict, skew, tdof1, tdof2, tdof3)
1323 CALL select_dof(icr, skew, rdof1, rdof2, rdof3)
1324
1325C transform velocity of main node from global coordinate to local coordinate
1326 DO i = 1 , 3
1327 vlm(i) = zero
1328 vrlm(i) = zero
1329 END DO
1330
1331 DO i = 1, 3
1332 DO j = 1 , 3
1333 vlm(i) = vlm(i) + skew((i-1)*3+j)*v(j,m)
1334 vrlm(i) = vrlm(i) + skew((i-1)*3+j)*vr(j,m)
1335 END DO
1336 END DO
1337
1338 DO i = 1 , nsn
1339
1340 ns = isl(i)
1341
1342 DO j = 1 , 3
1343 gl0blsm(j) = x(j,ns) - x(j,m)
1344 END DO
1345
1346C transform vector pointing from main node to secnd node to local coordinate
1347 DO j = 1 , 3
1348 localsm(j) = zero
1349 DO k = 1 , 3
1350 localsm(j) = localsm(j) + skew((j-1)*3+k)*gl0blsm(k)
1351 END DO
1352 END DO
1353
1354 DO j = 1 , 3
1355 vls(j) = vlm(j) * jt(j)
1356 vrls(j) = vrlm(j) * jr(j)
1357 END DO
1358
1359 IF( irad == 0) THEN ! NASTRAN FORMAT
1360 CALL velrot(vrlm, localsm,vsrot)
1361 IF( jt(1) /= 0 ) vls(1) = vls(1) + vsrot(1)
1362 IF( jt(2) /= 0 ) vls(2) = vls(2) + vsrot(2)
1363 IF( jt(3) /= 0 ) vls(3) = vls(3) + vsrot(3)
1364 ELSE IF( (jr(1)+jr(2)+jr(3))>0) THEN ! RIGID LINK
1365 DO j = 1, 3
1366 vrtemp(j) = vrlm(j) * jr(j)
1367 END DO
1368 CALL velrot(vrtemp, localsm,vsrot)
1369 DO j = 1 , 3
1370 vls(j) = vls(j) + vsrot(j)
1371 END DO
1372
1373 END IF ! IRAD == 0
1374
1375C update dependent DOF(s) by independent DOF(s)
1376
1377 CALL update_globv(ict,ns,vls,v,skew,tdof1,
1378 . tdof2,tdof3)
1379
1380 CALL update_globv(icr,ns,vrls,vr,skew,rdof1,
1381 . rdof2,rdof3)
1382
1383 END DO ! I = 1 , NSN
1384
1385C---
1386 RETURN
1387 END ! SUBROUTINE RBE2DL3
1388
1389!||====================================================================
1390!|| select_dof ../engine/source/constraints/general/rbe2/rbe2v.F
1391!||--- called by ------------------------------------------------------
1392!|| rbe2dl3 ../engine/source/constraints/general/rbe2/rbe2v.F
1393!||--- calls -----------------------------------------------------
1394!|| dir_rbe2 ../engine/source/constraints/general/rbe2/rbe2v.F
1395!|| l_dir ../engine/source/constraints/general/bcs/bc_imp0.F
1396!||====================================================================
1397 SUBROUTINE select_dof(ICT, SKEW, J, J1, K)
1398#include "implicit_f.inc"
1399
1400C
1401 INTEGER ICT, J, J1, K
1402 my_real
1403 . SKEW(*)
1404
1405C WORK VARIABLE
1406
1407 my_real
1408 . EJ(3), EJ1(3)
1409
1410C-------------------100---------------------
1411 IF (ict == 4 ) THEN
1412 ej(1)=skew(1)
1413 ej(2)=skew(2)
1414 ej(3)=skew(3)
1415 CALL l_dir(ej,j)
1416 j1=0
1417 CALL dir_rbe2(j ,j1 ,k )
1418C-------------------010---------------------
1419 ELSEIF (ict == 2) THEN
1420 ej(1)=skew(4)
1421 ej(2)=skew(5)
1422 ej(3)=skew(6)
1423 CALL l_dir(ej,j)
1424 j1=0
1425 CALL dir_rbe2(j ,j1 ,k )
1426C-------------------001---------------------
1427 ELSEIF (ict == 1) THEN
1428 ej(1)=skew(7)
1429 ej(2)=skew(8)
1430 ej(3)=skew(9)
1431 CALL l_dir(ej,j)
1432 j1=0
1433 CALL dir_rbe2(j ,j1 ,k )
1434C-------------------011---------------------
1435 ELSEIF (ict == 3) THEN
1436 ej(1)=skew(7)
1437 ej(2)=skew(8)
1438 ej(3)=skew(9)
1439 CALL l_dir(ej,j)
1440 ej1(1)=skew(4)
1441 ej1(2)=skew(5)
1442 ej1(3)=skew(6)
1443 CALL l_dir(ej1,j1)
1444 IF (j1==j) THEN
1445 ej1(j)=zero
1446 CALL l_dir(ej1,j1)
1447 ENDIF
1448 CALL dir_rbe2(j ,j1 ,k )
1449C-------------------101---------------------
1450 ELSEIF (ict == 5) THEN
1451 ej(1)=skew(7)
1452 ej(2)=skew(8)
1453 ej(3)=skew(9)
1454 CALL l_dir(ej,j)
1455 ej1(1)=skew(1)
1456 ej1(2)=skew(2)
1457 ej1(3)=skew(3)
1458 CALL l_dir(ej1,j1)
1459 IF (j1==j) THEN
1460 ej1(j)=zero
1461 CALL l_dir(ej1,j1)
1462 ENDIF
1463 CALL dir_rbe2(j ,j1 ,k )
1464C-------------------110---------------------
1465 ELSEIF (ict == 6) THEN
1466 ej(1)=skew(4)
1467 ej(2)=skew(5)
1468 ej(3)=skew(6)
1469 CALL l_dir(ej,j)
1470 ej1(1)=skew(1)
1471 ej1(2)=skew(2)
1472 ej1(3)=skew(3)
1473 CALL l_dir(ej1,j1)
1474 IF (j1==j) THEN
1475 ej1(j)=zero
1476 CALL l_dir(ej1,j1)
1477 ENDIF
1478 CALL dir_rbe2(j ,j1 ,k )
1479 ENDIF
1480
1481 END !SUBROUTINE SELECT_DOF
1482
1483
1484!||====================================================================
1485!|| update_globv ../engine/source/constraints/general/rbe2/rbe2v.F
1486!||--- called by ------------------------------------------------------
1487!|| rbe2dl3 ../engine/source/constraints/general/rbe2/rbe2v.F
1488!||====================================================================
1489 SUBROUTINE update_globv(ICT,NS,VLS,V,SKEW,J, J1, K)
1490#include "implicit_f.inc"
1491#include "param_c.inc"
1492 INTEGER ICT, NS, J, J1, K
1493 my_real
1494 . vls(3), v(3,*),skew(lskew)
1495
1496C WORK VARIABLE
1497 INTEGER M,N,I
1498 my_real
1499 . SKEWINV(3,3), ARRAY1(2), ARRAY2(2,2), TEMP, SKEW1(3,3)
1500
1501 DO I=1,3
1502 skewinv(i,1)= skew(i)
1503 skewinv(i,2)= skew(i+3)
1504 skewinv(i,3)= skew(i+6)
1505 ENDDO
1506
1507 DO m = 1, 3
1508 DO n = 1 ,3
1509 skew1(m,n) = skew((m-1)*3+n)
1510 END DO
1511 END DO
1512
1513C-------------------100---------------------
1514 IF (ict == 4 ) THEN
1515 v(j,ns) = one/skew1(1,j)*(vls(1)-skew1(1,j1)*v(j1,ns)
1516 . -skew1(1,k)*v(k,ns ))
1517C-------------------010---------------------
1518 ELSEIF (ict == 2) THEN
1519 v(j,ns) = one/skew1(2,j)*(vls(2)-skew1(2,j1)*v(j1,ns)
1520 . -skew1(2,k)*v(k,ns ))
1521C-------------------001---------------------
1522 ELSEIF (ict == 1) THEN
1523 v(j,ns) = one/skew1(3,j)*(vls(3)-skew1(3,j1)*v(j1,ns)
1524 . -skew1(3,k)*v(k,ns ))
1525C-------------------011---------------------
1526 ELSEIF (ict == 3) THEN
1527
1528 array1(1) = vls(2) - skew1(2,k) * v(k,ns)
1529 array1(2) = vls(3) - skew1(3,k) * v(k,ns)
1530
1531 temp = skew1(2,j)*skew1(3,j1) - skew1(2,j1)*skew1(3,j)
1532 array2(1,1) = skew1(3,j1)/temp
1533 array2(1,2) = -skew1(2,j1)/temp
1534 array2(2,1) = -skew1(3,j)/temp
1535 array2(2,2) = skew1(2,j)/temp
1536
1537 v(j,ns) = array2(1,1) * array1(1) + array2(1,2) * array1(2)
1538 v(j1,ns) = array2(2,1) * array1(1) + array2(2,2) * array1(2)
1539
1540C-------------------101---------------------
1541 ELSEIF (ict == 5) THEN
1542
1543 array1(1) = vls(1) - skew1(1,k) * v(k,ns)
1544 array1(2) = vls(3) - skew1(3,k) * v(k,ns)
1545
1546 temp = skew1(1,j)*skew1(3,j1) - skew1(1,j1)*skew1(3,j)
1547 array2(1,1) = skew1(3,j1)/temp
1548 array2(1,2) = -skew1(1,j1)/temp
1549 array2(2,1) = -skew1(3,j)/temp
1550 array2(2,2) = skew1(1,j)/temp
1551
1552 v(j,ns) = array2(1,1) * array1(1) + array2(1,2) * array1(2)
1553 v(j1,ns) = array2(2,1) * array1(1) + array2(2,2) * array1(2)
1554
1555C-------------------110---------------------
1556 ELSEIF (ict == 6) THEN
1557 array1(1) = vls(2) - skew1(2,k) * v(k,ns)
1558 array1(2) = vls(1) - skew1(1,k) * v(k,ns)
1559
1560 temp = skew1(2,j)*skew1(1,j1) - skew1(2,j1)*skew1(1,j)
1561 array2(1,1) = skew1(1,j1)/temp
1562 array2(1,2) = -skew1(2,j1)/temp
1563 array2(2,1) = -skew1(1,j)/temp
1564 array2(2,2) = skew1(2,j)/temp
1565
1566 v(j,ns) = array2(1,1) * array1(1) + array2(1,2) * array1(2)
1567 v(j1,ns) = array2(2,1) * array1(1) + array2(2,2) * array1(2)
1568
1569C-------------------110---------------------
1570 ELSEIF( ict == 7 ) THEN
1571 DO m = 1 , 3
1572 v(m,ns) = zero
1573 DO n = 1 , 3
1574 v(m,ns) = v(m,ns) + skewinv(m,n)*vls(n)
1575 END DO
1576 END DO
1577 ENDIF
1578
1579 RETURN
1580
1581 END ! SUBROUTINE CONDENSE
1582
l_dir
subroutine l_dir(ej, j)
Definition bc_imp0.F:405
bc_imp0
subroutine bc_imp0(icodt, icodr, iskew, ifix, ndof, iadn)
Definition bc_imp0.F:31
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
imp_fri
subroutine imp_fri(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, nddl, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:45
fr_u2dd
subroutine fr_u2dd(d, dr, x, ipari, intbuf_tab, ndof, a, ar, lx, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:2607
prerbe2
subroutine prerbe2(irbe2, jt, jr)
Definition kinchk.F:1974
imp3_u2x
subroutine imp3_u2x(x, ipari, intbuf_tab, ndof, lx, a, ar, x_imp, numn, inl, iddl, nrb, irb, iddlm, ni2, ii2, iddlm2, nfx, ifx, nbc, ibc, nrw, irw, ibfv, skew, xframe, irbe3, lrbe3, nr3, ir3, iddlm3, r3_max, fcdi, mcdi, nspc, ispc, irbe2, lrbe2, nr2, ir2, iddlm4)
Definition monv_imp0.F:1934
cdi_bcn1
subroutine cdi_bcn1(xs, ys, zs, jt, jr, skew, ktr, irad)
Definition rbe2_imp0.F:1449
rbe2v
subroutine rbe2v(irbe2, lrbe2, x, a, ar, v, vr, skew)
Definition rbe2v.F:34
rbe2dl
subroutine rbe2dl(nsn, isl, x, v, vr, jt, jr, m, skew)
Definition rbe2v.F:374
velrot
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119
rbe2_frd
subroutine rbe2_frd(ns, m, x, v, vr, jt, jr, skew0, isk, irad)
Definition rbe2v.F:1025
rbe2dl2
subroutine rbe2dl2(nsn, isl, x, v, vr, jt, jr, m, skew, irad)
Definition rbe2v.F:454
dir_rbe2
subroutine dir_rbe2(j, j1, k)
Definition rbe2v.F:714
rbe2v0
subroutine rbe2v0(nsl, isl, x, a, ar, v, vr, jt, jr, m)
Definition rbe2v.F:82
rbe2vl
subroutine rbe2vl(nsn, isl, x, a, ar, v, vr, jt, jr, m, skew)
Definition rbe2v.F:140
rbe2dl3
subroutine rbe2dl3(nsn, isl, x, v, vr, jt, jr, m, skew, irad)
Definition rbe2v.F:1292
crossproduct
subroutine crossproduct(x, y, z)
Definition rbe2v.F:1262
rbe2_impd
subroutine rbe2_impd(irbe2, lrbe2, x, d, dr, skew)
Definition rbe2v.F:221
update_globv
subroutine update_globv(ict, ns, vls, v, skew, j, j1, k)
Definition rbe2v.F:1490
rbe2d_bcl
subroutine rbe2d_bcl(ict, nsn, isl, m, v, skew)
Definition rbe2v.F:534
rbe2d0
subroutine rbe2d0(nsl, isl, x, v, vr, jt, jr, m, irad)
Definition rbe2v.F:277
rbe2vl1
subroutine rbe2vl1(nsl, isl, x, a, ar, v, vr, jt, jr, m, skew, irad, nsl_g)
Definition rbe2v.F:873
rbe2v1
subroutine rbe2v1(nsl, isl, x, a, ar, v, vr, jt, jr, m, irad, nsl_g)
Definition rbe2v.F:749
select_dof
subroutine select_dof(ict, skew, j, j1, k)
Definition rbe2v.F:1398