OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dtnodams.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!|| dtnodams ../engine/source/time_step/dtnodams.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| groupdef_mod ../common_source/modules/groupdef_mod.F
32!|| h3d_mod ../engine/share/modules/h3d_mod.F
33!|| message_mod ../engine/share/message_module/message_mod.F
34!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
35!||====================================================================
36 SUBROUTINE dtnodams(NODFT ,NODLT ,NELTST,ITYPTST,ITAB ,
37 2 MS ,IN ,STIFN ,STIFR ,DT2T ,
38 3 DMAST ,DINERT,ADT ,ADM ,IMSCH ,
39 4 WEIGHT,A ,AR ,IGRNOD ,
40 5 ADI ,RBYM ,ARBY ,ARRBY ,ISMSCH ,
41 6 NODNX_SMS,DIAG_SMS ,NPBY ,TAGMSR_RBY_SMS,
42 7 H3D_DATA )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 USE h3d_mod
48 USE groupdef_mod
49 USE my_alloc_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com01_c.inc"
59#include "com04_c.inc"
60#include "task_c.inc"
61#include "scr02_c.inc"
62#include "scr07_c.inc"
63#include "scr14_c.inc"
64#include "scr16_c.inc"
65#include "scr18_c.inc"
66#include "units_c.inc"
67#include "com08_c.inc"
68#include "param_c.inc"
69#include "parit_c.inc"
70#include "sms_c.inc"
71C-----------------------------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER NODFT, NODLT,NELTST,ITYPTST,ITAB(*),
75 . WEIGHT(*),IMSCH,
76 . ISMSCH, NODNX_SMS(*), NPBY(NNPBY,*), TAGMSR_RBY_SMS(*)
77C REAL
78 my_real DT2T, DMAST, DINERT,
79 . MS(*) ,IN(*) ,STIFN(*), STIFR(*),ADT(*) ,ADM(*) ,
80 . a(3,*) ,ar(3,*) ,adi(*) ,rbym(nfrbym,*),arby(3,*),
81 . arrby(3,*), diag_sms(*)
82 TYPE(h3d_database) :: H3D_DATA
83C-----------------------------------------------
84 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER N, NN, K1, KMAX1, K2, KMAX2, ISTOP,I,J,
89 . INDTN1(1024), INDTN2(1024), IOK, K, M, MSR, NSN, IAD
90 INTEGER,DIMENSION(:),ALLOCATABLE :: TAG
91 INTEGER,DIMENSION(:),ALLOCATABLE :: TAGR
92 my_real DTN1(1024), DTN2(1024),
93 . DTNOD1, DTNOD2, DT2P, MAS, INER, MAS0, DMM, MASS, STI,
94 . dt2x, dt2s
95C----------------------------------------------------------
96 CALL my_alloc(tag,numnod)
97 CALL my_alloc(tagr,numnod)
98C----------------------------------------------------------
99C TAG NODAL GROUP
100C----------------------------------------------------------
101 IF(idtgr(11)<0)THEN
102 iok = 0
103 DO n=1,ngrnod
104 IF (-idtgr(11)==igrnod(n)%ID) THEN
105 idtgr(11)=n
106 iok = 1
107 ENDIF
108 ENDDO
109 IF (iok == 0) THEN
110 CALL ancmsg(msgid=237,anmode=aninfo,
111 . i1=-idtgr(11))
112 CALL arret(2)
113 ENDIF
114 ENDIF
115 IF(idtgr(11)/=0)THEN
116 DO n=nodft,nodlt
117 tag(n) = 0
118 tagr(n) = 0
119 ENDDO
120 DO n=1,igrnod(idtgr(11))%NENTITY
121 IF(nodnx_sms(igrnod(idtgr(11))%ENTITY(n))==0)THEN
122 tag(igrnod(idtgr(11))%ENTITY(n)) = 1
123 tagr(igrnod(idtgr(11))%ENTITY(n)) = 1
124 END IF
125 ENDDO
126 ELSE
127 DO n=nodft,nodlt
128 IF(nodnx_sms(n)==0)THEN
129 tag(n) = 1
130 tagr(n) = 1
131 ELSE
132 tag(n) = 0
133 tagr(n) = 0
134 END IF
135 ENDDO
136 ENDIF
137C----------------------------------------------------------
138C ANIM TIME STEP
139C----------------------------------------------------------
140!$OMP SINGLE
141 imsch = 0
142!$OMP END SINGLE
143 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
144#include "vectorize.inc"
145 DO nn=nodft,nodlt
146 adt(nn) = ep06
147 ENDDO
148 ENDIF
149C----------------------------------------------------------
150C SCALE TIME STEP
151C----------------------------------------------------------
152 istop = 0
153C----------------------------------------------------------
154C NODAL TIME STEP VS TRANSLATION (NON AMS NODES)
155C----------------------------------------------------------
156 dt2s=dt2t
157
158 IF(i7kglo > 0 .OR. nodadt /= 0)THEN
159 DO 370 i=nodft,nodlt,1024
160 k1 = 0
161 dtnod1 = ep20
162#include "vectorize.inc"
163 DO n=i,min(nodlt,i+1023)
164 IF(stifn(n)<=zero)THEN
165 istop = -itab(n)
166 ELSEIF(nodnx_sms(n)==0)THEN
167 IF(ms(n)>zero)THEN
168 k1 = k1 + 1
169C MS si non compense
170 dtn1(k1) = dtfac1(11)*sqrt(two * ms(n) / stifn(n))
171 dtnod1 = min(dtnod1,dtn1(k1))
172 indtn1(k1) = n
173 ENDIF
174 ENDIF
175 ENDDO
176 kmax1 = k1
177C
178 IF(dtnod1<dtmin1(11))THEN
179 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
180 DO k1=1,kmax1
181C IF(DTN1(K1)<DTMIN1(11))THEN
182C N = INDTN1(K1)
183C ISTOP = ITAB(N)
184C ENDIF
185 dtn1(k1)=dtmin1(11)
186 ENDDO
187 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
188C----------------------------------------------------------
189 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
190#include "vectorize.inc"
191 DO k1=1,kmax1
192 IF(dtn1(k1)<dtmin1(11))THEN
193 n = indtn1(k1)
194 dt2p = dtmin1(11)/dtfac1(11)
195 mas = half * stifn(n) * dt2p * dt2p * onep00001
196 IF(tag(n)==1)THEN
197 IF(weight(n)==1) THEN
198 dmast = dmast + mas - ms(n)
199 adm(n) = mas*(one+adm(n))/ms(n) - one
200 ENDIF
201 ms(n) = mas
202 imsch = 1
203 ENDIF
204 dtn1(k1)=dtmin1(11)
205 ENDIF
206 ENDDO
207 ELSE
208#include "vectorize.inc"
209 DO k1=1,kmax1
210 IF(dtn1(k1)<dtmin1(11))THEN
211 n = indtn1(k1)
212 dt2p = dtmin1(11)/dtfac1(11)
213 mas = half * stifn(n) * dt2p * dt2p * onep00001
214 IF(tag(n)==1)THEN
215 dmast = dmast + (mas - ms(n))*weight(n)
216 ms(n) = mas
217 imsch = 1
218 ENDIF
219 dtn1(k1)=dtmin1(11)
220 ENDIF
221 ENDDO
222 ENDIF
223 ELSEIF(idtmin(11)==4)THEN
224#include "vectorize.inc"
225 DO k1=1,kmax1
226 IF(dtn1(k1)<dtmin1(11))THEN
227 n = indtn1(k1)
228 dt2p = dtmin1(11)/dtfac1(11)
229 mas = half * stifn(n) * dt2p * dt2p
230 mas=ms(n)/mas
231 dtn1(k1)=dtmin1(11)
232 a(1,n)=a(1,n)*mas
233 a(2,n)=a(2,n)*mas
234 a(3,n)=a(3,n)*mas
235 ENDIF
236 ENDDO
237 ENDIF
238 ENDIF
239C--------
240 IF(dtnod1<dt2t)THEN
241 DO k1=1,kmax1
242 IF(dtn1(k1)<dt2t)THEN
243 n = indtn1(k1)
244 neltst = itab(n)
245 ityptst = 11
246 dt2t = dtn1(k1)
247 ENDIF
248 ENDDO
249 ENDIF
250#include "vectorize.inc"
251 DO n=i,min(nodlt,i+1023)
252 stifn(n) = em20
253 ENDDO
254C----------------------------------------------------------
255C ANIM TIME STEP
256C----------------------------------------------------------
257 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
258#include "vectorize.inc"
259 DO k1=1,kmax1
260 adt(indtn1(k1))=dtn1(k1)
261 ENDDO
262 ENDIF
263 370 CONTINUE
264 END IF
265C----------------------------------------------------------
266C AMS TIME STEP & NODAL TIME STEP (ROTATION)
267C----------------------------------------------------------
268 IF (iroddl/=0) THEN
269 DO 450 i=nodft,nodlt,1024
270 dtnod1 = ep20
271 dtnod2 = ep20
272 k1 = 0
273 k2 = 0
274#include "vectorize.inc"
275 DO n=i,min(nodlt,i+1023)
276 IF(stifr(n)<=zero)THEN
277 istop=-itab(n)
278 ELSEIF(nodadt/=0 .AND. nodnx_sms(n)==0)THEN
279 IF(in(n)>zero)THEN
280 k1 = k1 + 1
281 indtn1(k1) = n
282 dtn1(k1) = dtfac1(11)*sqrt(two * in(n) / stifr(n))
283 dtnod1 = min(dtnod1,dtn1(k1))
284 ENDIF
285 ELSEIF(nodnx_sms(n)/=0)THEN
286 IF(in(n)>zero)THEN
287 k2 = k2 + 1
288 indtn2(k2) = n
289 dtn2(k2) = dtfacs*sqrt(two * in(n) / stifr(n))
290 dtnod2 = min(dtnod2,dtn2(k2))
291 ENDIF
292 ENDIF
293 ENDDO
294 kmax1 = k1
295 kmax2 = k2
296 IF(dtnod1<dtmin1(11))THEN
297 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
298 DO k1=1,kmax1
299 dtn1(k1)=dtmin1(11)
300C IF(DTN1(K1)<DTMIN1(11))THEN
301C N = INDTN1(K1)
302C ISTOP = ITAB(N)
303C ENDIF
304 ENDDO
305 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
306 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
307#include "vectorize.inc"
308 DO k1=1,kmax1
309 IF(dtn1(k1)<dtmin1(11))THEN
310 n = indtn1(k1)
311 iner = in(n)
312 dt2p = dtmin1(11)/dtfac1(11)
313 iner = half * stifr(n) * dt2p * dt2p * onep00001
314 IF(tagr(n)==1)THEN
315 IF(weight(n)==1)THEN
316 dinert = dinert + ( iner - in(n))
317 adi(n) = iner*(one+adi(n))/in(n) - one
318 END IF
319 in(n) = max(iner,in(n))
320 imsch = 1
321 ENDIF
322 dtn1(k1)=dtmin1(11)
323 ENDIF
324 ENDDO
325C
326 ELSE
327#include "vectorize.inc"
328 DO k1=1,kmax1
329 IF(dtn1(k1)<dtmin1(11))THEN
330 n = indtn1(k1)
331 iner = in(n)
332 dt2p = dtmin1(11)/dtfac1(11)
333 iner = half * stifr(n) * dt2p * dt2p * onep00001
334 IF(tagr(n)==1)THEN
335 dinert = dinert + ( iner - in(n))*weight(n)
336 in(n) = max(iner,in(n))
337 imsch = 1
338 ENDIF
339 dtn1(k1)=dtmin1(11)
340 ENDIF
341 ENDDO
342 ENDIF
343 ELSEIF(idtmin(11)==4)THEN
344#include "vectorize.inc"
345 DO k1=1,kmax1
346 IF(dtn1(k1)<dtmin1(11))THEN
347 n = indtn1(k1)
348 dt2p = dtmin1(11)/dtfac1(11)
349 mas = half * stifr(n) * dt2p * dt2p
350 mas=in(n)/mas
351 dtn1(k1)=dtmin1(11)
352 ar(1,n)=ar(1,n)*mas
353 ar(2,n)=ar(2,n)*mas
354 ar(3,n)=ar(3,n)*mas
355 ENDIF
356 ENDDO
357 ENDIF
358 ENDIF
359C-----------
360 IF(dtnod1<dt2t)THEN
361 DO k1=1,kmax1
362 IF(dtn1(k1)<dt2t)THEN
363 n = indtn1(k1)
364 neltst = itab(n)
365 ityptst = 11
366 dt2t = dtn1(k1)
367 ENDIF
368 ENDDO
369 ENDIF
370C-----------
371 IF(dtnod2<dtmins)THEN
372 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
373#include "vectorize.inc"
374 DO k2=1,kmax2
375 IF(dtn2(k2)<dtmins)THEN
376 n = indtn2(k2)
377 iner = in(n)
378 dt2p = dtmins/dtfacs
379 iner = half * stifr(n) * dt2p * dt2p * onep00001
380 IF(nodnx_sms(n)/=0)THEN
381 IF(weight(n)==1)THEN
382 dinert = dinert + ( iner - in(n))
383 adi(n) = iner*(one+adi(n))/in(n) - one
384 END IF
385 in(n) = max(iner,in(n))
386 imsch = 1
387 dtn2(k2)=dtmins
388 ENDIF
389 ENDIF
390 ENDDO
391C
392 ELSE
393#include "vectorize.inc"
394 DO k2=1,kmax2
395 IF(dtn2(k2)<dtmins)THEN
396 n = indtn2(k2)
397 iner = in(n)
398 dt2p = dtmins/dtfacs
399 iner = half * stifr(n) * dt2p * dt2p * onep00001
400 IF(nodnx_sms(n)/=0)THEN
401 dinert = dinert + ( iner - in(n))*weight(n)
402 in(n) = max(iner,in(n))
403 imsch = 1
404 dtn2(k2)=dtmins
405 ENDIF
406 ENDIF
407 ENDDO
408 ENDIF
409 ENDIF
410C-----------
411 IF(dtnod2<dt2t)THEN
412 DO k2=1,kmax2
413 IF(dtn2(k2)<dt2t)THEN
414 n = indtn2(k2)
415 neltst = itab(n)
416 ityptst = 11
417 dt2t = dtn2(k2)
418 ENDIF
419 ENDDO
420 ENDIF
421#include "vectorize.inc"
422 DO n=i,min(nodlt,i+1023)
423 stifn(n) = em20
424 ENDDO
425#include "vectorize.inc"
426 DO n=i,min(nodlt,i+1023)
427 stifr(n) = em20
428 ENDDO
429C----------------------------------------------------------
430C ANIM TIME STEP
431C----------------------------------------------------------
432 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
433#include "vectorize.inc"
434 DO k1=1,kmax1
435 n = indtn1(k1)
436 adt(n)=min(adt(n),dtn1(k1))
437 ENDDO
438#include "vectorize.inc"
439 DO k2=1,kmax2
440 n = indtn2(k2)
441 adt(n)=min(adt(n),dtn2(k2))
442 ENDDO
443 ENDIF
444 450 CONTINUE
445C
446 ENDIF
447
448 IF(idtmin(11)==8) THEN
449 IF(dt2t < dtmin1(11)) dt2t=min(dt2s,dtmin1(11))
450 END IF
451
452C--------------------------------
453 IF (idtmin(11)/=5)THEN
454 IF(istop>0)THEN
455 tstop = tt
456#include "lockon.inc"
457 WRITE(iout,*)
458 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
459 WRITE(istdo,*)
460 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
461#include "lockoff.inc"
462 ELSEIF(istop<0)THEN
463 tstop = tt
464#include "lockon.inc"
465 WRITE(iout,*)
466 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
467 WRITE(istdo,*)
468 . ' **error : negative stiffness node',-istop
469 IF ( istamping == 1) THEN
470 WRITE(istdo,'(A)')'The run encountered a problem in an in
471 .terface Type 7.'
472 WRITE(istdo,'(A)')'You may need to check if there is enou
473 .gh clearance between the tools,'
474 WRITE(istdo,'(A)')'and that they do not penetrate each ot
475 .her during their travel'
476 WRITE(iout, '(A)')'The run encountered a problem in an in
477 .terface Type 7.'
478 WRITE(iout, '(A)')'You may need to check if there is enou
479 .gh clearance between the tools,'
480 WRITE(iout, '(A)')'and that they do not penetrate each ot
481 .her during their travel'
482 ENDIF
483#include "lockoff.inc"
484 ENDIF
485 ELSE
486 IF(istop>0)THEN
487 mstop = 2
488#include "lockon.inc"
489 WRITE(iout,*)
490 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
491 WRITE(istdo,*)
492 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
493#include "lockoff.inc"
494 ELSEIF(istop<0)THEN
495 mstop = 2
496#include "lockon.inc"
497 WRITE(iout,*)
498 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
499 WRITE(istdo,*)
500 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
501 IF ( istamping == 1) THEN
502 WRITE(istdo,'(A)')'The run encountered a problem in an in
503 .terface Type 7.'
504 WRITE(istdo,'(A)')'You may need to check if there is enou
505 .gh clearance between the tools,'
506 WRITE(istdo,'(A)')'and that they do not penetrate each ot
507 .her during their travel'
508 WRITE(iout, '(A)')'The run encountered a problem in an in
509 .terface Type 7.'
510 WRITE(iout, '(A)')'You may need to check if there is enou
511 .gh clearance between the tools,'
512 WRITE(iout, '(A)')'and that they do not penetrate each ot
513 .her during their travel'
514 ENDIF
515#include "lockoff.inc"
516 ENDIF
517 ENDIF
518 IF(iparit==0) THEN
519 IF(iroddl==0) THEN
520 DO n = nodft, nodlt
521 stifn(n) = stifn(n)*weight(n)
522 ENDDO
523 ELSE
524 DO n = nodft, nodlt
525 stifn(n) = stifn(n)*weight(n)
526 stifr(n) = stifr(n)*weight(n)
527 ENDDO
528 ENDIF
529 ENDIF
530C
531 DEALLOCATE(tag)
532 DEALLOCATE(tagr)
533
534 RETURN
535 END
dtnodams
subroutine dtnodams(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, adi, rbym, arby, arrby, ismsch, nodnx_sms, diag_sms, npby, tagmsr_rby_sms, h3d_data)
Definition dtnodams.F:43
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
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
arret
subroutine arret(nn)
Definition arret.F:87
h3d_mod::h3d_database
Definition h3d_mod.F:435