OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_part_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_part_clause ../starter/source/model/sets/create_part_clause.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| create_part_list ../starter/source/model/sets/create_part_clause.F
30!|| create_part_list_g ../starter/source/model/sets/create_part_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_part_clause(
37 . CLAUSE ,IPARTM1 ,JCLAUSE ,OPT_G ,IS_AVAILABLE ,
38 . LSUBMODEL)
39C-----------------------------------------------
40C ROUTINE DESCRIPTION :
41C ===================
42C Treat the PART Clause, read PARTs from HM_READER & fill clause
43C Calls CREATE_PART_LIST (simple list)
44C Calls CREATE_PART_LIST_G (PART_G : All parts from a MIN to MAX with increment)
45C------------------------------------------------------------------
46C DUMMY ARGUMENTS DESCRIPTION:
47C ===================
48C
49C NAME DESCRIPTION
50C
51C CLAUSE (SET structure) Clause to be treated
52C IPARTM1 MAP Table UID -> LocalID
53C JCLAUSE parameter with HM_READER (current clause read)
54C Opt_G Opt_G operator 1 if PART_G is set, 0 else
55C IS_AVAILABLE Bool / Result of HM_interface
56C LSUBMODEL SUBMODEL Structure.
57C============================================================================
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE setdef_mod
62 USE submodel_mod
63 USE message_mod
64 USE hm_option_read_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(NPART,2) :: IPARTM1
79C-----------------------------------------------
80 TYPE (SET_) :: CLAUSE
81 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85!
86 IF(npart == 0)THEN
87 CALL ancmsg(msgid=2007,anmode=aninfo,
88 . msgtype=msgwarning,
89 . i1 = clause%SET_ID,
90 . c1=trim(clause%TITLE),
91 . c2='PARTS')
92 clause%NB_PART = 0
93 RETURN
94 ENDIF
95
96 IF (opt_g == 1 ) THEN
97 CALL create_part_list_g(clause, ipartm1 ,jclause ,is_available ,lsubmodel)
98 ELSE
99 CALL create_part_list (clause, ipartm1 ,jclause ,is_available ,lsubmodel)
100 ENDIF
101C-----------------------------------------------
102 END
103!||====================================================================
104!|| create_part_list ../starter/source/model/sets/create_part_clause.F
105!||--- called by ------------------------------------------------------
106!|| create_part_clause ../starter/source/model/sets/create_part_clause.F
107!||--- calls -----------------------------------------------------
108!|| ancmsg ../starter/source/output/message/message.F
109!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
110!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
111!|| set_usrtos ../starter/source/model/sets/ipartm1.F
112!||--- uses -----------------------------------------------------
113!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
114!|| message_mod ../starter/share/message_module/message_mod.F
115!|| submodel_mod ../starter/share/modules1/submodel_mod.F
116!||====================================================================
117 SUBROUTINE create_part_list(
118 . CLAUSE, IPARTM1 ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL)
119C-----------------------------------------------
120C ROUTINE DESCRIPTION :
121C ===================
122C Create PART Clause from LIST
123C------------------------------------------------------------------
124C DUMMY ARGUMENTS DESCRIPTION:
125C ===================
126C
127C NAME DESCRIPTION
128C
129C CLAUSE (SET structure) Clause to be treated
130C IPARTM1 MAP Table UID -> LocalID
131C JCLAUSE parameter with HM_READER (current clause read)
132C IS_AVAILABLE Bool / Result of HM_interface
133C LSUBMODEL SUBMODEL Structure.
134C============================================================================
135C-----------------------------------------------
136C M o d u l e s
137C-----------------------------------------------
138 USE setdef_mod
139 USE submodel_mod
140 USE message_mod
141 USE hm_option_read_mod
142C-----------------------------------------------
143C I m p l i c i t T y p e s
144C-----------------------------------------------
145#include "implicit_f.inc"
146C-----------------------------------------------
147C C o m m o n B l o c k s
148C-----------------------------------------------
149#include "com04_c.inc"
150C-----------------------------------------------
151C D u m m y A r g u m e n t s
152C-----------------------------------------------
153 INTEGER JCLAUSE
154 LOGICAL :: IS_AVAILABLE
155 INTEGER, INTENT(IN), DIMENSION(NPART,2) :: IPARTM1
156!
157 TYPE (SET_) :: CLAUSE
158 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(*)
159C-----------------------------------------------
160C L o c a l V a r i a b l e s
161C-----------------------------------------------
162 INTEGER I,IDS,NINDX,LIST_SIZE,IDS_MAX,PARTM
163 INTEGER IWORK(70000)
164!
165 INTEGER, ALLOCATABLE, DIMENSION(:) :: PART_READ_TMP,SORTED_PARTS,INDEX
166C
167 INTEGER SET_USRTOS
168 EXTERNAL set_usrtos
169C=======================================================================
170
171 CALL hm_get_int_array_index('idsmax' ,ids_max ,jclause,is_available,lsubmodel)
172
173 ALLOCATE(part_read_tmp(ids_max))
174 ALLOCATE(sorted_parts(ids_max))
175
176 ALLOCATE(index(2*ids_max))
177 index = 0
178
179 nindx = 0
180 list_size = 0
181
182 ! Read & convert Parts
183 ! ---------------------
184 DO i=1,ids_max
185 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
186!
187 partm = set_usrtos(ids,ipartm1,npart)
188 IF(partm == 0)THEN
189 ! Part was not found. Issue a Warning & Skip.
190 CALL ancmsg(msgid=1902,anmode=aninfo,
191 . msgtype=msgwarning,
192 . i1 = clause%SET_ID,
193 . i2=ids,
194 . c1=trim(clause%TITLE),
195 . c2='PART')
196 ELSE
197
198 partm=ipartm1(partm,2)
199
200 nindx=nindx+1 ! nb of CLAUSE parts
201 part_read_tmp(nindx) = partm
202 ENDIF
203
204 ENDDO ! DO K=1,IDS_MAX
205
206 ! Sort the Readed PARTs and remove eventual duplicates
207 ! ----------------------------------------------------
208
209 DO i=1,nindx
210 index(i) = i
211 ENDDO
212 CALL my_orders(0,iwork,part_read_tmp,index,nindx,1)
213
214 DO i=1,nindx
215 sorted_parts(i) = part_read_tmp(index(i))
216 ENDDO
217
218 CALL remove_duplicates( sorted_parts,nindx,list_size)
219
220 ! Copy in final SET
221 ! ------------------
222 clause%NB_PART = list_size
223 ALLOCATE( clause%PART( list_size ) )
224
225 DO i=1,list_size
226 clause%PART(i) = sorted_parts(i)
227 ENDDO
228!---
229
230C-------------------------
231 DEALLOCATE(part_read_tmp)
232 DEALLOCATE(sorted_parts)
233 DEALLOCATE(index)
234C-------------------------
235 RETURN
236 END
237
238!||====================================================================
239!|| create_part_list_g ../starter/source/model/sets/create_part_clause.F
240!||--- called by ------------------------------------------------------
241!|| create_part_clause ../starter/source/model/sets/create_part_clause.F
242!||--- calls -----------------------------------------------------
243!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
244!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
245!|| set_usrtos_nearest ../starter/source/model/sets/ipartm1.F
246!||--- uses -----------------------------------------------------
247!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
248!|| message_mod ../starter/share/message_module/message_mod.F
249!|| submodel_mod ../starter/share/modules1/submodel_mod.f
250!||====================================================================
251 SUBROUTINE create_part_list_g(
252 . CLAUSE, IPARTM1 ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL)
253C-----------------------------------------------
254C ROUTINE DESCRIPTION :
255C ===================
256C Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
257C--------------------------------------------------------------------------------------
258C DUMMY ARGUMENTS DESCRIPTION:
259C ===================
260C
261C NAME DESCRIPTION
262C
263C CLAUSE (SET structure) Clause to be treated
264C IPARTM1 MAP Table UID -> LocalID
265C JCLAUSE parameter with HM_READER (current clause read)
266C IS_AVAILABLE Bool / Result of HM_interface
267C LSUBMODEL SUBMODEL Structure.
268C============================================================================
269C-----------------------------------------------
270C M o d u l e s
271C-----------------------------------------------
272 USE setdef_mod
273 USE submodel_mod
274 USE message_mod
275 USE hm_option_read_mod
276C-----------------------------------------------
277C I m p l i c i t T y p e s
278C-----------------------------------------------
279#include "implicit_f.inc"
280C-----------------------------------------------
281C C o m m o n B l o c k s
282C-----------------------------------------------
283#include "com04_c.inc"
284C-----------------------------------------------
285C D u m m y A r g u m e n t s
286C-----------------------------------------------
287 INTEGER JCLAUSE
288 LOGICAL :: IS_AVAILABLE
289 INTEGER, INTENT(IN), DIMENSION(NPART,2) :: IPARTM1
290!
291 TYPE (SET_) :: CLAUSE
292 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
293C-----------------------------------------------
294C L o c a l V a r i a b l e s
295C-----------------------------------------------
296 INTEGER I,IDS,LIST_SIZE,IDS_MAX,PARTM,GENE_MAX,K,P,P1
297 INTEGER START_GENE,END_GENE,INCR_GENE,PSTART,PSTOP,STACK,STACK_ONE,NB_RESULT
298!-
299 INTEGER, ALLOCATABLE, DIMENSION(:) :: PART_READ_TMP,
300 . part_read_one,result
301C
302 INTEGER SET_USRTOS_NEAREST
303 EXTERNAL set_usrtos_nearest
304C=======================================================================
305
306 CALL hm_get_int_array_index('genemax' ,gene_max ,jclause,is_available,lsubmodel)
307
308 ALLOCATE(part_read_tmp(npart))
309 ALLOCATE(part_read_one(npart))
310
311 IF (gene_max > 1) THEN
312 ALLOCATE(result(npart))
313 ENDIF
314
315 stack=0
316
317 DO k=1,gene_max
318 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
319 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
320 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
321
322 ! set value by default for increment to 1
323 IF (incr_gene == 0) incr_gene = 1
324
325 pstart = set_usrtos_nearest(start_gene,ipartm1,npart,1)
326 pstop = set_usrtos_nearest(end_gene,ipartm1,npart,2)
327
328 stack_one=0
329
330 DO p=pstart, pstop
331 p1 = ipartm1(p,1)
332 IF ( mod( p1-start_gene , incr_gene) == 0 ) THEN
333 stack_one = stack_one+1
334 part_read_one(stack_one) = ipartm1(p,2)
335 ENDIF
336 ENDDO
337
338 IF (stack==0) THEN
339 part_read_tmp(1:stack_one) = part_read_one(1:stack_one)
340 stack = stack_one
341 ELSE
342 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
343 CALL union_2_sorted_sets( part_read_tmp, stack ,
344 * part_read_one, stack_one ,
345 * result, nb_result )
346
347 part_read_tmp(1:nb_result) = result(1:nb_result)
348 stack = nb_result
349 ENDIF
350 ENDDO
351
352 clause%NB_PART = stack
353 ALLOCATE(clause%PART(stack))
354 clause%PART(1:stack) = part_read_tmp(1:stack)
355!
356 DEALLOCATE (part_read_tmp)
357 DEALLOCATE (part_read_one)
358 IF (ALLOCATED(result)) DEALLOCATE (result)
359!
360 END
361
362
create_part_list_g
subroutine create_part_list_g(clause, ipartm1, jclause, is_available, lsubmodel)
Definition create_part_clause.F:253
create_part_clause
subroutine create_part_clause(clause, ipartm1, jclause, opt_g, is_available, lsubmodel)
Definition create_part_clause.F:39
create_part_list
subroutine create_part_list(clause, ipartm1, jclause, is_available, lsubmodel)
Definition create_part_clause.F:119
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
hm_set
subroutine hm_set(set, lsubmodel, inv_group, map_tables, ipart, igrsurf, igrnod, igrslin, igrpart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, ixs, ixs10, ixc, ixtg, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, ipartc, ipartg, iparts, sh4tree, sh3tree, ixq, knod2elq, nod2elq, x, ixt, ixp, ixr, ixx, kxx, kxsp, ixs20, ixs16, geo, itabm1, ibox, skew, ipartq, ipartt, ipartp, ipartr, subset, rby_msn, iskn, rtrans, unitab, bufsf, iad, siskwn, sskew, rootnam, rootlen, infile_name, infile_name_len)
Definition hm_set.F:88
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
setdef_mod
Definition setdef_mod.F:107
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