OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_lecgre.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_lecgre ../starter/source/groups/hm_lecgre.F
25!||--- called by ------------------------------------------------------
26!|| lecgroup ../starter/source/groups/lecgroup.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| groups_get_elem_list ../starter/source/groups/groups_get_elem_list.F
30!|| groups_get_nentity ../starter/source/groups/groups_get_nentity.F
31!|| hm_admlcnt ../starter/source/groups/hm_admlistcnt.F
32!|| hm_admlist ../starter/source/groups/hm_admlist.F
33!|| hm_bigbox2 ../starter/source/model/box/hm_bigbox2.F
34!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
35!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
36!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.f
37!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
38!|| hm_submodgre ../starter/source/groups/hm_submodgr.F
39!|| hm_tagpart ../starter/source/groups/hm_tagpart.F
40!|| nintlst ../starter/source/system/nintrr.F
41!|| nintlstn ../starter/source/system/nintrr.F
42!|| udouble_igr ../starter/source/system/sysfus.F
43!||--- uses -----------------------------------------------------
44!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
45!|| message_mod ../starter/share/message_module/message_mod.F
46!|| submodel_mod ../starter/share/modules1/submodel_mod.F
47!||====================================================================
48 SUBROUTINE hm_lecgre(
49 1 IGRELEM ,IX ,
50 2 NIX1 ,NIX ,NUMEL ,NGRELE ,IELT ,
51 3 IPART ,IPARTE ,X ,ELKEY ,
52 4 ISUBMOD ,FLAG ,KELTREE ,ELTREE ,KSONTREE ,
53 5 NSONTREE,KLEVTREE ,SKEW ,ISKN ,UNITAB ,
54 6 ITABM1 ,IBOX ,RTRANS ,LSUBMODEL,
55 7 IXX_S ,IXX_S_IND,IADBOXMAX,SUBSET , STARTKEY)
56C-----------------------------------------------
57C M o d u l e s
58C-----------------------------------------------
59 USE my_alloc_mod
60 USE unitab_mod
61 USE submodel_mod
62 USE message_mod
63 USE groupdef_mod
64 USE optiondef_mod
65 USE hm_option_read_mod
66 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com04_c.inc"
75#include "param_c.inc"
76#include "remesh_c.inc"
77#include "scr17_c.inc"
78C-----------------------------------------------
79C D u m m y A r g u m e n t s
80C-----------------------------------------------
81 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
82 INTEGER NIX1 ,NIX ,NUMEL ,NGRELE,IELT,FLAG
83 INTEGER IPARTE(*),IPART(LIPART1,*),IX(NIX,*),ISUBMOD(*),
84 . KELTREE, ELTREE(KELTREE,*),
85 . KSONTREE, NSONTREE, KLEVTREE,ISKN(LISKN,*),ITABM1(*),
86 . IXX_S(*), IXX_S_IND(*)
87 MY_REAL
88 . x(3,*),skew(lskew,*),rtrans(*)
89 TYPE(submodel_data) LSUBMODEL(*)
90 CHARACTER ELKEY*4,STARTKEY*7
91C-----------------------------------------------
92 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
93 TYPE (GROUP_) , TARGET, DIMENSION(NGRELE) :: IGRELEM
94 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 INTEGER I,J,K,L,II,JJ,KK,ISU,ID,NEL,N1,N2,IGS,JREC,
99 . iad0,iadc,iadfin,it0,it1,it2,it3,it4,it5,
100 . kad,uid,iflagunit,
101 . isk,boxtype,j2(2),it6,sub_id,iadbox,nn,iadboxmax,
102 . it7, idb
103 INTEGER NLIST,STAT,LIST_IGR(NGRELE)
104 INTEGER IP, NLEV, MY_LEV,IDMIN,IDMAX,OFFSET,NLINES
105 my_real
106 . xmin,xmax,ymin,ymax,zmin,zmax,bid,fac_l,
107 . diam,xp1,yp1,zp1,xp2,yp2,zp2
108 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
109 CHARACTER(LEN=NCHARKEY) :: KEY, KEY2
110 CHARACTER MES*40
111 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFTMP
112 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFBOX
113 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
114C-----------------------------------------------
115 INTEGER, DIMENSION(:), POINTER :: ELEM
116 INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ENTITY
117 INTEGER :: NENTITY
118C-----------------------------------------------
119 INTERFACE
120 SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)
121 USE submodel_mod
122 INTEGER,DIMENSION(:),ALLOCATABLE :: arg1
123 INTEGER,INTENT(INOUT) :: arg2
124 TYPE(submodel_data) :: arg3(NSUBMOD)
125 END SUBROUTINE
126 END INTERFACE
127C-----------------------------------------------
128C E x t e r n a l F u n c t i o n s
129C-----------------------------------------------
130 INTEGER NINTLST,NINTLSTN,LISTCNT
131C-----------------------------------------------
132C IGRELEM(IGS)%ID : GROUP identifier
133C IGRELEM(IGS)%TITLE : GROUP title
134C IGRELEM(IGS)%NENTITY : Entities (elements) number of the GROUP
135C IGRELEM(IGS)%GRTYPE : TYPE ( 0-NOEUDS, 1-BRIC, 2-QUAD, 3-SHELL_4N,
136! 4-TRUSS, 5-BEAM, 6-SPRINGS,7-SHELL_3N)
137!! GRTYPE --- > OBSOLETE
138C IGRELEM(IGS)%SORTED : FLAG for sorted/unsorted elements
139! = 0 -> sorted
140! = 1 -> unsorted
141C IGRELEM(IGS)%GRPGRP : TYPE of element GROUP
142! = 1 ELEM
143! = 2 GRELEM
144! = 3 SUBSET,PART,MAT,PROP
145! = 4 BOX,GENE
146! = 5 SUBMOD
147C IGRELEM(IGS)%LEVEL : Hierarchy level
148! (FLAG 'SUBLEVEL DONE' FOR GROUPS OF GROUPS)
149! = 0 ---> not yet initialized
150! = 1 ---> done
151C=======================================================================
152 mes(01:04) = elkey
153 mes(05:18) = ' ELEMENT GROUP'
154 mes(19:40) = ' '
155 it0 = 0
156 it1 = 0
157 it2 = 0
158 it3 = 0
159 it4 = 0
160 it5 = 0
161 it6 = 0
162 it7 = 0
163 titr1='ELEMENT GROUP'
164 ALLOCATE(buftmp(max(numel*5,npart)),stat=stat)
165 IF (stat /= 0) THEN
166 CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='BUFTMP')
167 ENDIF
168C-------------------------
169C groupes d' elements + init IGRN(1,IGS)
170C-------------------------
171 igs=0
172 CALL hm_option_start(trim(startkey))
173 DO i=1,ngrele !NGRBRIC, NGRQUAD, etc...
174
175 CALL hm_option_read_key(lsubmodel,
176 . option_id = id,
177 . option_titr = titr ,
178 . unit_id = uid,
179 . keyword2 = key ,
180 . keyword3 = key2)
181
182 igs=igs+1
183!
184! initialized variables:
185 IF (flag == 0) THEN
186 igrelem(igs)%ID = 0
187 igrelem(igs)%NENTITY = 0
188 igrelem(igs)%GRTYPE = 0
189 igrelem(igs)%SORTED = 0
190 igrelem(igs)%GRPGRP = 0
191 igrelem(igs)%LEVEL = 0
192 igrelem(igs)%R2R_ALL = 0
193 igrelem(igs)%R2R_SHARE = 0
194 ENDIF
195!
196 igrelem(igs)%ID=id
197 igrelem(igs)%GRTYPE=ielt
198 igrelem(igs)%LEVEL=1
199 igrelem(igs)%TITLE=titr
200C
201 IF(key(1:6) == startkey(2:7))THEN
202C groupes de groupes
203 igrelem(igs)%NENTITY=-1
204 igrelem(igs)%GRPGRP=2
205 igrelem(igs)%LEVEL=0
206 it0=it0+1
207 ELSEIF(key(1:4) == elkey)THEN
208C groupe d'elements
209 it1=it1+1
210 IF (flag == 0) THEN
211 igrelem(igs)%NENTITY=0
212 igrelem(igs)%GRPGRP=1
213 ENDIF
214 ELSEIF(key(1:4) == 'PART' .OR. key(1:6) == 'SUBSET' .OR. key(1:3) == 'MAT' .OR. key(1:4) == 'PROP') THEN
215C groupe de SUBSET PART MAT OU PROP
216 it2=it2+1
217 IF (flag == 0) THEN
218 igrelem(igs)%NENTITY=0
219 igrelem(igs)%GRPGRP=3
220 ENDIF
221 ELSEIF((key(1:3) == 'BOX' .AND. nbbox == 0 .AND.(key2(1:5) /= 'RECTA'.AND.
222 . key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER')).OR.key(1:4) == 'GENE')THEN
223C groupe d'elements dans un box (old/obsolete/not supported with new reader) OR GENE
224 it3=it3+1
225 IF (flag == 0) THEN
226 igrelem(igs)%NENTITY=0
227 igrelem(igs)%GRPGRP=4
228 ENDIF
229 ELSEIF(key(1:6) == 'SUBMOD')THEN
230C groupe d'elements dans un submodel
231 it4=it4+1
232 IF (flag == 0) THEN
233 igrelem(igs)%NENTITY=0
234 igrelem(igs)%GRPGRP=5
235 ENDIF
236 ELSEIF(key(1:3) == 'BOX'.AND.(key2(1:5) == 'RECTA'.OR.
237 . key2(1:5) == 'CYLIN'.OR.key2(1:5) == 'SPHER'))THEN
238C old /grnod/box (not /BOX/BOX)
239C groupe de noeuds dans un box (clasical box, parallelepiped,
240C cylindrical, spherical)
241 it5=it5+1
242 IF (flag == 0) THEN
243 igrelem(igs)%NENTITY=0
244 igrelem(igs)%GRPGRP=6
245 ENDIF
246 ELSEIF(key(1:3) == 'BOX' .AND. nbbox > 0)THEN
247C multi box (box de box)
248 it6=it6+1
249 ELSEIF(key(1:8) == 'GEN_INCR')THEN
250C groupe d'elements gen_inc first last offset
251C
252 it7=it7+1
253 IF (flag == 0) THEN
254 igrelem(igs)%NENTITY=0
255 igrelem(igs)%GRPGRP=4
256 ENDIF
257 ENDIF
258C
259 ENDDO !next I
260
261C-------------------------------------
262C Recherche des ID doubles
263C-------------------------------------
264 IF (flag == 0) THEN
265 DO igs=1,ngrele
266 list_igr(igs) = igrelem(igs)%ID
267 enddo!next IGS
268 CALL udouble_igr(list_igr,ngrele,mes,0,bid)
269 ENDIF
270
271C-------------------------------------
272C Remplacement des n0 d'elements user par systeme
273C-------------------------------------
274
275 igs=0
276 kk=0
277
278 IF (it1 /= 0) THEN
279
280 buftmp = 0
281 IF(nadmesh==0.OR.(elkey(1:4)/='SHEL'.AND.elkey(1:4)/='SH3N'))THEN
282 CALL hm_option_start(trim(startkey))
283 DO i=1,ngrele !NGRBRIC, NGRQUAD, etc...
284 CALL hm_option_read_key(lsubmodel,
285 . option_id = id,
286 . option_titr = titr ,
287 . unit_id = uid,
288 . keyword2 = key ,
289 . keyword3 = key2)
290 nel=0
291 nn = 0
292 igs=igs+1
293 IF(key(1:4) == elkey)THEN
294 IF(flag == 0)THEN
295 CALL groups_get_nentity(nel,lsubmodel)
296 igrelem(igs)%NENTITY=nel
297 CALL my_alloc(igrelem(igs)%ENTITY,nel)
298 igrelem(igs)%ENTITY = 0
299 ELSEIF (flag == 1) THEN
300
301 CALL groups_get_elem_list(list_entity, nentity, lsubmodel)
302 DO kk=1,nentity
303 jj=list_entity(kk)
304 IF(jj /= 0)THEN
305 nn = nn + 1
306 igrelem(igs)%ENTITY(nn) = jj
307 ENDIF
308 enddo! NEXT KK
309 IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)
310
311 IF ( numel == 0 ) igrelem(igs)%NENTITY = 0
312 nel = igrelem(igs)%NENTITY
313 IF (nel > 0) THEN
314 titr = igrelem(igs)%TITLE
315 elem => igrelem(igs)%ENTITY
316 nel=nintlstn(
317 . elem,nel ,ixx_s ,nix ,numel ,
318 . mes,ixx_s_ind,buftmp(1+2*numel),elkey,
319 . igrelem(igs)%ID,titr)
320 igrelem(igs)%NENTITY=nel
321 ENDIF
322 ENDIF
323
324 ENDIF
325 enddo!next I
326 ELSE
327 CALL hm_option_start(trim(startkey))
328 DO i=1,ngrele !NGRBRIC, NGRQUAD, etc ...
329 nel=0
330 igs=igs+1
331 CALL hm_option_read_key(lsubmodel,
332 . option_id = id,
333 . option_titr = titr ,
334 . unit_id = uid,
335 . keyword2 = key ,
336 . keyword3 = key2)
337 IF(key(1:4) == elkey)THEN
338 IF(flag == 0)THEN
339 CALL groups_get_nentity(nlist,lsubmodel)
340 titr=igrelem(igs)%TITLE
341 CALL hm_admlcnt(nix ,ix ,numel ,iparte ,ipart ,
342 . keltree ,eltree ,ksontree,nsontree,klevtree,
343 . nlist ,mes ,buftmp ,buftmp(1+numel),buftmp(1+2*numel),
344 . kk ,nel ,elkey ,igrelem(igs)%ID,titr,lsubmodel)
345 kk=1
346 igrelem(igs)%NENTITY=nel
347 CALL my_alloc(igrelem(igs)%ENTITY,nel)
348 igrelem(igs)%ENTITY = 0
349 ELSEIF (flag == 1) THEN
350 nel = igrelem(igs)%NENTITY
351 IF (nel > 0) THEN
352 CALL groups_get_nentity(nlist,lsubmodel)
353 titr=igrelem(igs)%TITLE
354 elem => igrelem(igs)%ENTITY
355 CALL hm_admlist(nix ,ix ,numel ,iparte ,ipart ,
356 . keltree ,eltree ,ksontree,nsontree,klevtree,
357 . nlist ,mes ,buftmp ,buftmp(1+numel),buftmp(1+2*numel),
358 . kk ,nel ,elem,elkey,igrelem(igs)%ID,titr,lsubmodel)
359 kk=1
360 ENDIF
361 ENDIF
362 ENDIF
363 enddo! next I
364 ENDIF
365 ENDIF
366C-------------------------
367C BOX, GENERATION
368C-------------------------
369 igs=0
370 IF (it3 /= 0) THEN
371 CALL hm_option_start(trim(startkey))
372 DO i=1,ngrele
373
374 CALL hm_option_read_key(lsubmodel,
375 . option_id = id,
376 . option_titr = titr ,
377 . unit_id = uid,
378 . keyword2 = key ,
379 . keyword3 = key2)
380 nn = 0
381 nel=0
382 igs=igs+1
383C-------------------------
384C BOX (OLD)
385C-------------------------
386 IF(key(1:3) == 'BOX'.AND.(key2(1:5) /= 'RECTA'.AND.key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER').AND.nbbox == 0)THEN
387 !no longer supported
388 !ERROR MESSAGE
389C-------------------------
390C GENERATION
391C-------------------------
392 ELSEIF(key(1:4) == 'GENE')THEN
393 iadc = 0
394 buftmp = 0
395 CALL hm_get_intv ('grnodGenArrCnt' ,nentity,is_available,lsubmodel)
396 DO kk=1,nentity
397 CALL hm_get_int_array_index ('Ifirst' ,n1 ,kk,is_available,lsubmodel)
398 CALL hm_get_int_array_index ('Ilast' ,n2 ,kk,is_available,lsubmodel)
399 IF(n2>n1)THEN
400 !tag des elements
401 DO k=1,numel
402 IF (ix(nix,k) >= n1 .AND. ix(nix,k) <= n2) buftmp(k)=1
403 enddo!next K
404 ENDIF
405 enddo! NEXT KK
406
407 IF(nadmesh==0)THEN
408 nel=0
409 IF (flag == 0) THEN
410 DO j=1,numel
411 IF (buftmp(j) == 1) nel=nel+1
412 enddo!next J
413 igrelem(igs)%NENTITY=nel
414 CALL my_alloc(igrelem(igs)%ENTITY,nel)
415 igrelem(igs)%ENTITY = 0
416 ELSEIF (flag == 1) THEN
417 DO j=1,numel
418 IF (buftmp(j) == 1) THEN
419 nn = nn + 1
420 igrelem(igs)%ENTITY(nn)=j
421 ENDIF
422 enddo!next J
423 ENDIF
424 ELSE
425 nel=0
426 IF (flag == 0) THEN
427 DO j=1,numel
428 IF (buftmp(j) == 1) THEN
429 ip=iparte(j)
430 nlev =ipart(10,ip)
431 my_lev=eltree(klevtree,j)
432 IF(my_lev < 0) my_lev=-(my_lev+1)
433 IF(my_lev==nlev)nel=nel+1
434 END IF
435 enddo!next J
436 igrelem(igs)%NENTITY=nel
437 CALL my_alloc(igrelem(igs)%ENTITY,nel)
438 igrelem(igs)%ENTITY = 0
439 ELSEIF (flag == 1) THEN
440 DO j=1,numel
441 IF (buftmp(j) == 1) THEN
442 ip=iparte(j)
443 nlev =ipart(10,ip)
444 my_lev=eltree(klevtree,j)
445 IF(my_lev < 0) my_lev=-(my_lev+1)
446 IF(my_lev==nlev)THEN
447 nn = nn + 1
448 igrelem(igs)%ENTITY(nn)=j
449 ENDIF
450 ENDIF
451 enddo!next J
452 ENDIF
453 ENDIF
454 ENDIF
455 enddo! next I
456 ENDIF
457C-------------------------
458C BOX (parallelepiped, cylindrical, spherical) - old one (10SA1)
459C-------------------------
460
461 igs=0
462 IF (it5 /= 0) THEN
463 !obsolete
464
465 !ERROR MESSAGE
466
467 ENDIF
468C-------------------------
469C NEW BOX OPTION (MULTI BOX COMBINATION)
470C-------------------------
471 igs=0
472 IF(it6 /= 0)THEN
473C---
474C
475 IF (flag == 0) THEN
476 ALLOCATE(bufbox(1))
477 bufbox = 0
478 ELSEIF (flag == 1) THEN
479 ALLOCATE(bufbox(iadboxmax))
480 bufbox(1:iadboxmax) = 0
481 ENDIF
482!
483 CALL hm_option_start(trim(startkey))
484 DO i=1,ngrele
485 CALL hm_option_read_key(lsubmodel,
486 . option_id = id,
487 . option_titr = titr ,
488 . unit_id = uid,
489 . keyword2 = key ,
490 . keyword3 = key2)
491 nn = 0
492 nel=0
493 igs=igs+1
494 IF (key(1:3) == 'BOX'.AND. nbbox > 0)THEN
495 buftmp = 0
496 iadbox = 1
497 iflagunit = 0
498 id = igrelem(igs)%ID
499 DO j=1,unitab%NUNITS
500 IF (unitab%UNIT_ID(j) == uid) THEN
501 fac_l = unitab%FAC_L(j)
502 iflagunit = 1
503 EXIT
504 ENDIF
505 ENDDO
506 IF (uid/=0.AND.iflagunit==0) THEN
507 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
508 . i2=uid,i1=id,c1='ELEMENT GROUP',
509 . c2='ELEMENT GROUP',
510 . c3=titr)
511 ENDIF
512C---
513 CALL hm_get_int_array_index ('ids' ,idb ,1,is_available,lsubmodel)
514 CALL hm_bigbox2(x ,flag ,nel ,
515 . skew ,igs ,iskn ,itabm1,ibox ,
516 . id ,nadmesh,nix ,ix ,nix1 ,numel ,
517 . iparte ,ipart ,klevtree,eltree,keltree,buftmp,
518 . key ,titr ,mes ,igrelem,ngrele ,nn ,
519 . iadbox ,iadboxmax,bufbox,idb)
520C---
521 iadboxmax = max(iadbox,iadboxmax)
522 IF(flag == 0)THEN
523 igrelem(igs)%NENTITY=nel
524 CALL my_alloc(igrelem(igs)%ENTITY,nel)
525 igrelem(igs)%ENTITY = 0
526 ELSE IF(flag == 1)THEN
527 igrelem(igs)%NENTITY=nel
528 ENDIF ! IF(FLAG == 0)
529 ENDIF
530
531
532 ENDDO
533 IF(ALLOCATED(bufbox))DEALLOCATE(bufbox)
534 ENDIF ! IF(IT6 /= 0)
535C-------------------------
536C groupes de SUBSETS,PART,MAT,PROP
537C-------------------------
538
539 igs=0
540 IF (it2 > 0) THEN
541 CALL hm_option_start(trim(startkey))
542 DO i=1,ngrele
543 CALL hm_option_read_key(lsubmodel,
544 . option_id = id,
545 . option_titr = titr ,
546 . unit_id = uid ,
547 . keyword2 = key ,
548 . keyword3 = key2)
549 nn = 0
550 nel=0
551 igs=igs+1
552 IF (key(1:6)=='SUBSET' .OR. key(1:4)=='PART' .OR. key(1:3)=='MAT' .OR. key(1:4)=='PROP') THEN
553C---
554 buftmp = 0
555 CALL hm_tagpart(buftmp, ipart, key, igrelem(igs)%ID, titr, titr1, flag, subset, lsubmodel)
556C---
557 IF(nadmesh==0)THEN
558 IF (flag == 0) THEN
559 DO j=1,numel
560 IF (buftmp(iparte(j)) == 1) nel=nel+1
561 ENDDO
562 igrelem(igs)%NENTITY=nel
563 CALL my_alloc(igrelem(igs)%ENTITY,nel)
564 igrelem(igs)%ENTITY = 0
565 ELSEIF (flag == 1) THEN
566 DO j=1,numel
567 IF (buftmp(iparte(j)) == 1) THEN
568 nn = nn + 1
569 igrelem(igs)%ENTITY(nn)=j
570 ENDIF
571 ENDDO
572 ENDIF
573 ELSE
574 IF (flag == 0) THEN
575 DO j=1,numel
576 ip=iparte(j)
577 IF(buftmp(ip) == 1) THEN
578 nlev =ipart(10,ip)
579 my_lev=eltree(klevtree,j)
580 IF(my_lev < 0) my_lev=-(my_lev+1)
581 IF(my_lev==nlev)nel=nel+1
582 END IF
583 ENDDO
584 igrelem(igs)%NENTITY=nel
585 CALL my_alloc(igrelem(igs)%ENTITY,nel)
586 igrelem(igs)%ENTITY = 0
587 ELSEIF (flag == 1) THEN
588 DO j=1,numel
589 ip=iparte(j)
590 IF (buftmp(ip) == 1) THEN
591 nlev =ipart(10,ip)
592 my_lev=eltree(klevtree,j)
593 IF(my_lev < 0) my_lev=-(my_lev+1)
594 IF(my_lev==nlev)THEN
595 nn = nn + 1
596 igrelem(igs)%ENTITY(nn)=j
597 ENDIF
598 ENDIF
599 ENDDO
600 ENDIF
601 ENDIF
602 ENDIF
603
604 ENDDO
605 ENDIF
606C-------------------------
607C groupes de SUBMODELS
608C-------------------------
609
610 igs=0
611 IF (it4 > 0) THEN
612 CALL hm_option_start(trim(startkey))
613 DO i=1,ngrele
614 CALL hm_option_read_key(lsubmodel,
615 . option_id = id,
616 . option_titr = titr ,
617 . unit_id = uid ,
618 . keyword2 = key ,
619 . keyword3 = key2)
620 nn = 0
621 nel=0
622 igs=igs+1
623 IF (key(1:6) == 'SUBMOD') THEN
624 CALL hm_submodgre(
625 . isubmod ,ix ,nix ,id ,
626 . nel ,numel ,ielt ,mes ,
627 . flag ,titr ,titr1 ,lsubmodel,igrelem ,
628 . nn ,igs )
629 IF (flag == 0) THEN
630 igrelem(igs)%NENTITY=nel
631 CALL my_alloc(igrelem(igs)%ENTITY,nel)
632 igrelem(igs)%ENTITY = 0
633 ENDIF
634 ENDIF
635
636 ENDDO
637 ENDIF
638C-------------------------
639C GENERATION MIN MAX OFFSET
640C-------------------------
641 igs=0
642 IF (it7 /= 0) THEN
643 CALL hm_option_start(trim(startkey))
644 DO i=1,ngrele
645 CALL hm_option_read_key(lsubmodel,
646 . option_id = id,
647 . option_titr = titr ,
648 . unit_id = uid ,
649 . keyword2 = key ,
650 . keyword3 = key2)
651 nn = 0
652 nel=0
653 igs=igs+1
654 IF(key(1:8) == 'GEN_INCR')THEN
655 iadc = 0
656 buftmp = 0
657 CALL hm_get_intv ('grnodGenArrCnt' ,nlines,is_available,lsubmodel)
658 DO kk=1,nlines
659 CALL hm_get_int_array_index ('Ifirst' ,idmin ,kk,is_available,lsubmodel)
660 CALL hm_get_int_array_index ('Ilast' ,idmax ,kk,is_available,lsubmodel)
661 CALL hm_get_int_array_index ('Iincr' ,offset ,kk,is_available,lsubmodel)
662 !optimized loop
663 DO k=1,numel
664 id=ix(nix,k)
665 IF(id<idmin .OR. id>idmax)cycle
666 IF(mod(id-idmin,offset)==0)buftmp(k)=1
667 ENDDO
668 ENDDO
669
670 IF(nadmesh==0)THEN
671 nel=0
672 IF (flag == 0) THEN
673 DO j=1,numel
674 IF (buftmp(j) == 1) nel=nel+1
675 ENDDO
676 igrelem(igs)%NENTITY=nel
677 CALL my_alloc(igrelem(igs)%ENTITY,nel)
678 igrelem(igs)%ENTITY = 0
679 ELSEIF (flag == 1) THEN
680 DO j=1,numel
681 IF (buftmp(j) == 1) THEN
682 nn = nn + 1
683 igrelem(igs)%ENTITY(nn)=j
684 ENDIF
685 ENDDO
686 ENDIF
687 ELSE
688 nel=0
689 IF (flag == 0) THEN
690 DO j=1,numel
691 IF (buftmp(j) == 1) THEN
692 ip=iparte(j)
693 nlev =ipart(10,ip)
694 my_lev=eltree(klevtree,j)
695 IF(my_lev < 0) my_lev=-(my_lev+1)
696 IF(my_lev==nlev)nel=nel+1
697 END IF
698 ENDDO
699 igrelem(igs)%NENTITY=nel
700 CALL my_alloc(igrelem(igs)%ENTITY,nel)
701 igrelem(igs)%ENTITY = 0
702 ELSEIF (flag == 1) THEN
703 DO j=1,numel
704 IF (buftmp(j) == 1) THEN
705 ip=iparte(j)
706 nlev =ipart(10,ip)
707 my_lev=eltree(klevtree,j)
708 IF(my_lev < 0) my_lev=-(my_lev+1)
709 IF(my_lev==nlev)THEN
710 nn = nn + 1
711 igrelem(igs)%ENTITY(nn)=j
712 ENDIF
713 ENDIF
714 ENDDO
715 ENDIF
716 ENDIF
717 ENDIF
718
719 enddo!next I
720 ENDIF
721C------------------------------
722 IF (ALLOCATED(buftmp)) DEALLOCATE(buftmp)
723C------------------------------
724 RETURN
725 END
groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46
groups_get_nentity
subroutine groups_get_nentity(nentity, lsubmodel)
Definition groups_get_nentity.F:36
hm_admlist
subroutine hm_admlist(nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, kk, nel, nelt, elkey, id, titr, lsubmodel)
Definition hm_admlist.F:41
hm_admlcnt
subroutine hm_admlcnt(nix, ix, numel, ipartel, ipart, keltree, eltree, ksontree, nsontree, klevtree, nlist, mess, ix1, ix2, index, ll, nel, elkey, id, titr, lsubmodel)
Definition hm_admlistcnt.F:39
hm_bigbox2
subroutine hm_bigbox2(x, flag, nel, skew, igs, iskn, itabm1, ibox, id, nadmesh, nix, ix, nix1, numel, iparte, ipart, klevtree, eltree, keltree, buftmp, key, titr, mes, igrelem, ngrele, nn, iadb, iboxmax, ibufbox, idb)
Definition hm_bigbox2.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:523
hm_lecgre
subroutine hm_lecgre(igrelem, ix, nix1, nix, numel, ngrele, ielt, ipart, iparte, x, elkey, isubmod, flag, keltree, eltree, ksontree, nsontree, klevtree, skew, iskn, unitab, itabm1, ibox, rtrans, lsubmodel, ixx_s, ixx_s_ind, iadboxmax, subset, startkey)
Definition hm_lecgre.F:56
hm_option_read_key
subroutine hm_option_read_key(lsubmodel, option_id, unit_id, submodel_index, submodel_id, option_titr, keyword1, keyword2, keyword3, keyword4, opt_pos)
Definition hm_option_read_key.F:249
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_submodgre
subroutine hm_submodgre(isubmod, ix, nix, sid, nel, numel, ielt, mess, flag, titr, titr1, lsubmodel, igrelem, nn, igs)
Definition hm_submodgr.F:179
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
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
lecgroup
subroutine lecgroup(itab, itabm1, isubmod, x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, flagg, sh4tree, sh3tree, skew, iskn, unitab, ibox, ixs10, ixs16, ixs20, rtrans, lsubmodel, ixs_s, ixs_s_ind, ixq_s, ixq_s_ind, ixc_s, ixc_s_ind, ixt_s, ixt_s_ind, ixp_s, ixp_s_ind, ixr_s, ixr_s_ind, ixtg_s, ixtg_s_ind, iadboxmax, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
Definition lecgroup.F:44
max
#define max(a, b)
Definition macros.h:21
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
optiondef_mod
Definition optiondef_mod.F:90
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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
udouble_igr
subroutine udouble_igr(list, nlist, mess, ir, rlist)
Definition sysfus.F:1220
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723