OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cndint.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "scr02_c.inc"
#include "scr18_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cndint (ixc, ipartc, ixtg, iparttg, ipart, itask, a, v, ar, vr, ms, in, nodft, nodlt, x, sh4tree, sh3tree, itab, stifn, stifr, mscnd, incnd)

Function/Subroutine Documentation

◆ cndint()

subroutine cndint ( integer, dimension(nixc,*) ixc,
integer, dimension(*) ipartc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) iparttg,
integer, dimension(lipart1,*) ipart,
integer itask,
a,
v,
ar,
vr,
ms,
in,
integer nodft,
integer nodlt,
x,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree,
integer, dimension(*) itab,
stifn,
stifr,
mscnd,
incnd )

Definition at line 33 of file cndint.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE remesh_mod
42 use element_mod , only : nixc,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "scr17_c.inc"
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "remesh_c.inc"
55#include "scr02_c.inc"
56#include "scr18_c.inc"
57#include "task_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IXC(NIXC,*), IPARTC(*), IXTG(NIXTG,*), IPARTTG(*),
62 . IPART(LIPART1,*), ITASK, NODFT, NODLT,SH4TREE(KSH4TREE,*),
63 . SH3TREE(KSH3TREE,*), ITAB(*)
64 my_real
65 . a(3,*),v(3,*),
66 . ar(3,*),vr(3,*), ms(*), in(*), x(3,*),
67 . stifn(*), stifr(*), mscnd(*), incnd(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER SH4FT, SH4LT, SH3FT, SH3LT
72 INTEGER N, NN, LEVEL, IP, NLEV, LL, IERR
73 INTEGER SON,M1,M2,M3,M4,MC,N1,N2,N3,N4,J,NA,NB
74 my_real
75 . vv, ax(3,numnod), arx(3,numnod), fac,
76 . dt2p, mas, iner, dtn
77C-----------------------------------------------
78C
79C allocation tag
80 tagnod(nodft:nodlt)=0
81C
82C Retrieve forces on nodes (static nodes would be enough).
83 ax(1:3,nodft:nodlt)=acnd(1:3,nodft:nodlt)
84 arx(1:3,nodft:nodlt)=arcnd(1:3,nodft:nodlt)
85C
86 CALL my_barrier
87C
88 ll=psh4upl(1)
89 sh4ft = 1+itask*ll/ nthread
90 sh4lt = (itask+1)*ll/nthread
91
92 DO nn=sh4ft,sh4lt
93 n =lsh4upl(nn)
94C
95 n1=ixc(2,n)
96 n2=ixc(3,n)
97 n3=ixc(4,n)
98 n4=ixc(5,n)
99C
100 IF(tagnod(n1)==0)THEN
101 tagnod(n1)=1
102 DO j=1,3
103 acnd(j,n1) =a(j,n1)
104 END DO
105 DO j=1,3
106 arcnd(j,n1) =ar(j,n1)
107 END DO
108 END IF
109C
110 IF(tagnod(n2)==0)THEN
111 tagnod(n2)=1
112 DO j=1,3
113 acnd(j,n2) =a(j,n2)
114 END DO
115 DO j=1,3
116 arcnd(j,n2) =ar(j,n2)
117 END DO
118 END IF
119C
120 IF(tagnod(n3)==0)THEN
121 tagnod(n3)=1
122 DO j=1,3
123 acnd(j,n3) =a(j,n3)
124 END DO
125 DO j=1,3
126 arcnd(j,n3) =ar(j,n3)
127 END DO
128 END IF
129C
130 IF(tagnod(n4)==0)THEN
131 tagnod(n4)=1
132 DO j=1,3
133 acnd(j,n4) =a(j,n4)
134 END DO
135 DO j=1,3
136 arcnd(j,n4) =ar(j,n4)
137 END DO
138 END IF
139C
140 END DO
141C
142 ll=psh3upl(1)
143 sh3ft = 1+itask*ll/ nthread
144 sh3lt = (itask+1)*ll/nthread
145
146 DO nn=sh3ft,sh3lt
147 n =lsh3upl(nn)
148C
149 n1=ixtg(2,n)
150 n2=ixtg(3,n)
151 n3=ixtg(4,n)
152C
153 IF(tagnod(n1)==0)THEN
154 tagnod(n1)=1
155 DO j=1,3
156 acnd(j,n1) =a(j,n1)
157 END DO
158 DO j=1,3
159 arcnd(j,n1) =ar(j,n1)
160 END DO
161 END IF
162C
163 IF(tagnod(n2)==0)THEN
164 tagnod(n2)=1
165 DO j=1,3
166 acnd(j,n2) =a(j,n2)
167 END DO
168 DO j=1,3
169 arcnd(j,n2) =ar(j,n2)
170 END DO
171 END IF
172C
173 IF(tagnod(n3)==0)THEN
174 tagnod(n3)=1
175 DO j=1,3
176 acnd(j,n3) =a(j,n3)
177 END DO
178 DO j=1,3
179 arcnd(j,n3) =ar(j,n3)
180 END DO
181 END IF
182C
183 END DO
184C
185 CALL my_barrier
186C
187 tagnod(nodft:nodlt)=0
188C
189 CALL my_barrier
190C
191C-------
192C interpolation of v, a
193 DO level=0,levelmax-1
194
195 ll=psh4upl(level+1)-psh4upl(level)
196 sh4ft = psh4upl(level)+ 1+itask*ll/ nthread
197 sh4lt = psh4upl(level)+ (itask+1)*ll/nthread
198
199 DO nn=sh4ft,sh4lt
200 n =lsh4upl(nn)
201C
202 n1=ixc(2,n)
203 n2=ixc(3,n)
204 n3=ixc(4,n)
205 n4=ixc(5,n)
206C
207 son=sh4tree(2,n)
208C
209 mc=ixc(3,son+3)
210
211 IF(tagnod(mc)==0)THEN
212
213 tagnod(mc)=1
214 DO j=1,3
215 vv =
216 . fourth*(acnd(j,n1)+acnd(j,n2)+acnd(j,n3)+acnd(j,n4))
217 acnd(j,mc) =vv
218 END DO
219
220 DO j=1,3
221 vv =
222 . fourth*(arcnd(j,n1)+arcnd(j,n2)+arcnd(j,n3)+arcnd(j,n4))
223 arcnd(j,mc)=vv
224 END DO
225
226 END IF
227C
228 m1=ixc(3,son )
229 m2=ixc(4,son+1)
230 m3=ixc(5,son+2)
231 m4=ixc(2,son+3)
232
233 IF(tagnod(m1)==0)THEN
234 tagnod(m1)=1
235 na=min(n1,n2)
236 nb=max(n1,n2)
237
238 DO j=1,3
239 vv = half*(acnd(j,na)+acnd(j,nb))
240 acnd(j,m1) =vv
241 END DO
242
243 DO j=1,3
244 vv = half*(arcnd(j,na)+arcnd(j,nb))
245 arcnd(j,m1)=vv
246 END DO
247
248 END IF
249
250 IF(tagnod(m2)==0)THEN
251 tagnod(m2)=1
252 na=min(n2,n3)
253 nb=max(n2,n3)
254
255 DO j=1,3
256 vv = half*(acnd(j,na)+acnd(j,nb))
257 acnd(j,m2) =vv
258 END DO
259
260 DO j=1,3
261 vv = half*(arcnd(j,na)+arcnd(j,nb))
262 arcnd(j,m2)=vv
263 END DO
264
265 END IF
266
267 IF(tagnod(m3)==0)THEN
268 tagnod(m3)=1
269 na=min(n3,n4)
270 nb=max(n3,n4)
271
272 DO j=1,3
273 vv = half*(acnd(j,na)+acnd(j,nb))
274 acnd(j,m3) =vv
275 END DO
276
277 DO j=1,3
278 vv = half*(arcnd(j,na)+arcnd(j,nb))
279 arcnd(j,m3)=vv
280 END DO
281
282 END IF
283
284 IF(tagnod(m4)==0)THEN
285 tagnod(m4)=1
286 na=min(n4,n1)
287 nb=max(n4,n1)
288
289 DO j=1,3
290 vv = half*(acnd(j,na)+acnd(j,nb))
291 acnd(j,m4) =vv
292 END DO
293
294 DO j=1,3
295 vv = half*(arcnd(j,na)+arcnd(j,nb))
296 arcnd(j,m4)=vv
297 END DO
298
299 END IF
300
301 END DO
302C
303 ll=psh3upl(level+1)-psh3upl(level)
304 sh3ft = psh3upl(level)+ 1+itask*ll/ nthread
305 sh3lt = psh3upl(level)+ (itask+1)*ll/nthread
306
307 DO nn=sh3ft,sh3lt
308 n =lsh3upl(nn)
309C
310 n1=ixtg(2,n)
311 n2=ixtg(3,n)
312 n3=ixtg(4,n)
313C
314 son=sh3tree(2,n)
315C
316 m1=ixtg(4,son+3)
317 m2=ixtg(2,son+3)
318 m3=ixtg(3,son+3)
319
320 IF(tagnod(m1)==0)THEN
321 tagnod(m1)=1
322 na=min(n1,n2)
323 nb=max(n1,n2)
324
325 DO j=1,3
326 vv = half*(acnd(j,na)+acnd(j,nb))
327 acnd(j,m1) =vv
328 END DO
329 DO j=1,3
330 vv = half*(arcnd(j,na)+arcnd(j,nb))
331 arcnd(j,m1)=vv
332 END DO
333
334 END IF
335
336 IF(tagnod(m2)==0)THEN
337 tagnod(m2)=1
338 na=min(n2,n3)
339 nb=max(n2,n3)
340 DO j=1,3
341 vv = half*(acnd(j,na)+acnd(j,nb))
342 acnd(j,m2) =vv
343 END DO
344 DO j=1,3
345 vv = half*(arcnd(j,na)+arcnd(j,nb))
346 arcnd(j,m2)=vv
347 END DO
348
349 END IF
350
351 IF(tagnod(m3)==0)THEN
352 tagnod(m3)=1
353 na=min(n3,n1)
354 nb=max(n3,n1)
355 DO j=1,3
356 vv = half*(acnd(j,na)+acnd(j,nb))
357 acnd(j,m3) =vv
358 END DO
359 DO j=1,3
360 vv = half*(arcnd(j,na)+arcnd(j,nb))
361 arcnd(j,m3)=vv
362 END DO
363
364 END IF
365
366 END DO
367C
368 CALL my_barrier
369C
370C-------
371 END DO
372C
373C-------
374 IF(nodadt /= 0.OR.i7kglo/=0.AND.(idtmin(11)==3.OR.idtmin(11)==8))THEN
375 dt2p = dtmin1(11)/dtfac1(11)
376 DO n=nodft,nodlt
377 IF(tagnod(n)/=0)THEN
378 mas = half * stifn(n) * dt2p * dt2p * onep00001
379 mscnd(n)=max(mscnd(n),mas)
380 END IF
381 END DO
382 END IF
383 IF(nodadt /= 0.AND.(idtmin(11)==3.OR.idtmin(11)==8))THEN
384 dt2p = dtmin1(11)/dtfac1(11)
385 DO n=nodft,nodlt
386 IF(tagnod(n)/=0)THEN
387 iner = half * stifr(n) * dt2p * dt2p * onep00001
388 incnd(n)=max(incnd(n),iner)
389 END IF
390 END DO
391 END IF
392
393c for debug
394c DT2P=DT2*ZEP999
395c DO N=NODFT,NODLT
396c IF(TAGNOD(N)/=0)THEN
397c DTN = DTFAC1(11)*SQRT(2. * MSCND(N) / STIFN(N))
398c IF(DTN < DT2P)THEN
399c#include "lockon.inc"
400c WRITE(IOUT,*)
401c .' **WARNING : TIME STEP LESS OR EQUAL DT2 FOR CONDENSED NODE N=',
402c . ITAB(N),DT2,DTN
403c WRITE(ISTDO,*)
404c .' **WARNING : TIME STEP LESS OR EQUAL DT2 FOR CONDENSED NODE N=',
405c . ITAB(N),DT2,DTN
406c#include "lockoff.inc"
407c END IF
408c DTN = DTFAC1(11)*SQRT(2. * INCND(N) / STIFR(N))
409c IF(DTN < DT2P)THEN
410c#include "lockon.inc"
411c WRITE(IOUT,*)
412c .' **WARNING : TIME STEP LESS OR EQUAL DT2 FOR CONDENSED NODE N=',
413c . ITAB(N),DT2,DTN
414c WRITE(ISTDO,*)
415c .' **WARNING : TIME STEP LESS OR EQUAL DT2 FOR CONDENSED NODE N=',
416c . ITAB(N),DT2,DTN
417c#include "lockoff.inc"
418c END IF
419c END IF
420c END DO
421C
422C-------
423 DO n=nodft,nodlt
424 IF(tagnod(n)/=0)THEN
425
426 fac=one/max(mscnd(n),em20)
427 a(1,n) = ax(1,n)*fac+acnd(1,n)
428 a(2,n) = ax(2,n)*fac+acnd(2,n)
429 a(3,n) = ax(3,n)*fac+acnd(3,n)
430
431 fac=one/max(incnd(n),em20)
432 ar(1,n) = arx(1,n)*fac+arcnd(1,n)
433 ar(2,n) = arx(2,n)*fac+arcnd(2,n)
434 ar(3,n) = arx(3,n)*fac+arcnd(3,n)
435
436 END IF
437 END DO
438
439 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh4upl
integer, dimension(:), allocatable lsh4upl
Definition remesh_mod.F:71
remesh_mod::lsh3upl
integer, dimension(:), allocatable lsh3upl
Definition remesh_mod.F:71
remesh_mod::psh3upl
integer, dimension(:), allocatable psh3upl
Definition remesh_mod.F:71
remesh_mod::psh4upl
integer, dimension(:), allocatable psh4upl
Definition remesh_mod.F:71
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77
my_barrier
subroutine my_barrier
Definition machine.F:31