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