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

Go to the source code of this file.

Functions/Subroutines

subroutine sort_set (lsubmodel, map_tables, set_list, set, clause)

Function/Subroutine Documentation

◆ sort_set()

subroutine sort_set ( type(submodel_data), dimension(*), intent(in) lsubmodel,
type(mapping_struct_) map_tables,
integer, dimension(nsets) set_list,
type (set_), dimension(nsets), intent(inout) set,
type (set_) clause )

Definition at line 44 of file sort_sets.F.

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,S,T,ID
91 INTEGER SET_ID,ISET_TYPE,CLAUSES_MAX,ITMP,ICODE,NCOLLECT,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 INTEGER CLAUSE_OPERATOR
98
99C-----------------------------------------------
100C Characters
101 CHARACTER MESS*40
102 CHARACTER(LEN=NCHARFIELD) :: KEYSET,SET_TYPE,KEY_TYPE
103 CHARACTER(LEN=NCHARTITLE) :: TITLE,TITLE2,SET_TITLE
104 CHARACTER(LEN=NCHARKEY) :: KEYPART,KEY
105C-----------------------------------------------
106 idebug=0
107
108 IF (idebug == 1)THEN
109 print*,' '
110 print*,' '
111 print*,' -----------------------------------------------'
112 print*,' SORTING SETS'
113 print*,' -----------------------------------------------'
114 print*,' '
115 ENDIF
116
117 ALLOCATE(set_array(nsets))
118 ALLOCATE(setcol_array(nsets))
119 ALLOCATE(set_clause_array(nsets))
120 ALLOCATE(is_collect(nsets))
121 ALLOCATE(result(nsets))
122 ALLOCATE(collect_list(map_tables%NSET_COLLECT))
123
124
125 !-------------------------------------------------
126 ! SET%IS_ACTIVE & /SET/COLLECT
127 ! ----------------------------
128 ! Loops to define which set is active
129 ! In /SET/COLLECT only one SET of the SERIES is active
130 ! And assembled by the others.
131 ! all secondary sets needs to be treated before the
132 ! the active SET.
133 ! /SET/GENERAL : all SETs are active
134 !-------------------------------------------------
135
136 DO igs=1,nsets
137 set(igs)%SET_ACTIV=-1
138 is_collect(igs)=0
139 ENDDO
140
141 IF (map_tables%NSET_COLLECT > 0)THEN
142
143 igs = map_tables%ISETCOLM(1,2)
144 is_collect(igs)=1
145 set(igs)%SET_ACTIV=1
146
147 DO i=2,map_tables%NSET_COLLECT
148 igs = map_tables%ISETCOLM(i,2)
149 igs2 = map_tables%ISETCOLM(i-1,2)
150
151 id1 = map_tables%ISETCOLM(i,1)
152 id2 = map_tables%ISETCOLM(i-1,1)
153
154 is_collect(igs)=1
155 IF(id1 /= id2) THEN
156 set(igs)%SET_ACTIV=1
157 ELSE
158 set(igs)%SET_ACTIV=0
159 ENDIF
160 ENDDO
161 ENDIF
162 DO igs=1,nsets
163 IF(is_collect(igs) == 0) set(igs)%SET_ACTIV=1
164 ENDDO
165 !-------------------------------------------------
166
167 CALL hm_option_start('/SET')
168
169 DO igs=1,nsets
170
171 set_array_size=0
172
173 CALL hm_option_read_key (lsubmodel,
174 . option_id = set_id,
175 . option_titr = set_title,
176 . keyword2 = key)
177
178
179 CALL hm_get_string('set_Type' , set_type ,ncharfield, is_available)
180 CALL hm_get_intv ('iset_Type', iset_type,is_available,lsubmodel)
181
182 CALL hm_get_intv('clausesmax',clauses_max,is_available,lsubmodel)
183
184
185
186
187 ! Parse all clauses find SET clauses
188 ! -------------------------
189 DO j=1,clauses_max ! max KEY's of the current /SET
190 CALL hm_get_string_index('KEY_type', keyset, j, ncharline, is_available)
191
192 CALL hm_get_int_array_index('opt_D',opt_d,j,is_available,lsubmodel)
193 CALL hm_get_int_array_index('opt_O',opt_o,j,is_available,lsubmodel)
194 CALL hm_get_int_array_index('opt_G',opt_g,j,is_available,lsubmodel)
195 CALL hm_get_int_array_index('opt_B',opt_b,j,is_available,lsubmodel)
196 CALL hm_get_int_array_index('opt_A',opt_a,j,is_available,lsubmodel)
197 CALL hm_get_int_array_index('opt_E',opt_e,j,is_available,lsubmodel)
198 CALL hm_get_int_array_index('opt_I',opt_i,j,is_available,lsubmodel)
199 CALL hm_get_int_array_index('opt_C',opt_c,j,is_available,lsubmodel)
200
201
202 IF(trim(keyset) == 'SET' )THEN
203
204 ! get the list of SETs for the current clause
205 ! ---------------------------------------------
206 set_clause_size = 0
207 CALL create_set_array(set_clause_array , set_clause_size,
208 . map_tables%ISETM , map_tables%NSET_GENERAL,
209 . j ,opt_g ,is_available ,
210 . lsubmodel,clause,0)
211
212 IF( set_clause_size > 0 ) THEN
213
214 new_size = 0
215 CALL set_merge_simple( set_array , set_array_size ,
216 * set_clause_array, set_clause_size ,
217 * result , new_size ,
218 * set_add )
219
220 set_array(1:new_size) = result(1:new_size)
221 set_array_size = new_size
222 ENDIF
223
224 ELSEIF (trim(keyset) == 'SETCOL' )THEN
225 CALL create_setcol_array(set,setcol_array,setcol_array_size ,
226 * map_tables%ISETCOLM,map_tables%NSET_COLLECT,
227 * j,opt_g ,is_available ,
228 * lsubmodel)
229
230 IF(setcol_array_size > 0 ) THEN
231
232 new_size = 0
233 CALL set_merge_simple( set_array , set_array_size ,
234 * setcol_array , setcol_array_size ,
235 * result , new_size ,
236 * set_add )
237
238 set_array(1:new_size) = result(1:new_size)
239 set_array_size = new_size
240 ENDIF
241
242
243 ENDIF
244
245
246 ENDDO ! DO J=1,CLAUSES_MAX
247
248
249 IF(trim(key) == 'COLLECT')THEN ! SET COLLECT - find all other SETs with Same ID.
250
251 IF (set(igs)%SET_ACTIV==1 ) THEN
252
253 DO j=1,map_tables%NSET_COLLECT ! Find all SET with same ID but "inactive" / set them as dependent from this SET.
254
255 id = map_tables%ISETCOLM(j,1)
256 ig = map_tables%ISETCOLM(j,2)
257
258 IF (id > set_id) EXIT ! ISETCOLM is sorted by UID, when ID is greater we have finished.
259
260
261 IF( id == set_id .AND. set(ig)%SET_ACTIV==0)THEN
262 set_array_size = set_array_size + 1
263 set_array(set_array_size)=ig
264 ENDIF
265
266 ENDDO
267 ENDIF
268
269 ENDIF
270
271 IF (idebug == 1)THEN
272 WRITE(6,'(A,I8,A,I8,A,I8)') 'SET ',set_id,'-> ',igs,' Number of Child list : ',set_array_size
273 WRITE(6,'(A, 100I8)') 'Child List ',( set_array(t), t=1,set_array_size)
274 WRITE(6,'(A)') ' '
275 ENDIF
276
277 ! Create an Edge in the Dependency Graph
278 CALL set_graph_add_set ( igs, set_array, set_array_size)
279
280
281 ENDDO
282
283 ! ALL Edges are done
284 ! --------------------
285 CALL set_graph_sort ( set_list , ierror)
286
287 IF (ierror < 0) THEN
288 print*,'ERROR CIRCULAR DEPENDENCY ON SET ',-ierror
289 CALL arret(2)
290 ENDIF
291
292 IF (idebug == 1)THEN
293 print*,' '
294 print*,' -----------------------------------------------'
295 WRITE(6,'(A)') 'SORTED SETS'
296 print*,set_list(1:nsets)
297 print*,' '
298 print*,' -----------------------------------------------'
299 print*,' '
300 ENDIF
301
302 CALL set_graph_clean()
303
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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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:523
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
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:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:408
mapping_option_mod
Definition dichotomy_mod.F:36
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
set_mod
Definition set_mod.F:43
set_mod::set_add
integer, parameter set_add
add operator
Definition set_mod.F:47
set_mod::set
type(set_), dimension(:), allocatable, target set
Definition set_mod.F:54
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:712
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
arret
subroutine arret(nn)
Definition arret.F:87