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

Go to the source code of this file.

Functions/Subroutines

subroutine create_subs_clause (clause, isubsm, jclause, opt_g, is_available, lsubmodel, subset)
subroutine create_subs_list (clause, isubsm, jclause, is_available, lsubmodel, subset)
subroutine create_subs_list_g (clause, isubsm, jclause, is_available, lsubmodel, subset)

Function/Subroutine Documentation

◆ create_subs_clause()

subroutine create_subs_clause ( type (set_) clause,
integer, dimension(nsubs,2), intent(in) isubsm,
integer jclause,
integer opt_g,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (subset_), dimension(nsubs) subset )

Definition at line 35 of file create_subs_clause.F.

38C-----------------------------------------------
39C ROUTINE DESCRIPTION :
40C ===================
41C Treat the PART Clause, read PARTs from HM_READER & fill clause
42C Calls CREATE_PART_LIST (simple list)
43C Calls CREATE_PART_LIST_G (PART_G : All parts from a MIN to MAX with increment)
44C------------------------------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C CLAUSE (SET structure) Clause to be treated
51C ISUBSM MAP Table UID -> LocalID
52C JCLAUSE parameter with HM_READER (current clause read)
53C Opt_G Opt_G operator 1 if PART_G is set, 0 else
54C IS_AVAILABLE Bool / Result of HM_interface
55C LSUBMODEL SUBMODEL Structure.
56C============================================================================
57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE setdef_mod
61 USE submodel_mod
62 USE message_mod
63 USE hm_option_read_mod
64 USE groupdef_mod
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "com04_c.inc"
73C-----------------------------------------------
74C D u m m y A r g u m e n t s
75C-----------------------------------------------
76 INTEGER JCLAUSE,OPT_G
77 LOGICAL :: IS_AVAILABLE
78 INTEGER, INTENT(IN), DIMENSION(NSUBS,2) :: ISUBSM
79C-----------------------------------------------
80 TYPE (SET_) :: CLAUSE
81 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
82 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86!
87 IF (opt_g == 1 ) THEN
88 CALL create_subs_list_g(clause, isubsm ,jclause ,is_available ,lsubmodel,
89 . subset)
90 ELSE
91 CALL create_subs_list (clause, isubsm ,jclause ,is_available ,lsubmodel,
92 . subset)
93 ENDIF
94C-----------------------------------------------
create_subs_list
subroutine create_subs_list(clause, isubsm, jclause, is_available, lsubmodel, subset)
Definition create_subs_clause.F:113
create_subs_list_g
subroutine create_subs_list_g(clause, isubsm, jclause, is_available, lsubmodel, subset)
Definition create_subs_clause.F:296
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
setdef_mod
Definition setdef_mod.F:107
submodel_mod
Definition submodel_mod.F:717

◆ create_subs_list()

subroutine create_subs_list ( type (set_) clause,
integer, dimension(nsubs,2), intent(in) isubsm,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (subset_), dimension(nsubs) subset )

Definition at line 110 of file create_subs_clause.F.

113C-----------------------------------------------
114C ROUTINE DESCRIPTION :
115C ===================
116C Create PART Clause from LIST
117C------------------------------------------------------------------
118C DUMMY ARGUMENTS DESCRIPTION:
119C ===================
120C
121C NAME DESCRIPTION
122C
123C CLAUSE (SET structure) Clause to be treated
124C ISUBSM MAP Table UID -> LocalID
125C JCLAUSE parameter with HM_READER (current clause read)
126C IS_AVAILABLE Bool / Result of HM_interface
127C LSUBMODEL SUBMODEL Structure.
128C============================================================================
129C-----------------------------------------------
130C M o d u l e s
131C-----------------------------------------------
132 USE setdef_mod
133 USE submodel_mod
134 USE message_mod
135 USE hm_option_read_mod
136 USE groupdef_mod
137C-----------------------------------------------
138C I m p l i c i t T y p e s
139C-----------------------------------------------
140#include "implicit_f.inc"
141C-----------------------------------------------
142C C o m m o n B l o c k s
143C-----------------------------------------------
144
145#include "com04_c.inc"
146C-----------------------------------------------
147C D u m m y A r g u m e n t s
148C-----------------------------------------------
149 INTEGER JCLAUSE
150 LOGICAL :: IS_AVAILABLE
151 INTEGER, INTENT(IN), DIMENSION(NSUBS,2) :: ISUBSM
152!
153 TYPE (SET_) :: CLAUSE
154 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
155 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
156C-----------------------------------------------
157C L o c a l V a r i a b l e s
158C-----------------------------------------------
159 INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,SUBSM,PARTM,ISET,IP
160 INTEGER IWORK(70000)
161!
162 INTEGER, ALLOCATABLE, DIMENSION(:) :: SUBS_READ_TMP,SORTED_SUBS,INDEXS,
163 . PART_READ_TMP,SORTED_PARTS,INDEXP
164C
165 INTEGER SET_USRTOS
166 EXTERNAL set_usrtos
167C=======================================================================
168
169 CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
170
171 ALLOCATE(subs_read_tmp(ids_max))
172 ALLOCATE(sorted_subs(ids_max))
173
174 ALLOCATE(part_read_tmp(npart))
175 ALLOCATE(sorted_parts(npart))
176
177 ALLOCATE(indexs(2*ids_max)) ! subsets
178 indexs = 0
179
180 ALLOCATE(indexp(2*npart)) ! parts of subsets
181 indexp = 0
182
183 nindx = 0
184 list_size = 0
185
186 ! Read & convert Subsets
187 ! ---------------------
188 DO i=1,ids_max
189 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
190!
191 subsm = set_usrtos(ids,isubsm,nsubs)
192 IF(subsm == 0)THEN
193 ! Subset was not found. Issue a Warning & Skip.
194 CALL ancmsg(msgid=1902,anmode=aninfo,
195 . msgtype=msgwarning,
196 . i1 = clause%SET_ID,
197 . i2=ids,
198 . c1=trim(clause%TITLE),
199 . c2='SUBSET')
200 ELSE
201
202 subsm=isubsm(subsm,2)
203
204 nindx=nindx+1 ! nb of CLAUSE subsets
205 subs_read_tmp(nindx) = subsm
206 ENDIF
207
208 ENDDO ! DO K=1,IDS_MAX
209
210
211 ! Sort the Readed SUBSETs and remove eventual duplicates
212 ! ----------------------------------------------------
213
214 iwork(:) = 0
215 DO i=1,nindx
216 indexs(i) = i
217 ENDDO
218 CALL my_orders(0,iwork,subs_read_tmp,indexs,nindx,1)
219
220 DO i=1,nindx
221 sorted_subs(i) = subs_read_tmp(indexs(i))
222 ENDDO
223
224 CALL remove_duplicates(sorted_subs,nindx,list_size)
225
226
227 ! TAG Parts from Readed SUBSETs
228 ! ----------------------------------------------------
229
230 nindx = 0
231 DO i=1,list_size
232 iset = sorted_subs(i)
233 DO ip=1,subset(iset)%NTPART
234
235 partm = subset(iset)%TPART(ip)
236
237 nindx=nindx+1 ! nb of Parts of CLAUSE subsets
238 part_read_tmp(nindx) = partm
239 ENDDO ! DO
240 ENDDO
241
242
243 ! Sort of TAG Parts from Readed SUBSETs and remove eventual duplicates
244 ! ----------------------------------------------------
245
246 iwork(:) = 0
247 DO i=1,nindx
248 indexp(i) = i
249 ENDDO
250 CALL my_orders(0,iwork,part_read_tmp,indexp,nindx,1)
251
252 DO i=1,nindx
253 sorted_parts(i) = part_read_tmp(indexp(i))
254 ENDDO
255
256 list_size = 0
257 CALL remove_duplicates(sorted_parts,nindx,list_size)
258
259
260 ! Copy in final SET
261 ! ------------------
262 clause%NB_PART = list_size
263 ALLOCATE( clause%PART( list_size ) )
264
265 DO i=1,list_size
266 clause%PART(i) = sorted_parts(i)
267 ENDDO
268!---
269
270C-------------------------
271 DEALLOCATE(subs_read_tmp)
272 DEALLOCATE(sorted_subs)
273 DEALLOCATE(indexs)
274 DEALLOCATE(part_read_tmp)
275 DEALLOCATE(sorted_parts)
276 DEALLOCATE(indexp)
277C-------------------------
278 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:895

◆ create_subs_list_g()

subroutine create_subs_list_g ( type (set_) clause,
integer, dimension(nsubs,2), intent(in) isubsm,
integer jclause,
logical is_available,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (subset_), dimension(nsubs) subset )

Definition at line 293 of file create_subs_clause.F.

296C-----------------------------------------------
297C ROUTINE DESCRIPTION :
298C ===================
299C Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
300C--------------------------------------------------------------------------------------
301C DUMMY ARGUMENTS DESCRIPTION:
302C ===================
303C
304C NAME DESCRIPTION
305C
306C CLAUSE (SET structure) Clause to be treated
307C ISUBSM MAP Table UID -> LocalID
308C JCLAUSE parameter with HM_READER (current clause read)
309C IS_AVAILABLE Bool / Result of HM_interface
310C LSUBMODEL SUBMODEL Structure.
311C============================================================================
312C-----------------------------------------------
313C M o d u l e s
314C-----------------------------------------------
315 USE setdef_mod
316 USE submodel_mod
317 USE message_mod
318 USE hm_option_read_mod
319 USE groupdef_mod
320C-----------------------------------------------
321C I m p l i c i t T y p e s
322C-----------------------------------------------
323#include "implicit_f.inc"
324C-----------------------------------------------
325C C o m m o n B l o c k s
326C-----------------------------------------------
327#include "com04_c.inc"
328C-----------------------------------------------
329C D u m m y A r g u m e n t s
330C-----------------------------------------------
331 INTEGER JCLAUSE
332 LOGICAL :: IS_AVAILABLE
333 INTEGER, INTENT(IN), DIMENSION(NSUBS,2) :: ISUBSM
334!
335 TYPE (SET_) :: CLAUSE
336 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
337 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
338C-----------------------------------------------
339C L o c a l V a r i a b l e s
340C-----------------------------------------------
341 INTEGER I,LIST_SIZE,PARTM,GENE_MAX,K,S,S1,
342 . NINDX,IP,ISET
343 INTEGER START_GENE,END_GENE,INCR_GENE,SSTART,SSTOP,STACK,STACK_ONE,NB_RESULT
344!-
345 INTEGER, ALLOCATABLE, DIMENSION(:) :: SUBS_READ_TMP,SUBS_READ_ONE,RESULT,
346 . PART_READ_TMP,SORTED_PARTS,INDEX
347C
348 INTEGER SET_USRTOS_NEAREST
349 EXTERNAL set_usrtos_nearest
350 INTEGER IWORK(70000)
351C=======================================================================
352 CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
353
354 ALLOCATE(subs_read_tmp(nsubs))
355 ALLOCATE(subs_read_one(nsubs))
356
357 ALLOCATE(part_read_tmp(npart))
358 ALLOCATE(sorted_parts(npart))
359
360 ALLOCATE(index(2*npart))
361 index = 0
362
363 IF (gene_max > 1) THEN
364 ALLOCATE(result(nsubs))
365 ENDIF
366
367 stack=0
368
369 DO k=1,gene_max
370 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
371 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
372 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
373
374 ! set value by default for increment to 1
375 IF (incr_gene == 0) incr_gene = 1
376
377 sstart = set_usrtos_nearest(start_gene,isubsm,nsubs,1)
378 sstop = set_usrtos_nearest(end_gene,isubsm,nsubs,2)
379
380 stack_one=0
381
382 DO s=sstart, sstop
383 s1 = isubsm(s,1)
384 IF ( mod( s1-start_gene , incr_gene) == 0 ) THEN
385 stack_one = stack_one+1
386 subs_read_one(stack_one) = isubsm(s,2)
387 ENDIF
388 ENDDO
389
390 IF (stack==0) THEN
391 subs_read_tmp(1:stack_one) = subs_read_one(1:stack_one)
392 stack = stack_one
393 ELSE
394 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
395 CALL union_2_sorted_sets( subs_read_tmp, stack ,
396 * subs_read_one, stack_one ,
397 * result, nb_result )
398
399 subs_read_tmp(1:nb_result) = result(1:nb_result)
400 stack = nb_result
401 ENDIF
402 ENDDO
403
404
405 ! TAG Parts from Readed SUBSETs
406 ! ----------------------------------------------------
407
408 nindx = 0
409 DO i=1,stack
410 iset = subs_read_tmp(i)
411 DO ip=1,subset(iset)%NTPART
412
413 partm = subset(iset)%TPART(ip)
414
415 nindx=nindx+1 ! nb of Parts of CLAUSE subsets
416 part_read_tmp(nindx) = partm
417 ENDDO ! DO
418 ENDDO
419
420
421 ! Sort of TAG Parts from Readed SUBSETs and remove eventual duplicates
422 ! ----------------------------------------------------
423
424
425 DO i=1,nindx
426 index(i) = i
427 ENDDO
428 CALL my_orders(0,iwork,part_read_tmp,index,nindx,1)
429
430 DO i=1,nindx
431 sorted_parts(i) = part_read_tmp(index(i))
432 ENDDO
433
434 list_size = 0
435 CALL remove_duplicates(sorted_parts,nindx,list_size)
436
437
438
439!
440 ! Copy in final SET
441 ! ------------------
442 clause%NB_PART = list_size
443 ALLOCATE(clause%PART(list_size))
444 clause%PART(1:list_size) = sorted_parts(1:list_size)
445!---
446 DEALLOCATE (part_read_tmp)
447 DEALLOCATE (sorted_parts)
448 IF (ALLOCATED(result)) DEALLOCATE (result)
449 DEALLOCATE (subs_read_tmp)
450 DEALLOCATE (subs_read_one)
451!---
set_usrtos_nearest
integer function set_usrtos_nearest(ui, map, sz, uplow)
Definition ipartm1.F:197