OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_spher.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_spher ../starter/source/constraints/general/rwall/hm_read_rwall_spher.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_spher(RWL ,NPRW ,LPRW ,IFI ,MS ,
48 . V ,ITAB ,ITABM1 ,X ,IKINE ,
49 . IGRNOD ,MFI ,IMERGE ,UNITAB ,IDDLEVEL,
50 . LSUBMODEL,RTRANS ,NOM_OPT ,ITAGND ,NCHSPHER,
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 : 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,NCHSPHER,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, X1, DISN, X2, Y2, Z2, X3, FREQ, ALPHA, FAC_M_R2R
98 CHARACTER MESS*40
99 CHARACTER(LEN=NCHARTITLE) :: TITR
100 LOGICAL :: IS_AVAILABLE
101 INTEGER :: IPEN
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
110C-----------------------------------------------
111! ******************************** !
112! RWALL/SPHER read with hm reader !
113! ******************************** !
114C-----------------------------------------------
115 is_available = .false.
116 CALL hm_option_start('/RWALL/SPHER')
117 ! Flag for RWALL type SPHER
118 ityp = 3
119C
120 !----------------------------------------------------------------------
121 ! Loop over NCHSPHER
122 !----------------------------------------------------------------------
123 DO n = 1+offs, nchspher+offs
124C
125 ! Reading the option
126 ! /RWALL/SPHER/rwall_ID/node_ID
127 ! rwall_title
128 titr = ''
129 CALL hm_option_read_key(lsubmodel,
130 . option_id = nuser,
131 . unit_id = uid,
132 . submodel_index = sub_index,
133 . submodel_id = sub_id,
134 . option_titr = titr)
135C
136 nom_opt(1,n)=nuser
137 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
138C
139 ! Checking flag unit
140 iflagunit = 0
141 DO j=1,unitab%NUNITS
142 IF (unitab%UNIT_ID(j) == uid) THEN
143 iflagunit = 1
144 EXIT
145 ENDIF
146 ENDDO
147 IF (uid /= 0 .AND. iflagunit == 0) THEN
148 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
149 . i2=uid,i1=nuser,c1='RIGID WALL',
150 . c2='RIGID WALL',
151 . c3=titr)
152 ENDIF
153C
154 ! node_ID Slide grnd_ID1 grnd_ID2
155 CALL hm_get_intv('Node1',nuser,is_available,lsubmodel)
156 CALL hm_get_intv('slidingflag',itied,is_available,lsubmodel)
157 CALL hm_get_intv('NodeSet_ID',igu,is_available,lsubmodel)
158 CALL hm_get_intv('excludeNodeSet_ID',igu2,is_available,lsubmodel)
159 CALL hm_get_intv('Iform',ipen,is_available,lsubmodel)
160C
161 IF(nuser /= 0) THEN
162 msr = usr2sys(nuser,itabm1,mess,nuser)
163 CALL anodset(msr, check_used)
164 DO jc = 1,nmerged
165 IF (msr == imerge(jc)) msr = imerge(numcnod+jc)
166 ENDDO
167 ELSE
168 msr = 0
169 ENDIF
170C
171 ! 2nd card
172 ! d fric Diameter ffac ifq
173 CALL hm_get_floatv('offset' ,dist ,is_available, lsubmodel, unitab)
174 CALL hm_get_floatv('fric' ,fric ,is_available, lsubmodel, unitab)
175 CALL hm_get_floatv('Diameter' ,diam ,is_available, lsubmodel, unitab)
176 CALL hm_get_floatv('Filteringfactor',freq ,is_available, lsubmodel, unitab)
177 CALL hm_get_intv('Filteringflag' ,ifq ,is_available, lsubmodel)
178 IF (freq == 0 .AND. ifq /= 0) ifq = 0
179 IF (ifq == 0) freq = one
180 alpha = zero
181 IF (ifq >= 0) THEN
182 IF (ifq <= 1) alpha = freq
183 IF (ifq == 2) alpha = four*atan2(one,zero) / freq
184 IF (ifq == 3) alpha = four*atan2(one,zero) * freq
185 ENDIF
186 IF ((alpha < zero) .OR. ((alpha > one .AND. ifq <= 2))) THEN
187 CALL ancmsg(msgid=350,anmode=aninfo,msgtype=msgerror,
188 . i1=nuser,
189 . c1=titr,
190 . r1=freq)
191 ENDIF
192 rwl(13,n) = fric
193 rwl(14,n) = alpha
194 rwl(15,n) = ifq
195C
196 ! 3rd card
197 ! if node_ID == 0
198 IF (msr == 0) THEN
199 ! XM YM ZM
200 CALL hm_get_floatv('x' ,x1 ,is_available, lsubmodel, unitab)
201 CALL hm_get_floatv('y' ,x2 ,is_available, lsubmodel, unitab)
202 CALL hm_get_floatv('z' ,x3 ,is_available, lsubmodel, unitab)
203 IF(sub_id /= 0) CALL subrotpoint(x1,x2,x3,rtrans,sub_id,lsubmodel)
204 rwl(4,n) = x1
205 rwl(5,n) = x2
206 rwl(6,n) = x3
207 ! if node_ID > 0
208 ELSE IF (msr /= 0)THEN
209 ! Mass VX0 VY0 VZ0
210 CALL hm_get_floatv('Mass' ,xmas ,is_available, lsubmodel, unitab)
211 CALL hm_get_floatv('motionx' ,vx ,is_available, lsubmodel, unitab)
212 CALL hm_get_floatv('motiony' ,vy ,is_available, lsubmodel, unitab)
213 CALL hm_get_floatv('motionz' ,vz ,is_available, lsubmodel, unitab)
214 ! Multidomains : masse of the rwall splitted between 2 domains
215 fac_m_r2r = one
216 IF (nsubdom > 0) THEN
217 IF(tagno(npart+msr) == 4) fac_m_r2r = half
218 ENDIF
219 IF(sub_id /= 0) CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
220 rwl(4,n) = x(1,msr)
221 rwl(5,n) = x(2,msr)
222 rwl(6,n) = x(3,msr)
223 ms(msr) = ms(msr) + xmas*fac_m_r2r
224 v(1,msr) = vx
225 v(2,msr) = vy
226 v(3,msr) = vz
227 ENDIF
228C
229 ! Initialization depending on the type of interface
230 rwl(7,n) = diam
231C
232 ! Looking for SECONDARY nodes
233 DO i = 1,numnod
234 lprw(k+i) = 0
235 ENDDO
236C
237 ! SECONDARY nodes at DIST from the RWALL
238 IF (dist /= zero) THEN
239 DO i = 1,numnod
240 x2 = (x(1,i)-rwl(4,n))**2
241 y2 = (x(2,i)-rwl(5,n))**2
242 z2 = (x(3,i)-rwl(6,n))**2
243 disn = sqrt(x2+y2+z2)- half*diam
244 IF (disn >= zero .AND. disn <= dist .AND. i /= msr) lprw(k+i)=1
245 ENDDO
246 ENDIF
247C
248 ! Node group +
249 ingr2usr => igrnod(1:ngrnod)%ID
250 igrs = ngr2usr(igu,ingr2usr,ngrnod)
251 IF (igrs /= 0) THEN
252 DO j = 1,igrnod(igrs)%NENTITY
253 nosys = igrnod(igrs)%ENTITY(j)
254 lprw(k+nosys) = 1
255 IF (itab(nosys) == nuser) THEN
256 CALL ancmsg(msgid=637,
257 . msgtype=msgerror,
258 . anmode=aninfo_blind_1,
259 . i1=nuser,
260 . c1=titr,
261 . i2=nuser)
262 ENDIF
263 ENDDO
264 ENDIF
265C
266 ! Node group -
267 ingr2usr => igrnod(1:ngrnod)%ID
268 igrs = ngr2usr(igu2,ingr2usr,ngrnod)
269 IF (igrs /= 0) THEN
270 DO j = 1,igrnod(igrs)%NENTITY
271 nosys = igrnod(igrs)%ENTITY(j)
272 lprw(k+nosys) = 0
273 ENDDO
274 ENDIF
275C
276 ! Compaction
277 nsl = 0
278 DO i = 1,numnod
279 IF (lprw(k+i) > 0) THEN
280 IF (ns10e > 0.AND. ipen==0) THEN
281 IF( itagnd(i) /= 0) cycle
282 ENDIF
283 nsl = nsl+1
284 lprw(k+nsl) = i
285 IF (iddlevel == 0.AND. ipen==0) THEN
286 CALL kinset(4,itab(i),ikine(i),1,n+numskw+1,ikine1(i))
287 ENDIF
288 ENDIF
289 ENDDO
290 ! Itet=2 of S10
291 IF (ns10e > 0 .AND. ipen==0) CALL remove_nd(nsl,lprw(k+1),itagnd)
292 ifi=ifi+nsl
293 IF (ifq > 0) THEN
294 mfi=mfi+3*nsl
295 srwsav = srwsav + 3 * nsl
296 ENDIF
297C
298 ! Printing
299 IF (msr == 0) THEN
300 WRITE(iout,1100) n,ityp,itied,nsl
301 ELSE
302 WRITE(iout,1150) n,ityp,itied,nsl,nuser,xmas,vx,vy,vz
303 ENDIF
304 IF (ipen > 0) WRITE(iout,2500)
305C
306 WRITE(iout,2003)(rwl(l,n),l=4,6),rwl(7,n)
307C
308 IF (itied == 2) WRITE(iout,2101)fric,ifq,freq
309 IF (ipri >= 1) THEN
310 WRITE(iout,1200)
311 WRITE(iout,1201) (itab(lprw(i+k)),i=1,nsl)
312 ENDIF
313C
314 nprw(n) = nsl
315 nprw(n+nrwall) = itied
316 nprw(n+2*nrwall) = msr
317 nprw(n+3*nrwall) = ityp
318 nprw(n+4*nrwall) = 0
319 nprw(n+5*nrwall) = 0
320 nprw(n+8*nrwall) = ipen
321 k = k+nsl
322C
323 ENDDO
324C
325 ! Updating the OFFSET
326 offs = offs + nchspher
327C------------------------------------------
328 RETURN
329C
330 1100 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
331 . /10x,'RIGID WALL TYPE . . . . .',i10
332 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
333 . /10x,'NUMBER OF NODES . . . . .',i10)
334 1150 FORMAT(/5x,'RIGID WALL NUMBER. . . . .',i10
335 . /10x,'RIGID WALL TYPE . . . . .',i10
336 . /10x,'TYPE SLIDE/TIED/FRICTION.',i10
337 . /10x,'NUMBER OF NODES . . . . .',i10
338 . /10x,'WALL NODE NUMBER. . . . .',i10
339 . /10x,'WALL MASS . . . . . . . .',1pg14.4
340 . /10x,'WALL X-VELOCITY . . . . .',1pg14.4
341 . /10x,'WALL Y-VELOCITY . . . . .',1pg14.4
342 . /10x,'WALL Z-VELOCITY . . . . .',1pg14.4)
343 1200 FORMAT(/10x,'SECONDARY NODES : ')
344 1201 FORMAT(/10x,10i10)
345 2003 FORMAT(/5x,'SPHERICAL WALL CHARACTERISTICS',
346 . /10x,'POINT M . . . . . . . . .',1p3g20.13
347 . /10x,'SPHERE DIAMETER . . . . .',1pg14.4)
348 2101 FORMAT(/5x,'COULOMB FRICTION CHARACTERISTICS',
349 . /10x,'FRICTION COEFFICIENT . . .',1pg14.4
350 . /10x,'FILTRATION FLAG. . . . . .',i10
351 . /10x,'FILTRATION FACTOR. . . . .',1pg14.4)
352 2500 FORMAT(/5x,'RIGID WALL FORMULATION : PENALTY'/)
353 END
354
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_spher
subroutine hm_read_rwall_spher(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchspher, k, offs, ikine1)
Definition hm_read_rwall_spher.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