OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_node.F File Reference
#include "implicit_f.inc"
#include "hash_id.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "titr_c.inc"
#include "sphcom.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_node (x, itab, itabm1, cmerge, unitab, wige, lsubmodel, is_dyna)

Function/Subroutine Documentation

◆ hm_read_node()

subroutine hm_read_node ( dimension(3,*), intent(out) x,
integer, dimension(*), intent(out) itab,
integer, dimension(*), intent(out) itabm1,
dimension(*), intent(out) cmerge,
type (unit_type_), intent(in) unitab,
dimension(*), intent(out) wige,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) is_dyna )

Definition at line 42 of file hm_read_node.F.

44C-----------------------------------------------
45C ROUTINE DESCRIPTION :
46C ===================
47C READ /NODE ELEMENTS USING HM_READER
48C READ /CNODE ELEMENTS USING 'READ IN FILE'
49C-----------------------------------------------
50C DUMMY ARGUMENTS DESCRIPTION:
51C ===================
52C
53C NAME DESCRIPTION
54C
55C X NODE COORDS
56C ITAB USER ID OF NODES
57C ITABM1 REVERSE TAB ITA
58C CMERGE CNODE MERGING DISTANCE
59C UNITAB UNITS ARRAY
60C WIGE WEIGHT FOR IGEO ANALYSIS
61C LSUBMODEL SUBMODEL STRUCTURE
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE unitab_mod
66 USE message_mod
67 USE submodel_mod
68 USE hm_option_read_mod
69 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
70 USE format_mod , ONLY : fmt_i_3f
71 USE user_id_mod , ONLY : id_limit
72 USE sph_mod, ONLY : xi_res, yi_res, zi_res
73C-----------------------------------------------
74C I m p l i c i t T y p e s
75C-----------------------------------------------
76#include "implicit_f.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80C INPUT ARGUMENTS
81 INTEGER, INTENT(IN) :: IS_DYNA
82 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
83 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
84C OUTPUT ARGUMENTS
85 INTEGER,INTENT(OUT)::ITAB(*)
86 INTEGER,INTENT(OUT)::ITABM1(*)
87 my_real, INTENT(OUT)::x(3,*)
88 my_real, INTENT(OUT)::cmerge(*)
89 my_real, INTENT(OUT)::wige(*)
90C-----------------------------------------------
91C C o m m o n B l o c k s
92C-----------------------------------------------
93#include "hash_id.inc"
94#include "com01_c.inc"
95#include "com04_c.inc"
96#include "units_c.inc"
97#include "scr03_c.inc"
98#include "scr16_c.inc"
99#include "scr17_c.inc"
100#include "titr_c.inc"
101#include "sphcom.inc"
102#include "remesh_c.inc"
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER :: N,I,J,STAT
107 INTEGER :: NUMNUSR,NUMNUSR1,NUMNAUX,KSPHRES,NUMNUSR2
108 INTEGER :: UID, IFLAGUNIT, ID
109 my_real :: x1,x2,x3,xmin,ymin,zmin,xmax,ymax,zmax,fac_l,w
110 CHARACTER(LEN=NCHARLINE) :: LLINE
111 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_NOD,UID_NOD,ITAB_TMP,ITABM1_TMP
112 real*8, DIMENSION(:,:), ALLOCATABLE :: hm_x
113 my_real, DIMENSION(:,:), ALLOCATABLE :: x_tmp
114 LOGICAL :: IS_AVAILABLE
115 real*8, DIMENSION(:), ALLOCATABLE :: dmerge
116C-----------------------------------------------
117C E x t e r n a l F u n c t i o n s
118C-----------------------------------------------
119 INTEGER USRTOS
120C=======================================================================
121 fac_l = one
122
123 xmin = ep20
124 ymin = ep20
125 zmin = ep20
126 xmax =-ep20
127 ymax =-ep20
128 zmax =-ep20
129C--------------------------------------------------
130C ALLOCS & INITS
131C--------------------------------------------------
132 CALL cpp_nodes_count(numnusr1,numnusr2)
133 ALLOCATE (sub_nod(numnusr1),stat=stat)
134 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_NOD')
135 ALLOCATE (uid_nod(numnusr1),stat=stat)
136 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='UID_NOD')
137 ALLOCATE (hm_x(3,numnusr1),stat=stat)
138 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_X')
139 ALLOCATE (dmerge(numnusr2),stat=stat)
140 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='DMERGE')
141 sub_nod(1:numnusr1) = 0
142 uid_nod(1:numnusr1) = 0
143 hm_x(1:3,1:numnusr1) = 0
144 dmerge(1:numnusr2) = zero
145
146 IF(is_dyna==0)THEN
147C--------------------------------------------------
148C READING NODES INPUTS IN HM STRUCTURE
149C----------------------------------------------------
150 w = zero
151 CALL cpp_node_read(itab,hm_x,w,sub_nod,uid_nod)
152C----------------------------------------------------
153C FILL OTHER STRUCTURES + CHECKS
154C----------------------------------------------------
155 uid = -1
156 n = 0
157 DO i=1,numnusr1
158 n=n+1
159 x(1,n) = hm_x(1,n)
160 x(2,n) = hm_x(2,n)
161 x(3,n) = hm_x(3,n)
162C---------------------------------------------------
163C SUBMODEL OFFSET
164C---------------------------------------------------
165 IF(sub_nod(n) /= 0)THEN
166 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID /= 0) uid_nod(n) = lsubmodel(sub_nod(n))%UID
167 ENDIF
168C---------------------------------------------------
169C UNITS
170C---------------------------------------------------
171 IF(uid_nod(n) /= uid )THEN
172 uid = uid_nod(n)
173 iflagunit = 0
174 DO j=1,unitab%NUNITS
175 IF (unitab%UNIT_ID(j) == uid) THEN
176 fac_l = unitab%FAC_L(j)
177 iflagunit = 1
178 EXIT
179 ENDIF
180 ENDDO
181 IF (uid/=0 .AND. iflagunit==0)THEN
182 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/NODE')
183 ENDIF
184 ENDIF
185 x(1,n) = x(1,n)*fac_l
186 x(2,n) = x(2,n)*fac_l
187 x(3,n) = x(3,n)*fac_l
188C----------------------------------------------------
189 IF(numelig3d > 0) wige(n) = w
190 xmin=min(xmin,x(1,n))
191 ymin=min(ymin,x(2,n))
192 zmin=min(zmin,x(3,n))
193 xmax=max(xmax,x(1,n))
194 ymax=max(ymax,x(2,n))
195 zmax=max(zmax,x(3,n))
196 ENDDO
197 ELSE ! IF(IS_DYNA==0)THEN
198C
199C Possible nodes merging!
200 ALLOCATE (itab_tmp(numnusr1),stat=stat)
201 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ITAB_TMP')
202 ALLOCATE (itabm1_tmp(2*numnusr1),stat=stat)
203 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ITABM1_TMP')
204 ALLOCATE (x_tmp(3,numnusr1),stat=stat)
205 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='X_TMP')
206C--------------------------------------------------
207C READING NODES INPUTS IN HM STRUCTURE
208C----------------------------------------------------
209 w = zero
210 CALL cpp_node_read(itab_tmp,hm_x,w,sub_nod,uid_nod)
211C----------------------------------------------------
212C FILL OTHER STRUCTURES + CHECKS
213C----------------------------------------------------
214 uid = -1
215 n = 0
216 DO i=1,numnusr1
217 n=n+1
218 x_tmp(1,n) = hm_x(1,n)
219 x_tmp(2,n) = hm_x(2,n)
220 x_tmp(3,n) = hm_x(3,n)
221C---------------------------------------------------
222C SUBMODEL OFFSET
223C---------------------------------------------------
224 IF(sub_nod(n) /= 0)THEN
225 IF(uid_nod(n) == 0 .AND. lsubmodel(sub_nod(n))%UID /= 0)
226 . uid_nod(n) = lsubmodel(sub_nod(n))%UID
227 ENDIF
228C---------------------------------------------------
229C UNITS
230C---------------------------------------------------
231 IF(uid_nod(n) /= uid )THEN
232 uid = uid_nod(n)
233 iflagunit = 0
234 DO j=1,unitab%NUNITS
235 IF (unitab%UNIT_ID(j) == uid) THEN
236 fac_l = unitab%FAC_L(j)
237 iflagunit = 1
238 EXIT
239 ENDIF
240 ENDDO
241 IF (uid/=0 .AND. iflagunit==0)THEN
242 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/NODE')
243 ENDIF
244 ENDIF
245 x_tmp(1,n) = x_tmp(1,n)*fac_l
246 x_tmp(2,n) = x_tmp(2,n)*fac_l
247 x_tmp(3,n) = x_tmp(3,n)*fac_l
248C----------------------------------------------------
249 IF(numelig3d > 0) wige(n) = w
250 xmin=min(xmin,x_tmp(1,n))
251 ymin=min(ymin,x_tmp(2,n))
252 zmin=min(zmin,x_tmp(3,n))
253 xmax=max(xmax,x_tmp(1,n))
254 ymax=max(ymax,x_tmp(2,n))
255 zmax=max(zmax,x_tmp(3,n))
256 ENDDO
257C--------------------------------------------------
258C USER NODE: INVERSE ARRAY
259C--------------------------------------------------
260 CALL constit(itab_tmp,itabm1_tmp,numnusr1)
261C
262C Compaction of ITAB and X (cf /MERGE/NODE) - Nodes are sorted by ID
263 numnaux = 1
264 itab(1) = itabm1_tmp(1)
265 x(1:3,1) = x_tmp(1:3,itabm1_tmp(numnusr1+1))
266 DO i=2,numnusr1
267 IF(itabm1_tmp(numnusr1+i) == itabm1_tmp(numnusr1+i-1)) cycle ! Twice the same ID
268 numnaux = numnaux + 1
269 itab(numnaux) = itabm1_tmp(i)
270 x(1:3,numnaux) = x_tmp(1:3,itabm1_tmp(numnusr1+i))
271 ENDDO
272 numnusr1 = numnaux
273C--------------------------------------------------
274 IF(ALLOCATED(itab_tmp)) DEALLOCATE(itab_tmp)
275 IF(ALLOCATED(itabm1_tmp)) DEALLOCATE(itabm1_tmp)
276 IF(ALLOCATED(x_tmp)) DEALLOCATE(x_tmp)
277 END IF ! IF(IS_DYNA==0)THEN
278C--------------------------------------------------
279 IF(ALLOCATED(sub_nod)) DEALLOCATE(sub_nod)
280 IF(ALLOCATED(uid_nod)) DEALLOCATE(uid_nod)
281 IF(ALLOCATED(hm_x)) DEALLOCATE(hm_x)
282C--------------------------------------------------
283C READING CNODES INPUTS IN HM STRUCTURE
284C--------------------------------------------------
285C
286 IF(numnusr2 /= 0) THEN
287 ALLOCATE (itab_tmp(numnusr2),stat=stat)
288 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='ITAB_TMP')
289 ALLOCATE (sub_nod(numnusr2),stat=stat)
290 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_NOD')
291 ALLOCATE (uid_nod(numnusr2),stat=stat)
292 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='UID_NOD')
293 ALLOCATE (hm_x(3,numnusr2),stat=stat)
294 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='HM_X')
295
296 itab_tmp(1:numnusr2) = 0
297 sub_nod(1:numnusr2) = 0
298 uid_nod(1:numnusr2) = 0
299 hm_x(1:3,1:numnusr2) = zero
300
301 CALL cpp_cnode_read(itab_tmp,hm_x,dmerge,sub_nod,uid_nod)
302 n = numnusr1
303 DO i=1,numnusr2
304 n = n + 1
305C---------------------------------------------------
306C SUBMODEL OFFSET
307C---------------------------------------------------
308 IF(sub_nod(i) /= 0)THEN
309 IF(uid_nod(i) == 0 .AND. lsubmodel(sub_nod(i))%UID /= 0)
310 . uid_nod(i) = lsubmodel(sub_nod(i))%UID
311 ENDIF
312 itab(n) = itab_tmp(i)
313C---------------------------------------------------
314C UNITS
315C---------------------------------------------------
316 IF(uid_nod(i) /= uid )THEN
317 uid = uid_nod(i)
318 iflagunit = 0
319 DO j=1,unitab%NUNITS
320 IF (unitab%UNIT_ID(j) == uid) THEN
321 fac_l = unitab%FAC_L(j)
322 iflagunit = 1
323 EXIT
324 ENDIF
325 ENDDO
326 IF (uid/=0 .AND. iflagunit==0)THEN
327 CALL ancmsg(msgid=643,anmode=aninfo,msgtype=msgerror,i1=uid,c1='/CNODE')
328 ENDIF
329 ENDIF
330 x(1,n) = hm_x(1,i)*fac_l
331 x(2,n) = hm_x(2,i)*fac_l
332 x(3,n) = hm_x(3,i)*fac_l
333 cmerge(i) = dmerge(i) * fac_l
334 xmin=min(xmin,x(1,n))
335 ymin=min(ymin,x(2,n))
336 zmin=min(zmin,x(3,n))
337 xmax=max(xmax,x(1,n))
338 ymax=max(ymax,x(2,n))
339 zmax=max(zmax,x(3,n))
340 ENDDO
341 IF(ALLOCATED(itab_tmp)) DEALLOCATE(itab_tmp)
342 IF(ALLOCATED(sub_nod)) DEALLOCATE(sub_nod)
343 IF(ALLOCATED(uid_nod)) DEALLOCATE(uid_nod)
344 IF(ALLOCATED(hm_x)) DEALLOCATE(hm_x)
345 END IF
346 numnusr = n
347C Here : NUMNUSR == NUMNOD0 !
348C--------------------------------------------------
349C SPH RESERVE
350C--------------------------------------------------
351 x1=xmin-fourth*(xmax-xmin)
352 x2=ymin-fourth*(ymax-ymin)
353 x3=zmin-fourth*(zmax-zmin)
354
355 xi_res = x1
356 yi_res = x2
357 zi_res = x3
358
359 CALL hm_option_start('/SPH/RESERVE')
360 i =numnusr
361 isphres=i
362 DO n=1,nbpartinlet
363 CALL hm_option_read_key(lsubmodel,option_id = id)
364 CALL hm_get_intv('np',KSPHRES,IS_AVAILABLE,LSUBMODEL)
365c KSPHRES by proc
366 DO J=1,KSPHRES*NSPMD
367 I =I+1
368 ITAB(I)=ID_LIMIT%ADMESH_LT_NODE_AUTO
369 ID_LIMIT%ADMESH_LT_NODE_AUTO=ID_LIMIT%ADMESH_LT_NODE_AUTO+1
370 X(1,I)=X1
371 X(2,I)=X2
372 X(3,I)=X3
373 ENDDO
374 ENDDO
375C--------------------------------------------------
376C Solids TO SPH
377 FIRSTNOD_SPHSOL=I+1
378 DO N=1,NSPHSOL
379 I=I+1
380 ITAB(I)=ID_LIMIT%ADMESH_LT_NODE_AUTO
381 ID_LIMIT%ADMESH_LT_NODE_AUTO=ID_LIMIT%ADMESH_LT_NODE_AUTO+1
382 X(1,I) =ZERO
383 X(2,I) =ZERO
384 X(3,I) =ZERO
385 END DO
386C--------------------------------------------------
387C TABN for additional nodes
388 IF(NADMESH/=0)THEN
389 IF(NUMNOD-NUMNOD0>100000000)THEN
390 CALL ANCMSG(MSGID=645,
391 . MSGTYPE=MSGERROR,
392 . ANMODE=ANINFO)
393 ENDIF
394 DO N=NUMNOD0+1,NUMNOD
395 ITAB(N)=ID_LIMIT%ADMESH+N-NUMNOD0-NUMCNOD
396 END DO
397 END IF
398C--------------------------------------------------
399C IGE: deprecated
400C--------------------------------------------------
401
402 IF(NADIGEMESH/=0)THEN
403 IF(NUMNOD-NUMNODIGE0>100000000)THEN
404 CALL ANCMSG(MSGID=645,
405 . MSGTYPE=MSGERROR,
406 . ANMODE=ANINFO)
407 ENDIF
408 DO N=NUMNODIGE0+1,NUMNOD
409 ITAB(N)=ID_LIMIT%ADMESH+N-NUMNODIGE0
410 END DO
411 END IF
412C--------------------------------------------------
413 DO N=1,64*NUMELIG3D
414 ID_LIMIT%ADMESH_LT_NODE_AUTO=ID_LIMIT%ADMESH_LT_NODE_AUTO+1
415 END DO
416C--------------------------------------------------
417 CALL CONSTIT(ITAB,ITABM1,NUMNOD)
418
419 CALL C_NEW_HASH(H_NODE,NUMNOD)
420 DO I=1,NUMNOD
421 CALL C_HASH_INSERT(H_NODE,ITAB(I),I)
422 ENDDO
423
424C--------------------------------------------------
425C X from file Ynn
426C--------------------------------------------------
427.OR..OR. IF (ISIGI==3ISIGI==4ISIGI==5) THEN
428C
429 120 READ(IIN4,FMT='(a)',END=199,ERR=199)LLINE
430 IF(LLINE(1:33)/='/nodal /vector /coordinate')GOTO 120
431 READ(IIN4,FMT='(a)',END=199,ERR=199)LLINE
432C
433 IF (IOUTP_FMT==2) THEN
434 125 READ(IIN4,FMT='(a)',END=130,ERR=199)LLINE
435 IF(LLINE(1:1)=='#')GOTO 125
436 IF(lline(1:1)=='/')GOTO 130
437 READ(lline,'(I8,3F16.0)')n,x1,x2,x3
438 i = usrtos(n,itabm1)
439 IF(i/=0)THEN
440 x(1,i) = x1
441 x(2,i) = x2
442 x(3,i) = x3
443 ENDIF
444 GOTO 125
445 ELSE
446 126 READ(iin4,fmt='(A)',END=130,ERR=199)lline
447 IF(lline(1:1)=='#')GOTO 126
448 IF(lline(1:1)=='/')GOTO 130
449 READ(lline,fmt=fmt_i_3f) n,x1,x2,x3
450 i = usrtos(n,itabm1)
451 IF(i/=0)THEN
452 x(1,i) = x1
453 x(2,i) = x2
454 x(3,i) = x3
455 ENDIF
456 GOTO 126
457 ENDIF
458 130 CONTINUE
459 199 CONTINUE
460 rewind(iin4)
461C
462 ENDIF
463C--------------------------------
464 j=0
465 IF (ipri > 3)THEN
466 DO n=1,numnusr1,50
467
468 j=j+50
469 j=min(j,numnusr1)
470 WRITE(iout,'(//A/A//A/)')titre(70),titre(71),titre(72)
471 DO i=n,j
472 WRITE(iout,'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
473 ENDDO
474 ENDDO
475C
476 DO n=numnusr1+1,numnusr,50
477 j=j+50
478 j=min(j,numnusr)
479 WRITE(iout,'(A)')titre(117)
480 DO i=n,j
481 WRITE(iout,'(5X,I10,8X,1P3G20.13)')itab(i),x(1,i),x(2,i),x(3,i)
482 ENDDO
483 ENDDO
484 ENDIF
485C--------------------------------
486 IF (ipri > 6)THEN
487 IF(numnod > numnusr)THEN
488 DO n=numnusr+1,numnod,50
489 j=j+50
490 j=min(j,numnod)
491 WRITE(iout,'(//A)')' COORDINATES OF NODES FOR SPH RESERVES'
492 WRITE(iout,'(A)') ' -------------------------------------'
493 WRITE(iout,'(A/)')titre(72)
494 DO i=n,j
495 WRITE(iout,'(5X,I10,8X,1P3G20.13)') itab(i),x(1,i),x(2,i),x(3,i)
496 ENDDO
497 ENDDO
498 ENDIF
499 ENDIF
500C--------------------------------------------------
501 RETURN
constit
subroutine constit(itab, itabm1, numnod)
Definition constit.F:35
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
sph_mod
Definition sph_mod.F:31
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
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:895
usrtos
integer function usrtos(iu, itabm1)
Definition sysfus.F:240