OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_paral.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_paral ../starter/source/constraints/general/rwall/hm_read_rwall_paral.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_paral(RWL ,NPRW ,LPRW ,IFI ,MS ,
48 . V ,ITAB ,ITABM1 ,X ,IKINE ,
49 . IGRNOD ,MFI ,IMERGE ,UNITAB ,IDDLEVEL,
50 . LSUBMODEL,RTRANS ,NOM_OPT ,ITAGND ,NCHPARAL,
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,NCHPARAL,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, XM2, YM2, VN
98 my_real :: ZM2, 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/PARAM read with hm reader !
112! ******************************** !
113C-----------------------------------------------
114 is_available = .false.
115 CALL hm_option_start('/RWALL/PARAL')
116 ! Flag for RWALL type PARAL
117 ityp = 4
118 !----------------------------------------------------------------------
119 ! Loop over NCHPARAL
120 !----------------------------------------------------------------------
121 DO n = 1+offs, nchparal+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.AND. IF (FREQ == 0 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.OR..AND. IF ((ALPHA < ZERO) ((ALPHA > ONE 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 VX = ZERO
205 VY = ZERO
206 VZ = ZERO
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 ! 4th card (only for PLANE, CYL and PARAL)
230 ! XM1 YM1 ZM1
231 CALL HM_GET_FLOATV('cnode1_x' ,XM1 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
232 CALL HM_GET_FLOATV('cnode1_y' ,YM1 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
233 CALL HM_GET_FLOATV('cnode1_z' ,ZM1 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
234 IF(SUB_ID /= 0) CALL SUBROTPOINT(XM1,YM1,ZM1,RTRANS,SUB_ID,LSUBMODEL)
235C
236 ! 5th card (only for PARAL)
237 ! XM2 YM2 ZM2
238 CALL HM_GET_FLOATV('cnode2_x' ,XM2 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
239 CALL HM_GET_FLOATV('cnode2_y' ,YM2 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
240 CALL HM_GET_FLOATV('cnode2_z' ,ZM2 ,IS_AVAILABLE, LSUBMODEL, UNITAB)
241 IF(SUB_ID /= 0) CALL SUBROTPOINT(XM2,YM2,ZM2,RTRANS,SUB_ID,LSUBMODEL)
242C
243 ! Initialization depending on the type of interface
244C MM1 ET MM2 DEFINISSENT LE PARALLELOGRAMME
245 RWL(1,N) = (YM1-RWL(5,N))*(ZM2-RWL(6,N))
246 . - (ZM1-RWL(6,N))*(YM2-RWL(5,N))
247 RWL(2,N) = (ZM1-RWL(6,N))*(XM2-RWL(4,N))
248 . - (XM1-RWL(4,N))*(ZM2-RWL(6,N))
249 RWL(3,N) = (XM1-RWL(4,N))*(YM2-RWL(5,N))
250 . - (YM1-RWL(5,N))*(XM2-RWL(4,N))
251 XN = SQRT(RWL(1,N)**2+RWL(2,N)**2+RWL(3,N)**2)
252 IF (XN <= EM10) THEN
253 CALL ANCMSG(MSGID=168,ANMODE=ANINFO,MSGTYPE=MSGERROR,
254 . I1=NUSER,C2='paral',C1=TITR)
255 ELSE
256 RWL(1,N) = RWL(1,N)/XN
257 RWL(2,N) = RWL(2,N)/XN
258 RWL(3,N) = RWL(3,N)/XN
259 ENDIF
260 RWL(7,N) = XM1-RWL(4,N)
261 RWL(8,N) = YM1-RWL(5,N)
262 RWL(9,N) = ZM1-RWL(6,N)
263 RWL(10,N) = XM2-RWL(4,N)
264 RWL(11,N) = YM2-RWL(5,N)
265 RWL(12,N) = ZM2-RWL(6,N)
266C
267 ! Looking for SECONDARY nodes
268 DO I = 1,NUMNOD
269 LPRW(K+I) = 0
270 ENDDO
271C
272 ! SECONDARY nodes at DIST from the RWALL
273 IF (DIST /= ZERO) THEN
274 DO I = 1,NUMNOD
275 X1 = (X(1,I)-RWL(4,N))*RWL(1,N)
276 Y1 = (X(2,I)-RWL(5,N))*RWL(2,N)
277 Z1 = (X(3,I)-RWL(6,N))*RWL(3,N)
278 DISN = X1+Y1+Z1
279.AND..AND. IF (DISN >= ZERO DISN <= DIST I /= MSR) LPRW(K+I)=1
280 ENDDO
281 ENDIF
282C
283 ! Node group +
284 INGR2USR => IGRNOD(1:NGRNOD)%ID
285 IGRS = NGR2USR(IGU,INGR2USR,NGRNOD)
286 IF (IGRS /= 0) THEN
287 DO J = 1,IGRNOD(IGRS)%NENTITY
288 NOSYS = IGRNOD(IGRS)%ENTITY(J)
289 LPRW(K+NOSYS) = 1
290 IF (ITAB(NOSYS) == NUSER) THEN
291 CALL ANCMSG(MSGID=637,
292 . MSGTYPE=MSGERROR,
293 . ANMODE=ANINFO_BLIND_1,
294 . I1=NUSER,
295 . C1=TITR,
296 . I2=NUSER)
297 ENDIF
298 ENDDO
299 ENDIF
300C
301 ! Node group -
302 INGR2USR => IGRNOD(1:NGRNOD)%ID
303 IGRS = NGR2USR(IGU2,INGR2USR,NGRNOD)
304 IF (IGRS /= 0) THEN
305 DO J = 1,IGRNOD(IGRS)%NENTITY
306 NOSYS = IGRNOD(IGRS)%ENTITY(J)
307 LPRW(K+NOSYS) = 0
308 ENDDO
309 ENDIF
310C
311 ! Compaction
312 NSL = 0
313 DO I = 1,NUMNOD
314 IF (LPRW(K+I) > 0) THEN
315 IF (NS10E > 0) THEN
316 IF(ITAGND(I) /= 0) CYCLE
317 ENDIF
318 NSL = NSL+1
319 LPRW(K+NSL) = I
320 IF (IDDLEVEL == 0) THEN
321 CALL KINSET(4,ITAB(I),IKINE(I),1,N+NUMSKW+1,IKINE1(I))
322 ENDIF
323 ENDIF
324 ENDDO
325 ! Itet=2 of S10
326 IF (NS10E > 0 ) CALL REMOVE_ND(NSL,LPRW(K+1),ITAGND)
327 IFI=IFI+NSL
328 IF (IFQ > 0) THEN
329 MFI=MFI+3*NSL
330 SRWSAV = SRWSAV + 3 * NSL
331 ENDIF
332C
333 ! Printing
334 IF (MSR == 0) THEN
335 WRITE(IOUT,1100) N,ITYP,ITIED,NSL
336 ELSE
337 WRITE(IOUT,1150) N,ITYP,ITIED,NSL,NUSER,XMAS,VX,VY,VZ
338 ENDIF
339C
340 WRITE(IOUT,2004)(RWL(L,N),L=4,6),(RWL(L,N),L=7,9),
341 . (RWL(L,N),L=10,12)
342C
343 IF (ITIED == 2) WRITE(IOUT,2101) FRIC,IFQ,FREQ
344 IF (IPRI >= 1) THEN
345 WRITE(IOUT,1200)
346 WRITE(IOUT,1201) (ITAB(LPRW(I+K)),I=1,NSL)
347 ENDIF
348C
349 NPRW(N) = NSL
350 NPRW(N+NRWALL) = ITIED
351 NPRW(N+2*NRWALL) = MSR
352 NPRW(N+3*NRWALL) = ITYP
353 NPRW(N+4*NRWALL) = 0
354 NPRW(N+5*NRWALL) = 0
355 IF (MSR /= 0) THEN
356 VN = VX*RWL(1,N)+VY*RWL(2,N)+VZ*RWL(3,N)
357 RWL(4,N) = VN
358 RWL(5,N) = ZERO
359 RWL(6,N) = ZERO
360 ENDIF
361 K = K+NSL
362C
363 ENDDO
364C
365 ! Updating the OFFSET
366 OFFS = OFFS + NCHPARAL
367C---------------------------------
368 RETURN
369C
370 1100 FORMAT(/5X,'rigid wall number. . . . .',I10
371 . /10X,'rigid wall TYPE . . . . .',I10
372 . /10X,'type slide/tied/friction.',I10
373 . /10X,'number of nodes . . . . .',I10)
374 1150 FORMAT(/5X,'rigid wall number. . . . .',I10
375 . /10X,'rigid wall TYPE . . . . .',I10
376 . /10X,'type slide/tied/friction.',I10
377 . /10X,'number of nodes . . . . .',I10
378 . /10X,'wall node number. . . . .',I10
379 . /10X,'wall mass . . . . . . . .',1PG14.4
380 . /10X,'wall x-velocity . . . . .',1PG14.4
381 . /10X,'wall y-velocity . . . . .',1PG14.4
382 . /10X,'wall z-velocity . . . . .',1PG14.4)
383 1200 FORMAT(/10X,'secondary nodes : ')
384 1201 FORMAT(/10X,10I10)
385 2004 FORMAT(/5X,'parallelogramm wall characteristics',
386 . /10X,'point m . . . . . . . . .',1P3G20.13
387 . /10X,'mm1 vector. . . . . . . .',1P3G20.13
388 . /10X,'mm2 vector. . . . . . . .',1P3G20.13)
389 2101 FORMAT(/5X,'coulomb friction characteristics',
390 . /10X,'friction coefficient . . .',1PG14.4
391 . /10X,'filtration flag. . . . . .',I10
392 . /10X,'filtration factor. . . . .',1PG14.4)
393 END
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
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_paral
subroutine hm_read_rwall_paral(rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ikine, igrnod, mfi, imerge, unitab, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, nchparal, k, offs, ikine1)
Definition hm_read_rwall_paral.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