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 41 of file hm_read_node.F.

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