OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
create_subm_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_subm_clause ../starter/source/model/sets/create_subm_clause.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.F
27!||--- calls -----------------------------------------------------
28!|| create_subm_list ../starter/source/model/sets/create_subm_clause.F
29!|| create_subm_list_g ../starter/source/model/sets/create_subm_clause.F
30!||--- uses -----------------------------------------------------
31!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE create_subm_clause(
36 . CLAUSE ,ISUBMM ,JCLAUSE ,OPT_G ,IS_AVAILABLE ,
37 . LSUBMODEL,IPART )
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
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com04_c.inc"
72#include "scr17_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(NSUBMOD,2) :: ISUBMM
79 INTEGER IPART(LIPART1,NPART)
80C-----------------------------------------------
81 TYPE (SET_) :: CLAUSE
82 TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(*)
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_subm_list_g(clause, isubmm ,jclause ,is_available ,lsubmodel,
89 . ipart )
90 ELSE
91 CALL create_subm_list (clause, isubmm ,jclause ,is_available ,lsubmodel,
92 . ipart )
93 ENDIF
94C-----------------------------------------------
95 END
96!||====================================================================
97!|| create_subm_list ../starter/source/model/sets/create_subm_clause.F
98!||--- called by ------------------------------------------------------
99!|| create_subm_clause ../starter/source/model/sets/create_subm_clause.F
100!||--- calls -----------------------------------------------------
101!|| ancmsg ../starter/source/output/message/message.f
102!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
103!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
104!|| set_usrtos ../starter/source/model/sets/ipartm1.F
105!||--- uses -----------------------------------------------------
106!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
107!|| message_mod ../starter/share/message_module/message_mod.F
108!|| submodel_mod ../starter/share/modules1/submodel_mod.F
109!||====================================================================
110 SUBROUTINE create_subm_list(
111 . CLAUSE, ISUBMM ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL,
112 . IPART )
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
136C-----------------------------------------------
137C I m p l i c i t T y p e s
138C-----------------------------------------------
139#include "implicit_f.inc"
140C-----------------------------------------------
141C C o m m o n B l o c k s
142C-----------------------------------------------
143#include "com04_c.inc"
144#include "scr17_c.inc"
145C-----------------------------------------------
146C D u m m y A r g u m e n t s
147C-----------------------------------------------
148 INTEGER JCLAUSE
149 LOGICAL :: IS_AVAILABLE
150 INTEGER, INTENT(IN), DIMENSION(NSUBMOD,2) :: ISUBMM
151 INTEGER IPART(LIPART1,NPART)
152!
153 TYPE (SET_) :: CLAUSE
154 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(*)
155C-----------------------------------------------
156C L o c a l V a r i a b l e s
157C-----------------------------------------------
158 INTEGER I,J,IDS,NINDX,IDS_MAX,SUBMM,PARTM,ISUB,IP,SUB_INDEX,
159 . LIST_SIZE_S,LIST_SIZE_P,LIST_SIZE_N,NODE
160 INTEGER IWORK(70000)
161!
162 INTEGER, ALLOCATABLE, DIMENSION(:) :: SUBM_READ_TMP,SORTED_SUBM,INDEXS,
163 . PART_READ_TMP,SORTED_PARTS,INDEXP,TAGNODSUB,NODE_READ_TMP,SORTED_NODES,INDEXN
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(subm_read_tmp(ids_max))
172 ALLOCATE(sorted_subm(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 ALLOCATE(tagnodsub(numnod))
184
185 ALLOCATE(node_read_tmp(numnod))
186!! ALLOCATE(SORTED_NODES(NUMNOD))
187!! ALLOCATE(INDEXN(2*NUMNOD)) ! nodes of subsets
188!! INDEXN = 0
189
190
191 nindx = 0
192 list_size_s = 0
193 list_size_p = 0
194 list_size_n = 0
195
196 ! Read & convert Subsets
197 ! ---------------------
198 DO i=1,ids_max
199 CALL hm_get_int_array_2indexes('ids',ids,jclause,i,is_available,lsubmodel)
200
201 submm = set_usrtos(ids,isubmm,nsubmod)
202 IF(submm == 0)THEN
203 ! Submodel was not found. Issue a Warning & Skip.
204 CALL ancmsg(msgid=1902,anmode=aninfo,
205 . msgtype=msgwarning,
206 . i1 = clause%SET_ID,
207 . i2=ids,
208 . c1=trim(clause%TITLE),
209 . c2='SUBMODEL')
210 ELSE
211
212 submm=isubmm(submm,2)
213
214 nindx=nindx+1 ! nb of CLAUSE submodels
215 subm_read_tmp(nindx) = submm
216 ENDIF
217
218 ENDDO ! DO K=1,IDS_MAX
219
220
221 ! Sort the Readed SUBSETs and remove eventual duplicates
222 ! ----------------------------------------------------
223
224 iwork(:) = 0
225 DO i=1,nindx
226 indexs(i) = i
227 ENDDO
228 CALL my_orders(0,iwork,subm_read_tmp,indexs,nindx,1)
229
230 DO i=1,nindx
231 sorted_subm(i) = subm_read_tmp(indexs(i))
232 ENDDO
233
234 CALL remove_duplicates(sorted_subm,nindx,list_size_s)
235
236
237 ! TAG Parts from Readed SUBSETs
238 ! ----------------------------------------------------
239
240 nindx = 0
241 DO i=1,list_size_s
242 isub = sorted_subm(i)
243 DO ip=1,npart
244 sub_index = ipart(9,ip)
245 IF (isub == sub_index) THEN
246
247 partm = ip
248
249 nindx=nindx+1 ! nb of Parts of CLAUSE subsets
250 part_read_tmp(nindx) = partm
251
252 ENDIF
253 ENDDO
254 ENDDO
255
256
257 ! Sort of TAG Parts from Readed SUBMODELs and remove eventual duplicates
258 ! ----------------------------------------------------
259
260 iwork(:) = 0
261 DO i=1,nindx
262 indexp(i) = i
263 ENDDO
264 CALL my_orders(0,iwork,part_read_tmp,indexp,nindx,1)
265
266 DO i=1,nindx
267 sorted_parts(i) = part_read_tmp(indexp(i))
268 ENDDO
269
270 list_size_p = 0
271 CALL remove_duplicates(sorted_parts,nindx,list_size_p)
272
273
274 ! Copy in final SET
275 ! ------------------
276 clause%NB_PART = list_size_p
277 ALLOCATE( clause%PART( list_size_p ) )
278
279 DO i=1,list_size_p
280 clause%PART(i) = sorted_parts(i)
281 ENDDO
282!---
283
284
285 ! Tag & convert Nodes of Submodel
286 ! ---------------------
287 CALL cpp_node_sub_tag(tagnodsub)
288
289
290 nindx = 0
291 DO i=1,list_size_s
292 isub = sorted_subm(i)
293 DO j=1,numnod
294 sub_index = tagnodsub(j)
295 IF (isub == sub_index) THEN
296
297 node = j
298
299 nindx=nindx+1 ! nb of Nodes of CLAUSE subsets
300 node_read_tmp(nindx) = node
301
302 ENDIF
303 ENDDO
304 ENDDO
305
306
307 ! Sort of TAG Nodes from Readed SUBMODELs and remove eventual duplicates
308 ! ----------------------------------------------------
309
310 ALLOCATE(sorted_nodes(nindx))
311 ALLOCATE(indexn(2*nindx))
312 indexn = 0
313
314 iwork(:) = 0
315 DO i=1,nindx
316 indexn(i) = i
317 ENDDO
318 CALL my_orders(0,iwork,node_read_tmp,indexn,nindx,1)
319
320 DO i=1,nindx
321 sorted_nodes(i) = node_read_tmp(indexn(i))
322 ENDDO
323
324 list_size_n = 0
325 CALL remove_duplicates(sorted_nodes,nindx,list_size_n)
326
327
328 ! Copy in final SET
329 ! ------------------
330 clause%NB_NODE = list_size_n
331 ALLOCATE( clause%NODE( list_size_n ) )
332
333 DO i=1,list_size_n
334 clause%NODE(i) = sorted_nodes(i)
335 ENDDO
336
337C-------------------------
338 DEALLOCATE(subm_read_tmp)
339 DEALLOCATE(sorted_subm)
340 DEALLOCATE(indexs)
341 DEALLOCATE(part_read_tmp)
342 DEALLOCATE(sorted_parts)
343 DEALLOCATE(indexp)
344 DEALLOCATE(tagnodsub)
345 DEALLOCATE(node_read_tmp)
346 DEALLOCATE(sorted_nodes)
347 DEALLOCATE(indexn)
348C-------------------------
349 RETURN
350 END
351!||====================================================================
352!|| create_subm_list_g ../starter/source/model/sets/create_subm_clause.F
353!||--- called by ------------------------------------------------------
354!|| create_subm_clause ../starter/source/model/sets/create_subm_clause.F
355!||--- calls -----------------------------------------------------
356!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
357!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.f
358!|| set_usrtos_nearest ../starter/source/model/sets/ipartm1.F
359!||--- uses -----------------------------------------------------
360!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
361!|| message_mod ../starter/share/message_module/message_mod.F
362!|| submodel_mod ../starter/share/modules1/submodel_mod.F
363!||====================================================================
364 SUBROUTINE create_subm_list_g(
365 . CLAUSE, ISUBMM ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL,
366 . IPART )
367C-----------------------------------------------
368C ROUTINE DESCRIPTION :
369C ===================
370C Create PART Clause from Generation All parts from Min to Max with Increment (Opt_G)
371C--------------------------------------------------------------------------------------
372C DUMMY ARGUMENTS DESCRIPTION:
373C ===================
374C
375C NAME DESCRIPTION
376C
377C CLAUSE (SET structure) Clause to be treated
378C ISUBMM MAP Table UID -> LocalID
379C JCLAUSE parameter with HM_READER (current clause read)
380C IS_AVAILABLE Bool / Result of HM_interface
381C LSUBMODEL SUBMODEL Structure.
382C============================================================================
383C-----------------------------------------------
384C M o d u l e s
385C-----------------------------------------------
386 USE setdef_mod
387 USE submodel_mod
388 USE message_mod
389 USE hm_option_read_mod
390C-----------------------------------------------
391C I m p l i c i t T y p e s
392C-----------------------------------------------
393#include "implicit_f.inc"
394C-----------------------------------------------
395C C o m m o n B l o c k s
396C-----------------------------------------------
397#include "com04_c.inc"
398#include "scr17_c.inc"
399C-----------------------------------------------
400C D u m m y A r g u m e n t s
401C-----------------------------------------------
402 INTEGER JCLAUSE
403 LOGICAL :: IS_AVAILABLE
404 INTEGER, INTENT(IN), DIMENSION(NSUBMOD,2) :: ISUBMM
405 INTEGER IPART(LIPART1,NPART)
406!
407 TYPE (SET_) :: CLAUSE
408 TYPE(submodel_data),INTENT(IN):: LSUBMODEL(*)
409C-----------------------------------------------
410C L o c a l V a r i a b l e s
411C-----------------------------------------------
412 INTEGER I,J,LIST_SIZE,PARTM,GENE_MAX,K,S,S1,
413 . nindx,ip,isub,sub_index,node
414 INTEGER START_GENE,END_GENE,INCR_GENE,SSTART,SSTOP,STACK,STACK_ONE,NB_RESULT
415!-
416 INTEGER, ALLOCATABLE, DIMENSION(:) :: SUBM_READ_TMP,SUBM_READ_ONE,RESULT,
417 . PART_READ_TMP,SORTED_PARTS,INDEX,TAGNODSUB,NODE_READ_TMP,
418 . sorted_nodes,indexn
419C
420 INTEGER SET_USRTOS_NEAREST
421 EXTERNAL SET_USRTOS_NEAREST
422 INTEGER IWORK(70000)
423C=======================================================================
424 CALL HM_GET_INT_ARRAY_INDEX('genemax' ,GENE_MAX ,JCLAUSE,IS_AVAILABLE,LSUBMODEL)
425
426 ALLOCATE(subm_read_tmp(nsubmod))
427 ALLOCATE(subm_read_one(nsubmod))
428
429 ALLOCATE(part_read_tmp(npart))
430 ALLOCATE(sorted_parts(npart))
431
432 ALLOCATE(index(2*npart))
433 index = 0
434
435 IF (gene_max > 1) THEN
436 ALLOCATE(result(nsubmod))
437 ENDIF
438
439 ALLOCATE(tagnodsub(numnod))
440
441 ALLOCATE(node_read_tmp(numnod))
442!! ALLOCATE(SORTED_NODES(NUMNOD))
443!! ALLOCATE(INDEXN(2*NUMNOD)) ! nodes of subsets
444!! INDEXN = 0
445
446 stack=0
447
448 DO k=1,gene_max
449 CALL hm_get_int_array_2indexes('start' ,start_gene,jclause,k,is_available,lsubmodel)
450 CALL hm_get_int_array_2indexes('end' ,end_gene ,jclause,k,is_available,lsubmodel)
451 CALL hm_get_int_array_2indexes('by' ,incr_gene ,jclause,k,is_available,lsubmodel)
452
453 sstart = set_usrtos_nearest(start_gene,isubmm,nsubmod,1)
454 sstop = set_usrtos_nearest(end_gene,isubmm,nsubmod,2)
455
456 stack_one=0
457
458 DO s=sstart, sstop
459 s1 = isubmm(s,1)
460 IF ( mod( s1-start_gene , incr_gene) == 0 ) THEN
461 stack_one = stack_one+1
462 subm_read_one(stack_one) = isubmm(s,2)
463 ENDIF
464 ENDDO
465
466 IF (stack==0) THEN
467 subm_read_tmp(1:stack_one) = subm_read_one(1:stack_one)
468 stack = stack_one
469 ELSE
470 ! This code will not go if GENE_MAX == 1 / Result does not need to be allocated
471 CALL union_2_sorted_sets( subm_read_tmp, stack ,
472 * subm_read_one, stack_one ,
473 * result, nb_result )
474
475 subm_read_tmp(1:nb_result) = result(1:nb_result)
476 stack = nb_result
477 ENDIF
478 ENDDO
479
480
481 ! TAG Parts from Readed SUBSETs
482 ! ----------------------------------------------------
483
484 nindx = 0
485 DO i=1,stack
486 isub = subm_read_tmp(i)
487 DO ip=1,npart
488 sub_index = ipart(9,ip)
489 IF (isub == sub_index) THEN
490
491 partm = ip
492
493 nindx=nindx+1 ! nb of Parts of CLAUSE submodels
494 part_read_tmp(nindx) = partm
495
496 ENDIF
497 ENDDO ! DO
498 ENDDO
499
500
501 ! Sort of TAG Parts from Readed SUBMODELs and remove eventual duplicates
502 ! ----------------------------------------------------
503
504
505 DO i=1,nindx
506 index(i) = i
507 ENDDO
508 CALL my_orders(0,iwork,part_read_tmp,index,nindx,1)
509
510 DO i=1,nindx
511 sorted_parts(i) = part_read_tmp(index(i))
512 ENDDO
513
514 list_size = 0
515 CALL remove_duplicates(sorted_parts,nindx,list_size)
516
517
518
519!
520 ! Copy in final SET
521 ! ------------------
522 clause%NB_PART = list_size
523 ALLOCATE(clause%PART(list_size))
524 clause%PART(1:list_size) = sorted_parts(1:list_size)
525
526
527
528 ! Tag & convert Nodes of Submodel
529 ! ---------------------
530 CALL cpp_node_sub_tag(tagnodsub)
531
532
533 nindx = 0
534 DO i=1,stack
535 isub = subm_read_tmp(i)
536 DO j=1,numnod
537 sub_index = tagnodsub(j)
538 IF (isub == sub_index) THEN
539
540 node = j
541
542 nindx=nindx+1 ! nb of Nodes of CLAUSE subsets
543 node_read_tmp(nindx) = node
544
545 ENDIF
546 ENDDO
547 ENDDO
548
549
550 ! Sort of TAG Nodes from Readed SUBMODELs and remove eventual duplicates
551 ! ----------------------------------------------------
552
553 ALLOCATE(sorted_nodes(nindx))
554 ALLOCATE(indexn(2*nindx))
555 indexn = 0
556
557 iwork(:) = 0
558 DO i=1,nindx
559 indexn(i) = i
560 ENDDO
561 CALL my_orders(0,iwork,node_read_tmp,indexn,nindx,1)
562
563 DO i=1,nindx
564 sorted_nodes(i) = node_read_tmp(indexn(i))
565 ENDDO
566
567 list_size = 0
568 CALL remove_duplicates(sorted_nodes,nindx,list_size)
569
570
571 ! Copy in final SET
572 ! ------------------
573 clause%NB_NODE = list_size
574 ALLOCATE( clause%NODE( list_size ) )
575
576 DO i=1,list_size
577 clause%NODE(i) = sorted_nodes(i)
578 ENDDO
579
580
581
582
583!---
584 DEALLOCATE (part_read_tmp)
585 DEALLOCATE (sorted_parts)
586 IF (ALLOCATED(result)) DEALLOCATE (result)
587 DEALLOCATE (subm_read_tmp)
588 DEALLOCATE (subm_read_one)
589 DEALLOCATE(tagnodsub)
590 DEALLOCATE(node_read_tmp)
591 DEALLOCATE(sorted_nodes)
592 DEALLOCATE(indexn)
593!---
594 END
create_subm_list
subroutine create_subm_list(clause, isubmm, jclause, is_available, lsubmodel, ipart)
Definition create_subm_clause.F:113
create_subm_clause
subroutine create_subm_clause(clause, isubmm, jclause, opt_g, is_available, lsubmodel, ipart)
Definition create_subm_clause.F:38
create_subm_list_g
subroutine create_subm_list_g(clause, isubmm, jclause, is_available, lsubmodel, ipart)
Definition create_subm_clause.F:367
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
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:412
message_mod
Definition message_mod.F:1257
setdef_mod
Definition setdef_mod.F:107
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
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
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728