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

Go to the source code of this file.

Functions/Subroutines

subroutine rbe3v (rbe3, nodes, skew)
subroutine rbe3_impd (irbe3, lrbe3, x, d, dr, frbe3, skew)
subroutine rbe3_frd (nml, iml, ns, d, dr, fdstnb, mdstnb, jt, jr, irot)

Function/Subroutine Documentation

◆ rbe3_frd()

subroutine rbe3_frd ( integer nml,
integer, dimension(*) iml,
integer ns,
d,
dr,
fdstnb,
mdstnb,
integer, dimension(*) jt,
integer, dimension(*) jr,
integer irot )

Definition at line 229 of file rbe3v.F.

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

◆ rbe3_impd()

subroutine rbe3_impd ( integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe3,
x,
d,
dr,
frbe3,
skew )

Definition at line 139 of file rbe3v.F.

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
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

◆ rbe3v()

subroutine rbe3v ( type(rbe3_), intent(inout) rbe3,
type(nodal_arrays_), intent(inout) nodes,
skew )

Definition at line 34 of file rbe3v.F.

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