OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
simple_rbody_box.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!|| simple_rbody_box ../starter/source/model/sets/simple_rbody_box.F
25!||--- called by ------------------------------------------------------
26!|| rbody_box ../starter/source/model/sets/fill_clause_rbody_box.F
27!||--- calls -----------------------------------------------------
28!|| checkcyl ../starter/source/model/box/rdbox.F
29!|| checkpara ../starter/source/model/box/rdbox.F
30!|| checksphere ../starter/source/model/box/rdbox.F
31!||--- uses -----------------------------------------------------
32!||====================================================================
33 SUBROUTINE simple_rbody_box(
34 . IBOX ,X ,SKEW ,
35 . IB, ND_ARRAY,ND_SIZE,RBY_MSN)
36C-----------------------------------------------
37C ROUTINE DESCRIPTION :
38C ===================
39C create node list from BOX
40C------------------------------------------------------------------
41C DUMMY ARGUMENTS DESCRIPTION:
42C ===================
43C
44C NAME DESCRIPTION
45C
46C IBOX BOX structure
47C X Node position
48C SKEW SKEW array
49C NOD_ARRAY Result list of nodes
50C ND_SIZE number of stacked nodes
51C IB Box to treat
52C============================================================================
53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com04_c.inc"
65#include "param_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER ND_ARRAY(*),IB,ND_SIZE
70 my_real
71 . x(3,*),skew(lskew,*)
72C-----------------------------------------------
73 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
74 INTEGER, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,J,INSIDE,ISK,BOX_TYPE,NBOXBOX,IBX
79 my_real
80 . xp1,yp1,zp1,xp2,yp2,zp2,diam,nodinb(3)
81C-----------------------------------------------
82 nd_size = 0
83C------------
84! IBOX(IGS)%ISKBOX = ISK
85! IBOX(IGS)%NOD1 = J2(1)
86! IBOX(IGS)%NOD2 = J2(2)
87C IBOX(IGS)%NBOXBOX : NUMBER OF SUB BOXES (BOXES OF BOXES)
88! IF(KEY(1:5) == 'RECTA')IBOX(IGS)%TYPE = 1
89! IF(KEY(1:5) == 'CYLIN')IBOX(IGS)%TYPE = 2
90! IF(KEY(1:5) == 'SPHER')IBOX(IGS)%TYPE = 3
91! IBOX(IGS)%DIAM = DIAM
92! IBOX(IGS)%X1 = XP1
93! IBOX(IGS)%Y1 = YP1
94! IBOX(IGS)%Z1 = ZP1
95! IBOX(IGS)%X2 = XP2
96! IBOX(IGS)%Y2 = YP2
97! IBOX(IGS)%Z2 = ZP2
98C------------
99 ibx = abs(ib) ! a box can be have negative user_ID if within Box of Box
100 isk = ibox(ibx)%ISKBOX
101 box_type = ibox(ibx)%TYPE
102 xp1 = ibox(ibx)%X1
103 yp1 = ibox(ibx)%Y1
104 zp1 = ibox(ibx)%Z1
105 xp2 = ibox(ibx)%X2
106 yp2 = ibox(ibx)%Y2
107 zp2 = ibox(ibx)%Z2
108 diam = ibox(ibx)%DIAM
109 !
110 ! RECTA
111 IF (box_type == 1) THEN
112!! DO J=1,NUMNOD
113 DO i=1,nrbody
114 j = rby_msn(2,i)
115 inside = 0
116 nodinb(1) = x(1,j)
117 nodinb(2) = x(2,j)
118 nodinb(3) = x(3,j)
119 CALL checkpara(xp1,yp1,zp1,xp2,yp2,zp2,
120 . isk,nodinb,skew,inside)
121
122 IF (inside == 1) THEN
123 nd_size = nd_size + 1
124 nd_array(nd_size) = j ! add node
125 ENDIF
126
127 ENDDO ! DO I=1,NRBODY
128 !
129 ! CYLIN
130 ELSEIF (box_type == 2) THEN
131! DO J=1,NUMNOD
132 DO i=1,nrbody
133 j = rby_msn(2,i)
134 inside = 0
135 nodinb(1) = x(1,j)
136 nodinb(2) = x(2,j)
137 nodinb(3) = x(3,j)
138 CALL checkcyl(xp1, yp1, zp1 , xp2, yp2, zp2,
139 . nodinb , diam, inside )
140
141 IF (inside == 1) THEN
142 nd_size = nd_size + 1
143 nd_array(nd_size) = j ! add node
144 ENDIF
145
146 ENDDO ! DO I=1,NRBODY
147 !
148 ! SPHER
149 ELSEIF (box_type == 3) THEN
150! DO J=1,NUMNOD
151 DO i=1,nrbody
152 j = rby_msn(2,i)
153 inside = 0
154 nodinb(1) = x(1,j)
155 nodinb(2) = x(2,j)
156 nodinb(3) = x(3,j)
157 CALL checksphere(xp1, yp1, zp1, nodinb, diam, inside)
158
159 IF (inside == 1) THEN
160 nd_size = nd_size + 1
161 nd_array(nd_size) = j ! add node
162 ENDIF
163
164 ENDDO ! DO I=1,NRBODY
165 ENDIF ! IF (BOX_TYPE == 1)
166!
167C---------------
168 RETURN
169 END
subroutine checkcyl(xp1, yp1, zp1, xp2, yp2, zp2, nodin, d, ok)
Definition rdbox.F:229
subroutine checkpara(xp1, yp1, zp1, xp2, yp2, zp2, isk, nodin, skew, ok)
Definition rdbox.F:39
subroutine checksphere(xp, yp, zp, nodin, d, ok)
Definition rdbox.F:347
subroutine simple_rbody_box(ibox, x, skew, ib, nd_array, nd_size, rby_msn)