OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rbe3v.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!|| rbe3v ../engine/source/constraints/general/rbe3/rbe3v.f
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
29!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
30!||--- uses -----------------------------------------------------
31!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
32!|| rbe3_mod ../common_source/modules/constraints/rbe3_mod.F90
33!||====================================================================
34 SUBROUTINE rbe3v(RBE3 ,NODES, SKEW )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE rbe3_mod
39 use nodal_arrays_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com01_c.inc"
48#include "com04_c.inc"
49#include "param_c.inc"
50#include "tabsiz_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 my_real skew(*)
56 TYPE(rbe3_),INTENT(INOUT) :: RBE3
57 TYPE(nodal_arrays_), INTENT(INOUT) :: NODES
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
62 . JT(3,NRBE3),JR(3,NRBE3),NM,NN,K,IPEN
63C REAL
64 my_real
65 . vs(3),vrs(3),as(3),ars(3)
66 my_real,
67 . DIMENSION(:,:,:),ALLOCATABLE :: fdstnb ,mdstnb
68
69C======================================================================|
70 iads = slrbe3/2
71 CALL prerbe3(rbe3%IRBE3 ,max_m , irotg,jt ,jr )
72 ALLOCATE(fdstnb(3,6,max_m))
73 IF (irotg>0) ALLOCATE(mdstnb(3,6,max_m))
74 DO n= nrbe3,1,-1
75 iad = rbe3%IRBE3(1,n)
76 ns = rbe3%IRBE3(3,n)
77 nml = rbe3%IRBE3(5,n)
78 ipen= rbe3%IRBE3(9,n)
79 IF (ns==0.OR.ipen>0) cycle
80 irot =min(rbe3%IRBE3(6,n),iroddl)
81 CALL rbe3cl(rbe3%LRBE3(iad+1),rbe3%LRBE3(iads+iad+1),ns ,nodes%X ,
82 . rbe3%FRBE3(6*iad+1),skew ,nml ,irot ,fdstnb ,
83 . mdstnb ,rbe3%IRBE3(2,n))
84 DO j = 1,3
85 vs(j) = zero
86 vrs(j) = zero
87 as(j) = zero
88 ars(j) = zero
89 ENDDO
90 DO i=1,nml
91 m = rbe3%LRBE3(iad+i)
92 DO j = 1,3
93 DO k = 1,3
94 vs(j) = vs(j)+fdstnb(k,j,i)*nodes%V(k,m)
95 as(j) = as(j)+fdstnb(k,j,i)*nodes%A(k,m)
96 vrs(j) = vrs(j)+fdstnb(k,j+3,i)*nodes%V(k,m)
97 ars(j) = ars(j)+fdstnb(k,j+3,i)*nodes%A(k,m)
98 ENDDO
99 ENDDO
100 ENDDO
101 IF (irot>0) THEN
102 DO i=1,nml
103 m = rbe3%LRBE3(iad+i)
104 DO j = 1,3
105 DO k = 1,3
106 vs(j) = vs(j)+mdstnb(k,j,i)*nodes%VR(k,m)
107 as(j) = as(j)+mdstnb(k,j,i)*nodes%AR(k,m)
108 vrs(j) = vrs(j)+mdstnb(k,j+3,i)*nodes%VR(k,m)
109 ars(j) = ars(j)+mdstnb(k,j+3,i)*nodes%AR(k,m)
110 ENDDO
111 ENDDO
112 ENDDO
113 ENDIF
114 DO j = 1,3
115 nodes%V(j,ns) = vs(j) *jt(j,n)
116 nodes%A(j,ns) = as(j) *jt(j,n)
117 ENDDO
118 IF ((jr(1,n)+jr(2,n)+jr(3,n))>0) THEN
119 DO j = 1,3
120 nodes%VR(j,ns) = vrs(j) *jr(j,n)
121 nodes%AR(j,ns) = ars(j) *jr(j,n)
122 ENDDO
123 ENDIF
124 ENDDO
125C
126 DEALLOCATE(fdstnb)
127 IF (irotg>0) DEALLOCATE(mdstnb)
128C---
129 RETURN
130 END
131!||====================================================================
132!|| rbe3_impd ../engine/source/constraints/general/rbe3/rbe3v.F
133!||--- called by ------------------------------------------------------
134!|| recukin ../engine/source/implicit/recudis.F
135!||--- calls -----------------------------------------------------
136!|| prerbe3 ../engine/source/constraints/general/rbe3/rbe3f.F
137!|| rbe3cl ../engine/source/constraints/general/rbe3/rbe3f.F
138!||====================================================================
139 SUBROUTINE rbe3_impd(IRBE3 ,LRBE3 ,X ,D ,DR ,
140 1 FRBE3 ,SKEW )
141C-----------------------------------------------
142C I m p l i c i t T y p e s
143C-----------------------------------------------
144#include "implicit_f.inc"
145C-----------------------------------------------
146C C o m m o n B l o c k s
147C-----------------------------------------------
148#include "com01_c.inc"
149#include "com04_c.inc"
150#include "param_c.inc"
151#include "tabsiz_c.inc"
152C-----------------------------------------------
153C D u m m y A r g u m e n t s
154C-----------------------------------------------
155 INTEGER IRBE3(NRBE3L,*),LRBE3(*)
156C REAL
157 my_real
158 . x(3,*), d(3,*), dr(3,*), frbe3(*),skew(*)
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162 INTEGER I, J, N, M, NS ,NML, IAD,JJ,IROT,IADS,MAX_M,IROTG,
163 . jt(3,nrbe3),jr(3,nrbe3),nm,nn,k
164C REAL
165 my_real
166 . vs(3),vrs(3)
167 my_real,
168 . DIMENSION(:,:,:),ALLOCATABLE :: fdstnb ,mdstnb
169
170C======================================================================|
171 iads = slrbe3/2
172 CALL prerbe3(irbe3 ,max_m , irotg,jt ,jr )
173 ALLOCATE(fdstnb(3,6,max_m))
174 IF (irotg>0) ALLOCATE(mdstnb(3,6,max_m))
175 DO n=1,nrbe3
176 iad = irbe3(1,n)
177 ns = irbe3(3,n)
178 IF (ns==0) cycle
179 nml = irbe3(5,n)
180 irot =min(irbe3(6,n),iroddl)
181 CALL rbe3cl(lrbe3(iad+1),lrbe3(iads+iad+1),ns ,x ,
182 . frbe3(6*iad+1),skew ,nml ,irot ,fdstnb ,
183 . mdstnb ,irbe3(2,n))
184 DO j = 1,3
185 vs(j) = zero
186 vrs(j) = zero
187 ENDDO
188 DO i=1,nml
189 m = lrbe3(iad+i)
190 DO j = 1,3
191 DO k = 1,3
192 vs(j) = vs(j)+fdstnb(k,j,i)*d(k,m)
193 vrs(j) = vrs(j)+fdstnb(k,j+3,i)*d(k,m)
194 ENDDO
195 ENDDO
196 ENDDO
197 IF (irot>0) THEN
198 DO i=1,nml
199 m = lrbe3(iad+i)
200 DO j = 1,3
201 DO k = 1,3
202 vs(j) = vs(j)+mdstnb(k,j,i)*dr(k,m)
203 vrs(j) = vrs(j)+mdstnb(k,j+3,i)*dr(k,m)
204 ENDDO
205 ENDDO
206 ENDDO
207 ENDIF
208 DO j = 1,3
209 d(j,ns) = vs(j) *jt(j,n)
210 ENDDO
211 IF ((jr(1,n)+jr(2,n)+jr(3,n))>0) THEN
212 DO j = 1,3
213 dr(j,ns) = vrs(j) *jr(j,n)
214 ENDDO
215 ENDIF
216 ENDDO
217C
218 DEALLOCATE(fdstnb)
219 IF (irotg>0) DEALLOCATE(mdstnb)
220C---
221 RETURN
222 END
223!||====================================================================
224!|| rbe3_frd ../engine/source/constraints/general/rbe3/rbe3v.F
225!||--- called by ------------------------------------------------------
226!|| fr_u2dd ../engine/source/mpi/implicit/imp_fri.F
227!|| imp3_u2x ../engine/source/airbag/monv_imp0.F
228!||====================================================================
229 SUBROUTINE rbe3_frd(NML ,IML ,NS ,D ,DR ,
230 1 FDSTNB ,MDSTNB ,JT ,JR ,IROT )
231C-----------------------------------------------
232C I m p l i c i t T y p e s
233C-----------------------------------------------
234#include "implicit_f.inc"
235C-----------------------------------------------
236C D u m m y A r g u m e n t s
237C-----------------------------------------------
238 INTEGER NML,IML(*),NS,IROT,JT(*),JR(*)
239 my_real
240 . d(3,*), dr(3,*), fdstnb(3,6,*) ,mdstnb(3,6,*)
241C-----------------------------------------------
242C L o c a l V a r i a b l e s
243C-----------------------------------------------
244 INTEGER I, J, N, M, IAD,JJ,NM,NN,K
245 my_real
246 . vs(3),vrs(3)
247
248C======================================================================|
249 DO j = 1,3
250 vs(j) = zero
251 vrs(j) = zero
252 ENDDO
253 DO i=1,nml
254 m = iml(i)
255 DO j = 1,3
256 DO k = 1,3
257 vs(j) = vs(j)+fdstnb(k,j,i)*d(k,m)
258 vrs(j) = vrs(j)+fdstnb(k,j+3,i)*d(k,m)
259 ENDDO
260 ENDDO
261 ENDDO
262 IF (irot>0) THEN
263 DO i=1,nml
264 m = iml(i)
265 DO j = 1,3
266 DO k = 1,3
267 vs(j) = vs(j)+mdstnb(k,j,i)*dr(k,m)
268 vrs(j) = vrs(j)+mdstnb(k,j+3,i)*dr(k,m)
269 ENDDO
270 ENDDO
271 ENDDO
272 ENDIF
273 DO j = 1,3
274 d(j,ns) = vs(j) *jt(j)
275 ENDDO
276 IF ((jr(1)+jr(2)+jr(3))>0) THEN
277 DO j = 1,3
278 dr(j,ns) = vrs(j) *jr(j)
279 ENDDO
280 ENDIF
281C---
282 RETURN
283 END
284
my_real
#define my_real
Definition cppsort.cpp:32
rbe3cl
subroutine rbe3cl(inrbe3, ilrbe3, ns, xyz, frbe3, skew, ng, irot, fdstnb, mdstnb)
Definition kinchk.F:1586
prerbe3
subroutine prerbe3(irbe3, max_m, irotg, jt, jr)
Definition kinchk.F:1494
min
#define min(a, b)
Definition macros.h:20
rbe3_frd
subroutine rbe3_frd(nml, iml, ns, d, dr, fdstnb, mdstnb, jt, jr, irot)
Definition rbe3v.F:231
rbe3v
subroutine rbe3v(rbe3, nodes, skew)
Definition rbe3v.F:35
rbe3_impd
subroutine rbe3_impd(irbe3, lrbe3, x, d, dr, frbe3, skew)
Definition rbe3v.F:141