OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rwall_paral.F File Reference
#include "implicit_f.inc"
#include "analyse_name.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ hm_read_rwall_paral()

subroutine hm_read_rwall_paral ( rwl,
integer, dimension(*) nprw,
integer, dimension(*) lprw,
integer ifi,
ms,
v,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
x,
integer, dimension(*) ikine,
type (group_), dimension(ngrnod), target igrnod,
integer mfi,
integer, dimension(*) imerge,
type (unit_type_), intent(in) unitab,
integer iddlevel,
type(submodel_data), dimension(nsubmod) lsubmodel,
rtrans,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) itagnd,
integer nchparal,
integer k,
integer offs,
integer, dimension(3*numnod) ikine1 )

Definition at line 47 of file hm_read_rwall_paral.F.

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.AND. IF (UID /= 0 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)
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
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
submodel_mod::submodel_data
Definition submodel_mod.F:723