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 32 of file cndint.F.

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