OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sort_sets.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!|| sort_set ../starter/source/model/sets/sort_sets.F
25!||--- called by ------------------------------------------------------
26!|| hm_set ../starter/source/model/sets/hm_set.F
27!||--- calls -----------------------------------------------------
28!|| arret ../starter/source/system/arret.F
29!|| create_set_array ../starter/source/model/sets/create_set_clause.F
30!|| create_setcol_array ../starter/source/model/sets/create_setcol_clause.F
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
34!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
37!|| set_merge_simple ../starter/source/model/sets/set_merge_simple.F
38!||--- uses -----------------------------------------------------
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| mapping_option_mod ../starter/share/modules1/dichotomy_mod.F
41!|| set_mod ../starter/share/modules1/set_mod.F
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE sort_set (LSUBMODEL ,MAP_TABLES, SET_LIST ,SET,CLAUSE)
45C-----------------------------------------------
46C ROUTINE DESCRIPTION :
47C ===================
48C Main Routine to Sort SETs according to their dependencies (/SET of /SET)
49C If a SET has SET clause (child SETs), ensure that those are treated before.
50C
51C All Sets are parsed to find Child Sets, fill a Graph with SET & Childs
52C Go through the Graph to generate the list
53C-----------------------------------------------
54C DUMMY ARGUMENTS DESCRIPTION:
55C ===================
56C
57C NAME DESCRIPTION
58C LSUBMODEL SUBMODEL Structure
59C MAP_TABLES Mapping table structure
60C SET_LIST List of sorted SETs
61C SET SET Structure / ACTIV Flag will be defined for /SET/COLLECT
62C===========================================================================================
63C-----------------------------------------------
64C D e f i n i t i o n s
65C-----------------------------------------------
66C-----------------------------------------------
67C M o d u l e s
68C-----------------------------------------------
69 USE submodel_mod
70 USE hm_option_read_mod
71 USE setdef_mod
72 USE mapping_option_mod
73 USE names_and_titles_mod , ONLY : nchartitle, ncharfield, ncharkey, ncharline
74 USE set_mod , ONLY : set_add
75C-----------------------------------------------
76C I m p l i c i t T y p e s
77C-----------------------------------------------
78#include "implicit_f.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(*)
83 TYPE(mapping_struct_) :: MAP_TABLES
84 TYPE (SET_), DIMENSION(NSETS),INTENT(INOUT) :: SET
85 INTEGER SET_LIST(NSETS)
86 TYPE (SET_) :: CLAUSE
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER IGS, IGS2, ID1, ID2, IG, I, J, SET_CLAUSE_SIZE, SET_ARRAY_SIZE, NEW_SIZE, IERROR, T, ID
91 INTEGER SET_ID, ISET_TYPE, CLAUSES_MAX, SETCOL_ARRAY_SIZE
92 INTEGER OPT_D,OPT_O,OPT_G,OPT_B,OPT_A,OPT_E,OPT_I,OPT_C
93 INTEGER IDEBUG
94 LOGICAL IS_AVAILABLE
95 INTEGER, DIMENSION(:),ALLOCATABLE :: SET_ARRAY,SET_CLAUSE_ARRAY,RESULT,SETCOL_ARRAY
96 INTEGER, DIMENSION(:),ALLOCATABLE :: COLLECT_LIST,IS_COLLECT
97
98C-----------------------------------------------
99C Characters
100 CHARACTER MESS*40
101 CHARACTER(LEN=NCHARFIELD) :: KEYSET,SET_TYPE,KEY_TYPE
102 CHARACTER(LEN=NCHARTITLE) :: TITLE,TITLE2,SET_TITLE
103 CHARACTER(LEN=NCHARKEY) :: KEYPART,KEY
104C-----------------------------------------------
105 idebug=0
106
107 IF (idebug == 1)THEN
108 print*,' '
109 print*,' '
110 print*,' -----------------------------------------------'
111 print*,' SORTING SETS'
112 print*,' -----------------------------------------------'
113 print*,' '
114 ENDIF
115
116 ALLOCATE(set_array(nsets))
117 ALLOCATE(setcol_array(nsets))
118 ALLOCATE(set_clause_array(nsets))
119 ALLOCATE(is_collect(nsets))
120 ALLOCATE(result(nsets))
121 ALLOCATE(collect_list(map_tables%NSET_COLLECT))
122
123
124 !-------------------------------------------------
125 ! SET%IS_ACTIVE & /SET/COLLECT
126 ! ----------------------------
127 ! Loops to define which set is active
128 ! In /SET/COLLECT only one SET of the SERIES is active
129 ! And assembled by the others.
130 ! All secondary SETs needs to be treated before the
131 ! the active SET.
132 ! /SET/GENERAL : all SETs are active
133 !-------------------------------------------------
134
135 DO igs=1,nsets
136 set(igs)%SET_ACTIV=-1
137 is_collect(igs)=0
138 ENDDO
139
140 IF (map_tables%NSET_COLLECT > 0)THEN
141
142 igs = map_tables%ISETCOLM(1,2)
143 is_collect(igs)=1
144 set(igs)%SET_ACTIV=1
145
146 DO i=2,map_tables%NSET_COLLECT
147 igs = map_tables%ISETCOLM(i,2)
148 igs2 = map_tables%ISETCOLM(i-1,2)
149
150 id1 = map_tables%ISETCOLM(i,1)
151 id2 = map_tables%ISETCOLM(i-1,1)
152
153 is_collect(igs)=1
154 IF(id1 /= id2) THEN
155 set(igs)%SET_ACTIV=1
156 ELSE
157 set(igs)%SET_ACTIV=0
158 ENDIF
159 ENDDO
160 ENDIF
161 DO igs=1,nsets
162 IF(is_collect(igs) == 0) set(igs)%SET_ACTIV=1
163 ENDDO
164 !-------------------------------------------------
165
166 CALL hm_option_start('/SET')
167
168 DO igs=1,nsets
169
170 set_array_size=0
171
172 CALL hm_option_read_key (lsubmodel,
173 . option_id = set_id,
174 . option_titr = set_title,
175 . keyword2 = key)
176
177
178 CALL hm_get_string('set_Type' , set_type ,ncharfield, is_available)
179 CALL hm_get_intv ('iset_Type', iset_type,is_available,lsubmodel)
180
181 CALL hm_get_intv('clausesmax',clauses_max,is_available,lsubmodel)
182
183
184
185
186 ! Parse all clauses find SET clauses
187 ! -------------------------
188 DO j=1,clauses_max ! max KEY's of the current /SET
189 CALL hm_get_string_index('KEY_type', keyset, j, ncharline, is_available)
190
191 CALL hm_get_int_array_index('opt_D',opt_d,j,is_available,lsubmodel)
192 CALL hm_get_int_array_index('opt_O',opt_o,j,is_available,lsubmodel)
193 CALL hm_get_int_array_index('opt_G',opt_g,j,is_available,lsubmodel)
194 CALL hm_get_int_array_index('opt_B',opt_b,j,is_available,lsubmodel)
195 CALL hm_get_int_array_index('opt_A',opt_a,j,is_available,lsubmodel)
196 CALL hm_get_int_array_index('opt_E',opt_e,j,is_available,lsubmodel)
197 CALL hm_get_int_array_index('opt_I',opt_i,j,is_available,lsubmodel)
198 CALL hm_get_int_array_index('opt_C',opt_c,j,is_available,lsubmodel)
199
200
201 IF(trim(keyset) == 'SET' )THEN
202
203 ! get the list of SETs for the current clause
204 ! ---------------------------------------------
205 set_clause_size = 0
206 CALL create_set_array(set_clause_array , set_clause_size,
207 . map_tables%ISETM , map_tables%NSET_GENERAL,
208 . j ,opt_g ,is_available ,
209 . lsubmodel,clause,0)
210
211 IF( set_clause_size > 0 ) THEN
212
213 new_size = 0
214 CALL set_merge_simple( set_array , set_array_size ,
215 * set_clause_array, set_clause_size ,
216 * result , new_size ,
217 * set_add )
218
219 set_array(1:new_size) = result(1:new_size)
220 set_array_size = new_size
221 ENDIF
222
223 ELSEIF (trim(keyset) == 'SETCOL' )THEN
224 CALL create_setcol_array(set,setcol_array,setcol_array_size ,
225 * map_tables%ISETCOLM,map_tables%NSET_COLLECT,
226 * j,opt_g ,is_available ,
227 * lsubmodel)
228
229 IF(setcol_array_size > 0 ) THEN
230
231 new_size = 0
232 CALL set_merge_simple( set_array , set_array_size ,
233 * setcol_array , setcol_array_size ,
234 * result , new_size ,
235 * set_add )
236
237 set_array(1:new_size) = result(1:new_size)
238 set_array_size = new_size
239 ENDIF
240
241
242 ENDIF
243
244
245 ENDDO ! DO J=1,CLAUSES_MAX
246
247
248 IF(trim(key) == 'COLLECT')THEN ! SET COLLECT - find all other SETs with Same ID.
249
250 IF (set(igs)%SET_ACTIV==1 ) THEN
251
252 DO j=1,map_tables%NSET_COLLECT ! Find all SET with same ID but "inactive" / set them as dependent from this SET.
253
254 id = map_tables%ISETCOLM(j,1)
255 ig = map_tables%ISETCOLM(j,2)
256
257 IF (id > set_id) EXIT ! ISETCOLM is sorted by UID, when ID is greater we have finished.
258
259
260 IF( id == set_id .AND. set(ig)%SET_ACTIV==0)THEN
261 set_array_size = set_array_size + 1
262 set_array(set_array_size)=ig
263 ENDIF
264
265 ENDDO
266 ENDIF
267
268 ENDIF
269
270 IF (idebug == 1)THEN
271 WRITE(6,'(A,I8,A,I8,A,I8)') 'SET ',set_id,'-> ',igs,' Number of Child list : ',set_array_size
272 WRITE(6,'(A, 100I8)') 'Child List ',( set_array(t), t=1,set_array_size)
273 WRITE(6,'(A)') ' '
274 ENDIF
275
276 ! Create an Edge in the Dependency Graph
277 CALL set_graph_add_set ( igs, set_array, set_array_size)
278
279
280 ENDDO
281
282 ! ALL Edges are done
283 ! --------------------
284 CALL set_graph_sort ( set_list , ierror)
285
286 IF (ierror < 0) THEN
287 print*,'ERROR CIRCULAR DEPENDENCY ON SET ',-ierror
288 CALL arret(2)
289 ENDIF
290
291 IF (idebug == 1)THEN
292 print*,' '
293 print*,' -----------------------------------------------'
294 WRITE(6,'(A)') 'SORTED SETS'
295 print*,set_list(1:nsets)
296 print*,' '
297 print*,' -----------------------------------------------'
298 print*,' '
299 ENDIF
300
301 CALL set_graph_clean()
302
303 END
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_setcol_array
subroutine create_setcol_array(set, setcol_array, array_size, isetcolm, nset_collect, jclause, opt_g, is_available, lsubmodel)
Definition create_setcol_clause.F:40
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_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
hm_option_read_mod
Definition hm_option_read_mod.F:412
mapping_option_mod
Definition dichotomy_mod.F:36
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
set_mod
Definition set_mod.F:43
set_mod::set_add
integer, parameter set_add
add operator
Definition set_mod.F:47
setdef_mod
Definition setdef_mod.F:107
submodel_mod
Definition submodel_mod.F:717
set_merge_simple
subroutine set_merge_simple(set_entity, nb_set_entity, clause_entity, nb_clause_entity, result, nb_result, clause_operator)
Definition set_merge_simple.F:42
sort_set
subroutine sort_set(lsubmodel, map_tables, set_list, set, clause)
Definition sort_sets.F:45
arret
subroutine arret(nn)
Definition arret.F:86
mapping_option_mod::mapping_struct_
Definition dichotomy_mod.F:58
submodel_mod::submodel_data
Definition submodel_mod.F:728