OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_plane.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_plane ../starter/source/constraints/general/rwall/hm_read_rwall_plane.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_plane(RWL ,NPRW ,LPRW ,IFI ,MS ,
48 . V ,ITAB ,ITABM1 ,X ,IKINE ,
49 . IGRNOD ,MFI ,IMERGE ,UNITAB ,IDDLEVEL,
50 . LSUBMODEL,RTRANS ,NOM_OPT ,ITAGND ,NCHPLAN ,
51 . K ,OFFS ,IKINE1 )
52C-------------------------------------
53C READING MUR RIGIDE
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE unitab_mod
58 USE submodel_mod , ONLY : submodel_data, nsubmod
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,NCHPLAN,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
98 my_real :: 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/PLANE read with hm reader !
113! ************************** !
114C-----------------------------------------------
115 is_available = .false.
116 CALL hm_option_start('/RWALL/PLANE')
117 ! Flag for RWALL type PLANE
118 ityp = 1
119 !----------------------------------------------------------------------
120 ! Loop over HM_RWALLs
121 !----------------------------------------------------------------------
122 DO n = 1+offs, nchplan+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 ! if node_ID > 0
207 ELSE IF (msr /= 0)THEN
208 ! Mass VX0 VY0 VZ0
209 CALL hm_get_floatv('Mass' ,xmas ,is_available, lsubmodel, unitab)
210 CALL hm_get_floatv('motionx' ,vx ,is_available, lsubmodel, unitab)
211 CALL hm_get_floatv('motiony' ,vy ,is_available, lsubmodel, unitab)
212 CALL hm_get_floatv('motionz' ,vz ,is_available, lsubmodel, unitab)
213 ! Multidomains : masse of the rwall splitted between 2 domains
214 fac_m_r2r = one
215 IF (nsubdom > 0) THEN
216 IF(tagno(npart+msr) == 4) fac_m_r2r = half
217 ENDIF
218 IF(sub_id /= 0) CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
219 rwl(4,n) = x(1,msr)
220 rwl(5,n) = x(2,msr)
221 rwl(6,n) = x(3,msr)
222 ms(msr) = ms(msr) + xmas*fac_m_r2r
223 v(1,msr) = vx
224 v(2,msr) = vy
225 v(3,msr) = vz
226 ENDIF
227C
228 ! 4th card (only for PLANE, CYL and PARAL)
229 ! XM1 YM1 ZM1
230 CALL hm_get_floatv('XH' ,xm1 ,is_available, lsubmodel, unitab)
231 CALL hm_get_floatv('YH' ,ym1 ,is_available, lsubmodel, unitab)
232 CALL hm_get_floatv('ZH' ,zm1 ,is_available, lsubmodel, unitab)
233 IF (sub_id /= 0) CALL subrotpoint(xm1,ym1,zm1,rtrans,sub_id,lsubmodel)
234C
235 ! Initialization depending on the type of interface
236 ! PLANE
237C M MUR ET MM1 NORMALE
238 rwl(1,n) = xm1-rwl(4,n)
239 rwl(2,n) = ym1-rwl(5,n)
240 rwl(3,n) = zm1-rwl(6,n)
241 xn = sqrt(rwl(1,n)**2+rwl(2,n)**2+rwl(3,n)**2)
242 IF (xn <= em10) THEN
243 CALL ancmsg(msgid=167,anmode=aninfo,msgtype=msgerror,
244 . i1=nuser,c2='PLANE',c1=titr)
245 ELSE
246 rwl(1,n) = rwl(1,n)/xn
247 rwl(2,n) = rwl(2,n)/xn
248 rwl(3,n) = rwl(3,n)/xn
249 ENDIF
250C
251 ! Looking for SECONDARY nodes
252 DO i = 1,numnod
253 lprw(k+i) = 0
254 ENDDO
255C
256 ! SECONDARY nodes at DIST from the RWALL
257 IF (dist /= zero) THEN
258 DO i = 1,numnod
259 x1 = (x(1,i)-rwl(4,n))*rwl(1,n)
260 y1 = (x(2,i)-rwl(5,n))*rwl(2,n)
261 z1 = (x(3,i)-rwl(6,n))*rwl(3,n)
262 disn = x1+y1+z1
263 IF (disn >= zero .AND. disn <= dist .AND. i /= msr) lprw(k+i)=1
264 ENDDO
265 ENDIF
266C
267 ! Node group +
268 ingr2usr => igrnod(1:ngrnod)%ID
269 igrs = ngr2usr(igu,ingr2usr,ngrnod)
270 IF (igrs /= 0) THEN
271 DO j = 1,igrnod(igrs)%NENTITY
272 nosys = igrnod(igrs)%ENTITY(j)
273 lprw(k+nosys) = 1
274 IF (itab(nosys) == nuser) THEN
275 CALL ancmsg(msgid=637,
276 . msgtype=msgerror,
277 . anmode=aninfo_blind_1,
278 . i1=nuser,
279 . c1=titr,
280 . i2=nuser)
281 ENDIF
282 ENDDO
283 ENDIF
284C
285 ! Node group -
286 ingr2usr => igrnod(1:ngrnod)%ID
287 igrs = ngr2usr(igu2,ingr2usr,ngrnod)
288 IF (igrs /= 0) THEN
289 DO j = 1,igrnod(igrs)%NENTITY
290 nosys = igrnod(igrs)%ENTITY(j)
291 lprw(k+nosys) = 0
292 ENDDO
293 ENDIF
294C
295 ! Compaction
296 nsl = 0
297 DO i = 1,numnod
298 IF (lprw(k+i) > 0) THEN
299 IF (ns10e > 0.AND. ipen==0) THEN
300 IF(itagnd(i) /= 0) cycle
301 ENDIF
302 nsl = nsl+1
303 lprw(k+nsl) = i
304 IF (iddlevel == 0.AND. ipen==0) THEN
305 CALL kinset(4,itab(i),ikine(i),1,n+numskw+1,ikine1(i))
306 ENDIF
307 ENDIF
308 ENDDO
309 ! Itet=2 of S10
310 IF (ns10e > 0 .AND. ipen==0) CALL remove_nd(nsl,lprw(k+1),itagnd)
311 ifi=ifi+nsl
312 IF (ifq > 0) THEN
313 mfi=mfi+3*nsl
314 srwsav = srwsav + 3 * nsl
315 ENDIF
316C
317 ! Printing
318 IF (msr == 0) THEN
319 WRITE(iout,1100) n,ityp,itied,nsl
320 ELSE
321 WRITE(iout,1150) n,ityp,itied,nsl,nuser,xmas,vx,vy,vz
322 ENDIF
323 IF (ipen > 0) WRITE(iout,2500)
324C
325 WRITE(iout,2001)(rwl(l,n),l=4,6),(rwl(l,n),l=1,3)
326
327 IF (itied == 2) WRITE(iout,2101)fric,ifq,freq
328 IF (ipri >= 1) THEN
329 WRITE(iout,1200)
330 WRITE(iout,1201) (itab(lprw(i+k)),i=1,nsl)
331 ENDIF
332C
333 nprw(n) = nsl
334 nprw(n+nrwall) = itied
335 nprw(n+2*nrwall) = msr
336 nprw(n+3*nrwall) = ityp
337 nprw(n+4*nrwall) = 0
338 nprw(n+5*nrwall) = 0
339 nprw(n+8*nrwall) = ipen
340 k = k+nsl
341C
342 ENDDO
343C
344 ! Updating the OFFSET
345 offs = offs + nchplan
346C
347 RETURN
348C
349 1100 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
350 . /10x,'RIGID WALL TYPE . . . . .',i10
351 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
352 . /10x,'NUMBER OF NODES . . . . .',i10)
353 1150 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
354 . /10x,'RIGID WALL TYPE . . . . .',i10
355 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
356 . /10x,'NUMBER OF NODES . . . . .',i10
357 . /10x,'WALL NODE NUMBER. . . . .',i10
358 . /10x,'WALL MASS . . . . . . . .',1pg14.4
359 . /10x,'WALL X-VELOCITY . . . . .',1pg14.4
360 . /10x,'WALL Y-VELOCITY . . . . .',1pg14.4
361 . /10x,'WALL Z-VELOCITY . . . . .',1pg14.4)
362 1200 FORMAT(/10x,'SECONDARY NODES : ')
363 1201 FORMAT(/10x,10i10)
364 2001 FORMAT(/5x,'INFINITE WALL CHARACTERISTICS',
365 . /10x,'POINT M . . . . . . . . .',1p3g20.13
366 . /10x,'NORMAL VECTOR . . . . . .',1p3g20.13)
367 2101 FORMAT(/5x,'COULOMB FRICTION CHARACTERISTICS',
368 . /10x,'FRICTION COEFFICIENT . . .',1pg14.4
369 . /10x,'filtration flag. . . . . .',I10
370 . /10X,'filtration factor. . . . .',1PG14.4)
371 2500 FORMAT(/5X,'rigid wall formulation : penalty'/)
372 END
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
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_read_rwall_plane
subroutine hm_read_rwall_plane(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchplan, k, offs, ikine1)
Definition hm_read_rwall_plane.F:52
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
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
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