OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_cyl.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_rwall_cyl ../starter/source/constraints/general/rwall/hm_read_rwall_cyl.F
25!||--- called by ------------------------------------------------------
26!|| read_rwall ../starter/source/constraints/general/rwall/read_rwall.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| fretitl ../starter/source/starter/freform.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| kinset ../starter/source/constraints/general/kinset.F
36!|| ngr2usr ../starter/source/system/nintrr.f
37!|| remove_nd ../starter/source/elements/solid/solide10/dim_s10edg.F
38!|| subrotpoint ../starter/source/model/submodel/subrot.f
39!|| subrotvect ../starter/source/model/submodel/subrot.f
40!|| usr2sys ../starter/source/system/sysfus.F
41!||--- uses -----------------------------------------------------
42!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
43!|| message_mod ../starter/share/message_module/message_mod.F
44!|| r2r_mod ../starter/share/modules1/r2r_mod.F
45!|| submodel_mod ../starter/share/modules1/submodel_mod.F
46!||====================================================================
47 SUBROUTINE hm_read_rwall_cyl(RWL ,NPRW ,LPRW ,IFI ,MS ,
48 . V ,ITAB ,ITABM1 ,X ,IKINE ,
49 . IGRNOD ,MFI ,IMERGE ,UNITAB ,IDDLEVEL,
50 . LSUBMODEL,RTRANS ,NOM_OPT ,ITAGND ,NCHCYL ,
51 . K ,OFFS ,IKINE1 )
52C-------------------------------------
53C LECTURE 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
105C-----------------------------------------------
106C E x t e r n a l F u n c t i o n s
107C-----------------------------------------------
108 INTEGER USR2SYS, NGR2USR
109 INTEGER, DIMENSION(:), POINTER :: INGR2USR
110 DATA MESS/'STANDARD RIGID WALL DEFINITION '/
111C=======================================================================
112C
113C-----------------------------------------------
114! ****************************** !
115! RWALL/CYL read with hm reader !
116! ****************************** !
117C-----------------------------------------------
118 is_available = .false.
119 CALL hm_option_start('/RWALL/CYL')
120 ! Flag for RWALL type CYL
121 ityp = 2
122 !----------------------------------------------------------------------
123 ! Loop over NCHCYL
124 !----------------------------------------------------------------------
125 DO n = 1+offs, nchcyl+offs
126C
127 ! Reading the option
128 ! /RWALL/type/rwall_ID/node_ID
129 ! rwall_title
130 titr = ''
131 CALL hm_option_read_key(lsubmodel,
132 . option_id = nuser,
133 . unit_id = uid,
134 . submodel_index = sub_index,
135 . submodel_id = sub_id,
136 . option_titr = titr)
137C
138 nom_opt(1,n)=nuser
139 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
140C
141 ! Checking flag unit
142 iflagunit = 0
143 DO j=1,unitab%NUNITS
144 IF (unitab%UNIT_ID(j) == uid) THEN
145 iflagunit = 1
146 EXIT
147 ENDIF
148 ENDDO
149 IF (uid /= 0 .AND. iflagunit == 0) THEN
150 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
151 . i2=uid,i1=nuser,c1='RIGID WALL',
152 . c2='RIGID WALL',
153 . c3=titr)
154 ENDIF
155C
156 ! node_ID Slide grnd_ID1 grnd_ID2
157 CALL hm_get_intv('Node1',nuser,is_available,lsubmodel)
158 CALL hm_get_intv('slidingflag',itied,is_available,lsubmodel)
159 CALL hm_get_intv('NodeSet_ID',igu,is_available,lsubmodel)
160 CALL hm_get_intv('excludeNodeSet_ID',igu2,is_available,lsubmodel)
161C
162 IF(nuser /= 0) THEN
163 msr = usr2sys(nuser,itabm1,mess,nuser)
164 CALL anodset(msr, check_used)
165 DO jc = 1,nmerged
166 IF (msr == imerge(jc)) msr = imerge(numcnod+jc)
167 ENDDO
168 ELSE
169 msr = 0
170 ENDIF
171C
172 ! 2nd card
173 ! d fric Diameter ffac ifq
174 CALL hm_get_floatv('offset' ,dist ,is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('fric' ,fric ,is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('Diameter' ,diam ,is_available, lsubmodel, unitab)
177 CALL hm_get_floatv('Filteringfactor',freq ,is_available, lsubmodel, unitab)
178 CALL hm_get_intv('Filteringflag' ,ifq ,is_available, lsubmodel)
179 alpha = zero
180 IF (freq == 0 .AND. ifq /= 0) ifq = 0
181 IF (ifq == 0) freq = one
182 IF (ifq >= 0) THEN
183 IF (ifq <= 1) alpha = freq
184 IF (ifq == 2) alpha = four*atan2(one,zero) / freq
185 IF (ifq == 3) alpha = four*atan2(one,zero) * freq
186 ENDIF
187 IF ((alpha < zero) .OR. ((alpha > one .AND. ifq <= 2))) THEN
188 CALL ancmsg(msgid=350,anmode=aninfo,msgtype=msgerror,
189 . i1=nuser,
190 . c1=titr,
191 . r1=freq)
192 ENDIF
193 rwl(13,n) = fric
194 rwl(14,n) = alpha
195 rwl(15,n) = ifq
196C
197 ! 3rd card
198 ! if node_ID == 0
199 IF (msr == 0) THEN
200 ! XM YM ZM
201 CALL hm_get_floatv('x' ,x1 ,is_available, lsubmodel, unitab)
202 CALL hm_get_floatv('y' ,x2 ,is_available, lsubmodel, unitab)
203 CALL hm_get_floatv('z' ,x3 ,is_available, lsubmodel, unitab)
204 IF(sub_id /= 0) CALL subrotpoint(x1,x2,x3,rtrans,sub_id,lsubmodel)
205 rwl(4,n) = x1
206 rwl(5,n) = x2
207 rwl(6,n) = x3
208 ! if node_ID > 0
209 ELSE IF (msr /= 0)THEN
210 ! Mass VX0 VY0 VZ0
211 CALL hm_get_floatv('Mass' ,xmas ,is_available, lsubmodel, unitab)
212 CALL hm_get_floatv('motionx' ,vx ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv('motiony' ,vy ,is_available, lsubmodel, unitab)
214 CALL hm_get_floatv('motionz' ,vz ,is_available, lsubmodel, unitab)
215 ! Multidomains : masse of the rwall splitted between 2 domains
216 fac_m_r2r = one
217 IF (nsubdom > 0) THEN
218 IF(tagno(npart+msr) == 4) fac_m_r2r = half
219 ENDIF
220 IF(sub_id /= 0) CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
221 rwl(4,n) = x(1,msr)
222 rwl(5,n) = x(2,msr)
223 rwl(6,n) = x(3,msr)
224 ms(msr) = ms(msr) + xmas*fac_m_r2r
225 v(1,msr) = vx
226 v(2,msr) = vy
227 v(3,msr) = vz
228 ENDIF
229C
230 ! 4th card (only for PLANE, CYL and PARAL)
231 ! XM1 YM1 ZM1
232 CALL hm_get_floatv('XH' ,xm1 ,is_available, lsubmodel, unitab)
233 CALL hm_get_floatv('YH' ,ym1 ,is_available, lsubmodel, unitab)
234 CALL hm_get_floatv('ZH' ,zm1 ,is_available, lsubmodel, unitab)
235 IF (sub_id /= 0) CALL subrotpoint(xm1,ym1,zm1,rtrans,sub_id,lsubmodel)
236C
237 ! Initialization depending on the type of interface
238 ! CYL
239C M SUR L'AXE ET MM1 AXE DU CYLINDRE
240 rwl(1,n) = xm1-rwl(4,n)
241 rwl(2,n) = ym1-rwl(5,n)
242 rwl(3,n) = zm1-rwl(6,n)
243 xn = sqrt(rwl(1,n)**2+rwl(2,n)**2+rwl(3,n)**2)
244 IF (xn <= em10) THEN
245 CALL ancmsg(msgid=167,anmode=aninfo,msgtype=msgerror,
246 . i1=nuser,c2='CYL',c1=titr)
247 ELSE
248 rwl(1,n) = rwl(1,n)/xn
249 rwl(2,n) = rwl(2,n)/xn
250 rwl(3,n) = rwl(3,n)/xn
251 rwl(7,n) = diam
252 ENDIF
253C
254 ! Looking for SECONDARY nodes
255 DO i = 1,numnod
256 lprw(k+i) = 0
257 ENDDO
258C
259 ! SECONDARY nodes at DIST from the RWALL
260 IF (dist /= zero) THEN
261 DO i = 1,numnod
262 x1 = (x(1,i)-rwl(4,n))*rwl(1,n)
263 y1 = (x(2,i)-rwl(5,n))*rwl(2,n)
264 z1 = (x(3,i)-rwl(6,n))*rwl(3,n)
265 d1 = (x1+y1+z1)
266 x2 = (x(1,i)-rwl(4,n))**2
267 y2 = (x(2,i)-rwl(5,n))**2
268 z2 = (x(3,i)-rwl(6,n))**2
269 d2 = (x2+y2+z2)
270 disn = sqrt(d2-d1**2) - half*diam
271 IF (disn >= zero .AND. disn <= dist .AND. i /= msr) lprw(k+i)=1
272 ENDDO
273 ENDIF
274C
275 ! Node group +
276 ingr2usr => igrnod(1:ngrnod)%ID
277 igrs = ngr2usr(igu,ingr2usr,ngrnod)
278 IF (igrs /= 0) THEN
279 DO j = 1,igrnod(igrs)%NENTITY
280 nosys = igrnod(igrs)%ENTITY(j)
281 lprw(k+nosys) = 1
282 IF (itab(nosys) == nuser) THEN
283 CALL ancmsg(msgid=637,
284 . msgtype=msgerror,
285 . anmode=aninfo_blind_1,
286 . i1=nuser,
287 . c1=titr,
288 . i2=nuser)
289 ENDIF
290 ENDDO
291 ENDIF
292C
293 ! Node group -
294 ingr2usr => igrnod(1:ngrnod)%ID
295 igrs = ngr2usr(igu2,ingr2usr,ngrnod)
296 IF (igrs /= 0) THEN
297 DO j = 1,igrnod(igrs)%NENTITY
298 nosys = igrnod(igrs)%ENTITY(j)
299 lprw(k+nosys) = 0
300 ENDDO
301 ENDIF
302C
303 ! Compaction
304 nsl = 0
305 DO i = 1,numnod
306 IF (lprw(k+i) > 0) THEN
307 IF (ns10e > 0) THEN
308 IF( itagnd(i) /= 0) cycle
309 ENDIF
310 nsl = nsl+1
311 lprw(k+nsl) = i
312 IF (iddlevel == 0) THEN
313 CALL kinset(4,itab(i),ikine(i),1,n+numskw+1,ikine1(i))
314 ENDIF
315 ENDIF
316 ENDDO
317 ! Itet=2 of S10
318 IF (ns10e > 0 ) CALL remove_nd(nsl,lprw(k+1),itagnd)
319 ifi=ifi+nsl
320 IF (ifq > 0) THEN
321 mfi=mfi+3*nsl
322 srwsav = srwsav + 3 * nsl
323 ENDIF
324C
325 ! Printing
326 IF (msr == 0) THEN
327 WRITE(iout,1100) n,ityp,itied,nsl
328 ELSE
329 WRITE(iout,1150) n,ityp,itied,nsl,nuser,xmas,vx,vy,vz
330 ENDIF
331C
332 WRITE(iout,2002)(rwl(l,n),l=4,6),rwl(7,n),(rwl(l,n),l=1,3)
333C
334 IF (itied == 2) WRITE(iout,2101) fric,ifq,freq
335 IF (ipri >= 1) THEN
336 WRITE(iout,1200)
337 WRITE(iout,1201) (itab(lprw(i+k)),i=1,nsl)
338 ENDIF
339C
340 nprw(n) = nsl
341 nprw(n+nrwall) = itied
342 nprw(n+2*nrwall) = msr
343 nprw(n+3*nrwall) = ityp
344 nprw(n+4*nrwall) = 0
345 nprw(n+5*nrwall) = 0
346 k = k+nsl
347C
348 ENDDO
349C
350 ! Updating the OFFSET
351 offs = offs + nchcyl
352C----------------------------------------------------
353 RETURN
354C
355 1100 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
356 . /10x,'RIGID WALL TYPE . . . . .',i10
357 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
358 . /10x,'NUMBER OF NODES . . . . .',i10)
359 1150 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 . /10x,'WALL NODE NUMBER. . . . .',i10
364 . /10x,'WALL MASS . . . . . . . .',1pg14.4
365 . /10x,'WALL X-VELOCITY . . . . .',1pg14.4
366 . /10x,'WALL Y-VELOCITY . . . . .',1pg14.4
367 . /10x,'WALL Z-VELOCITY . . . . .',1pg14.4)
368 1200 FORMAT(/10x,'SECONDARY NODES : ')
369 1201 FORMAT(/10x,10i10)
370 2002 FORMAT(/5x,'CYLINDRIC WALL CHARACTERISTICS',
371 . /10x,'point m . . . . . . . . .',1P3G20.13
372 . /10X,'cylinder diameter . . . .',1PG14.4
373 . /10X,'axis vector . . . . . . .',1P3G20.13)
374 2101 FORMAT(/5X,'coulomb friction characteristics',
375 . /10X,'friction coefficient . . .',1PG14.4
376 . /10X,'filtration flag. . . . . .',I10
377 . /10X,'filtration factor. . . . .',1PG14.4)
378 END
379
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:219
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
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_read_rwall_cyl
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)
Definition hm_read_rwall_cyl.F:52
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
groupdef_mod
Definition groupdef_mod.F:662
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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
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:712
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723
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