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

Go to the source code of this file.

Functions/Subroutines

subroutine create_rbody_clause (clause, irbodym, jclause, opt_g, is_available, lsubmodel, opt_b, ibox, x, skew, set_title, keyset, rby_msn)
subroutine create_rbody_list (clause, irbodym, jclause, is_available, lsubmodel)
subroutine create_rbody_list_g (clause, irbodym, jclause, is_available, lsubmodel)

Function/Subroutine Documentation

◆ create_rbody_clause()

subroutine create_rbody_clause ( type (set_) clause,
integer, dimension(nrbody,2), intent(in) irbodym,
integer jclause,
integer opt_g,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer opt_b,
type (box_), dimension(nbbox) ibox,
x,
skew,
character(len=nchartitle) set_title,
character(len=ncharfield) keyset,
integer, dimension(2,nrbody), intent(in) rby_msn )

Definition at line 36 of file create_rbody_clause.F.

40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C Treat the RBODY Clause, read RBODYs from HM_READER & fill clause
44C Calls CREATE_RBODY_LIST (simple list)
45C Calls CREATE_RBODY_LIST_G (RBODY_G : All nodes from a MIN to MAX with increment)
46C------------------------------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C CLAUSE (SET structure) Clause to be treated
53C ITABM1 MAP Table UID -> LocalID
54C JCLAUSE parameter with HM_READER (current clause read)
55C Opt_G Opt_G operator 1 if PART_G is set, 0 else
56C IS_AVAILABLE Bool / Result of HM_interface
57C LSUBMODEL SUBMODEL Structure.
58C============================================================================
59C-----------------------------------------------
60C M o d u l e s
61C-----------------------------------------------
62 USE setdef_mod
63 USE submodel_mod
64 USE message_mod
65 USE hm_option_read_mod
66 USE optiondef_mod
67 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
68C-----------------------------------------------
69C I m p l i c i t T y p e s
70C-----------------------------------------------
71#include "implicit_f.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com04_c.inc"
76#include "param_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER JCLAUSE,OPT_G,OPT_B
81 LOGICAL :: IS_AVAILABLE
82 INTEGER, INTENT(IN), DIMENSION(NRBODY,2) :: IRBODYM
83 INTEGER, INTENT(IN), DIMENSION(2,NRBODY) :: RBY_MSN
84 my_real x(3,*),skew(lskew,*)
85 CHARACTER(LEN=NCHARFIELD) :: KEYSET
86 CHARACTER(LEN=NCHARTITLE) :: SET_TITLE
87C-----------------------------------------------
88 TYPE (SET_) :: CLAUSE
89 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
90 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94!
95 IF ( opt_g == 1 ) THEN
96
97 CALL create_rbody_list_g(clause, irbodym ,jclause ,is_available ,lsubmodel)
98
99 ELSEIF ( opt_g == 0 .AND. opt_b == 0 ) THEN
100
101 CALL create_rbody_list(clause, irbodym ,jclause ,is_available ,lsubmodel)
102
103 ELSEIF ( opt_b == 1 ) THEN
104
105 CALL create_rbody_box(clause ,irbodym ,jclause ,is_available ,lsubmodel,
106 . ibox ,x ,skew ,set_title ,keyset ,
107 . rby_msn )
108 ENDIF
109C-----------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
create_rbody_box
subroutine create_rbody_box(clause, irbodym, jclause, is_available, lsubmodel, ibox, x, skew, set_title, keyset, rby_msn)
Definition create_rbody_box.F:41
create_rbody_list_g
subroutine create_rbody_list_g(clause, irbodym, jclause, is_available, lsubmodel)
Definition create_rbody_clause.F:268
create_rbody_list
subroutine create_rbody_list(clause, irbodym, jclause, is_available, lsubmodel)
Definition create_rbody_clause.F:127
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
setdef_mod
Definition setdef_mod.F:107
submodel_mod
Definition submodel_mod.F:712

◆ create_rbody_list()

subroutine create_rbody_list ( type (set_) clause,
integer, dimension(nrbody,2), intent(in) irbodym,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 125 of file create_rbody_clause.F.

127C-----------------------------------------------
128C ROUTINE DESCRIPTION :
129C ===================
130C Create RBODY Clause from LIST
131C------------------------------------------------------------------
132C DUMMY ARGUMENTS DESCRIPTION:
133C ===================
134C
135C NAME DESCRIPTION
136C
137C CLAUSE (SET structure) Clause to be treated
138C IRBODYM MAP Table UID -> LocalID
139C JCLAUSE parameter with HM_READER (current clause read)
140C IS_AVAILABLE Bool / Result of HM_interface
141C LSUBMODEL SUBMODEL Structure.
142C============================================================================
143C-----------------------------------------------
144C M o d u l e s
145C-----------------------------------------------
146 USE setdef_mod
147 USE submodel_mod
148 USE message_mod
149 USE hm_option_read_mod
150C-----------------------------------------------
151C I m p l i c i t T y p e s
152C-----------------------------------------------
153#include "implicit_f.inc"
154C-----------------------------------------------
155C C o m m o n B l o c k s
156C-----------------------------------------------
157#include "com04_c.inc"
158C-----------------------------------------------
159C D u m m y A r g u m e n t s
160C-----------------------------------------------
161 INTEGER JCLAUSE
162 LOGICAL :: IS_AVAILABLE
163 INTEGER, INTENT(IN), DIMENSION(NRBODY,2) :: IRBODYM
164!
165 TYPE (SET_) :: CLAUSE
166 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
167C-----------------------------------------------
168C L o c a l V a r i a b l e s
169C-----------------------------------------------
170 INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,NODSYS,RBYM
171 INTEGER IWORK(70000)
172!
173 INTEGER, ALLOCATABLE, DIMENSION(:) :: RBYM_READ_TMP,INDEX,SORT
174C
175 INTEGER SET_USRTOS
176 EXTERNAL set_usrtos
177C=======================================================================
178
179 CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
180
181 ALLOCATE(rbym_read_tmp(ids_max))
182 rbym_read_tmp(1:ids_max) = 0
183 ALLOCATE(index(2*ids_max))
184 ALLOCATE(sort(ids_max))
185
186 index = 0
187
188 nindx = 0
189 list_size = 0
190
191
192 ! Read & convert Nodes
193 ! ---------------------
194 DO i=1,ids_max
195 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
196
197
198
199 rbym = set_usrtos(ids,irbodym,nrbody)
200 IF (rbym == 0) THEN
201 ! Rbody was not found. Issue a Warning & Skip.
202 CALL ancmsg(msgid=1902,anmode=aninfo,
203 . msgtype=msgwarning,
204 . i1 = clause%SET_ID,
205 . i2=ids,
206 . c1=trim(clause%TITLE),
207 . c2='RBODY')
208 ELSE
209
210 rbym=irbodym(rbym,2)
211!
212 nindx=nindx+1 ! nb of CLAUSE Rbody
213 rbym_read_tmp(nindx) = rbym
214 ENDIF
215
216 ENDDO ! DO K=1,IDS_MAX
217
218
219
220
221
222 ! Sort the Readed RBODYs and remove eventual duplicates
223 ! ----------------------------------------------------
224
225 DO i=1,nindx
226 index(i) = i
227 sort(i) = rbym_read_tmp(i)
228 ENDDO
229 CALL my_orders(0,iwork,sort,index,nindx,1)
230
231 DO i=1,nindx
232 rbym_read_tmp(i) = sort(index(i))
233 ENDDO
234
235 CALL remove_duplicates(rbym_read_tmp,nindx,list_size)
236
237 ! Copy in final SET
238 ! ------------------
239 clause%NB_RBODY = list_size
240 ALLOCATE( clause%RBODY( list_size ) )
241
242 DO i=1,list_size
243 clause%RBODY(i) = rbym_read_tmp(i)
244 ENDDO
245C-------------------------
246 DEALLOCATE(rbym_read_tmp)
247 DEALLOCATE(sort)
248 DEALLOCATE(index)
249C-------------------------
250 RETURN
hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
set_usrtos
integer function set_usrtos(iu, ipartm1, npart)
Definition ipartm1.F:128
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ create_rbody_list_g()

subroutine create_rbody_list_g ( type (set_) clause,
integer, dimension(nrbody,2), intent(in) irbodym,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 266 of file create_rbody_clause.F.

268C-----------------------------------------------
269C ROUTINE DESCRIPTION :
270C ===================
271C Create RBODY Clause from Generation All parts from Min to Max with Increment (Opt_G)
272C--------------------------------------------------------------------------------------
273C DUMMY ARGUMENTS DESCRIPTION:
274C ===================
275C
276C NAME DESCRIPTION
277C
278C CLAUSE (SET structure) Clause to be treated
279C IRBODYM MAP Table UID -> LocalID
280C JCLAUSE parameter with HM_READER (current clause read)
281C IS_AVAILABLE Bool / Result of HM_interface
282C LSUBMODEL SUBMODEL Structure.
283C============================================================================
284C-----------------------------------------------
285C M o d u l e s
286C-----------------------------------------------
287 USE setdef_mod
288 USE submodel_mod
289 USE message_mod
290 USE hm_option_read_mod
291C-----------------------------------------------
292C I m p l i c i t T y p e s
293C-----------------------------------------------
294#include "implicit_f.inc"
295C-----------------------------------------------
296C C o m m o n B l o c k s
297C-----------------------------------------------
298#include "com04_c.inc"
299C-----------------------------------------------
300C D u m m y A r g u m e n t s
301C-----------------------------------------------
302 INTEGER JCLAUSE
303 LOGICAL :: IS_AVAILABLE
304 INTEGER, INTENT(IN), DIMENSION(NRBODY,2) :: IRBODYM
305!
306 TYPE (SET_) :: CLAUSE
307 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
308C-----------------------------------------------
309C L o c a l V a r i a b l e s
310C-----------------------------------------------
311 INTEGER I,IDS,LIST_SIZE,IDS_MAX,GENE_MAX,K,R,R1
312 INTEGER START_GENE,END_GENE,INCR_GENE,RSTART,RSTOP,STACK,STACK_ONE,NB_RESULT
313!-
314 INTEGER, ALLOCATABLE, DIMENSION(:) :: RBYM_READ_TMP,
315 . RBYM_READ_ONE,RESULT
316C
317 INTEGER SET_USRTOS_NEAREST
318 EXTERNAL set_usrtos_nearest
319C=======================================================================
320 CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
321
322 ALLOCATE(rbym_read_tmp(nrbody))
323 ALLOCATE(rbym_read_one(nrbody))
324
325
326 IF (gene_max > 1) THEN
327 ALLOCATE(result(nrbody))
328 ENDIF
329
330 stack=0
331
332 DO k=1,gene_max
333 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
334 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
335 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
336
337 ! set value by default for increment to 1
338 IF (incr_gene == 0) incr_gene = 1
339
340 rstart = set_usrtos_nearest(start_gene,irbodym,nrbody,1)
341 rstop = set_usrtos_nearest(end_gene,irbodym,nrbody,2)
342
343 stack_one=0
344 DO r=rstart, rstop
345 r1 = irbodym(r,1)
346 IF ( mod( r1-start_gene , incr_gene) == 0)THEN
347 stack_one = stack_one+1
348 rbym_read_one(stack_one) = irbodym(r,2)
349 ENDIF
350 ENDDO
351
352 IF (stack==0) THEN
353 rbym_read_tmp(1:stack_one) = rbym_read_one(1:stack_one)
354 stack = stack_one
355 ELSE
356 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
357 CALL union_2_sorted_sets( rbym_read_tmp, stack ,
358 * rbym_read_one, stack_one ,
359 * result, nb_result )
360
361 rbym_read_tmp(1:nb_result) = result(1:nb_result)
362 stack = nb_result
363 ENDIF
364 ENDDO
365
366 clause%NB_RBODY = stack
367 ALLOCATE(clause%RBODY(stack))
368 clause%RBODY(1:stack) = rbym_read_tmp(1:stack)
369C-------------------------
370 DEALLOCATE (rbym_read_tmp)
371 DEALLOCATE (rbym_read_one)
372 IF (ALLOCATED(result)) DEALLOCATE (result)
373C-------------------------
set_usrtos_nearest
integer function set_usrtos_nearest(ui, map, sz, uplow)
Definition ipartm1.F:197