OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_gjnt.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!|| lag_gjnt ../engine/source/tools/lagmul/lag_gjnt.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- calls -----------------------------------------------------
28!|| gjnt_diff ../engine/source/tools/lagmul/gjnt_diff.F
29!|| gjnt_gear ../engine/source/tools/lagmul/gjnt_gear.F
30!|| gjnt_rack ../engine/source/tools/lagmul/gjnt_rack.F
31!|| lag_direct ../engine/source/tools/lagmul/lag_direct.F
32!|| rotbmr ../engine/source/tools/skew/rotbmr.F
33!||====================================================================
34 SUBROUTINE lag_gjnt(GJBUFI ,GJBUFR ,X ,VR ,AR ,
35 2 IADLL ,LLL ,JLL ,SLL ,XLL ,
36 3 COMNTAG,LTSM ,ICFTAG ,JCFTAG ,MS ,
37 4 IN ,V ,A ,ISKIP ,NCF_S ,
38 5 NC )
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "param_c.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com08_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER NC,ISKIP,NCF_S,
55 . LLL(*),JLL(*),SLL(*),IADLL(*),GJBUFI(LKJNI,*),
56 . COMNTAG(*),ICFTAG(*),JCFTAG(*)
57 my_real
58 . gjbufr(lkjnr,*),ltsm(6,*),xll(*),ms(*),in(*),
59 . x(3,*),v(3,*),a(3,*),vr(3,*),ar(3,*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,K,JTYP,N0,N1,N2,N3,IC,NC_INI,NCL,COMFLAG
64 my_real
65 . VRN(3),DVR(3),VL(3),P(9),L1(3),L2(3),L3(3),ALPHA, DTD
66C======================================================================|
67 DO i=1,ngjoint
68 jtyp= gjbufi(2,i)
69 n0 = gjbufi(3,i)
70 n1 = gjbufi(4,i)
71 n2 = gjbufi(5,i)
72 n3 = gjbufi(6,i)
73C
74C--- Frame actualisation (main skew) at the beginning of the step
75 vrn(1) = vr(1,n0) + dt12*ar(1,n0)
76 vrn(2) = vr(2,n0) + dt12*ar(2,n0)
77 vrn(3) = vr(3,n0) + dt12*ar(3,n0)
78 vl(1) = gjbufr( 2,i)*vr(1,n0)
79 . +gjbufr( 3,i)*vr(2,n0)
80 . +gjbufr( 4,i)*vr(3,n0)
81 vl(2) = gjbufr( 5,i)*vr(1,n0)
82 . +gjbufr( 6,i)*vr(2,n0)
83 . +gjbufr( 7,i)*vr(3,n0)
84 vl(3) = gjbufr( 8,i)*vr(1,n0)
85 . +gjbufr( 9,i)*vr(2,n0)
86 . +gjbufr(10,i)*vr(3,n0)
87 CALL rotbmr (vl ,gjbufr(2,i) ,dt1)
88C--- Frame estimation at the middle of the step
89 dvr(1) = dt12*ar(1,n0)
90 dvr(2) = dt12*ar(2,n0)
91 dvr(3) = dt12*ar(3,n0)
92 p(1) = gjbufr( 2,i)
93 p(2) = gjbufr( 3,i)
94 p(3) = gjbufr( 4,i)
95 p(4) = gjbufr( 5,i)
96 p(5) = gjbufr( 6,i)
97 p(6) = gjbufr( 7,i)
98 p(7) = gjbufr( 8,i)
99 p(8) = gjbufr( 9,i)
100 p(9) = gjbufr(10,i)
101 vl(1)=gjbufr(2,i)*vrn(1)+gjbufr(3,i)*vrn(2)+gjbufr(4,i)*vrn(3)
102 vl(2)=gjbufr(5,i)*vrn(1)+gjbufr(6,i)*vrn(2)+gjbufr(7,i)*vrn(3)
103 vl(3)=gjbufr(8,i)*vrn(1)+gjbufr(9,i)*vrn(2)+gjbufr(10,i)*vrn(3)
104 vl(1)=p(1)*dvr(1)+p(2)*dvr(2)+p(3)*dvr(3)
105 vl(2)=p(4)*dvr(1)+p(5)*dvr(2)+p(6)*dvr(3)
106 vl(3)=p(7)*dvr(1)+p(8)*dvr(2)+p(9)*dvr(3)
107 dtd = half*dt2
108 CALL rotbmr (vl ,p ,dtd)
109C
110 alpha = gjbufr( 1,i)
111 l1(1) = gjbufr(11,i)
112 l1(2) = gjbufr(12,i)
113 l1(3) = gjbufr(13,i)
114 l2(1) = gjbufr(14,i)
115 l2(2) = gjbufr(15,i)
116 l2(3) = gjbufr(16,i)
117 nc_ini = nc
118 comflag = 0
119 IF (comntag(n0)>1) comflag = 1
120 IF (comntag(n1)>1) comflag = 1
121 IF (comntag(n2)>1) comflag = 1
122C---
123 IF (jtyp==1) THEN
124 ncl = 11
125 CALL gjnt_gear(p ,l1 ,l2 ,alpha ,x ,
126 2 iadll ,lll ,jll ,sll ,xll ,
127 3 n0 ,n1 ,n2 ,nc )
128 ELSEIF (jtyp==2) THEN
129 IF (comntag(n3)>1) comflag = 1
130 ncl = 13
131 l3(1) = gjbufr(17,i)
132 l3(2) = gjbufr(18,i)
133 l3(3) = gjbufr(19,i)
134 CALL gjnt_diff(p ,l1 ,l2 ,l3 ,alpha ,
135 2 iadll ,lll ,jll ,sll ,xll ,
136 3 x ,n0 ,n1 ,n2 ,n3 ,
137 4 nc )
138 ELSEIF (jtyp==3) THEN
139 ncl = 9
140 CALL gjnt_rack(p ,l1 ,l2 ,alpha ,x ,
141 2 iadll ,lll ,jll ,sll ,xll ,
142 3 n0 ,n1 ,n2 ,nc )
143 ENDIF
144C
145C--- Solving local Lagrange multipliers
146 CALL lag_direct(
147 1 iadll ,lll ,jll ,xll ,ltsm ,
148 2 v ,vr ,a ,ar ,ms ,
149 3 in ,nc_ini ,ncl )
150 IF (comflag==0) THEN
151 iskip = iskip + ncl
152 nc = nc_ini
153 ELSE
154 ic = nc_ini - ncf_s
155 DO k=1,ncl
156 ic = ic + 1
157 icftag(ic) = ic + iskip
158 jcftag(ic+iskip) = nc_ini + k
159 ENDDO
160 ENDIF
161 ENDDO
162C---
163 RETURN
164 END
alpha
#define alpha
Definition eval.h:35
gjnt_diff
subroutine gjnt_diff(sk, l1, l2, l3, alpha, iadll, lll, jll, sll, xll, x, n0, n1, n2, n3, nc)
Definition gjnt_diff.F:32
gjnt_gear
subroutine gjnt_gear(sk, l1, l2, alpha, x, iadll, lll, jll, sll, xll, n0, n1, n2, nc)
Definition gjnt_gear.F:31
gjnt_rack
subroutine gjnt_rack(sk, l1, l2, alpha, x, iadll, lll, jll, sll, xll, n0, n1, n2, nc)
Definition gjnt_rack.F:31
lag_direct
subroutine lag_direct(iadll, lll, jll, xll, ltsm, v, vr, a, ar, ms, in, nc_ini, ncl)
Definition lag_direct.F:38
lag_gjnt
subroutine lag_gjnt(gjbufi, gjbufr, x, vr, ar, iadll, lll, jll, sll, xll, comntag, ltsm, icftag, jcftag, ms, in, v, a, iskip, ncf_s, nc)
Definition lag_gjnt.F:39
rotbmr
subroutine rotbmr(vr, rby, dt)
Definition rotbmr.F:35