OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_lecgrn.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_lecgrn ../starter/source/groups/hm_lecgrn.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_bigbox ../starter/source/model/box/hm_bigbox.F
30!|| hm_elngr ../starter/source/groups/hm_elngr.F
31!|| hm_elngrr ../starter/source/groups/hm_elngrr.F
32!|| hm_elngrs ../starter/source/groups/hm_elngr.F
33!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
34!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
35!|| hm_linengr ../starter/source/groups/hm_linengr.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_submodgrn ../starter/source/groups/hm_submodgr.F
39!|| hm_surfnod ../starter/source/groups/hm_surfnod.F
40!|| hm_tagpart ../starter/source/groups/hm_tagpart.F
41!|| tagnod ../starter/source/groups/tagnod.F
42!|| tagnodr ../starter/source/groups/tagnodr.F
43!|| tagnods ../starter/source/groups/tagnod.F
44!|| tagnodx ../starter/source/groups/tagnodx.F
45!|| udouble_igr ../starter/source/system/sysfus.F
46!|| ulist2s ../starter/source/system/sysfus.F
47!|| usr2sys ../starter/source/system/sysfus.F
48!||--- uses -----------------------------------------------------
49!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
50!|| message_mod ../starter/share/message_module/message_mod.F
51!|| submodel_mod ../starter/share/modules1/submodel_mod.F
52!||====================================================================
53 SUBROUTINE hm_lecgrn(
54 1 ITAB ,ITABM1 ,IGRNOD ,
55 2 ISUBMOD ,X ,GEO ,IXS ,
56 3 IXQ ,IXC ,IXT ,IXP ,IXR ,
57 4 IXTG ,IPART ,
58 5 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,
59 6 IPARTR ,IPARTG ,IPARTSP ,KXSP ,
60 7 FLAG ,MAXNNOD ,SKEW ,ISKN ,
61 8 UNITAB ,IBOX ,IXS10 ,IXS20 ,
62 9 IXS16 ,RTRANS ,LSUBMODEL,IXX ,
63 A KXX ,IPARTX ,IADBOXMAX,IGRSLIN,SUBSET ,
64 B IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
65 C IGRBEAM ,IGRSPRING,IGRSURF,NSETS )
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.AND. IF (IT1 /= 0 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.AND. IF (NNOD > 0 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.AND. ENDIF ! IF (IT1 /= 0 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.OR. . NBBOX == 0) (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.AND. IF (ITAB(K) >= N1 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.AND. IF (UID/=0IFLAGUNIT==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
740 END
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_lecgrn
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)
Definition hm_lecgrn.F:66
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_surfnod
subroutine hm_surfnod(id, igrsurf, tagbuf, titr, nsets, lsubmodel)
Definition hm_surfnod.F:37
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
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
submodel_mod::submodel_data
Definition submodel_mod.F:723