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 LECTURE 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
101C-----------------------------------------------
102C E x t e r n a l F u n c t i o n s
103C-----------------------------------------------
104 INTEGER USR2SYS, NGR2USR
105 INTEGER, DIMENSION(:), POINTER :: INGR2USR
106 DATA MESS/'STANDARD RIGID WALL DEFINITION '/
107C=======================================================================
108C
109C-----------------------------------------------
110! ******************************** !
111! RWALL/SPHER read with hm reader !
112! ******************************** !
113C-----------------------------------------------
114 is_available = .false.
115 CALL hm_option_start('/RWALL/SPHER')
116 ! Flag for RWALL type SPHER
117 ityp = 3
118C
119 !----------------------------------------------------------------------
120 ! Loop over NCHSPHER
121 !----------------------------------------------------------------------
122 DO n = 1+offs, nchspher+offs
123C
124 ! Reading the option
125 ! /RWALL/SPHER/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)
158C
159 IF(nuser /= 0) THEN
160 msr = usr2sys(nuser,itabm1,mess,nuser)
161 CALL anodset(msr, check_used)
162 DO jc = 1,nmerged
163 IF (msr == imerge(jc)) msr = imerge(numcnod+jc)
164 ENDDO
165 ELSE
166 msr = 0
167 ENDIF
168C
169 ! 2nd card
170 ! d fric Diameter ffac ifq
171 CALL hm_get_floatv('offset' ,dist ,is_available, lsubmodel, unitab)
172 CALL hm_get_floatv('fric' ,FRIC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
173 CALL HM_GET_FLOATV('diameter' ,DIAM ,IS_AVAILABLE, LSUBMODEL, UNITAB)
174 CALL HM_GET_FLOATV('filteringfactor',FREQ ,IS_AVAILABLE, LSUBMODEL, UNITAB)
175 CALL HM_GET_INTV('filteringflag' ,IFQ ,IS_AVAILABLE, LSUBMODEL)
176.AND. IF (FREQ == 0 IFQ /= 0) IFQ = 0
177 IF (IFQ == 0) FREQ = ONE
178 ALPHA = ZERO
179 IF (IFQ >= 0) THEN
180 IF (IFQ <= 1) ALPHA = FREQ
181 IF (IFQ == 2) ALPHA = FOUR*ATAN2(ONE,ZERO) / FREQ
182 IF (IFQ == 3) ALPHA = FOUR*ATAN2(ONE,ZERO) * FREQ
183 ENDIF
184.OR..AND. IF ((ALPHA < ZERO) ((ALPHA > ONE IFQ <= 2))) THEN
185 CALL ANCMSG(MSGID=350,ANMODE=ANINFO,MSGTYPE=MSGERROR,
186 . I1=NUSER,
187 . C1=TITR,
188 . R1=FREQ)
189 ENDIF
190 RWL(13,N) = FRIC
191 RWL(14,N) = ALPHA
192 RWL(15,N) = IFQ
193C
194 ! 3rd card
195 ! if node_ID == 0
196 IF (MSR == 0) THEN
197 ! XM YM ZM
198 CALL HM_GET_FLOATV('x' ,X1 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
199 CALL HM_GET_FLOATV('y' ,X2 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
200 CALL HM_GET_FLOATV('z' ,X3 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
201 IF(SUB_ID /= 0) CALL SUBROTPOINT(X1,X2,X3,RTRANS,SUB_ID,LSUBMODEL)
202 RWL(4,N) = X1
203 RWL(5,N) = X2
204 RWL(6,N) = X3
205 ! if node_ID > 0
206 ELSE IF (MSR /= 0)THEN
207 ! Mass VX0 VY0 VZ0
208 CALL HM_GET_FLOATV('mass' ,XMAS ,IS_AVAILABLE, LSUBMODEL, UNITAB)
209 CALL HM_GET_FLOATV('motionx' ,VX ,IS_AVAILABLE, LSUBMODEL, UNITAB)
210 CALL HM_GET_FLOATV('motiony' ,VY ,IS_AVAILABLE, LSUBMODEL, UNITAB)
211 CALL HM_GET_FLOATV('motionz' ,VZ ,IS_AVAILABLE, LSUBMODEL, UNITAB)
212 ! Multidomains : masse of the rwall splitted between 2 domains
213 FAC_M_R2R = ONE
214 IF (NSUBDOM > 0) THEN
215 IF(TAGNO(NPART+MSR) == 4) FAC_M_R2R = HALF
216 ENDIF
217 IF(SUB_ID /= 0) CALL SUBROTVECT(VX,VY,VZ,RTRANS,SUB_ID,LSUBMODEL)
218 RWL(4,N) = X(1,MSR)
219 RWL(5,N) = X(2,MSR)
220 RWL(6,N) = X(3,MSR)
221 MS(MSR) = MS(MSR) + XMAS*FAC_M_R2R
222 V(1,MSR) = VX
223 V(2,MSR) = VY
224 V(3,MSR) = VZ
225 ENDIF
226C
227 ! Initialization depending on the type of interface
228 RWL(7,N) = DIAM
229C
230 ! Looking for SECONDARY nodes
231 DO I = 1,NUMNOD
232 LPRW(K+I) = 0
233 ENDDO
234C
235 ! SECONDARY nodes at DIST from the RWALL
236 IF (DIST /= ZERO) THEN
237 DO I = 1,NUMNOD
238 X2 = (X(1,I)-RWL(4,N))**2
239 Y2 = (X(2,I)-RWL(5,N))**2
240 Z2 = (X(3,I)-RWL(6,N))**2
241 DISN = SQRT(X2+Y2+Z2)- HALF*DIAM
242.AND..AND. IF (DISN >= ZERO DISN <= DIST I /= MSR) LPRW(K+I)=1
243 ENDDO
244 ENDIF
245C
246 ! Node group +
247 INGR2USR => IGRNOD(1:NGRNOD)%ID
248 IGRS = NGR2USR(IGU,INGR2USR,NGRNOD)
249 IF (IGRS /= 0) THEN
250 DO J = 1,IGRNOD(IGRS)%NENTITY
251 NOSYS = IGRNOD(IGRS)%ENTITY(J)
252 LPRW(K+NOSYS) = 1
253 IF (ITAB(NOSYS) == NUSER) THEN
254 CALL ANCMSG(MSGID=637,
255 . MSGTYPE=MSGERROR,
256 . ANMODE=ANINFO_BLIND_1,
257 . I1=NUSER,
258 . C1=TITR,
259 . I2=NUSER)
260 ENDIF
261 ENDDO
262 ENDIF
263C
264 ! Node group -
265 INGR2USR => IGRNOD(1:NGRNOD)%ID
266 IGRS = NGR2USR(IGU2,INGR2USR,NGRNOD)
267 IF (IGRS /= 0) THEN
268 DO J = 1,IGRNOD(IGRS)%NENTITY
269 NOSYS = IGRNOD(IGRS)%ENTITY(J)
270 LPRW(K+NOSYS) = 0
271 ENDDO
272 ENDIF
273C
274 ! Compaction
275 NSL = 0
276 DO I = 1,NUMNOD
277 IF (LPRW(K+I) > 0) THEN
278 IF (NS10E > 0) THEN
279 IF( ITAGND(I) /= 0) CYCLE
280 ENDIF
281 NSL = NSL+1
282 LPRW(K+NSL) = I
283 IF (IDDLEVEL == 0) THEN
284 CALL KINSET(4,ITAB(I),IKINE(I),1,N+NUMSKW+1,IKINE1(I))
285 ENDIF
286 ENDIF
287 ENDDO
288 ! Itet=2 of S10
289 IF (NS10E > 0 ) CALL REMOVE_ND(NSL,LPRW(K+1),ITAGND)
290 IFI=IFI+NSL
291 IF (IFQ > 0) THEN
292 MFI=MFI+3*NSL
293 SRWSAV = SRWSAV + 3 * NSL
294 ENDIF
295C
296 ! Printing
297 IF (MSR == 0) THEN
298 WRITE(IOUT,1100) N,ITYP,ITIED,NSL
299 ELSE
300 WRITE(IOUT,1150) N,ITYP,ITIED,NSL,NUSER,XMAS,VX,VY,VZ
301 ENDIF
302C
303 WRITE(IOUT,2003)(RWL(L,N),L=4,6),RWL(7,N)
304C
305 IF (ITIED == 2) WRITE(IOUT,2101)FRIC,IFQ,FREQ
306 IF (IPRI >= 1) THEN
307 WRITE(IOUT,1200)
308 WRITE(IOUT,1201) (ITAB(LPRW(I+K)),I=1,NSL)
309 ENDIF
310C
311 NPRW(N) = NSL
312 NPRW(N+NRWALL) = ITIED
313 NPRW(N+2*NRWALL) = MSR
314 NPRW(N+3*NRWALL) = ITYP
315 NPRW(N+4*NRWALL) = 0
316 NPRW(N+5*NRWALL) = 0
317 K = K+NSL
318C
319 ENDDO
320C
321 ! Updating the OFFSET
322 OFFS = OFFS + NCHSPHER
323C------------------------------------------
324 RETURN
325C
326 1100 FORMAT(/5X,'rigid wall number. . . . .',I10
327 . /10X,'rigid wall TYPE . . . . .',I10
328 . /10X,'type slide/tied/friction.',I10
329 . /10X,'number of nodes . . . . .',I10)
330 1150 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 . /10X,'wall node number. . . . .',I10
335 . /10X,'wall mass . . . . . . . .',1PG14.4
336 . /10X,'wall x-velocity . . . . .',1PG14.4
337 . /10X,'wall y-velocity . . . . .',1PG14.4
338 . /10X,'wall z-velocity . . . . .',1PG14.4)
339 1200 FORMAT(/10X,'secondary nodes : ')
340 1201 FORMAT(/10X,10I10)
341 2003 FORMAT(/5X,'spherical wall characteristics',
342 . /10X,'point m . . . . . . . . .',1P3G20.13
343 . /10X,'sphere diameter . . . . .',1PG14.4)
344 2101 FORMAT(/5X,'coulomb friction characteristics',
345 . /10X,'friction coefficient . . .',1PG14.4
346 . /10X,'filtration flag. . . . . .',I10
347 . /10X,'filtration factor. . . . .',1PG14.4)
348 END
349
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
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_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:410
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
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
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