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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_lines (itab, itabm1, isubmod, igrslin, igrsurf, x, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, nsegs, flag, skew, iskn, unitab, ibox, rtrans, lsubmodel, ipartx, kxx, ixx, iadboxmax, subset, igrtruss, igrbeam, igrspring, nsets, map_tables)

Function/Subroutine Documentation

◆ hm_read_lines()

subroutine hm_read_lines ( integer, dimension(*) itab,
integer, dimension(*) itabm1,
integer, dimension(*) isubmod,
type (surf_), dimension(nslin+nsets) igrslin,
type (surf_), dimension(nsurf+nsets) igrsurf,
x,
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(*) iparttg,
integer nsegs,
integer flag,
skew,
integer, dimension(liskn,*) iskn,
type (unit_type_), intent(in) unitab,
type (box_), dimension(nbbox) ibox,
rtrans,
type(submodel_data), dimension(nsubmod) lsubmodel,
integer, dimension(*) ipartx,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
integer iadboxmax,
type (subset_), dimension(nsubs) subset,
type (group_), dimension(ngrtrus) igrtruss,
type (group_), dimension(ngrbeam) igrbeam,
type (group_), dimension(ngrspri) igrspring,
integer nsets,
type(mapping_struct_), intent(in) map_tables )

Definition at line 53 of file hm_read_lines.F.

63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE my_alloc_mod
67 USE unitab_mod
68 USE submodel_mod , ONLY : nsubmod, submodel_data
69 USE message_mod
70 USE groupdef_mod
71 USE optiondef_mod
72 USE surf_mod
73 USE hm_option_read_mod
74 USE mapping_option_mod
75 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
76 USE reader_old_mod , ONLY : line, kline
77C-----------------------------------------------
78C I m p l i c i t T y p e s
79C-----------------------------------------------
80#include "implicit_f.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "scr17_c.inc"
85#include "scr23_c.inc"
86#include "com04_c.inc"
87#include "param_c.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
92 INTEGER ITABM1(*),
93 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),
94 . IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*),IPARTS(*),
95 . IPARTQ(*),IPARTC(*),IPARTT(*),IPARTP(*),IPARTR(*),
96 . IPARTTG(*),IPART(LIPART1,*),
97 . ITAB(*),ISUBMOD(*),FLAG,NSEGS,ISKN(LISKN,*),
98 . IPARTX(*),KXX(NIXX,*),
99 . IXX(*),IADBOXMAX,NSETS
100 my_real
101 . x(3,*),skew(lskew,*),rtrans(*)
102 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
103 TYPE(MAPPING_STRUCT_), INTENT(IN) :: MAP_TABLES
104C-----------------------------------------------
105 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
106 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
107 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
108 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
109 TYPE (SURF_) , DIMENSION(NSURF+NSETS) :: IGRSURF
110 TYPE (SURF_) , DIMENSION(NSLIN+NSETS) :: IGRSLIN
111 TYPE (BOX_) , DIMENSION(NBBOX) :: IBOX
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 INTEGER I,II,K,L,J,JC,JJ,KK,ISU,ID,NSEG,NSEG0,NSEGV,N1,N2,NUMEL,
116 . OK,IGS,IGRS,JREC,IAD0,NE,ITYP,
117 . IT0,IT1,IT2,IT3,IT4,IT5,IT6,IT7,SBUFBOX,UID,IFLAGUNIT,
118 . ISK,BOXTYPE,J2(2),IT8,SUB_ID,IBUFSIZ,NINDX,STAT,
119 . INTMAX,IADBOX,LIST_LINE(NSLIN),ISEG,IBID,NSEG_TOT,NN,LINE_NSEG0,SUB_INDEX
120 my_real
121 . xmin,xmax,ymin,ymax,zmin,zmax,bid,fac_l,
122 . diam,xp1,yp1,zp1,xp2,yp2,zp2
123 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1,STRING
124 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
125 CHARACTER MESS*40
126 INTEGER, DIMENSION(:),ALLOCATABLE :: BUFBOX, BUFTMP, INDX,TAGT ,TAGP
127 LOGICAL :: FLAG_GRBRIC
128 INTEGER :: MODE, NENTITY
129 TYPE(PART_TYPE), DIMENSION(:), ALLOCATABLE :: SURF_ELM
130 LOGICAL IS_AVAILABLE, IS_ENCRYPTED, lERROR
131C-----------------------------------------------
132C D e s c r i p t i o n
133C-----------------------------------------------
134! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
135! FLAG_GRBRIC : flag to initialize the INDX_SOL(10) arrays
136! and optimize an old and expensive treatment in SSURFTAG
137! NOT USED IN THIS ROUTINE !!!!!!!!!!!!
138! MODE : integer
139! switch to initialize solid/shell/shell3n or truss/beam/spring
140! SURF_ELM : PART_TYPE structure
141! %Nxxx : number of element per part
142! %xxx_PART : ID of the element
143! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
144C-----------------------------------------------
145! IGRSLIN(IGS)%ID :: LINE identifier
146! IGRSLIN(IGS)%TITLE :: LINE title
147! IGRSLIN(IGS)%NSEG :: Number of lines
148! IGRSLIN(IGS)%LEVEL :: FLAG "SUBLEVEL DONE" FOR LINES OF LINES
149! = 0 ! initialized line
150! = 1 ! uninitialized line
151! IGRSLIN(IGS)%ELEM(J) :: element attached to the line segment
152! IGRSLIN(IGS)%NODES(J,2) :: 2 nodes of the line segment
153! IGRSLIN(IGS)%PROC(J) :: field to store the processor ID (/LINE only)
154!
155! 1. Set processor only when no element is set in lines
156! 2. Split lines accordingly
157!
158C-----------------------------------------------
159C E x t e r n a l F u n c t i o n s
160C-----------------------------------------------
161 INTEGER USR2SYS
162C 1234567890123456789012345678901234567890
163 DATA mess/'LINE DEFINITION '/
164 DATA intmax /2147483647/
165C-----------------------------------------------
166C S o u r c e L i n e s
167C-----------------------------------------------
168 it0=0
169 it1=0
170 it2=0
171 it3=0
172 it4=0
173 it5=0
174 it6=0
175 it7=0
176 it8=0
177 ok =0
178 flag_grbric = .false.
179 ibufsiz=6*nsegs
180 ALLOCATE(buftmp(ibufsiz),indx(ibufsiz),stat=stat)
181 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='BUFTMP')
182 nindx=0
183 buftmp(1:ibufsiz)=0 ! init to 0 only one time
184C-----------------------------------------------
185 CALL hm_option_start('/LINE')
186 titr1='LINE'
187 DO igs=1,nslin
188 lerror=.false.
189 CALL hm_option_read_key(lsubmodel,
190 . option_id = id,
191 . option_titr = titr ,
192 . unit_id = uid,
193 . keyword2 = key ,
194 . keyword3 = key2)
195 iseg = 0
196 IF (flag == 0) THEN
197 igrslin(igs)%ID = 0
198 igrslin(igs)%NSEG = 0
199 igrslin(igs)%TYPE = 0
200 igrslin(igs)%LEVEL = 0
201 igrslin(igs)%NSEG_R2R_ALL = 0
202 igrslin(igs)%NSEG_R2R_SHARE = 0
203 ENDIF
204 igrslin(igs)%ID = id
205 igrslin(igs)%LEVEL = 1
206 igrslin(igs)%TITLE = titr
207 IF(key(1:4) == 'LINE') THEN !tag des lines of lines
208 igrslin(igs)%NSEG = -1
209 igrslin(igs)%LEVEL = 0
210 it0=it0+1
211 ELSEIF(key(1:3) == 'SEG') THEN
212 it1=it1+1
213 IF (flag == 0) THEN
214 CALL hm_get_intv('segmax',nseg,is_available,lsubmodel)
215 igrslin(igs)%NSEG = nseg
216 CALL my_alloc(igrslin(igs)%NODES,nseg,2)
217 igrslin(igs)%NODES(1:nseg,1:2) = 0
218 CALL my_alloc(igrslin(igs)%ELTYP,nseg)
219 igrslin(igs)%ELTYP(1:nseg) = 0
220 CALL my_alloc(igrslin(igs)%ELEM,nseg)
221 igrslin(igs)%ELEM(1:nseg) = 0
222 CALL my_alloc(igrslin(igs)%PROC,nseg)
223 igrslin(igs)%PROC(1:nseg) = 0
224 ENDIF
225 IF(flag == 1) THEN
226 CALL hm_get_intv ('segmax' ,nentity,is_available,lsubmodel)
227 DO kk=1,nentity
228 CALL hm_get_int_array_index ('N1' ,n1 ,kk,is_available,lsubmodel)
229 CALL hm_get_int_array_index ('N2' ,n2 ,kk,is_available,lsubmodel)
230 igrslin(igs)%NODES(kk,1) = usr2sys(n1,itabm1,mess,id)
231 igrslin(igs)%NODES(kk,2) = usr2sys(n2,itabm1,mess,id)
232 igrslin(igs)%ELTYP(kk) = 0
233 igrslin(igs)%ELEM(kk) = 0
234 ENDDO
235 ENDIF
236 ELSEIF(key(1:4) == 'PART'.OR.key(1:6) == 'SUBSET'.OR. key(1:3) == 'MAT' .OR.key(1:4) == 'PROP') THEN
237C line de SUBSET PART MAT OU PROP
238 it2=it2+1
239 IF (flag == 0) igrslin(igs)%NSEG = 0
240 ELSEIF(key(1:3) == 'BOX'.AND.nbbox == 0 .AND.(key2(1:5) /= 'RECTA'.AND.key2(1:5) /= 'CYLIN'.AND.key2(1:5) /= 'SPHER'))THEN
241C line dans un box (old)
242 lerror=.true.
243 ELSEIF(key(1:2) == 'GR'.OR.key(1:4) == 'WIRE') THEN
244C line d'ele 2N dans un group d'elements
245 it4=it4+1
246 IF (flag == 0) igrslin(igs)%NSEG = 0
247 ELSEIF(key(1:4) == 'SURF'.OR.key(1:4) == 'EDGE') THEN
248C line d'ele 2N dans une surface ou son bord
249 it5=it5+1
250 IF (flag == 0) igrslin(igs)%NSEG = 0
251 ELSEIF(key(1:6) == 'SUBMOD') THEN
252C line de submodel
253 it6=it6+1
254 IF (flag == 0) igrslin(igs)%NSEG = 0
255 ELSEIF(key(1:3) == 'BOX'.AND.(key2(1:5) == 'RECTA'.OR. key2(1:5) == 'CYLIN'.OR.key2(1:5) == 'SPHER'))THEN
256 !old /grnod/box (not /BOX/BOX)
257 !line dans un box (classical box, parallelepiped (oriented),
258 ! cylindrical, spherical)
259 lerror=.true.
260 ELSEIF(key(1:3) == 'BOX' .AND. nbbox > 0)THEN
261 !multi box (box de box)
262 it8=it8+1
263 ELSE
264 lerror=.true.
265 ENDIF
266
267 IF(lerror)THEN
268 !INVALID KEYWORD
269 string=' '
270 string = "/LINE/"//key(1:len_trim(key)-1)
271 IF(len_trim(key2)>1)string = string//key2(1:len_trim(key2)-1)
272 CALL ancmsg(msgid=688,anmode=aninfo,msgtype=msgerror,i1=id, c1=titr, c2=string)
273 ENDIF
274
275 ENDDO
276
277C-------------------------------------
278C Recherche des ID doubles
279C-------------------------------------
280 IF (flag == 0) THEN
281 DO igs=1,nslin
282 list_line(igs) = igrslin(igs)%ID
283 ENDDO
284 CALL udouble_igr(list_line,nslin,mess,0,bid)
285 ENDIF
286C=======================================================================
287C BOX (old)
288C=======================================================================
289 IF(it3 /= 0) THEN
290 !NO LONGER SUPPORTED
291 ENDIF
292C=======================================================================
293C BOX (parallelepiped, cylindrical, spherical) - old one (10SA1)
294C=======================================================================
295 IF(it7 /= 0) THEN
296 !NO LONGER SUPPORTED
297 ENDIF
298C-------------------------
299C NEW BOX OPTION (MULTI BOX COMBINATION)
300C-------------------------
301 IF (it8 /= 0) THEN
302 ALLOCATE(tagt(numelt),stat=stat)
303 ALLOCATE(tagp(numelp),stat=stat)
304 tagt(1:numelt) = 0
305 tagp(1:numelp) = 0
306 IF (flag == 0) THEN
307 ALLOCATE(bufbox(1))
308 bufbox = 0
309 ELSEIF (flag == 1) THEN
310 ALLOCATE(bufbox(iadboxmax))
311 bufbox(1:iadboxmax) = 0
312 ENDIF
313 sbufbox = int(intmax)
314 CALL hm_option_start('/LINE')
315 titr1='LINE'
316 DO igs=1,nslin
317 CALL hm_option_read_key(lsubmodel,
318 . option_id = id,
319 . option_titr = titr ,
320 . unit_id = uid,
321 . keyword2 = key ,
322 . keyword3 = key2)
323 nn = 0
324 nseg=0
325 kline=line
326 IF(key(1:3) == 'BOX'.AND. nbbox > 0)THEN
327 nseg=0
328 iadbox = 1
329 iflagunit = 0
330 DO j=1,unitab%NUNITS
331 IF (unitab%UNIT_ID(j) == uid) THEN
332 fac_l = unitab%FAC_L(j)
333 iflagunit = 1
334 EXIT
335 ENDIF
336 ENDDO
337 IF (uid/=0.AND.iflagunit==0) THEN
338 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,i2=uid,i1=id,c1='LINE',c2='LINE',c3=titr)
339 ENDIF
340
341 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
342 nseg0 = igrslin(igs)%NSEG
343 CALL my_alloc(igrslin(igs)%NODES,nseg0,2)
344 igrslin(igs)%NODES(1:nseg0,1:2) = 0
345 CALL my_alloc(igrslin(igs)%ELTYP,nseg0)
346 igrslin(igs)%ELTYP(1:nseg0) = 0
347 CALL my_alloc(igrslin(igs)%ELEM,nseg0)
348 igrslin(igs)%ELEM(1:nseg0) = 0
349 CALL my_alloc(igrslin(igs)%PROC,nseg0)
350 igrslin(igs)%PROC(1:nseg0) = 0
351 ENDIF
352
353 IF(numelt > 0)
354 . CALL hm_bigsbox(numelt ,ixt ,nixt ,2 ,3 ,4 ,
355 . x ,nseg ,flag ,skew ,
356 . iskn ,0 ,itabm1 ,ibox ,
357 . id ,bufbox ,igrslin(igs),iadbox, key ,
358 . sbufbox,titr ,mess ,tagt,
359 . nn ,lsubmodel)
360 iadboxmax = max(iadbox,iadboxmax)
361 IF (iadbox>sbufbox .OR. iadbox<0)
362 . CALL ancmsg(msgid=1007,msgtype=msgerror,anmode=anstop)
363 IF(numelp > 0)
364 . CALL hm_bigsbox(numelp ,ixp ,nixp ,2 ,3 ,5 ,
365 . x ,nseg ,flag ,skew,
366 . iskn ,0 ,itabm1 ,ibox ,
367 . id ,bufbox ,igrslin(igs),iadbox, key ,
368 . sbufbox,titr ,mess ,tagp ,
369 . nn ,lsubmodel)
370 IF (iadbox>sbufbox .OR. iadbox<0)
371 . CALL ancmsg(msgid=1007,msgtype=msgerror,anmode=anstop)
372 iadboxmax = max(iadbox,iadboxmax)
373 IF (flag == 0) THEN
374 igrslin(igs)%NSEG = nseg
375 ELSEIF (flag == 1) THEN
376 igrslin(igs)%NSEG = nseg
377 ENDIF
378 ENDIF
379 ENDDO
380 DEALLOCATE(tagt,tagp)
381 IF(ALLOCATED(bufbox))DEALLOCATE(bufbox)
382 ENDIF ! IF(IT8 /= 0)
383C---
384C=======================================================================
385C ligne de SUBSETS,PART,MAT,PROP
386C=======================================================================
387 IF(it2/=0.OR.it6/=0) THEN
388 ALLOCATE( surf_elm(npart) )
389 mode = 2
390 CALL init_surf_elm(ibid ,ibid ,ibid ,ibid ,ibid ,
391 1 numelt ,numelp ,numelr ,npart ,ibid ,
392 2 ibid ,ibid ,ipartt ,ipartp ,ipartr ,
393 3 surf_elm,mode )
394 ENDIF
395
396 IF(it2 /= 0) THEN
397 CALL hm_option_start('/LINE')
398 titr1='LINE'
399 DO igs=1,nslin
400 CALL hm_option_read_key(lsubmodel,
401 . option_id = id,
402 . option_titr = titr ,
403 . unit_id = uid,
404 . keyword2 = key ,
405 . keyword3 = key2)
406 nseg=0
407 kline=line
408 IF (key(1:4) == 'PART'.OR.key(1:6) == 'SUBSET'.OR. key(1:3) == 'MAT' .OR.key(1:4) == 'PROP') THEN
409 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
410 nseg0 = igrslin(igs)%NSEG
411 CALL my_alloc(igrslin(igs)%NODES,nseg0,2)
412 igrslin(igs)%NODES(1:nseg0,1:2) = 0
413 CALL my_alloc(igrslin(igs)%ELTYP,nseg0)
414 igrslin(igs)%ELTYP(1:nseg0) = 0
415 CALL my_alloc(igrslin(igs)%ELEM,nseg0)
416 igrslin(igs)%ELEM(1:nseg0) = 0
417 CALL my_alloc(igrslin(igs)%PROC,nseg0)
418 igrslin(igs)%PROC(1:nseg0) = 0
419 ENDIF
420 CALL hm_tagpart2(buftmp,ipart ,key ,
421 . igrslin(igs)%ID,titr,titr1,indx,nindx ,
422 . flag,subset,lsubmodel,map_tables%IPARTM)
423 CALL surftag(numelt,ixt,nixt,2,3,4,ipartt,
424 . buftmp,igrslin(igs),nseg,flag,nindx,
425 . indx,surf_elm)
426 CALL surftag(numelp,ixp,nixp,2,3,5,ipartp,
427 . buftmp,igrslin(igs),nseg,flag,nindx,
428 . indx,surf_elm)
429 IF (key(1:3) /= 'MAT')
430 . CALL surftag(numelr,ixr,nixr,2,3,6,ipartr,
431 . buftmp,igrslin(igs),nseg,flag,nindx,
432 . indx,surf_elm)
433 IF (key(1:4) == 'PART')
434 . CALL surftagx(numelx,ixx,kxx,nixx,8,ipartx,
435 . buftmp,igrslin(igs),nseg,flag)
436 IF (flag == 0) igrslin(igs)%NSEG = nseg
437 ENDIF
438 ! reset BUFTMP to 0 (only where it was set to 1/-1)
439 DO ii=1,nindx
440 buftmp(indx(ii))=0
441 END DO
442 nindx=0
443 ENDDO
444 ENDIF
445
446C=======================================================================
447C ligne de SUBMODELS
448C=======================================================================
449 igs=0
450 IF (it6 > 0)THEN
451 CALL hm_option_start('/LINE')
452 titr1='LINE'
453 DO igs=1,nslin
454 CALL hm_option_read_key(lsubmodel,
455 . option_id = id,
456 . option_titr = titr ,
457 . unit_id = uid,
458 . keyword2 = key ,
459 . keyword3 = key2)
460 nseg=0
461 IF (key(1:6)=='SUBMOD') THEN
462 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
463 nseg0 = igrslin(igs)%NSEG
464 CALL my_alloc(igrslin(igs)%NODES,nseg0,2)
465 igrslin(igs)%NODES(1:nseg0,1:2) = 0
466 CALL my_alloc(igrslin(igs)%ELTYP,nseg0)
467 igrslin(igs)%ELTYP(1:nseg0) = 0
468 CALL my_alloc(igrslin(igs)%ELEM,nseg0)
469 igrslin(igs)%ELEM(1:nseg0) = 0
470 CALL my_alloc(igrslin(igs)%PROC,nseg0)
471 igrslin(igs)%PROC(1:nseg0) = 0
472 ENDIF
473!
474 CALL hm_submodpart(isubmod,buftmp,ipart,id ,flag ,
475 . mess ,titr ,titr1,indx,nindx,
476 . lsubmodel)
477 CALL surftag(numelt,ixt,nixt,2,3,4,ipartt,
478 . buftmp,igrslin(igs),nseg,flag,nindx,
479 . indx,surf_elm)
480 CALL surftag(numelp,ixp,nixp,2,3,5,ipartp,
481 . buftmp,igrslin(igs),nseg,flag,nindx,
482 . indx,surf_elm)
483 CALL surftag(numelr,ixr,nixr,2,3,6,ipartr,
484 . buftmp,igrslin(igs),nseg,flag,nindx,
485 . indx,surf_elm)
486 IF (flag == 0) igrslin(igs)%NSEG = nseg
487 ENDIF
488C reset BUFTMP to 0 (only where it was set to 1/-1)
489 DO ii=1,nindx
490 buftmp(indx(ii))=0
491 END DO
492 nindx=0
493 ENDDO
494 ENDIF
495C=======================================================================
496C ligne de bord de surface
497C=======================================================================
498 IF (it5 /= 0) THEN
499 CALL hm_option_start('/LINE')
500 titr1='LINE'
501 DO igs=1,nslin
502 CALL hm_option_read_key(lsubmodel,
503 . option_id = id,
504 . option_titr = titr ,
505 . unit_id = uid,
506 . keyword2 = key ,
507 . keyword3 = key2)
508 IF (key(1:4) == 'SURF' .OR. key(1:4) == 'EDGE') THEN
509 iad0 =1
510 nseg =0
511 nseg0=0
512 CALL hm_get_intv ('idsmax' ,nentity,is_available,lsubmodel)
513 DO kk=1,nentity
514 CALL hm_get_int_array_index ('ids' ,jj ,kk,is_available,lsubmodel)
515 IF (jj /= 0) THEN
516 igrs=0
517 DO k=1,nsurf
518 IF (jj == igrsurf(k)%ID) THEN
519 igrs=k
520 EXIT
521 ENDIF
522 ENDDO
523 IF (igrs /= 0) THEN
524 nseg0=nseg0+igrsurf(igrs)%NSEG
525 DO k=0,igrsurf(igrs)%NSEG-1
526 buftmp(iad0+6*k) = igrsurf(igrs)%NODES(k+1,1)
527 buftmp(iad0+6*k+1) = igrsurf(igrs)%NODES(k+1,2)
528 buftmp(iad0+6*k+2) = igrsurf(igrs)%NODES(k+1,3)
529 buftmp(iad0+6*k+3) = igrsurf(igrs)%NODES(k+1,4)
530 buftmp(iad0+6*k+4) = igrsurf(igrs)%ELTYP(k+1)
531 buftmp(iad0+6*k+5) = igrsurf(igrs)%ELEM(k+1)
532 DO jj=1,6
533 nindx=nindx+1
534 indx(nindx)=iad0+6*k+jj-1
535 ENDDO
536 ENDDO
537 iad0=iad0+6*igrsurf(igrs)%NSEG
538 ENDIF
539 ENDIF
540 ENDDO
541 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
542 CALL my_alloc(igrslin(igs)%NODES, igrslin(igs)%NSEG,2)
543 igrslin(igs)%NODES(1:igrslin(igs)%NSEG,1:2) = 0
544 CALL my_alloc(igrslin(igs)%ELTYP,igrslin(igs)%NSEG)
545 igrslin(igs)%ELTYP(1:igrslin(igs)%NSEG) = 0
546 CALL my_alloc(igrslin(igs)%ELEM,igrslin(igs)%NSEG)
547 igrslin(igs)%ELEM(1:igrslin(igs)%NSEG) = 0
548 CALL my_alloc(igrslin(igs)%PROC,igrslin(igs)%NSEG)
549 igrslin(igs)%PROC(1:igrslin(igs)%NSEG) = 0
550 ENDIF
551 IF (nseg0 > 0) THEN
552 line_nseg0 = 1
553 IF (flag == 1) line_nseg0 = igrslin(igs)%NSEG
554 CALL linedge(nseg0 ,nseg ,buftmp,igrslin(igs)%NODES ,key,
555 . flag ,igrslin(igs)%ELTYP,igrslin(igs)%ELEM,
556 . line_nseg0)
557 ENDIF
558 IF (flag == 0) igrslin(igs)%NSEG = nseg
559 ENDIF
560 !reset BUFTMP to 0 (only where it was set to 1/-1)
561 DO ii=1,nindx
562 buftmp(indx(ii))=0
563 END DO
564 nindx=0
565 ENDDO
566 ENDIF
567C=======================================================================
568C LIGNE FORMEE DE GROUPE DE TRUSS POUTRE RESSORT
569C=======================================================================
570 IF (it4 /= 0) THEN
571 CALL hm_option_start('/LINE')
572 titr1='LINE'
573 DO igs=1,nslin
574 CALL hm_option_read_key(lsubmodel,
575 . option_id = id,
576 . option_titr = titr ,
577 . unit_id = uid,
578 . keyword2 = key ,
579 . keyword3 = key2)
580 nseg=0
581 nseg_tot=0
582 IF (key(1:2) == 'GR'.OR.key(1:4) == 'WIRE') THEN
583 IF (flag == 1) THEN ! NSEG counted at FLAG = 0
584 nseg0 = igrslin(igs)%NSEG
585 CALL my_alloc(igrslin(igs)%NODES,nseg0,2)
586 igrslin(igs)%NODES(1:nseg0,1:2) = 0
587 CALL my_alloc(igrslin(igs)%ELTYP,igrslin(igs)%NSEG)
588 igrslin(igs)%ELTYP(1:igrslin(igs)%NSEG) = 0
589 CALL my_alloc(igrslin(igs)%ELEM,igrslin(igs)%NSEG)
590 igrslin(igs)%ELEM(1:igrslin(igs)%NSEG) = 0
591 CALL my_alloc(igrslin(igs)%PROC,nseg0)
592 igrslin(igs)%PROC(1:nseg0) = 0
593 ENDIF
594 IF(key(1:6) == 'GRSPRI') THEN
595 numel=numelr
596 CALL hm_surfgr2(ngrspri,key(1:6),numel,igrslin(igs)%ID,
597 . igrspring,buftmp,titr,titr1,
598 . indx,nindx,flag,ibid,ibid,
599 . ibid,ibid,flag_grbric,lsubmodel)
600 CALL surftage(numelr,ixr,nixr,2,3,6,
601 . buftmp,igrslin(igs),nseg,flag,
602 . indx,nindx,nseg_tot)
603 ELSEIF(key(1:6) == 'GRTRUS') THEN
604 numel=numelt
605 CALL hm_surfgr2(ngrtrus,key(1:6),numel,igrslin(igs)%ID,
606 . igrtruss,buftmp,titr,titr1,
607 . indx,nindx,flag,ibid,ibid,
608 . ibid,ibid,flag_grbric,lsubmodel)
609 CALL surftage(numelt,ixt,nixt,2,3,4,
610 . buftmp,igrslin(igs),nseg,flag,
611 . indx,nindx,nseg_tot)
612 ELSEIF(key(1:6) == 'GRBEAM') THEN
613 numel=numelp
614 CALL hm_surfgr2(ngrbeam,key(1:6),numel,igrslin(igs)%ID,
615 . igrbeam,buftmp,titr,titr1,
616 . indx,nindx,flag,ibid,ibid,
617 . ibid,ibid,flag_grbric,lsubmodel)
618 CALL surftage(numelp,ixp,nixp,2,3,5,
619 . buftmp,igrslin(igs),nseg,flag,
620 . indx,nindx,nseg_tot)
621 ENDIF
622 IF (flag == 0) igrslin(igs)%NSEG = nseg
623 ENDIF
624 ! reset BUFTMP to 0 (only where it was set to 1/-1)
625 DO ii=1,nindx
626 buftmp(indx(ii))=0
627 END DO
628 nindx=0
629C-----------
630 ENDDO
631 ENDIF
632C=======================================================================
633 DEALLOCATE(buftmp,indx)
634 IF(it2/=0.OR.it6/=0) THEN
635! deallocation of SURT_ELM structure
636 mode = 2
637 CALL deallocate_surf_elm(npart,surf_elm,mode)
638 DEALLOCATE( surf_elm )
639 ENDIF
640 RETURN
641 900 CONTINUE
642c Il n y a pas de label 900 ...
643 CALL ancmsg(msgid=189,msgtype=msgerror,anmode=aninfo,i1=igrslin(igs)%ID)
644 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
hm_bigsbox
subroutine hm_bigsbox(numel, ix, nix, nix1, nix2, ieltyp, x, nseg, flag, skew, iskn, isurf0, itabm1, ibox, id, ibufbox, isurflin, iadb, key, sbufbox, titr, mess, tagshellbox, nn, lsubmodel)
Definition hm_bigsbox.F:44
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_submodpart
subroutine hm_submodpart(isubmod, tagbuf, ipart, id, flag, mess, titr, titr1, indx, nindx, lsubmodel)
Definition hm_submodpart.F:41
hm_surfgr2
subroutine hm_surfgr2(ngrele, elchar, numel, id, igrelem, tagbuf, titr, titr1, indx, nindx, flag, nindx_sol, nindx_sol10, indx_sol, indx_sol10, flag_grbric, lsubmodel)
Definition hm_surfgr2.F:40
hm_tagpart2
subroutine hm_tagpart2(bufftmp, ipart, key, id, titr, titr1, indx, nindx, flag, subset, lsubmodel, map)
Definition hm_tagpart2.F:43
init_surf_elm
subroutine init_surf_elm(numels, numels8, numels10, numelc, numeltg, numelt, numelp, numelr, npart, iparts, ipartc, iparttg, ipartt, ipartp, ipartr, surf_elm, mode)
Definition init_surf_elm.F:35
deallocate_surf_elm
subroutine deallocate_surf_elm(npart, surf_elm, mode)
Definition init_surf_elm.F:200
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
linedge
subroutine linedge(nseg0, nseg, buftmp, slin_nodes, key, flag, slin_eltyp, slin_elem, line_nseg0)
Definition linedge.F:32
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
mapping_option_mod
Definition dichotomy_mod.F:36
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
surf_mod
Definition surf_mod.F:37
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
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
submodel_mod::submodel_data
Definition submodel_mod.F:723
surftag
subroutine surftag(numel, ix, nix, nix1, nix2, ieltyp, iparte, tagbuf, isu, nseg, flag, nindx, indx, surf_elm)
Definition surftag.F:34
surftagx
subroutine surftagx(numel, ixx, kxx, nixx, ieltyp, iparte, tagbuf, igrslin, nseg, flag)
Definition surftag.F:209
surftage
subroutine surftage(numel, ix, nix, nix1, nix2, ieltyp, tagbuf, isu, nseg, flag, indx, nindx, nseg_tot)
Definition surftage.F:33