OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_cyl.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_cyl (rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchcyl, k, offs, ikine1)

Function/Subroutine Documentation

◆ hm_read_rwall_cyl()

subroutine hm_read_rwall_cyl ( 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(*) lsubmodel,
rtrans,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) itagnd,
integer nchcyl,
integer k,
integer offs,
integer, dimension(3*numnod) ikine1 )

Definition at line 47 of file hm_read_rwall_cyl.F.

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