OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_paral.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_rwall_paral (rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchparal, k, offs, ikine1)

Function/Subroutine Documentation

◆ hm_read_rwall_paral()

subroutine hm_read_rwall_paral ( rwl,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer ifi,
ms,
v,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
x,
integer, dimension(*) ikine,
type (group_), dimension(ngrnod), target igrnod,
integer mfi,
integer, dimension(*) imerge,
type (unit_type_), intent(in) unitab,
integer iddlevel,
type(submodel_data), dimension(nsubmod) lsubmodel,
rtrans,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) itagnd,
integer nchparal,
integer k,
integer offs,
integer, dimension(3*numnod) ikine1 )

Definition at line 47 of file hm_read_rwall_paral.F.

52C-------------------------------------
53C READING MUR RIGIDE
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE unitab_mod
58 USE submodel_mod , ONLY : nsubmod, submodel_data
59 USE message_mod
60 USE r2r_mod
61 USE groupdef_mod
62 USE hm_option_read_mod
63 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C A n a l y s e M o d u l e
70C-----------------------------------------------
71#include "analyse_name.inc"
72C-----------------------------------------------
73C C o m m o n B l o c k s
74C-----------------------------------------------
75#include "com04_c.inc"
76#include "units_c.inc"
77#include "scr03_c.inc"
78#include "scr17_c.inc"
79#include "param_c.inc"
80#include "tabsiz_c.inc"
81#include "r2r_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
86 INTEGER :: IFI,MFI,IDDLEVEL,NCHPARAL,K,OFFS
87 INTEGER :: NPRW(*), LPRW(*), ITAB(*), ITABM1(*),IKINE(*), IMERGE(*),ITAGND(*),IKINE1(3*NUMNOD)
88 TYPE(SUBMODEL_DATA) :: LSUBMODEL(NSUBMOD)
89 my_real :: rwl(nrwlp,*), ms(*), v(3,*), x(3,*),rtrans(ntransf,*)
90 INTEGER NOM_OPT(LNOPT1,*)
91C-----------------------------------------------
92 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER N, ITYP, ITIED, NSL, NUSER, MSR, J, I,L, IGU,IGU2, IGRS, NOSYS, IFQ, JC,UID,IFLAGUNIT,SUB_ID, SUB_INDEX
97 my_real :: dist, fric, diam, xmas, vx, vy, vz, xm1, ym1, zm1, xm2, ym2, vn
98 my_real :: zm2, xn, x1, y1, z1, disn, x2, x3, freq, alpha, fac_m_r2r
99 CHARACTER MESS*40
100 CHARACTER(LEN=NCHARTITLE) :: TITR
101 LOGICAL :: IS_AVAILABLE
102 INTEGER :: IPEN
103C-----------------------------------------------
104C E x t e r n a l F u n c t i o n s
105C-----------------------------------------------
106 INTEGER USR2SYS, NGR2USR
107 INTEGER, DIMENSION(:), POINTER :: INGR2USR
108 DATA mess/'STANDARD RIGID WALL DEFINITION '/
109C=======================================================================
110C-----------------------------------------------
111! ******************************** !
112! RWALL/PARAM read with hm reader !
113! ******************************** !
114C-----------------------------------------------
115 is_available = .false.
116 CALL hm_option_start('/RWALL/PARAL')
117 ! Flag for RWALL type PARAL
118 ityp = 4
119 !----------------------------------------------------------------------
120 ! Loop over NCHPARAL
121 !----------------------------------------------------------------------
122 DO n = 1+offs, nchparal+offs
123C
124 ! Reading the option
125 ! /RWALL/type/rwall_ID/node_ID
126 ! rwall_title
127 titr = ''
128 CALL hm_option_read_key(lsubmodel,
129 . option_id = nuser,
130 . unit_id = uid,
131 . submodel_index = sub_index,
132 . submodel_id = sub_id,
133 . option_titr = titr)
134C
135 nom_opt(1,n) = nuser
136 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
137C
138 ! Checking flag unit
139 iflagunit = 0
140 DO j=1,unitab%NUNITS
141 IF (unitab%UNIT_ID(j) == uid) THEN
142 iflagunit = 1
143 EXIT
144 ENDIF
145 ENDDO
146 IF (uid /= 0 .AND. iflagunit == 0) THEN
147 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
148 . i2=uid,i1=nuser,c1='RIGID WALL',
149 . c2='RIGID WALL',
150 . c3=titr)
151 ENDIF
152C
153 ! node_ID Slide grnd_ID1 grnd_ID2
154 CALL hm_get_intv('Node1',nuser,is_available,lsubmodel)
155 CALL hm_get_intv('slidingflag',itied,is_available,lsubmodel)
156 CALL hm_get_intv('NodeSet_ID',igu,is_available,lsubmodel)
157 CALL hm_get_intv('excludeNodeSet_ID',igu2,is_available,lsubmodel)
158 CALL hm_get_intv('Iform',ipen,is_available,lsubmodel)
159C
160 IF(nuser /= 0) THEN
161 msr = usr2sys(nuser,itabm1,mess,nuser)
162 CALL anodset(msr, check_used)
163 DO jc = 1,nmerged
164 IF (msr == imerge(jc)) msr = imerge(numcnod+jc)
165 ENDDO
166 ELSE
167 msr = 0
168 ENDIF
169C
170 ! 2nd card
171 ! d fric Diameter ffac ifq
172 CALL hm_get_floatv('offset' ,dist ,is_available, lsubmodel, unitab)
173 CALL hm_get_floatv('fric' ,fric ,is_available, lsubmodel, unitab)
174 CALL hm_get_floatv('Diameter' ,diam ,is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('Filteringfactor',freq ,is_available, lsubmodel, unitab)
176 CALL hm_get_intv('Filteringflag' ,ifq ,is_available, lsubmodel)
177 IF (freq == 0 .AND. ifq /= 0) ifq = 0
178 IF (ifq == 0) freq = one
179 alpha = zero
180 IF (ifq >= 0) THEN
181 IF (ifq <= 1) alpha = freq
182 IF (ifq == 2) alpha = four*atan2(one,zero) / freq
183 IF (ifq == 3) alpha = four*atan2(one,zero) * freq
184 ENDIF
185 IF ((alpha < zero) .OR. ((alpha > one .AND. ifq <= 2))) THEN
186 CALL ancmsg(msgid=350,anmode=aninfo,msgtype=msgerror,
187 . i1=nuser,
188 . c1=titr,
189 . r1=freq)
190 ENDIF
191 rwl(13,n) = fric
192 rwl(14,n) = alpha
193 rwl(15,n) = ifq
194C
195 ! 3rd card
196 ! if node_ID == 0
197 IF (msr == 0) THEN
198 ! XM YM ZM
199 CALL hm_get_floatv('x' ,x1 ,is_available, lsubmodel, unitab)
200 CALL hm_get_floatv('y' ,x2 ,is_available, lsubmodel, unitab)
201 CALL hm_get_floatv('z' ,x3 ,is_available, lsubmodel, unitab)
202 IF(sub_id /= 0) CALL subrotpoint(x1,x2,x3,rtrans,sub_id,lsubmodel)
203 rwl(4,n) = x1
204 rwl(5,n) = x2
205 rwl(6,n) = x3
206 vx = zero
207 vy = zero
208 vz = zero
209 ! if node_ID > 0
210 ELSE IF (msr /= 0)THEN
211 ! Mass VX0 VY0 VZ0
212 CALL hm_get_floatv('Mass' ,xmas ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv('motionx' ,vx ,is_available, lsubmodel, unitab)
214 CALL hm_get_floatv('motiony' ,vy ,is_available, lsubmodel, unitab)
215 CALL hm_get_floatv('motionz' ,vz ,is_available, lsubmodel, unitab)
216 ! Multidomains : masse of the rwall splitted between 2 domains
217 fac_m_r2r = one
218 IF (nsubdom > 0) THEN
219 IF(tagno(npart+msr) == 4) fac_m_r2r = half
220 ENDIF
221 IF(sub_id /= 0) CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
222 rwl(4,n) = x(1,msr)
223 rwl(5,n) = x(2,msr)
224 rwl(6,n) = x(3,msr)
225 ms(msr) = ms(msr) + xmas*fac_m_r2r
226 v(1,msr) = vx
227 v(2,msr) = vy
228 v(3,msr) = vz
229 ENDIF
230C
231 ! 4th card (only for PLANE, CYL and PARAL)
232 ! XM1 YM1 ZM1
233 CALL hm_get_floatv('cnode1_x' ,xm1 ,is_available, lsubmodel, unitab)
234 CALL hm_get_floatv('cnode1_y' ,ym1 ,is_available, lsubmodel, unitab)
235 CALL hm_get_floatv('cnode1_z' ,zm1 ,is_available, lsubmodel, unitab)
236 IF(sub_id /= 0) CALL subrotpoint(xm1,ym1,zm1,rtrans,sub_id,lsubmodel)
237C
238 ! 5th card (only for PARAL)
239 ! XM2 YM2 ZM2
240 CALL hm_get_floatv('cnode2_x' ,xm2 ,is_available, lsubmodel, unitab)
241 CALL hm_get_floatv('cnode2_y' ,ym2 ,is_available, lsubmodel, unitab)
242 CALL hm_get_floatv('cnode2_z' ,zm2 ,is_available, lsubmodel, unitab)
243 IF(sub_id /= 0) CALL subrotpoint(xm2,ym2,zm2,rtrans,sub_id,lsubmodel)
244C
245 ! Initialization depending on the type of interface
246C MM1 AND MM2 DEFINE THE PARALLELOGRAM
247 rwl(1,n) = (ym1-rwl(5,n))*(zm2-rwl(6,n))
248 . - (zm1-rwl(6,n))*(ym2-rwl(5,n))
249 rwl(2,n) = (zm1-rwl(6,n))*(xm2-rwl(4,n))
250 . - (xm1-rwl(4,n))*(zm2-rwl(6,n))
251 rwl(3,n) = (xm1-rwl(4,n))*(ym2-rwl(5,n))
252 . - (ym1-rwl(5,n))*(xm2-rwl(4,n))
253 xn = sqrt(rwl(1,n)**2+rwl(2,n)**2+rwl(3,n)**2)
254 IF (xn <= em10) THEN
255 CALL ancmsg(msgid=168,anmode=aninfo,msgtype=msgerror,
256 . i1=nuser,c2='PARAL',c1=titr)
257 ELSE
258 rwl(1,n) = rwl(1,n)/xn
259 rwl(2,n) = rwl(2,n)/xn
260 rwl(3,n) = rwl(3,n)/xn
261 ENDIF
262 rwl(7,n) = xm1-rwl(4,n)
263 rwl(8,n) = ym1-rwl(5,n)
264 rwl(9,n) = zm1-rwl(6,n)
265 rwl(10,n) = xm2-rwl(4,n)
266 rwl(11,n) = ym2-rwl(5,n)
267 rwl(12,n) = zm2-rwl(6,n)
268C
269 ! Looking for SECONDARY nodes
270 DO i = 1,numnod
271 lprw(k+i) = 0
272 ENDDO
273C
274 ! SECONDARY nodes at DIST from the RWALL
275 IF (dist /= zero) THEN
276 DO i = 1,numnod
277 x1 = (x(1,i)-rwl(4,n))*rwl(1,n)
278 y1 = (x(2,i)-rwl(5,n))*rwl(2,n)
279 z1 = (x(3,i)-rwl(6,n))*rwl(3,n)
280 disn = x1+y1+z1
281 IF (disn >= zero .AND. disn <= dist .AND. i /= msr) lprw(k+i)=1
282 ENDDO
283 ENDIF
284C
285 ! Node group +
286 ingr2usr => igrnod(1:ngrnod)%ID
287 igrs = ngr2usr(igu,ingr2usr,ngrnod)
288 IF (igrs /= 0) THEN
289 DO j = 1,igrnod(igrs)%NENTITY
290 nosys = igrnod(igrs)%ENTITY(j)
291 lprw(k+nosys) = 1
292 IF (itab(nosys) == nuser) THEN
293 CALL ancmsg(msgid=637,
294 . msgtype=msgerror,
295 . anmode=aninfo_blind_1,
296 . i1=nuser,
297 . c1=titr,
298 . i2=nuser)
299 ENDIF
300 ENDDO
301 ENDIF
302C
303 ! Node group -
304 ingr2usr => igrnod(1:ngrnod)%ID
305 igrs = ngr2usr(igu2,ingr2usr,ngrnod)
306 IF (igrs /= 0) THEN
307 DO j = 1,igrnod(igrs)%NENTITY
308 nosys = igrnod(igrs)%ENTITY(j)
309 lprw(k+nosys) = 0
310 ENDDO
311 ENDIF
312C
313 ! Compaction
314 nsl = 0
315 DO i = 1,numnod
316 IF (lprw(k+i) > 0) THEN
317 IF (ns10e > 0.AND. ipen==0) THEN
318 IF(itagnd(i) /= 0) cycle
319 ENDIF
320 nsl = nsl+1
321 lprw(k+nsl) = i
322 IF (iddlevel == 0.AND. ipen==0) THEN
323 CALL kinset(4,itab(i),ikine(i),1,n+numskw+1,ikine1(i))
324 ENDIF
325 ENDIF
326 ENDDO
327 ! Itet=2 of S10
328 IF (ns10e > 0 .AND. ipen==0) CALL remove_nd(nsl,lprw(k+1),itagnd)
329 ifi=ifi+nsl
330 IF (ifq > 0) THEN
331 mfi=mfi+3*nsl
332 srwsav = srwsav + 3 * nsl
333 ENDIF
334C
335 ! Printing
336 IF (msr == 0) THEN
337 WRITE(iout,1100) n,ityp,itied,nsl
338 ELSE
339 WRITE(iout,1150) n,ityp,itied,nsl,nuser,xmas,vx,vy,vz
340 ENDIF
341 IF (ipen > 0) WRITE(iout,2500)
342C
343 WRITE(iout,2004)(rwl(l,n),l=4,6),(rwl(l,n),l=7,9),
344 . (rwl(l,n),l=10,12)
345C
346 IF (itied == 2) WRITE(iout,2101) fric,ifq,freq
347 IF (ipri >= 1) THEN
348 WRITE(iout,1200)
349 WRITE(iout,1201) (itab(lprw(i+k)),i=1,nsl)
350 ENDIF
351C
352 nprw(n) = nsl
353 nprw(n+nrwall) = itied
354 nprw(n+2*nrwall) = msr
355 nprw(n+3*nrwall) = ityp
356 nprw(n+4*nrwall) = 0
357 nprw(n+5*nrwall) = 0
358 nprw(n+8*nrwall) = ipen
359 IF (msr /= 0) THEN
360 vn = vx*rwl(1,n)+vy*rwl(2,n)+vz*rwl(3,n)
361 rwl(4,n) = vn
362 rwl(5,n) = zero
363 rwl(6,n) = zero
364 ENDIF
365 k = k+nsl
366C
367 ENDDO
368C
369 ! Updating the OFFSET
370 offs = offs + nchparal
371C---------------------------------
372 RETURN
373C
374 1100 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
375 . /10x,'RIGID WALL TYPE . . . . .',i10
376 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
377 . /10x,'NUMBER OF NODES . . . . .',i10)
378 1150 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
379 . /10x,'RIGID WALL TYPE . . . . .',i10
380 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
381 . /10x,'NUMBER OF NODES . . . . .',i10
382 . /10x,'WALL NODE NUMBER. . . . .',i10
383 . /10x,'WALL MASS . . . . . . . .',1pg14.4
384 . /10x,'WALL X-VELOCITY . . . . .',1pg14.4
385 . /10x,'WALL Y-VELOCITY . . . . .',1pg14.4
386 . /10x,'WALL Z-VELOCITY . . . . .',1pg14.4)
387 1200 FORMAT(/10x,'SECONDARY NODES : ')
388 1201 FORMAT(/10x,10i10)
389 2004 FORMAT(/5x,'PARALLELOGRAMM WALL CHARACTERISTICS',
390 . /10x,'POINT M . . . . . . . . .',1p3g20.13
391 . /10x,'MM1 VECTOR. . . . . . . .',1p3g20.13
392 . /10x,'MM2 VECTOR. . . . . . . .',1p3g20.13)
393 2101 FORMAT(/5x,'COULOMB FRICTION CHARACTERISTICS',
394 . /10x,'FRICTION COEFFICIENT . . .',1pg14.4
395 . /10x,'FILTRATION FLAG. . . . . .',i10
396 . /10x,'FILTRATION FACTOR. . . . .',1pg14.4)
397 2500 FORMAT(/5x,'RIGID WALL FORMULATION : PENALTY'/)
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
remove_nd
subroutine remove_nd(nn, inn, itagnd)
Definition dim_s10edg.F:221
alpha
#define alpha
Definition eval.h:35
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
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
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
groupdef_mod
Definition groupdef_mod.F:668
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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:323
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
submodel_mod::submodel_data
Definition submodel_mod.F:728
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180