OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fill_clause_elt_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!|| fill_clause_elt_box ../starter/source/model/sets/fill_clause_elt_box.F
25!||--- called by ------------------------------------------------------
26!|| create_elt_box ../starter/source/model/sets/create_elt_box.F
27!||--- calls -----------------------------------------------------
28!|| elt_box ../starter/source/model/sets/fill_clause_elt_box.F
29!|| set_merge_simple ../starter/source/model/sets/set_merge_simple.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!|| set_mod ../starter/share/modules1/set_mod.F
33!||====================================================================
34 SUBROUTINE fill_clause_elt_box(
35 * IBOX ,X ,SKEW ,SET_TITLE ,KEYSET ,
36 * BOXLIST ,BOXLIST_SIZE,BOXELTS ,SZ_BOXELTS,BOXTYPE,
37 * NIX ,IX ,NIX1 ,IPARTE ,IPART ,
38 * ELTREE ,KLEVTREE ,KELTREE ,NUMEL )
39
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE optiondef_mod
44 USE message_mod
45 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
46 USE set_mod , ONLY : set_add
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "scr17_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
61
62 INTEGER BOXELTS(*),BOXLIST(*),IPARTE(*),IPART(LIPART1,*),
63 . IX(NIX,*),ELTREE(KELTREE,*)
64 INTEGER SZ_BOXELTS, BOXLIST_SIZE,BOXTYPE,NIX,NIX1,KLEVTREE,
65 . KELTREE,NUMEL
66
67 my_real
68 . x(3,*),skew(lskew,*)
69
70 CHARACTER(LEN=NCHARFIELD):: KEYSET
71 CHARACTER(LEN=NCHARTITLE)::SET_TITLE
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,B_ELTS_SIZE,NB_RESULT,
76 . ID,IB,NB_BOX_OF_BOX,J,CLAUSE_OPERATOR
77 LOGICAL BOOL
78 INTEGER, DIMENSION(:) , ALLOCATABLE :: B_ELTS,RESULT
79C-----------------------------------------------
80 ALLOCATE(b_elts(numel))
81 ALLOCATE(result(numel))
82
83!
84 ! Tag nodes from boxes
85 ! ---------------------
86 clause_operator = set_add
87 sz_boxelts = 0
88 DO i=1,boxlist_size
89 ib = boxlist(i)
90 b_elts_size = 0
91
92 CALL elt_box(ib ,
93 * ibox ,x ,skew ,set_title ,keyset,
94 * b_elts ,b_elts_size,nix ,ix ,nix1 ,
95 * iparte ,ipart ,eltree ,klevtree ,keltree,
96 * numel ,boxtype )
97
98
99 CALL set_merge_simple( boxelts, sz_boxelts ,
100 * b_elts, b_elts_size ,
101 * result, nb_result ,
102 * clause_operator)
103
104 boxelts(1:nb_result) = result(1:nb_result)
105 sz_boxelts = nb_result
106 ENDDO ! DO I=1,BOXLIST_SIZE
107
108C-------
109 RETURN
110 END
111
112
113!||====================================================================
114!|| elt_box ../starter/source/model/sets/fill_clause_elt_box.F
115!||--- called by ------------------------------------------------------
116!|| fill_clause_elt_box ../starter/source/model/sets/fill_clause_elt_box.F
117!||--- calls -----------------------------------------------------
118!|| set_merge_simple ../starter/source/model/sets/set_merge_simple.F
119!|| simple_elt_box ../starter/source/model/sets/simpl_elt_box.F
120!||--- uses -----------------------------------------------------
121!|| message_mod ../starter/share/message_module/message_mod.F
122!|| set_mod ../starter/share/modules1/set_mod.F
123!||====================================================================
124 RECURSIVE SUBROUTINE elt_box( IB ,
125 * IBOX ,X ,SKEW ,SET_TITLE ,KEYSET,
126 * BOXELTS ,SZ_BOXELTS,NIX ,IX ,NIX1 ,
127 * IPARTE ,IPART ,ELTREE ,KLEVTREE ,KELTREE,
128 * NUMEL ,BOXTYPE )
129C-----------------------------------------------
130C ROUTINE DESCRIPTION :
131C ===================
132C Recursive routine - Go through tree and fill the Node Box array
133C
134C------------------------------------------------------------------
135C DUMMY ARGUMENTS DESCRIPTION:
136C ===================
137C
138C NAME DESCRIPTION
139C
140C IB Recursive indice / Current Box to treat
141C IBOX IBOX Structure
142C SKEW Skew Structure
143C SET_TITLE Title for Error message
144C KEYSET KEYSET for Error message
145C BOXELTS merged node array
146C SZ_BOXELTS number of stacked nodes in BOXELTS
147C============================================================================
148C-----------------------------------------------
149C M o d u l e s
150C-----------------------------------------------
151 USE optiondef_mod
152 USE message_mod
153 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
154 USE set_mod , ONLY : set_add,set_delete
155C-----------------------------------------------
156C I m p l i c i t T y p e s
157C-----------------------------------------------
158#include "implicit_f.inc"
159C-----------------------------------------------
160C C o m m o n B l o c k s
161C-----------------------------------------------
162#include "com04_c.inc"
163#include "scr17_c.inc"
164#include "param_c.inc"
165C-----------------------------------------------
166C D u m m y A r g u m e n t s
167C-----------------------------------------------
168 TYPE (box_) , DIMENSION(NBBOX) :: IBOX
169
170 INTEGER boxelts(*),ix(nix,*),iparte(*),ipart(lipart1,*),
171 . eltree(keltree,*)
172 INTEGER ib,sz_boxelts,NIX,nix1,klevtree,keltree,numel,boxtype
173
174 my_real
175 . x(3,*),skew(lskew,*)
176
177 CHARACTER(LEN=NCHARFIELD) :: keyset
178 CHARACTER(LEN=NCHARTITLE)::set_title
179C-----------------------------------------------
180C L o c a l V a r i a b l e s
181C-----------------------------------------------
182 INTEGER i,b_elts_size,nb_result,
183 . nb_box_of_box,j,new_box,clause_operator
184 LOGICAL bool
185 INTEGER, DIMENSION(:) , ALLOCATABLE :: b_elts,result
186
187C-----------------------------------------------
188
189
190 nb_box_of_box = ibox(ib)%NBOXBOX
191
192 IF ( nb_box_of_box == 0 ) THEN
193
194 ! Fill SIMPLE Boxes
195 ! ---------------------
196 sz_boxelts = 0
197 CALL simple_elt_box(
198 . ibox ,x ,skew ,ib ,boxelts ,
199 . sz_boxelts ,nix ,ix ,nix1 ,iparte ,
200 . ipart ,eltree ,klevtree ,keltree ,numel ,
201 . boxtype )
202
203 ELSE
204 ALLOCATE(b_elts(numel))
205 ALLOCATE(result(numel))
206
207
208 DO i=1,nb_box_of_box
209
210 j = ibox(ib)%IBOXBOX(i) ! could be negative
211 new_box = abs(j)
212
213 b_elts_size=0
214
215 CALL elt_box (new_box ,
216 * ibox ,x ,skew ,set_title ,keyset,
217 * b_elts ,b_elts_size,nix ,ix ,nix1 ,
218 * iparte ,ipart ,eltree ,klevtree ,keltree,
219 * numel ,boxtype )
220
221 IF (j < 0)THEN
222 clause_operator = set_delete
223 ELSE
224 clause_operator = set_add
225 ENDIF
226
227 CALL set_merge_simple( boxelts, sz_boxelts ,
228 * b_elts, b_elts_size ,
229 * result, nb_result ,
230 * clause_operator)
231
232 boxelts(1:nb_result) = result(1:nb_result)
233 sz_boxelts = nb_result
234 ENDDO
235
236 ENDIF
237
238C-------
239 RETURN
240 END
241
242
243
244
245
246
247
my_real
#define my_real
Definition cppsort.cpp:32
fill_clause_elt_box
subroutine fill_clause_elt_box(ibox, x, skew, set_title, keyset, boxlist, boxlist_size, boxelts, sz_boxelts, boxtype, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel)
Definition fill_clause_elt_box.F:39
elt_box
recursive subroutine elt_box(ib, ibox, x, skew, set_title, keyset, boxelts, sz_boxelts, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, boxtype)
Definition fill_clause_elt_box.F:129
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
optiondef_mod
Definition optiondef_mod.F:90
set_mod
Definition set_mod.F:43
set_mod::set_add
integer, parameter set_add
add operator
Definition set_mod.F:47
set_mod::set_delete
integer, parameter set_delete
delete operator
Definition set_mod.F:48
set_merge_simple
subroutine set_merge_simple(set_entity, nb_set_entity, clause_entity, nb_clause_entity, result, nb_result, clause_operator)
Definition set_merge_simple.F:42
simple_elt_box
subroutine simple_elt_box(ibox, x, skew, ib, elt_array, elt_size, nix, ix, nix1, iparte, ipart, eltree, klevtree, keltree, numel, itype)
Definition simpl_elt_box.F:38
optiondef_mod::box_
Definition optiondef_mod.F:150