OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_set_clause.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!|| create_set_array ../starter/source/model/sets/create_set_clause.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.F
27!|| sort_set ../starter/source/model/sets/sort_sets.F
28!||--- calls -----------------------------------------------------
29!|| create_set_list ../starter/source/model/sets/create_set_clause.F
30!|| create_set_list_g ../starter/source/model/sets/create_set_clause.F
31!||--- uses -----------------------------------------------------
32!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE create_set_array(SET_ARRAY ,ARRAY_SIZE,
37 . ISETM , NSET_GENERAL,
38 . JCLAUSE ,OPT_G ,IS_AVAILABLE ,
39 . LSUBMODEL,CLAUSE,FLAG)
40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C Treat the PART Clause, read PARTs from HM_READER & fill clause
44C Calls CREATE_PART_LIST (simple list)
45C Calls CREATE_PART_LIST_G (PART_G : All parts 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 IPARTM1 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
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER JCLAUSE,OPT_G,ARRAY_SIZE,NSET_GENERAL,FLAG
74 LOGICAL :: IS_AVAILABLE
75 INTEGER, INTENT(IN), DIMENSION(NSETS,2) :: ISETM
76C-----------------------------------------------
77 TYPE (SET_) :: CLAUSE
78 INTEGER SET_ARRAY(*)
79 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83!
84 IF (opt_g == 1 ) THEN
85 CALL create_set_list_g(set_array, array_size ,isetm ,nset_general ,jclause ,is_available ,lsubmodel)
86 ELSE
87 CALL create_set_list (set_array, array_size ,isetm ,nset_general ,jclause ,is_available ,lsubmodel,
88 . clause ,flag)
89 ENDIF
90C-----------------------------------------------
91 END
92!||====================================================================
93!|| create_set_list ../starter/source/model/sets/create_set_clause.F
94!||--- called by ------------------------------------------------------
95!|| create_set_array ../starter/source/model/sets/create_set_clause.F
96!||--- calls -----------------------------------------------------
97!|| ancmsg ../starter/source/output/message/message.F
98!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
99!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
100!|| set_usrtos ../starter/source/model/sets/ipartm1.F
101!||--- uses -----------------------------------------------------
102!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
103!|| message_mod ../starter/share/message_module/message_mod.f
104!|| submodel_mod ../starter/share/modules1/submodel_mod.F
105!||====================================================================
106 SUBROUTINE create_set_list(
107 . ARRAY, ARRAY_SIZE, ISETM ,NSET_GENERAL ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL,
108 . CLAUSE,FLAG)
109C-----------------------------------------------
110C ROUTINE DESCRIPTION :
111C ===================
112C Create PART Clause from LIST
113C------------------------------------------------------------------
114C DUMMY ARGUMENTS DESCRIPTION:
115C ===================
116C
117C NAME DESCRIPTION
118C
119C CLAUSE (SET structure) Clause to be treated
120C IPARTM1 MAP Table UID -> LocalID
121C JCLAUSE parameter with HM_READER (current clause read)
122C IS_AVAILABLE Bool / Result of HM_interface
123C LSUBMODEL SUBMODEL Structure.
124C============================================================================
125C-----------------------------------------------
126C M o d u l e s
127C-----------------------------------------------
128 USE setdef_mod
129 USE submodel_mod
130 USE message_mod
131 USE hm_option_read_mod
132C-----------------------------------------------
133C I m p l i c i t T y p e s
134C-----------------------------------------------
135#include "implicit_f.inc"
136C-----------------------------------------------
137C D u m m y A r g u m e n t s
138C-----------------------------------------------
139 INTEGER JCLAUSE, ARRAY_SIZE,NSET_GENERAL,FLAG
140 LOGICAL :: IS_AVAILABLE
141 INTEGER, INTENT(IN), DIMENSION(NSETS,2) :: ISETM
142 INTEGER ARRAY(*)
143 TYPE (SET_) :: CLAUSE
144 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(*)
145C-----------------------------------------------
146C L o c a l V a r i a b l e s
147C-----------------------------------------------
148 INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,SETM
149 INTEGER IWORK(70000)
150!
151 INTEGER, ALLOCATABLE, DIMENSION(:) :: SET_READ_TMP,INDEX
152C
153 INTEGER SET_USRTOS
154 EXTERNAL set_usrtos
155C=======================================================================
156
157 array_size=0
158
159 CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
160
161 ALLOCATE(set_read_tmp(ids_max))
162 set_read_tmp(1:ids_max) = 0
163
164 ALLOCATE(index(2*ids_max))
165 index = 0
166
167 nindx = 0
168 list_size = 0
169
170 ! Read & convert Part list
171 ! -------------------------
172 DO i=1,ids_max
173 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
174!
175 setm = set_usrtos(ids,isetm,nset_general)
176
177 IF(setm > 0)THEN ! 0 if SET was not found
178 setm=isetm(setm,2)
179 nindx=nindx+1 ! nb of CLAUSE sets
180 set_read_tmp(nindx) = setm
181 ELSEIF (flag == 1) THEN
182 ! SET was not found. Issue a Warning & Skip.
183 CALL ancmsg(msgid=1902,anmode=aninfo,
184 . msgtype=msgwarning,
185 . i1 = clause%SET_ID,
186 . i2=ids,
187 . c1=trim(clause%TITLE),
188 . c2='SET')
189 ENDIF
190 ENDDO ! DO K=1,IDS_MAX
191
192 ! Sort the Readed SETs and remove eventual duplicates
193 ! ----------------------------------------------------
194
195 DO i=1,nindx
196 index(i) = i
197 ENDDO
198 CALL my_orders(0,iwork,set_read_tmp,index,nindx,1)
199
200 DO i=1,nindx
201 array(i)=set_read_tmp(index(i))
202 ENDDO
203
204 CALL remove_duplicates( array,nindx,list_size)
205
206 ! Copy in final SET
207 ! ------------------
208 array_size = list_size
209
210!---
211
212C-------------------------
213 DEALLOCATE(set_read_tmp)
214 DEALLOCATE(index)
215C-------------------------
216 RETURN
217 END
218
219!||====================================================================
220!|| create_set_list_g ../starter/source/model/sets/create_set_clause.F
221!||--- called by ------------------------------------------------------
222!|| create_set_array ../starter/source/model/sets/create_set_clause.F
223!||--- calls -----------------------------------------------------
224!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
225!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
226!|| set_usrtos_nearest ../starter/source/model/sets/ipartm1.F
227!||--- uses -----------------------------------------------------
228!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
229!|| message_mod ../starter/share/message_module/message_mod.F
230!|| submodel_mod ../starter/share/modules1/submodel_mod.F
231!||====================================================================
232 SUBROUTINE create_set_list_g(
233 . ARRAY, ARRAY_SIZE, ISETM, NSET_GENERAL, JCLAUSE ,IS_AVAILABLE ,LSUBMODEL)
234C-----------------------------------------------
235C ROUTINE DESCRIPTION :
236C ===================
237C Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
238C--------------------------------------------------------------------------------------
239C DUMMY ARGUMENTS DESCRIPTION:
240C ===================
241C
242C NAME DESCRIPTION
243C
244C CLAUSE (SET structure) Clause to be treated
245C IPARTM1 MAP Table UID -> LocalID
246C JCLAUSE parameter with HM_READER (current clause read)
247C IS_AVAILABLE Bool / Result of HM_interface
248C LSUBMODEL SUBMODEL Structure.
249C============================================================================
250C-----------------------------------------------
251C M o d u l e s
252C-----------------------------------------------
253 USE setdef_mod
254 USE submodel_mod
255 USE message_mod
256 USE hm_option_read_mod
257C-----------------------------------------------
258C I m p l i c i t T y p e s
259C-----------------------------------------------
260#include "implicit_f.inc"
261C-----------------------------------------------
262C D u m m y A r g u m e n t s
263C-----------------------------------------------
264 INTEGER JCLAUSE,ARRAY_SIZE, NSET_GENERAL
265 INTEGER ARRAY(ARRAY_SIZE)
266 LOGICAL :: IS_AVAILABLE
267 INTEGER, INTENT(IN), DIMENSION(NSETS,2) :: ISETM
268!
269
270 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(*)
271C-----------------------------------------------
272C L o c a l V a r i a b l e s
273C-----------------------------------------------
274 INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,PARTM,GENE_MAX,K,P,P1
275 INTEGER START_GENE,END_GENE,INCR_GENE,PSTART,PSTOP,STACK,STACK_ONE,NB_RESULT
276 INTEGER IWORK(70000)
277!-
278 INTEGER, ALLOCATABLE, DIMENSION(:) :: SET_READ_TMP,SET_READ_ONE,IDEX,RESULT
279C
280 INTEGER SET_USRTOS_NEAREST
281 EXTERNAL set_usrtos_nearest
282C=======================================================================
283 CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
284
285 ALLOCATE(set_read_tmp(nsets))
286 ALLOCATE(set_read_one(nsets))
287 ALLOCATE(result(nsets))
288
289 stack=0
290
291 DO k=1,gene_max
292 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
293 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
294 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
295
296 ! set value by default for increment to 1
297 IF (incr_gene == 0) incr_gene = 1
298
299 pstart = set_usrtos_nearest(start_gene, isetm, nset_general,1)
300 pstop = set_usrtos_nearest(end_gene, isetm, nset_general,2)
301
302 stack_one=0 ! assemble in SET_READ_ONE Stack_one
303 DO p=pstart, pstop
304 p1 = isetm(p,1)
305 IF ( mod( p1-start_gene , incr_gene) == 0)THEN
306 stack_one = stack_one+1
307 set_read_one(stack_one) = isetm(p,2)
308 ENDIF
309 ENDDO
310
311 IF(stack==0) THEN
312
313 set_read_tmp(1:stack_one) = set_read_one(1:stack_one)
314 stack=stack_one
315
316 ELSE
317
318 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
319 CALL union_2_sorted_sets( set_read_tmp, stack ,
320 * set_read_one, stack_one ,
321 * result, nb_result )
322 set_read_tmp(1:nb_result)=result(1:nb_result)
323 stack = nb_result
324
325 ENDIF
326
327
328 ENDDO
329
330 array_size = stack
331 array(1:stack) = set_read_tmp(1:stack)
332
333 DEALLOCATE (set_read_one)
334 DEALLOCATE (set_read_tmp)
335 DEALLOCATE (result)
336 END
337!||====================================================================
338!|| create_set_clause ../starter/source/model/sets/create_set_clause.F
339!||--- called by ------------------------------------------------------
340!|| hm_set ../starter/source/model/sets/hm_set.F
341!||--- calls -----------------------------------------------------
342!|| insert_clause_in_set ../starter/source/model/sets/insert_clause_in_set.F
343!||--- uses -----------------------------------------------------
344!|| set_mod ../starter/share/modules1/set_mod.F
345!||====================================================================
346 SUBROUTINE create_set_clause(SET,
347 . SETL,SETL_SIZE,
348 . CLAUSE,
349 . IXS ,IXS10 , IXQ ,
350 . IXC ,IXTG ,IXT ,IXP ,IXR ,
351 . SH4TREE,
352 . SH3TREE ,KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC,
353 . KNOD2ELTG ,NOD2ELTG ,IPARTC ,IPARTG ,IPARTS ,
354 . IPART ,OPT_A ,OPT_O ,KNOD2ELQ ,NOD2ELQ,
355 . X ,KEYSET ,OPT_E ,DELBUF )
356C-----------------------------------------------
357C ROUTINE DESCRIPTION :
358C ===================
359C Create SET of SET Clause
360C--------------------------------------------------------------------------------------
361C DUMMY ARGUMENTS DESCRIPTION:
362C ===================
363C
364C NAME DESCRIPTION
365C
366C SET (SET structure) SET ARRAY
367C SETL List of SETs from Clause
368C SETL_SIZE Number of SETs from Clause
369C CLAUSE (SET structure) clause to fill.
370C
371C IXS - KXSP, IGEO : not need in this case, but kept for compatibility.
372C============================================================================
373C-----------------------------------------------
374C M o d u l e s
375C-----------------------------------------------
376 USE setdef_mod
377 USE set_scratch_mod
378 USE names_and_titles_mod , ONLY : ncharfield
379 USE set_mod , ONLY : set_add
380C-----------------------------------------------
381C I m p l i c i t T y p e s
382C-----------------------------------------------
383#include "implicit_f.inc"
384#include "param_c.inc"
385#include "sphcom.inc"
386#include "scr17_c.inc"
387C-----------------------------------------------
388C D u m m y A r g u m e n t s
389C-----------------------------------------------
390 INTEGER SETL_SIZE
391 INTEGER OPT_A,OPT_O,OPT_E
392 INTEGER, DIMENSION(NSETS), INTENT(IN) :: SETL
393 TYPE (SET_),DIMENSION(NSETS), INTENT(IN) :: SET
394 TYPE (SET_) :: CLAUSE
395 TYPE (SET_SCRATCH) :: DELBUF
396C
397 INTEGER IXS(NIXS,*),IXS10(6,*),
398 . IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),IXT(NIXT,*),
399 . IXP(NIXP,*),IXR(NIXR,*),
400 . SH4TREE(*),SH3TREE(*),KNOD2ELS(*),KNOD2ELC(*),KNOD2ELTG(*),
401 . KNOD2ELQ(*),NOD2ELS(*),NOD2ELC(*),NOD2ELTG(*),NOD2ELQ(*),
402 . IPARTS(*),IPARTC(*),IPARTG(*),IPART(LIPART1,*)
403 my_real X(3,*)
404 CHARACTER(LEN=NCHARFIELD) :: KEYSET
405C-----------------------------------------------
406C L o c a l V a r i a b l e s
407C-----------------------------------------------
408 INTEGER I,IGS
409C-----------------------------------------------
410 DO i=1,setl_size
411 igs = setl(i)
412
413 ! Each from list SET is add in the clause with SET_ADD
414 ! The goal is to merge all entities from SET in the clause.
415 ! Call to insert_clause_in_set can be used for that...
416 CALL insert_clause_in_set(clause ,set(igs) ,set_add,
417 . ixs ,ixs10 , ixq ,
418 . ixc ,ixtg ,ixt ,ixp ,ixr ,
419 . sh4tree,
420 . sh3tree ,knod2els ,nod2els ,knod2elc ,nod2elc,
421 . knod2eltg ,nod2eltg ,ipartc ,ipartg ,iparts ,
422 . ipart ,opt_a ,opt_o ,knod2elq ,nod2elq,
423 . x ,keyset ,opt_e ,delbuf )
424C
425 ENDDO
426C-----------------------------------------------
427 END
428
429
create_set_list_g
subroutine create_set_list_g(array, array_size, isetm, nset_general, jclause, is_available, lsubmodel)
Definition create_set_clause.F:234
create_set_array
subroutine create_set_array(set_array, array_size, isetm, nset_general, jclause, opt_g, is_available, lsubmodel, clause, flag)
Definition create_set_clause.F:40
create_set_list
subroutine create_set_list(array, array_size, isetm, nset_general, jclause, is_available, lsubmodel, clause, flag)
Definition create_set_clause.F:109
create_set_clause
subroutine create_set_clause(set, setl, setl_size, clause, ixs, ixs10, ixq, ixc, ixtg, ixt, ixp, ixr, sh4tree, sh3tree, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, ipart, opt_a, opt_o, knod2elq, nod2elq, x, keyset, opt_e, delbuf)
Definition create_set_clause.F:356
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
insert_clause_in_set
subroutine insert_clause_in_set(set, clause, clause_operator, ixs, ixs10, ixq, ixc, ixtg, ixt, ixp, ixr, sh4tree, sh3tree, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, ipart, opt_a, opt_o, knod2elq, nod2elq, x, keyset, opt_e, delbuf)
Definition insert_clause_in_set.F:50
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
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::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
set_mod
Definition set_mod.F:43
set_mod::set_add
integer, parameter set_add
add operator
Definition set_mod.F:47
set_scratch_mod
Definition setdef_mod.F:247
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:712
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723