OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_lecgrn.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_lecgrn (itab, itabm1, igrnod, isubmod, x, geo, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartsp, kxsp, flag, maxnnod, skew, iskn, unitab, ibox, ixs10, ixs20, ixs16, rtrans, lsubmodel, ixx, kxx, ipartx, iadboxmax, igrslin, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrsurf, nsets)

Function/Subroutine Documentation

◆ hm_lecgrn()

subroutine hm_lecgrn ( integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod), target igrnod,
integer, dimension(*) isubmod,
x,
geo,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) ipartg,
integer, dimension(*) ipartsp,
integer, dimension(nisp,*) kxsp,
integer flag,
integer maxnnod,
skew,
integer, dimension(liskn,*) iskn,
type (unit_type_), intent(in) unitab,
type (box_), dimension(nbbox) ibox,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
rtrans,
type(submodel_data), dimension(*) lsubmodel,
integer, dimension(*) ixx,
integer, dimension(*) kxx,
integer, dimension(*) ipartx,
integer iadboxmax,
type (surf_), dimension(nslin), target igrslin,
type (subset_), dimension(nsubs) subset,
type (group_), dimension(ngrbric), target igrbric,
type (group_), dimension(ngrquad), target igrquad,
type (group_), dimension(ngrshel), target igrsh4n,
type (group_), dimension(ngrsh3n), target igrsh3n,
type (group_), dimension(ngrtrus), target igrtruss,
type (group_), dimension(ngrbeam), target igrbeam,
type (group_), dimension(ngrspri), target igrspring,
type (surf_), dimension(nsurf), target igrsurf,
integer nsets )

Definition at line 53 of file hm_lecgrn.F.

66C !!! WARNING due to issues on ibm plateform keep IBUFTMP at the last position
67C-----------------------------------------------
68C M o d u l e s
69C-----------------------------------------------
70 USE my_alloc_mod
71 USE unitab_mod
72 USE submodel_mod
73 USE message_mod
74 USE groupdef_mod
75 USE optiondef_mod
76 USE hm_option_read_mod
77 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
78C-----------------------------------------------
79C I m p l i c i t T y p e s
80C-----------------------------------------------
81#include "implicit_f.inc"
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "scr17_c.inc"
86#include "com04_c.inc"
87#include "param_c.inc"
88#include "sphcom.inc"
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
93 INTEGER ITABM1(*),
94 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),
95 . IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),IPARTS(*),
96 . IPARTQ(*),IPARTC(*),IPARTT(*),IPARTP(*),IPARTR(*),
97 . IPARTG(*),IPART(LIPART1,*),ITAB(*),
98 . IXS10(6,*) ,IXS20(12,*) ,IXS16(8,*),
99 . KXSP(NISP,*),IPARTSP(*),ISUBMOD(*),ISKN(LISKN,*),
100 . IXX(*),KXX(*),IPARTX(*),IADBOXMAX,NSETS
101 INTEGER FLAG,MAXNNOD
102 my_real
103 . x(3,*),geo(npropg,*),skew(lskew,*),rtrans(*)
104 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
105C-----------------------------------------------
106 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
107 TYPE (GROUP_) , TARGET, DIMENSION(NGRNOD) :: IGRNOD
108 TYPE (GROUP_) , TARGET, DIMENSION(NGRQUAD) :: IGRQUAD
109 TYPE (GROUP_) , TARGET, DIMENSION(NGRBRIC) :: IGRBRIC
110 TYPE (GROUP_) , TARGET, DIMENSION(NGRSHEL) :: IGRSH4N
111 TYPE (GROUP_) , TARGET, DIMENSION(NGRSH3N) :: IGRSH3N
112 TYPE (GROUP_) , TARGET, DIMENSION(NGRTRUS) :: IGRTRUSS
113 TYPE (GROUP_) , TARGET, DIMENSION(NGRBEAM) :: IGRBEAM
114 TYPE (GROUP_) , TARGET, DIMENSION(NGRSPRI) :: IGRSPRING
115 TYPE (SURF_) , TARGET, DIMENSION(NSURF) :: IGRSURF
116 TYPE (SURF_) , TARGET, DIMENSION(NSLIN) :: IGRSLIN
117 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER J10(10),ID_SUB
122 INTEGER, DIMENSION(:), ALLOCATABLE :: BUFTMP ! NUMNOD*2+NPART
123 INTEGER I,J,K,II,KK,N1,N2,ISU,ID,JREC,NNOD,NL,NTRI,IGS,IGRS,
124 . OK,IT0,IT1,IT2,IT3,IT4,IT5,IT6,
125 . FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,STAT,IT7,UID,IFLAGUNIT,
126 . IT8,SUB_ID,IADBOX,NN,LIST_IGR(NGRNOD),IDMIN,IDMAX,OFFSET,
127 . IT9,IDB,NENTITY,NLINES,JJ
128
129 my_real
130 . xmin,xmax,ymin,ymax,zmin,zmax,bid,fac_l
131 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFTMP2
132 CHARACTER(LEN=NCHARTITLE) :: TITR, TITR1
133 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
134 CHARACTER MESS*40
135 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFBOX
136 LOGICAL IS_AVAILABLE
137C-----------------------------------------------
138C E x t e r n a l F u n c t i o n s
139C-----------------------------------------------
140 INTEGER USR2SYS,ULIST2S,LISTCNT
141C 1234567890123456789012345678901234567890
142 DATA mess/'NODE GROUP DEFINITION '/
143C-----------------------------------------------
144C IGRNOD(IGS)%ID : GROUP identifier
145C IGRNOD(IGS)%TITLE : GROUP title
146C IGRNOD(IGS)%NENTITY : Entities (nodes) number of the GROUP
147C IGRNOD(IGS)%GRTYPE : TYPE ( 0-NOEUDS, 1-BRIC, 2-QUAD, 3-SHELL_4N,
148! 4-TRUSS, 5-BEAM, 6-SPRINGS,7-SHELL_3N )
149!! GRTYPE --- > OBSOLETE
150C IGRNOD(IGS)%SORTED : FLAG for sorted/unsorted nodes
151! = 0 -> sorted
152! = 1 -> unsorted
153C IGRNOD(IGS)%GRPGRP : TYPE of nodal GROUP
154! = 1 FOR /GRNOD/NOD
155! = 2 FOR /GRNOD/GNROD
156! = 0 ALL THE REST
157C IGRNOD(IGS)%LEVEL : Hierarchy level
158! (FLAG 'SUBLEVEL DONE' FOR GROUPS OF GROUPS)
159! = 0 ---> not yet initialized
160! = 1 ---> done
161! - R2R -
162! ! R2R_ALL <--- IGROUP2(8,I) = IGROUP2(2,I) -- before splitting
163! ! R2R_SHARE <--- IGROUP2(9,I) (shared on boundary subdomain)
164C IGRNOD(IGS)%R2R_ALL ! Multidomaines -> number of node(elems, parts) before split
165C IGRNOD(IGS)%R2R_SHARE ! shared on boundary subdomain
166C-----------------------------------------------
167 ALLOCATE(buftmp(2*numnod + npart))
168 is_available = .false.
169 it0=0
170 it1=0
171 it2=0
172 it3=0
173 it4=0
174 it5=0
175 it6=0
176 it7=0
177 it8=0
178 it9=0
179C=======================================================================
180C Start reading groups of nodes (type NODE) + init IGRN(1,IGS)
181C=======================================================================
182 igs=0
183 titr1='NODE GROUP'
184C
185 CALL hm_option_start('/GRNOD')
186C
187 ! Loop over all GRNOD
188 DO i=1,ngrnod
189C
190 ! Read keys and uid
191 CALL hm_option_read_key(lsubmodel,
192 . option_id = id,
193 . option_titr = titr ,
194 . unit_id = uid,
195 . keyword2 = key ,
196 . keyword3 = key2)
197C
198 ! Increasing the counter
199 igs=igs+1
200C
201 ! Initialization of data structure
202 IF (flag == 0) THEN
203 igrnod(igs)%ID = 0
204 igrnod(igs)%NENTITY = 0
205 igrnod(igs)%GRTYPE = 0
206 igrnod(igs)%SORTED = 0
207 igrnod(igs)%GRPGRP = 0
208 igrnod(igs)%LEVEL = 0
209 igrnod(igs)%R2R_ALL = 0
210 igrnod(igs)%R2R_SHARE = 0
211 ENDIF
212 nn = 0
213 nnod = 0
214 igrnod(igs)%ID=id
215 igrnod(igs)%GRTYPE=0
216 igrnod(igs)%SORTED=0
217 igrnod(igs)%LEVEL=1
218 igrnod(igs)%TITLE = titr
219C
220 ! Filling data structure following type of GRNOD
221 !-----------------------------------------------------------------
222 ! GRNOD from GRNODNS
223 IF(key(1:7) == 'GRNODNS')THEN
224C tag des groupes de groupes
225 igrnod(igs)%NENTITY=-1
226c non sorted nodes
227 igrnod(igs)%SORTED=1
228 igrnod(igs)%GRPGRP=2 !!! /GROUP/GROUP
229 igrnod(igs)%LEVEL=0
230 !-----------------------------------------------------------------
231 ! GRNOD from GRNOD
232 ELSEIF(key(1:5) == 'GRNOD')THEN
233 igrnod(igs)%NENTITY=-1
234 igrnod(igs)%GRPGRP=2
235 igrnod(igs)%LEVEL=0
236 it0=it0+1
237 !-----------------------------------------------------------------
238 ! GRNOD from NODENS
239 ELSEIF(key(1:6) == 'NODENS') THEN
240 it1=it1+1
241 IF (flag == 0) THEN
242 CALL hm_get_intv('idsmax' ,nentity,is_available,lsubmodel)
243 DO kk = 1,nentity
244 CALL hm_get_int_array_index ('ids',jj ,kk,is_available,lsubmodel)
245 IF (jj /= 0) THEN
246 nnod = nnod + 1
247 ENDIF
248 ENDDO
249 igrnod(igs)%NENTITY=nnod
250! may be allocated already (prelecgrns.F) if NUMELX > 0
251 IF (.NOT. ALLOCATED(igrnod(igs)%ENTITY))
252 . CALL my_alloc(igrnod(igs)%ENTITY,nnod)
253 igrnod(igs)%GRPGRP=1
254 maxnnod = max(nnod,maxnnod)
255 ELSE
256 igrnod(igs)%SORTED=1
257 CALL hm_get_intv('idsmax' ,nentity,is_available,lsubmodel)
258 DO kk = 1,nentity
259 CALL hm_get_int_array_index ('ids',jj ,kk,is_available,lsubmodel)
260 IF (jj /= 0) THEN
261 nn = nn+1
262 igrnod(igs)%ENTITY(nn) = usr2sys(jj,itabm1,mess,id)
263 ENDIF
264 ENDDO
265 ENDIF
266 !-----------------------------------------------------------------
267 ! GRNOD from NODE
268 ELSEIF(key(1:4) == 'NODE' .OR. key(1:5) == 'CNODE') THEN
269C groupe de noeuds
270 it1=it1+1
271 IF (flag == 0) THEN
272 CALL hm_get_intv('idsmax' ,nentity,is_available,lsubmodel)
273 IF(is_available)nnod = nnod + nentity
274 igrnod(igs)%NENTITY=nnod
275! may be allocated already (prelecgrns.F) if NUMELX > 0
276 IF( .NOT. ALLOCATED(igrnod(igs)%ENTITY))
277 . CALL my_alloc(igrnod(igs)%ENTITY,nnod)
278 igrnod(igs)%GRPGRP=1
279 maxnnod = max(nnod,maxnnod)
280 ELSE
281c sorted nodes
282 CALL hm_get_intv('idsmax' ,nentity,is_available,lsubmodel)
283 DO kk = 1,nentity
284 CALL hm_get_int_array_index ('ids',jj ,kk,is_available,lsubmodel)
285 IF (jj /= 0) THEN
286 nn = nn+1
287 igrnod(igs)%ENTITY(nn) = jj
288 ENDIF
289 ENDDO
290 ENDIF
291 !-----------------------------------------------------------------
292 ! GRNOD from PART, SUBSET, MAT and PROP
293 ELSEIF(key(1:4) == 'PART'.OR.key(1:6) == 'SUBSET'.OR.
294 . key(1:3) == 'MAT' .OR.key(1:4) == 'PROP') THEN
295 it2=it2+1
296 IF (flag == 0) igrnod(igs)%NENTITY=0
297 igrnod(igs)%GRPGRP=0
298 !-----------------------------------------------------------------
299 ! GRNOD from /BOX/RECTA, /BOX/CYLIN, /BOX/SPHERE, GENE, BOXA
300 ELSEIF((key(1:3) == 'BOX' .AND. nbbox == 0 .AND.
301 . (key2(1:5) /= 'RECTA'.AND.
302 . key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER')).OR.
303 . key(1:4) == 'GENE'.OR.key(1:4) == 'BOXA')THEN
304 it3=it3+1
305 IF (flag == 0) igrnod(igs)%NENTITY=0
306 igrnod(igs)%GRPGRP=0
307 !-----------------------------------------------------------------
308 ! GRNOD from GR, SURF, LINE
309 ELSEIF(key(1:2) == 'GR'.OR.key(1:4) == 'SURF'.OR.key(1:4) == 'LINE')THEN
310 it4=it4+1
311 IF (flag == 0) igrnod(igs)%NENTITY=0
312 igrnod(igs)%GRPGRP=0
313 !-----------------------------------------------------------------
314 ! GRNOD from SUBMODEL
315 ELSEIF(key(1:6) == 'SUBMOD')THEN
316 it5=it5+1
317 IF (flag == 0) igrnod(igs)%NENTITY=0
318 igrnod(igs)%GRPGRP=0
319 !-----------------------------------------------------------------
320 ! GRNOD from /BOX
321 ELSEIF(key(1:3) == 'BOX'.AND.(key2(1:5) == 'RECTA'.OR.
322 . key2(1:5) == 'CYLIN'.OR.key2(1:5) == 'SPHER'))THEN
323C old /grnod/box (not /BOX/BOX)
324C groupe de noeuds dans un box (classical box, parallelepiped,
325C cylindrical, spherical)
326 it7=it7+1
327 IF (flag == 0) igrnod(igs)%NENTITY=0
328 igrnod(igs)%GRPGRP=0
329 !-----------------------------------------------------------------
330 ! GRNOD from BOX
331 ELSEIF(key(1:3) == 'BOX' .AND. nbbox > 0)THEN
332C multi box (box de box)
333 it8=it8+1
334 !-----------------------------------------------------------------
335 ! GRNOD from GEN_INCR
336 ELSEIF(key(1:8) == 'GEN_INCR')THEN
337 it9=it9+1
338 IF (flag == 0) igrnod(igs)%NENTITY=0
339 igrnod(igs)%GRPGRP=0
340 ENDIF
341C---
342 ENDDO
343C-------------------------------------
344C Looking for double IDs
345C-------------------------------------
346 IF (flag == 0) THEN
347 DO igs = 1,ngrnod
348 list_igr(igs) = igrnod(igs)%ID
349 ENDDO
350 CALL udouble_igr(list_igr,ngrnod,mess,0,bid)
351 ENDIF
352C=======================================================================
353C Remplacement des n0 de noeuds user par systeme (type NODE)
354C=======================================================================
355 IF (it1 /= 0 .AND. flag == 1)THEN
356!
357 ALLOCATE(buftmp2(maxnnod*2),stat=stat)
358 IF (stat /= 0) THEN
359 CALL ancmsg(msgid=727,
360 . msgtype=msgerror,
361 . anmode=anstop,
362 . c1='BUFTMP2')
363 ENDIF
364!
365 DO i=1,ngrnod
366 IF (igrnod(i)%GRPGRP == 1) THEN
367 id=igrnod(i)%ID
368 nnod=igrnod(i)%NENTITY
369 ntri=igrnod(i)%SORTED
370 IF (nnod > 0 .AND. ntri == 0)THEN
371 IF(nnod == 1) THEN
372C pas de tri necessaire et dichotomie
373 nn = igrnod(i)%ENTITY(nnod)
374 igrnod(i)%ENTITY(nnod)=usr2sys(nn,itabm1,mess,id)
375 igrnod(i)%NENTITY=1
376C ELSEIF(NNOD < 10 ou 100 ...)
377C algo avec tri simplifie et dichotomie, nnod limite a definir
378 ELSE
379C algo optimise pour groupe de taille non negligeable devant numnod
380 buftmp2(1:2*nnod) = 0
381 nnod=ulist2s(igrnod(i)%ENTITY,nnod,itabm1,mess,buftmp2,id)
382 igrnod(i)%NENTITY=nnod
383 END IF
384 ENDIF
385 ENDIF
386 ENDDO
387 DEALLOCATE (buftmp2)
388 ENDIF ! IF (IT1 /= 0 .AND. FLAG == 1)THEN
389C=======================================================================
390C BOX, GENERATION
391C=======================================================================
392 igs=0
393 IF (it3 /= 0) THEN
394 CALL hm_option_start('/GRNOD')
395 DO i=1,ngrnod
396C
397 CALL hm_option_read_key(lsubmodel,
398 . option_id = id,
399 . option_titr = titr ,
400 . unit_id = uid,
401 . keyword2 = key ,
402 . keyword3 = key2)
403C
404 nnod = 0
405 nn = 0
406 igs = igs+1
407C-------------------------
408C BOX (old)
409C-------------------------
410 IF((key(1:3) == 'BOX'.AND.(key2(1:5) /= 'RECTA'.AND.
411 . key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER').AND.
412 . nbbox == 0) .OR. (key(1:4) == 'BOXA'))THEN
413 ! No longer supported, ERROR MESSAGE
414C-------------------------
415C GENERATION
416C-------------------------
417 ELSEIF (key(1:4) == 'GENE') THEN
418 buftmp = 0
419C
420 CALL hm_get_intv('grnodGenArrCnt' ,nentity,is_available,lsubmodel)
421 DO kk = 1,nentity
422 CALL hm_get_int_array_index('Ifirst',n1 ,kk ,is_available,lsubmodel)
423 CALL hm_get_int_array_index('Ilast' ,n2 ,kk ,is_available,lsubmodel)
424 IF (n2 >= n1) THEN
425 DO k=1,numnod
426 IF (itab(k) >= n1 .AND. itab(k) <= n2) buftmp(k)=1
427 ENDDO
428 ENDIF
429 ENDDO
430C---
431 nnod=0
432 IF (flag == 0) THEN
433 DO j=1,numnod
434 IF (buftmp(j) == 1) nnod = nnod+1
435 ENDDO
436 igrnod(igs)%NENTITY=nnod
437 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
438 igrnod(igs)%ENTITY=0
439 ELSE
440 DO j=1,numnod
441 IF (buftmp(j) == 1)THEN
442 nn = nn + 1
443 igrnod(igs)%ENTITY(nn)=j
444 ENDIF
445 ENDDO
446 ENDIF
447C---
448 ENDIF
449 ENDDO
450 ENDIF
451C-------------------------
452C BOX (parallelepiped (oriented), cylindrical, spherical) - old one (10SA1)
453C-------------------------
454 igs=0
455 IF(it7 /= 0)THEN
456 ! Error message, obsolete
457 ENDIF
458C-------------------------
459C NEW BOX OPTION (MULTI BOX COMBINATION)
460C-------------------------
461 igs=0
462 IF(it8 /= 0)THEN
463C
464 IF (flag == 0) THEN
465 ALLOCATE(bufbox(1))
466 bufbox = 0
467 ELSEIF (flag == 1) THEN
468 ALLOCATE(bufbox(iadboxmax))
469 bufbox(1:iadboxmax) = 0
470 ENDIF
471C
472 CALL hm_option_start('/GRNOD')
473 DO i = 1,ngrnod
474c
475 CALL hm_option_read_key(lsubmodel,
476 . option_id = id,
477 . option_titr = titr ,
478 . unit_id = uid,
479 . keyword2 = key ,
480 . keyword3 = key2)
481c
482 nn = 0
483 nnod = 0
484 igs = igs+1
485c
486 IF (key(1:3) == 'BOX' .AND. nbbox > 0) THEN
487 iadbox = 1
488 iflagunit = 0
489 DO j=1,unitab%NUNITS
490 IF (unitab%UNIT_ID(j) == uid) THEN
491 fac_l = unitab%FAC_L(j)
492 iflagunit = 1
493 EXIT
494 ENDIF
495 ENDDO
496 IF (uid/=0.AND.iflagunit==0) THEN
497 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
498 . i2=uid,i1=id,c1='NODE GROUP',
499 . c2='NODE GROUP',
500 . c3=titr)
501 ENDIF
502C---
503 CALL hm_get_int_array_index('ids' ,idb ,1,is_available,lsubmodel)
504 CALL hm_bigbox(x ,flag,nnod ,
505 . skew,igs ,iskn ,itabm1,ibox ,
506 . id ,bufbox,iadbox,titr,key,nn,
507 . iadboxmax,igrnod,idb)
508C---
509 iadboxmax = max(iadbox,iadboxmax)
510 IF (flag == 0) THEN
511 igrnod(igs)%NENTITY=nnod
512 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
513 igrnod(igs)%ENTITY = 0
514 ELSEIF (flag == 1) THEN
515 igrnod(igs)%NENTITY=nnod
516 ENDIF ! IF (FLAG == 0)
517 ENDIF
518 ENDDO
519C---
520 IF(ALLOCATED(bufbox))DEALLOCATE(bufbox)
521 ENDIF ! IF(IT8 /= 0)
522C=======================================================================
523C groupes de SUBSETS,PART,MAT,PROP
524C=======================================================================
525 igs=0
526 IF (it2 /= 0)THEN
527 CALL hm_option_start('/GRNOD')
528 DO i = 1,ngrnod
529 CALL hm_option_read_key(lsubmodel,
530 . option_id = id,
531 . option_titr = titr ,
532 . unit_id = uid ,
533 . keyword2 = key ,
534 . keyword3 = key2)
535C
536 igs=igs+1
537 nn = 0
538 IF (key(1:4) == 'PART'.OR.key(1:6) == 'SUBSET'.OR.key(1:3) == 'MAT' .OR.key(1:4) == 'PROP') THEN
539C tag les PARTs
540 buftmp = 0
541 CALL hm_tagpart(buftmp ,ipart ,key ,igrnod(igs)%ID,titr ,titr1 ,flag ,subset, lsubmodel)
542C-------------------------
543C tag les noeuds
544 CALL tagnods(ixs,ixs10,ixs20,ixs16,iparts,buftmp,igrnod(igs)%ID,titr)
545 CALL tagnod(ixq,nixq,2,5,numelq,ipartq,buftmp,npart)
546 CALL tagnod(ixc,nixc,2,5,numelc,ipartc,buftmp,npart)
547 CALL tagnod(ixtg,nixtg,2,4,numeltg,ipartg,buftmp,npart)
548 CALL tagnod(ixt,nixt,2,3,numelt,ipartt,buftmp,npart)
549 CALL tagnod(ixp,nixp,2,3,numelp,ipartp,buftmp,npart)
550 CALL tagnodr(ixr,geo,numelr,ipartr,buftmp,npart)
551 CALL tagnod(kxsp,nisp,3,3,numsph,ipartsp,buftmp,npart)
552 CALL tagnodx(ixx,kxx,numelx,ipartx,buftmp,npart)
553C---
554 nnod=0
555 IF (flag == 0) THEN
556 DO j=1,numnod
557 IF (buftmp(j+npart) /= 0) nnod=nnod+1
558 ENDDO
559 igrnod(igs)%NENTITY=nnod
560 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
561 igrnod(igs)%ENTITY=0
562 ELSE
563 DO j=1,numnod
564 IF (buftmp(j+npart) /= 0)THEN
565 nn = nn + 1
566 igrnod(igs)%ENTITY(nn) = j
567 ENDIF
568 ENDDO
569 ENDIF
570C---
571 ENDIF
572 ENDDO
573 ENDIF
574C=======================================================================
575C groupes de SUBMODELS
576C=======================================================================
577 igs=0
578 IF (it5 > 0)THEN
579 CALL hm_option_start('/GRNOD')
580 DO i = 1,ngrnod
581 CALL hm_option_read_key(lsubmodel,
582 . option_id = id,
583 . option_titr = titr ,
584 . unit_id = uid ,
585 . keyword2 = key ,
586 . keyword3 = key2)
587c
588 nnod = 0
589 igs = igs+1
590 nn = 0
591 IF(key(1:6) == 'SUBMOD')THEN
592 CALL hm_submodgrn(itab ,itabm1 ,isubmod ,id ,
593 . nnod ,mess ,flag ,titr ,
594 . titr1 ,lsubmodel ,igrnod(igs),nn )
595 IF (flag == 0) THEN
596 igrnod(igs)%NENTITY=nnod
597 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
598 igrnod(igs)%ENTITY = 0
599 ENDIF
600 ENDIF
601 ENDDO
602 ENDIF
603C=======================================================================
604C groupes de groupes d'elements + surfaces
605C=======================================================================
606 igs=0
607 IF (it4 /= 0)THEN
608 CALL hm_option_start('/GRNOD')
609 DO i=1,ngrnod
610 CALL hm_option_read_key(lsubmodel,
611 . option_id = id,
612 . option_titr = titr ,
613 . unit_id = uid ,
614 . keyword2 = key ,
615 . keyword3 = key2)
616c
617 igs=igs+1
618 nn = 0
619C---
620 IF(key(1:5) == 'GRNOD')THEN
621 cycle
622 ELSEIF(key(1:2) == 'GR' .OR. key(1:4) == 'SURF' .OR. key(1:4) == 'LINE')THEN
623 buftmp = 0
624 id = igrnod(igs)%ID
625 IF(key(1:6) == 'GRBRIC')THEN
626 CALL hm_elngrs(ixs,ixs10,ixs20,ixs16,ngrbric,key(1:6),
627 . id ,igrbric,buftmp,titr,
628 . flag,lsubmodel)
629 ELSEIF(key(1:6) == 'GRQUAD')THEN
630 CALL hm_elngr(ixq,nixq,2,5,ngrquad,key(1:6),
631 . id,igrquad,buftmp,titr,
632 . flag,lsubmodel)
633 ELSEIF(key(1:6) == 'GRSHEL')THEN
634 CALL hm_elngr(ixc,nixc,2,5,ngrshel,key(1:6),
635 . id,igrsh4n,buftmp,titr,
636 . flag,lsubmodel)
637 ELSEIF(key(1:6) == 'GRTRUS')THEN
638 CALL hm_elngr(ixt,nixt,2,3,ngrtrus,key(1:6),
639 . id,igrtruss,buftmp,titr,
640 . flag,lsubmodel)
641 ELSEIF(key(1:6) == 'GRBEAM')THEN
642 CALL hm_elngr(ixp,nixp,2,3,ngrbeam,key(1:6),
643 . id,igrbeam,buftmp,titr,
644 . flag,lsubmodel)
645 ELSEIF(key(1:6) == 'GRSPRI')THEN
646 CALL hm_elngrr(ixr,geo,ngrspri,id,
647 . igrspring,buftmp,titr,
648 . flag,lsubmodel)
649 ELSEIF(key(1:6) == 'GRSH3N' .OR. key(1:6) == 'GRTRIA')THEN
650 CALL hm_elngr(ixtg,nixtg,2,4,ngrsh3n,key(1:6),
651 . id,igrsh3n,buftmp,titr,
652 . flag,lsubmodel)
653 ELSEIF(key(1:4) == 'SURF')THEN
654 CALL hm_surfnod(id,igrsurf,buftmp,titr,nsets,lsubmodel)
655 ELSEIF(key(1:4) == 'LINE')THEN
656 CALL hm_linengr(id,igrslin,buftmp,titr,nsets,lsubmodel)
657 ENDIF
658C---
659 nnod=0
660 IF (flag == 0) THEN
661 DO j=1,numnod
662 IF (buftmp(j) /= 0) nnod=nnod+1
663 ENDDO
664 igrnod(igs)%NENTITY=nnod
665 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
666 igrnod(igs)%ENTITY = 0
667 ELSE
668 DO j=1,numnod
669 IF (buftmp(j) /= 0)THEN
670 nn = nn + 1
671 igrnod(igs)%ENTITY(nn)=j
672 ENDIF
673 ENDDO
674 ENDIF
675C---
676 ENDIF
677 ENDDO
678 ENDIF
679C=======================================================================
680C BOX, GENERATION
681C=======================================================================
682 igs=0
683 IF(it9 /= 0)THEN
684 CALL hm_option_start('/GRNOD')
685 DO i=1,ngrnod
686 CALL hm_option_read_key(lsubmodel,
687 . option_id = id,
688 . option_titr = titr ,
689 . unit_id = uid ,
690 . keyword2 = key ,
691 . keyword3 = key2 )
692c
693 nnod=0
694 nn = 0
695 igs=igs+1
696C-------------------------
697C GENERATION MIN MAX OFFSET
698C-------------------------
699 IF (key(1:8) == 'GEN_INCR') THEN
700 buftmp = 0
701 CALL hm_get_intv ('grnodGenArrCnt' ,nlines,is_available,lsubmodel)
702 DO kk=1,nlines
703 CALL hm_get_int_array_index('Ifirst',idmin ,kk,is_available,lsubmodel)
704 CALL hm_get_int_array_index('Ilast' ,idmax ,kk,is_available,lsubmodel)
705 CALL hm_get_int_array_index('Iincr' ,offset ,kk,is_available,lsubmodel)
706 DO j=idmin, idmax , offset
707 IF (j > 0) THEN
708 DO k=1,numnod
709 id = itab(k)
710 IF(id<idmin .OR. id>idmax) cycle
711 IF(mod(id-idmin,offset)==0) buftmp(k) = 1
712 ENDDO
713 ENDIF
714 ENDDO
715 ENDDO
716C---
717 nnod=0
718 IF (flag == 0) THEN
719 DO j=1,numnod
720 IF (buftmp(j) == 1) nnod=nnod+1
721 ENDDO
722 igrnod(igs)%NENTITY=nnod
723 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
724 igrnod(igs)%ENTITY=0
725 ELSE
726 DO j=1,numnod
727 IF (buftmp(j) == 1)THEN
728 nn = nn + 1
729 igrnod(igs)%ENTITY(nn)=j
730 ENDIF
731 ENDDO
732 ENDIF
733C---
734 ENDIF
735 ENDDO
736 ENDIF
737C-----
738 DEALLOCATE(buftmp)
739 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_bigbox
subroutine hm_bigbox(x, flag, nnod, skew, igs, iskn, itabm1, ibox, id, ibufbox, iadb, titr, key, nn, iboxmax, igrnod, idb)
Definition hm_bigbox.F:38
hm_elngr
subroutine hm_elngr(ix, nix, nix1, nix2, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:39
hm_elngrs
subroutine hm_elngrs(ixs, ixs10, ixs20, ixs16, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:116
hm_elngrr
subroutine hm_elngrr(ixr, geo, ngrele, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngrr.F:39
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_linengr
subroutine hm_linengr(id, igrslin, tagbuf, titr, nsets, lsubmodel)
Definition hm_linengr.F:37
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_submodgrn
subroutine hm_submodgrn(itab, itabm1, isubmod, sid, nnod, mess, flag, titr, titr1, lsubmodel, igrnod, nn)
Definition hm_submodgr.F:39
hm_surfnod
subroutine hm_surfnod(id, igrsurf, tagbuf, titr, nsets, lsubmodel)
Definition hm_surfnod.F:37
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
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
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
ulist2s
integer function ulist2s(list, nlist, itabm1, mess, index, id)
Definition sysfus.F:465
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
udouble_igr
subroutine udouble_igr(list, nlist, mess, ir, rlist)
Definition sysfus.F:1220
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29
tagnods
subroutine tagnods(ixs, ixs10, ixs20, ixs16, iparts, tagbuf, idgrn, titr)
Definition tagnod.F:68
tagnodr
subroutine tagnodr(ixr, geo, numelr, ipartr, tagbuf, npart)
Definition tagnodr.F:29
tagnodx
subroutine tagnodx(ixx, kxx, numelx, ipartx, tagbuf, npart)
Definition tagnodx.F:29