OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_grpart.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!|| hm_read_grpart ../starter/source/groups/hm_read_grpart.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
32!|| hm_submodpart ../starter/source/groups/hm_submodpart.F
33!|| hm_tagpart ../starter/source/groups/hm_tagpart.F
34!|| udouble_igr ../starter/source/system/sysfus.F
35!||--- uses -----------------------------------------------------
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| message_mod ../starter/share/message_module/message_mod.F
38!|| submodel_mod ../starter/share/modules1/submodel_mod.F
39!||====================================================================
40 SUBROUTINE hm_read_grpart(
41 1 IGRPART ,IPART ,ISUBMOD ,FLAG ,NGRPRT ,
42 2 LSUBMODEL ,SUBSET )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE my_alloc_mod
47 USE message_mod
48 USE submodel_mod
49 USE groupdef_mod
50 USE hm_option_read_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "scr17_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER FLAG,NGRPRT
65 INTEGER IPART(LIPART1,*),ISUBMOD(*)
66 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
67C-----------------------------------------------
68 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
69 TYPE (GROUP_) , DIMENSION(NGRPRT) :: IGRPART
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,J,K,L,ID,NEL,IGS,JREC,
74 . IT0,IT1,IT2,IT3,IT4,IT5,
75 . flag_fmt,flag_fmt_tmp,ifix_tmp,ibid,n1,n2,ok,nindx,
76 . nn,idmin,idmax,offset,nentity
77 INTEGER J10(10),BUFTMP(NSUBS+NPART),INDX(NSUBS+NPART),
78 . LIST_IGR(NGRPRT),UID,KK
79 my_real bid
80 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
81 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
82 CHARACTER :: MES*40
83 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
84C-----------------------------------------------
85 DATA mes/' PART GROUP'/
86C-----------------------------------------------
87C IGRPART(IGS)%ID : GROUP identifier
88C IGRPART(IGS)%TITLE : GROUP title
89C IGRPART(IGS)%NENTITY : Entities (parts) number of the GROUP
90C IGRPART(IGS)%GRTYPE : TYPE ( 0-NOEUDS, 1-BRIC, 2-QUAD, 3-SHELL_4N,
91! 4-TRUSS, 5-BEAM, 6-SPRINGS,7-SHELL_3N,
92C -1 PARTS)
93!! GRTYPE --- > OBSOLETE
94C IGRPART(IGS)%SORTED : FLAG for sorted/unsorted parts
95! = 0 -> sorted
96! = 1 -> unsorted
97C IGRPART(IGS)%GRPGRP : TYPE of part GROUP
98! = 1 ELEM
99! = 2 GRELEM
100! = 3 SUBSET,PART,MAT,PROP
101! = 4 BOX,GENE
102! = 5 SUBMOD
103C IGRPART(IGS)%LEVEL : Hierarchy level
104! (FLAG 'SUBLEVEL DONE' FOR GROUPS OF GROUPS)
105! = 0 ---> not yet initialized
106! = 1 ---> done
107C-----------------------------------------------
108 IF(ngrpart<=0)RETURN
109C-----------------------------------------------
110 ibid=0
111 it0=0
112 it1=0
113 it2=0
114 it3=0
115 it4=0
116 it5=0
117 titr1='PART GROUP'
118C-------------------------
119C-------------------------
120C groupes d' elements + init IGRN(1,IGS)
121C-------------------------
122
123 CALL hm_option_start('/GRPART')
124
125 igs=0
126
127
128 DO igs=1,ngrpart
129
130 CALL hm_option_read_key(lsubmodel,
131 . option_id = id,
132 . option_titr = titr ,
133 . unit_id = uid,
134 . keyword2 = key ,
135 . keyword3 = key2)
136
137 !
138! initialized variables:
139 IF (flag == 0) THEN
140 igrpart(igs)%ID = 0
141 igrpart(igs)%NENTITY = 0
142 igrpart(igs)%GRTYPE = 0
143 igrpart(igs)%SORTED = 0
144 igrpart(igs)%GRPGRP = 0
145 igrpart(igs)%LEVEL = 0
146 igrpart(igs)%R2R_ALL = 0
147 igrpart(igs)%R2R_SHARE = 0
148 ENDIF
149!
150 igrpart(igs)%ID=id
151 igrpart(igs)%GRTYPE=-1
152 igrpart(igs)%TITLE=titr
153C
154 IF(key(1:6) == 'GRPART')THEN
155C groupes de groupes
156 igrpart(igs)%NENTITY=-1
157 igrpart(igs)%GRPGRP=2
158 it0=it0+1
159 ELSEIF(key(1:4) == 'PART' .OR. key(1:6) == 'SUBSET' .OR. key(1:3) == 'MAT' .OR. key(1:4) == 'PROP') THEN
160C groupe de SUBSET PART MAT OU PROP
161 it2=it2+1
162 IF (flag == 0) THEN
163 igrpart(igs)%NENTITY=0
164 igrpart(igs)%GRPGRP=3
165 ENDIF
166 ELSEIF(key(1:4) == 'GENE' )THEN
167C groupe d'elements dans un box
168 it3=it3+1
169 IF (flag == 0) THEN
170 igrpart(igs)%NENTITY=0
171 igrpart(igs)%GRPGRP=4
172 ENDIF
173 ELSEIF(key(1:6) == 'SUBMOD')THEN
174C groupe de parts dans un submodel
175 it4=it4+1
176 IF (flag == 0) THEN
177 igrpart(igs)%NENTITY=0
178 igrpart(igs)%GRPGRP=5
179 ENDIF
180 ELSEIF(key(1:8) == 'GEN_INCR' )THEN
181C groupe d'elements gen_inc first last offset
182 it5=it5+1
183 IF (flag == 0) THEN
184 igrpart(igs)%NENTITY=0
185 igrpart(igs)%GRPGRP=4
186 ENDIF
187 ENDIF
188C
189 ENDDO
190
191C-------------------------------------
192C Recherche des ID doubles
193C-------------------------------------
194 IF (flag == 0) THEN
195 DO igs=1,ngrprt
196 list_igr(igs) = igrpart(igs)%ID
197 ENDDO
198 CALL udouble_igr(list_igr,ngrprt,mes,0,bid)
199 ENDIF
200C-------------------------
201C groupes de SUBSETS,PART,MAT,PROP
202C-------------------------
203 IF (it2 > 0) THEN
204 CALL hm_option_start('/GRPART')
205 DO igs=1,ngrpart
206 CALL hm_option_read_key(lsubmodel,
207 . option_id = id,
208 . option_titr = titr ,
209 . unit_id = uid,
210 . keyword2 = key ,
211 . keyword3 = key2)
212 IF (key(1:6)=='SUBSET'.OR.key(1:4)=='PART'.OR. key(1:3)=='MAT' .OR.key(1:4)=='PROP') THEN
213 nn = 0
214 nel = 0
215 buftmp = 0
216 CALL hm_tagpart(buftmp ,ipart ,key ,igrpart(igs)%ID,titr ,titr1 ,flag ,subset ,lsubmodel)
217 IF (flag == 0) THEN
218 DO j=1,npart
219 IF (buftmp(j) == 1) nel=nel+1
220 ENDDO
221 igrpart(igs)%NENTITY=nel
222 CALL my_alloc(igrpart(igs)%ENTITY,nel)
223 igrpart(igs)%ENTITY = 0
224 ELSEIF (flag == 1) THEN
225 DO j=1,npart
226 IF (buftmp(j) == 1) THEN
227 nn = nn + 1
228 igrpart(igs)%ENTITY(nn)=j
229 ENDIF
230 ENDDO
231 igrpart(igs)%LEVEL=1
232 ENDIF
233 ENDIF
234 ENDDO
235 ENDIF
236
237
238C-------------------------
239C GENERATION
240C-------------------------
241 IF (it3 /= 0) THEN
242 CALL hm_option_start('/GRPART')
243 DO igs=1,ngrpart
244 CALL hm_option_read_key(lsubmodel,
245 . option_id = id,
246 . option_titr = titr ,
247 . unit_id = uid,
248 . keyword2 = key ,
249 . keyword3 = key2)
250 IF(key(1:4) == 'GENE')THEN
251 nn = 0
252 nel=0
253 buftmp = 0
254 CALL hm_get_intv ('grnodGenArrCnt' ,nentity,is_available,lsubmodel)
255 DO kk=1,nentity
256 CALL hm_get_int_array_index ('Ifirst' ,n1 ,kk,is_available,lsubmodel)
257 CALL hm_get_int_array_index ('Ilast' ,n2 ,kk,is_available,lsubmodel)
258 DO k=1,npart
259 IF (ipart(4,k) >= n1.AND.ipart(4,k) <= n2)buftmp(k)=1
260 ENDDO
261 ENDDO
262 nel=0
263 IF (flag == 0) THEN
264 DO j=1,npart
265 IF (buftmp(j) == 1) nel=nel+1
266 ENDDO
267 igrpart(igs)%NENTITY=nel
268 CALL my_alloc(igrpart(igs)%ENTITY,nel)
269 igrpart(igs)%ENTITY = 0
270 ELSEIF (flag == 1) THEN
271 DO j=1,npart
272 IF (buftmp(j) == 1) THEN
273 nn = nn + 1
274 igrpart(igs)%ENTITY(nn)=j
275 ENDIF
276 ENDDO
277 ENDIF
278 ENDIF
279 ENDDO
280 ENDIF
281
282C-------------------------
283C groupes de SUBMODELS
284C-------------------------
285 IF (it4 > 0) THEN
286 CALL hm_option_start('/GRPART')
287 DO igs=1,ngrpart
288 CALL hm_option_read_key(lsubmodel,
289 . option_id = id,
290 . option_titr = titr ,
291 . unit_id = uid,
292 . keyword2 = key ,
293 . keyword3 = key2)
294 IF (key(1:6) == 'SUBMOD') THEN
295 nn=0
296 nel=0
297 buftmp = 0
298 nindx = 0
299 CALL hm_submodpart(isubmod,buftmp ,ipart ,id ,flag ,
300 . mes ,titr,titr1,indx,nindx ,
301 . lsubmodel)
302 IF (flag == 0) THEN
303 DO j=1,npart
304 IF (buftmp(j) == 1) nel=nel+1
305 ENDDO
306 igrpart(igs)%NENTITY=nel
307 CALL my_alloc(igrpart(igs)%ENTITY,nel)
308 igrpart(igs)%ENTITY = 0
309 ELSEIF (flag == 1) THEN
310 DO j=1,npart
311 IF (buftmp(j) == 1) THEN
312 nn = nn + 1
313 igrpart(igs)%ENTITY(nn)=j
314 ENDIF
315 ENDDO
316 igrpart(igs)%LEVEL=1
317 ENDIF
318 ENDIF
319 ENDDO
320 ENDIF
321
322C-------------------------
323C GENERATION MIN MAX OFFSET
324C-------------------------
325 IF (it5 /= 0) THEN
326 CALL hm_option_start('/GRPART')
327 DO igs=1,ngrpart
328 CALL hm_option_read_key(lsubmodel,
329 . option_id = id,
330 . option_titr = titr ,
331 . unit_id = uid,
332 . keyword2 = key ,
333 . keyword3 = key2)
334
335
336 IF(key(1:8) == 'GEN_INCR')THEN
337 nn = 0
338 nel=0
339 buftmp = 0
340 CALL hm_get_intv ('grnodGenArrCnt' ,nentity,is_available,lsubmodel)
341 DO kk=1,nentity
342 CALL hm_get_int_array_index ('Ifirst' ,idmin ,kk,is_available,lsubmodel)
343 CALL hm_get_int_array_index ('Ilast' ,idmax ,kk,is_available,lsubmodel)
344 CALL hm_get_int_array_index ('Iincr' ,offset ,kk,is_available,lsubmodel)
345 !optimized loop
346 DO k=1,npart
347 id=ipart(4,k)
348 IF(id<idmin .OR. id>idmax)cycle
349 IF(mod(id-idmin,offset)==0)buftmp(k)=1
350 ENDDO
351 !previous loop
352 !DO J=MAX(1,IDMIN),IDMAX,OFFSET
353 ! DO K=1,NPART
354 ! IF (IPART(4,K) == J) THEN
355 ! BUFTMP(K)=1 !tag des parts
356 ! EXIT
357 ! ENDIF
358 ! ENDDO
359 !ENDDO
360 ENDDO
361 nel=0
362 IF (flag == 0) THEN
363 DO j=1,npart
364 IF (buftmp(j) == 1) nel=nel+1
365 ENDDO
366 igrpart(igs)%NENTITY=nel
367 CALL my_alloc(igrpart(igs)%ENTITY,nel)
368 igrpart(igs)%ENTITY = 0
369 ELSEIF (flag == 1) THEN
370 DO j=1,npart
371 IF (buftmp(j) == 1) THEN
372 nn = nn + 1
373 igrpart(igs)%ENTITY(nn)=j
374 ENDIF
375 ENDDO
376 ENDIF
377 ENDIF
378 ENDDO
379 ENDIF
380C------------------------------
381 RETURN
382 END
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
my_real
#define my_real
Definition cppsort.cpp:32
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_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_grpart
subroutine hm_read_grpart(igrpart, ipart, isubmod, flag, ngrprt, lsubmodel, subset)
Definition hm_read_grpart.F:43
hm_submodpart
subroutine hm_submodpart(isubmod, tagbuf, ipart, id, flag, mess, titr, titr1, indx, nindx, lsubmodel)
Definition hm_submodpart.F:41
hm_tagpart
subroutine hm_tagpart(bufftmp, ipart, key, id, titr, titr1, flag, subset, lsubmodel)
Definition hm_tagpart.F:40
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
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::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
submodel_mod
Definition submodel_mod.F:712
udouble_igr
subroutine udouble_igr(list, nlist, mess, ir, rlist)
Definition sysfus.F:1220
submodel_mod::submodel_data
Definition submodel_mod.F:723