OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dtnoda.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "scr02_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "units_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "impl1_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dtnoda (nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, nodadt_therm, adi, rbym, arby, arrby, weight_md, mcp, mcp_off, condn, nale, h3d_data)

Function/Subroutine Documentation

◆ dtnoda()

subroutine dtnoda ( integer nodft,
integer nodlt,
integer neltst,
integer ityptst,
integer, dimension(*) itab,
ms,
in,
stifn,
stifr,
dt2t,
dmast,
dinert,
adt,
adm,
integer imsch,
integer, dimension(*) weight,
a,
ar,
type (group_), dimension(ngrnod) igrnod,
integer, intent(in) nodadt_therm,
adi,
rbym,
arby,
arrby,
integer, dimension(*) weight_md,
mcp,
mcp_off,
condn,
integer, dimension(*), intent(in) nale,
type(h3d_database) h3d_data )

Definition at line 36 of file dtnoda.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE h3d_mod
47 USE groupdef_mod
48 USE ale_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "task_c.inc"
60#include "scr02_c.inc"
61#include "scr07_c.inc"
62#include "scr14_c.inc"
63#include "scr16_c.inc"
64#include "scr18_c.inc"
65#include "units_c.inc"
66#include "com08_c.inc"
67#include "parit_c.inc"
68#include "impl1_c.inc"
69C-----------------------------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER NODFT, NODLT,NELTST,ITYPTST,ITAB(*),
73 . WEIGHT(*),IMSCH,WEIGHT_MD(*)
74 INTEGER,INTENT(IN) :: NALE(*)
75 INTEGER, INTENT(IN) :: NODADT_THERM
76 my_real dt2t, dmast, dinert,
77 . ms(*) ,in(*) ,stifn(*), stifr(*),adt(*) ,adm(*) ,
78 . a(3,*) ,ar(3,*) ,adi(*) ,rbym(nfrbym,*),arby(3,*),
79 . arrby(3,*),condn(*),mcp(*),mcp_off(*)
80 TYPE(H3D_DATABASE) :: H3D_DATA
81C-----------------------------------------------
82 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER N, NN, K, KMAX, ISTOP,I,INDTN(1024), TAG(NUMNOD),IOK
87 my_real dtn(1024),dtnod, dt2p, mas, iner, mass, sti, dt2s
88C----------------------------------------------------------
89C TAG NODAL GROUP
90C----------------------------------------------------------
91 dtnod = huge(dtnod)
92 IF (ncycle == 0) THEN
93!$OMP SINGLE
94 IF(idtgr(11)<0)THEN
95 iok = 0
96 DO n=1,ngrnod
97 IF (-idtgr(11)==igrnod(n)%ID) THEN
98 idtgr(11)=n
99 iok = 1
100 ENDIF
101 ENDDO
102 IF (iok == 0) THEN
103 CALL ancmsg(msgid=237,anmode=aninfo,
104 . i1=-idtgr(11))
105 CALL arret(2)
106 ENDIF
107 ENDIF
108!$OMP END SINGLE
109 ENDIF
110
111 IF(idtgr(11)/=0)THEN
112 DO n=nodft,nodlt
113 tag(n) = 0
114 ENDDO
115 DO n=1,igrnod(idtgr(11))%NENTITY
116 tag(igrnod(idtgr(11))%ENTITY(n)) = 1
117 ENDDO
118 ELSE
119 DO n=nodft,nodlt
120 tag(n) = 1
121 ENDDO
122 ENDIF
123
124 !ALE or EULER grid points are not concerned about /DT/NODA & /DT/NODA/CST options
125 IF(iale+ieuler/=0 .AND. ale%GLOBAL%I_DT_NODA_ALE_ON==0 .AND. nodadt/=0)THEN
126 !NOD_LAG_COUNT = 0
127 DO n=nodft,nodlt
128 IF(iabs(nale(n))==1 .OR. iabs(nale(n))==2)THEN
129 tag(n) = 0
130 ENDIF
131 ENDDO
132 ENDIF
133
134C----------------------------------------------------------
135C ANIM TIME STEP
136C----------------------------------------------------------
137cc IMSCH = 0
138 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
139#include "vectorize.inc"
140 DO nn=nodft,nodlt
141 adt(nn) = ep06
142 ENDDO
143 ENDIF
144
145C----------------------------------------------------------
146C SCALE TIME STEP
147C----------------------------------------------------------
148 istop = 0
149C
150 IF(nodadt_therm == 1)THEN
151C-----------------------------
152C NODAL THERMAL TIME STEP
153C----------------------------------------------------------
154 DO i=nodft,nodlt,1024
155 k = 0
156 dtnod = ep20
157C true dependency
158 DO n=i,min(nodlt,i+1023)
159 mcp(n) = mcp(n) * mcp_off(n)
160 IF(mcp(n) < em10) mcp(n) = zero
161 IF(condn(n)<=zero)THEN
162 istop = -itab(n)
163 ELSEIF(mcp(n)>zero)THEN
164 k = k + 1
165 indtn(k) = n
166 ENDIF
167 ENDDO
168 kmax = k
169C vectorize sqrt
170 DO k=1,kmax
171 n = indtn(k)
172 dtn(k) = dtfac1(11)*two * mcp(n) / condn(n)
173 dtnod = min(dtnod,dtn(k))
174 END DO
175C
176 IF(dtnod<dtmin1(11))THEN
177#include "vectorize.inc"
178 DO k=1,kmax
179 IF(dtn(k)<dtmin1(11))THEN
180 n = indtn(k)
181 istop = itab(n)
182 ENDIF
183 ENDDO
184 ENDIF
185C
186 IF(dtnod<dt2t)THEN
187#include "vectorize.inc"
188 DO k=1,kmax
189 IF(dtn(k)<dt2t)THEN
190 n = indtn(k)
191 neltst = itab(n)
192 ityptst = 11
193 dt2t = dtn(k)
194 ENDIF
195 ENDDO
196 ENDIF
197C
198 DO n=i,min(nodlt,i+1023)
199 condn(n) = em20
200 ENDDO
201C----------------------------------------------------------
202C ANIM TIME STEP
203C----------------------------------------------------------
204 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
205#include "vectorize.inc"
206 DO k=1,kmax
207 adt(indtn(k))=dtn(k)
208 ENDDO
209 ENDIF
210 ENDDO
211C--------------------------------
212 DO n = nodft, nodlt
213 condn(n) = em20
214 ENDDO
215
216 ELSE ! Mechanical Time step
217
218 IF(nodadt>0)THEN
219
220 dt2s=dt2t
221C----------------------------------------------------------
222C NODAL TIME STEP (TRANSLATION)
223C----------------------------------------------------------
224 DO 340 i=nodft,nodlt,1024
225 k = 0
226 dtnod = ep20
227C true dependency
228 IF(iale+ieuler == 0 .OR. ale%GLOBAL%I_DT_NODA_ALE_ON==1)THEN
229 DO n=i,min(nodlt,i+1023)
230c write(6,*) "STIFN(",N,")=",STIFN(N)
231c call flush(6)
232 IF(stifn(n)<=zero)THEN
233 istop = -itab(n)
234 ELSEIF(ms(n)>zero)THEN
235 k = k + 1
236 indtn(k) = n
237 ENDIF
238 ENDDO
239 ELSE
240 DO n=i,min(nodlt,i+1023)
241 IF(stifn(n)<=zero)THEN
242 istop = -itab(n)
243 ELSEIF(ms(n)>zero)THEN
244 IF(nale(n)==0.OR.nale(n)==3)THEN
245 k = k + 1
246 indtn(k) = n
247 ENDIF
248 ENDIF
249 ENDDO
250 ENDIF
251
252 kmax = k
253
254C vectorize sqrt
255 DO k=1,kmax
256 n = indtn(k)
257 dtn(k) = dtfac1(11)*sqrt(two * ms(n) / stifn(n))
258 dtnod = min(dtnod,dtn(k))
259 END DO
260C
261 IF(dtnod<dtmin1(11))THEN
262 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
263#include "vectorize.inc"
264 DO k=1,kmax
265 IF(dtn(k)<dtmin1(11))THEN
266 n = indtn(k)
267 istop = itab(n)
268 ENDIF
269 ENDDO
270 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
271C----------------------------------------------------------
272 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
273 DO k=1,kmax
274 IF(dtn(k)<dtmin1(11))THEN
275 n = indtn(k)
276 dt2p = dtmin1(11)/dtfac1(11)
277 mas = half * stifn(n) * dt2p * dt2p * onep00001
278 IF(tag(n)==1)THEN
279 IF(weight_md(n)==1) THEN
280 dmast = dmast + mas - ms(n)
281 ! In 2D, MS(N) is re-written to its initial value at each timestep
282 IF (n2d /= 0) THEN
283 adm(n) = (mas-ms(n))/ms(n)
284 ELSE
285 adm(n) = mas*(one+adm(n))/ms(n) - one
286 ENDIF
287 ENDIF
288 ms(n) = mas
289 imsch = 1
290 ENDIF
291 ENDIF
292 ENDDO
293 ELSE
294 DO k=1,kmax
295 IF(dtn(k)<dtmin1(11))THEN
296 n = indtn(k)
297 dt2p = dtmin1(11)/dtfac1(11)
298 mas = half * stifn(n) * dt2p * dt2p * onep00001
299 IF(tag(n)==1)THEN
300 dmast = dmast + (mas - ms(n))*weight_md(n)
301 ms(n) = mas
302 imsch = 1
303 ENDIF
304 ENDIF
305 ENDDO
306 ENDIF
307 ELSEIF(idtmin(11)==4)THEN
308#include "vectorize.inc"
309 DO k=1,kmax
310 IF(dtn(k)<dtmin1(11))THEN
311 n = indtn(k)
312 dt2p = dtmin1(11)/dtfac1(11)
313 mas = half * stifn(n) * dt2p * dt2p
314 mas=ms(n)/mas
315 dtn(k)=dtmin1(11)
316 a(1,n)=a(1,n)*mas
317 a(2,n)=a(2,n)*mas
318 a(3,n)=a(3,n)*mas
319 ENDIF
320 ENDDO
321 ENDIF
322 ENDIF
323 IF(dtnod<dt2t)THEN
324#include "vectorize.inc"
325 DO k=1,kmax
326 IF(dtn(k)<dt2t)THEN
327 n = indtn(k)
328 neltst = itab(n)
329 ityptst = 11
330 dt2t = dtn(k)
331 ENDIF
332 ENDDO
333 ENDIF
334C
335 DO n=i,min(nodlt,i+1023)
336 stifn(n) = em20
337 ENDDO
338C----------------------------------------------------------
339C ANIM TIME STEP
340C----------------------------------------------------------
341 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
342#include "vectorize.inc"
343 DO k=1,kmax
344 adt(indtn(k))=dtn(k)
345 ENDDO
346 ENDIF
347 340 CONTINUE
348C
349C rigid material
350C
351C----------------------------------------------------------
352C NODAL TIME STEP (TRANSLATION)
353C----------------------------------------------------------
354 IF(irigid_mat > 0) THEN
355 k = 0
356C true dependency
357 DO i=1,nrbym
358 dtnod = ep20
359 mass = rbym(1,i)
360 sti = rbym(27,i)
361 IF(sti<=zero)THEN
362c le rigi materiau
363 istop = -(i+ numnod)
364 ELSEIF(mass> zero)THEN
365 k = k + 1
366C DTN(K) = DTFAC1(11)*SQRT(2. * MASS / STI)
367C DTNOD = MIN(DTNOD,DTN(K))
368 indtn(k) = i
369 ENDIF
370 ENDDO
371 kmax = k
372C vectorize sqrt
373 DO k=1,kmax
374 n = indtn(k)
375 dtn(k) = dtfac1(11)*sqrt(two * mass / sti)
376 dtnod = min(dtnod,dtn(k))
377 END DO
378C
379 IF(dtnod<dtmin1(11))THEN
380 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
381#include "vectorize.inc"
382 DO k=1,kmax
383 IF(dtn(k) < dtmin1(11))THEN
384 n = indtn(k)
385 istop = n + numnod
386 ENDIF
387 ENDDO
388 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
389C----------------------------------------------------------
390#include "vectorize.inc"
391 DO k=1,kmax
392 IF(dtn(k)<dtmin1(11))THEN
393 n = indtn(k)
394 mass = rbym(1,n)
395 sti = rbym(27,n)
396 dt2p = dtmin1(11)/dtfac1(11)
397 mas = half * sti * dt2p * dt2p * onep00001
398c IF(TAG(N)==1)THEN
399c IF(WEIGHT(N)==1) THEN
400c DMAST = DMAST + MAS - MS(N)
401c ADM(N) = MAS*(ONE+ADM(N))/MS(N) - ONE
402c ENDIF
403 rbym(1,n) = mas
404c IMSCH = 1
405c ENDIF
406 ENDIF
407 ENDDO
408 ELSEIF(idtmin(11)==4)THEN
409#include "vectorize.inc"
410 DO k=1,kmax
411 IF(dtn(k)<dtmin1(11))THEN
412 n = indtn(k)
413 mass = rbym(1,n)
414 sti = rbym(27,n)
415 dt2p = dtmin1(11)/dtfac1(11)
416 mas = half * sti * dt2p * dt2p
417 mas=mass/mas
418 dtn(k)=dtmin1(11)
419 arby(1,n)=arby(1,n)*mas
420 arby(2,n)=arby(2,n)*mas
421 arby(3,n)=arby(3,n)*mas
422 ENDIF
423 ENDDO
424 ENDIF
425 ENDIF
426 IF(dtnod<dt2t)THEN
427#include "vectorize.inc"
428 DO k=1,kmax
429 IF(dtn(k)<dt2t)THEN
430 n = indtn(k)
431 neltst = n + numnod
432 ityptst = 11
433 dt2t = dtn(k)
434 ENDIF
435 ENDDO
436 ENDIF
437C----------------------------------------------------------
438C ANIM TIME STEP
439C----------------------------------------------------------
440 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
441#include "vectorize.inc"
442 DO k=1,kmax
443 adt(indtn(k))=dtn(k)
444 ENDDO
445 ENDIF
446C
447 ENDIF
448C end rigid material
449C----------------------------------------------------------
450C NODAL TIME STEP (ROTATION)
451C----------------------------------------------------------
452 IF (iroddl/=0) THEN
453 DO 350 i=nodft,nodlt,1024
454 dtnod = 1.e20
455 k = 0
456C true dependency
457 DO n=i,min(nodlt,i+1023)
458 IF(stifr(n)<=zero)THEN
459 istop=-itab(n)
460 ELSEIF(in(n)>zero)THEN
461 k = k + 1
462 indtn(k) = n
463 ENDIF
464 ENDDO
465 kmax = k
466C vectorize sqrt
467 DO k=1,kmax
468 n = indtn(k)
469 dtn(k) = dtfac1(11)*sqrt(two * in(n) / stifr(n))
470 dtnod = min(dtnod,dtn(k))
471 END DO
472C
473 IF(dtnod<dtmin1(11))THEN
474 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
475#include "vectorize.inc"
476 DO k=1,kmax
477 IF(dtn(k)<dtmin1(11))THEN
478 n = indtn(k)
479 istop = itab(n)
480 ENDIF
481 ENDDO
482 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
483 IF (anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0) THEN
484#include "vectorize.inc"
485 DO k=1,kmax
486 IF(dtn(k)<dtmin1(11))THEN
487 n = indtn(k)
488 iner = in(n)
489 dt2p = dtmin1(11)/dtfac1(11)
490 iner = half * stifr(n) * dt2p * dt2p * onep00001
491 IF(tag(n)==1)THEN
492 IF(weight_md(n)==1)THEN
493 dinert = dinert + ( iner - in(n))
494 adi(n) = iner*(one+adi(n))/in(n) - one
495 END IF
496 in(n) = max(iner,in(n))
497 imsch = 1
498 ENDIF
499 ENDIF
500 ENDDO
501 ELSE
502#include "vectorize.inc"
503 DO k=1,kmax
504 IF(dtn(k)<dtmin1(11))THEN
505 n = indtn(k)
506 iner = in(n)
507 dt2p = dtmin1(11)/dtfac1(11)
508 iner = half * stifr(n) * dt2p * dt2p * onep00001
509 IF(tag(n)==1)THEN
510 dinert = dinert + ( iner - in(n))*weight_md(n)
511 in(n) = max(iner,in(n))
512 imsch = 1
513 ENDIF
514 ENDIF
515 ENDDO
516 ENDIF
517 ELSEIF(idtmin(11)==4)THEN
518#include "vectorize.inc"
519 DO k=1,kmax
520 IF(dtn(k)<dtmin1(11))THEN
521 n = indtn(k)
522 dt2p = dtmin1(11)/dtfac1(11)
523 mas = half * stifr(n) * dt2p * dt2p
524 mas=in(n)/mas
525 dtn(k)=dtmin1(11)
526 ar(1,n)=ar(1,n)*mas
527 ar(2,n)=ar(2,n)*mas
528 ar(3,n)=ar(3,n)*mas
529 ENDIF
530 ENDDO
531 ENDIF
532 ENDIF
533 IF(dtnod<dt2t)THEN
534#include "vectorize.inc"
535 DO k=1,kmax
536 IF(dtn(k)<dt2t)THEN
537 n = indtn(k)
538 neltst = itab(n)
539 ityptst = 11
540 dt2t = dtn(k)
541 ENDIF
542 ENDDO
543 ENDIF
544C
545 DO n=i,min(nodlt,i+1023)
546 stifr(n) = em20
547 ENDDO
548C----------------------------------------------------------
549C ANIM TIME STEP
550C----------------------------------------------------------
551 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
552#include "vectorize.inc"
553 DO k=1,kmax
554 n = indtn(k)
555 adt(n)=min(adt(n),dtn(k))
556 ENDDO
557 ENDIF
558 350 CONTINUE
559C
560C rigid material
561C
562 IF(irigid_mat > 0) THEN
563 k = 0
564C true dependency
565 DO i=1, nrbym
566 dtnod = 1.e20
567 iner = rbym(17, i)
568 sti = rbym(28,i)
569 IF(sti<=zero)THEN
570 istop=-(i + numnod)
571 ELSEIF(in(n)>zero)THEN
572 k = k + 1
573 indtn(k) = i
574 dtn(k) = dtfac1(11)*sqrt(two * iner / sti)
575 dtnod = min(dtnod,dtn(k))
576 ENDIF
577 ENDDO
578 kmax = k
579C vectorize sqrt
580 DO k=1,kmax
581 n = indtn(k)
582 dtn(k) = dtfac1(11)*sqrt(two * in(n) / stifr(n))
583 dtnod = min(dtnod,dtn(k))
584 END DO
585C
586 IF(dtnod<dtmin1(11))THEN
587 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
588#include "vectorize.inc"
589 DO k=1,kmax
590 IF(dtn(k)<dtmin1(11))THEN
591 n = indtn(k)
592 istop = nodft + n
593 ENDIF
594 ENDDO
595 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
596#include "vectorize.inc"
597 DO k=1,kmax
598 IF(dtn(k)<dtmin1(11))THEN
599 n = indtn(k)
600 sti = rbym(28,n)
601 dt2p = dtmin1(11)/dtfac1(11)
602 iner = half * sti * dt2p * dt2p * onep00001
603c IF(WEIGHT(N)==1)THEN
604c DINERT = DINERT + ( INER - IN(N))
605c ADI(N) = INER*(ONE+ADI(N))/IN(N) - ONE
606c END IF
607 rbym(17,n) = max(iner,rbym(17,n))
608 imsch = 1
609 ENDIF
610 ENDDO
611C
612 ELSEIF(idtmin(11)==4)THEN
613#include "vectorize.inc"
614 DO k=1,kmax
615 IF(dtn(k)<dtmin1(11))THEN
616 n = indtn(k)
617 sti = rbym(28,n)
618 dt2p = dtmin1(11)/dtfac1(11)
619 mas = half * sti * dt2p * dt2p
620 mas=rbym(17,n)/mas
621 dtn(k)=dtmin1(11)
622 arrby(1,n)=arrby(1,n)*mas
623 arrby(2,n)=arrby(2,n)*mas
624 arrby(3,n)=arrby(3,n)*mas
625 ENDIF
626 ENDDO
627 ENDIF
628 ENDIF
629 IF(dtnod<dt2t)THEN
630#include "vectorize.inc"
631 DO k=1,kmax
632 IF(dtn(k)<dt2t)THEN
633 n = indtn(k)
634 neltst = n + numnod
635 ityptst = 11
636 dt2t = dtn(k)
637 ENDIF
638 ENDDO
639 ENDIF
640C----------------------------------------------------------
641C ANIM TIME STEP
642C----------------------------------------------------------
643 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
644#include "vectorize.inc"
645 DO k=1,kmax
646 n = indtn(k)
647 adt(n)=min(adt(n),dtn(k))
648 ENDDO
649 ENDIF
650 ENDIF
651C --end rigid material
652 ENDIF
653
654 IF(idtmin(11)==8) THEN
655 IF(dt2t < dtmin1(11)) dt2t=min(dt2s,dtmin1(11))
656 END IF
657
658C----------------------------------------------------------
659C INTERFACES 7
660C----------------------------------------------------------
661 ELSEIF(i7kglo>0)THEN
662
663 dt2s=dt2t
664
665 DO 370 i=nodft,nodlt,1024
666 k = 0
667 dtnod = ep20
668C true dependency
669 DO n=i,min(nodlt,i+1023)
670 IF(stifn(n)<=zero)THEN
671 istop=-itab(n)
672 ELSEIF(ms(n)>zero)THEN
673 k = k + 1
674 indtn(k) = n
675 ENDIF
676 ENDDO
677 kmax = k
678C vectorize sqrt
679 DO k=1,kmax
680 n = indtn(k)
681 dtn(k) = dtfac1(11)*sqrt(two * ms(n) / stifn(n))
682 dtnod = min(dtnod,dtn(k))
683 END DO
684
685C
686 IF(dtnod<dtmin1(11))THEN
687 IF(idtmin(11)==1.OR.idtmin(11)==5)THEN
688#include "vectorize.inc"
689 DO k=1,kmax
690 IF(dtn(k)<dtmin1(11))THEN
691 n = indtn(k)
692 istop = itab(n)
693 ENDIF
694 ENDDO
695 ELSEIF(idtmin(11)==3.OR.idtmin(11)==8)THEN
696C----------------------------------------------------------
697 IF (anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0) THEN
698 DO k=1,kmax
699 IF(dtn(k)<dtmin1(11))THEN
700 n = indtn(k)
701 dt2p = dtmin1(11)/dtfac1(11)
702 mas = half * stifn(n) * dt2p * dt2p * onep00001
703 IF(tag(n)==1)THEN
704 IF(weight_md(n)==1) THEN
705 dmast = dmast + mas - ms(n)
706 adm(n) = mas*(one+adm(n))/ms(n) - one
707 ENDIF
708 ms(n) = mas
709 imsch = 1
710 ENDIF
711 ENDIF
712 ENDDO
713 ELSE
714 DO k=1,kmax
715 IF(dtn(k)<dtmin1(11))THEN
716 n = indtn(k)
717 dt2p = dtmin1(11)/dtfac1(11)
718 mas = half * stifn(n) * dt2p * dt2p * onep00001
719 IF(tag(n)==1)THEN
720 dmast = dmast + (mas - ms(n))*weight_md(n)
721 ms(n) = mas
722 imsch = 1
723 ENDIF
724 ENDIF
725 ENDDO
726 ENDIF
727 ENDIF
728 ENDIF
729C----------------------------------------------------------
730 IF(dtnod<dt2t)THEN
731#include "vectorize.inc"
732 DO k=1,kmax
733 IF(dtn(k)<dt2t)THEN
734 n = indtn(k)
735 neltst = itab(n)
736 ityptst = 11
737 dt2t = dtn(k)
738 ENDIF
739 ENDDO
740 ENDIF
741C
742 DO n=i,min(nodlt,i+1023)
743 stifn(n) = em20
744 ENDDO
745 IF (iroddl/=0) THEN
746 DO n=i,min(nodlt,i+1023)
747 stifr(n) = em20
748 ENDDO
749 ENDIF
750C----------------------------------------------------------
751C ANIM TIME STEP
752C----------------------------------------------------------
753 IF(anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT >0)THEN
754#include "vectorize.inc"
755 DO k=1,kmax
756 n = indtn(k)
757 adt(n)=min(adt(n),dtn(k))
758 ENDDO
759 ENDIF
760 370 CONTINUE
761
762 IF(idtmin(11)==8) THEN
763 IF(dt2t < dtmin1(11)) dt2t=min(dt2s,dtmin1(11))
764 END IF
765
766C--------------------------------
767
768 DO n = nodft, nodlt
769 stifn(n) = em20
770 ENDDO
771 IF (iroddl/=0) THEN
772 DO n = nodft, nodlt
773 stifr(n) = em20
774 ENDDO
775 ENDIF
776C--------------------------------
777 ENDIF
778C--------------------------------
779 IF (idtmin(11)/=5.AND.inconv==1)THEN
780 IF(istop>0)THEN
781 tstop = tt
782#include "lockon.inc"
783 WRITE(iout,*)
784 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
785 WRITE(istdo,*)
786 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
787#include "lockoff.inc"
788 ELSEIF(istop<0)THEN
789 tstop = tt
790#include "lockon.inc"
791 WRITE(iout,*)
792 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
793 WRITE(istdo,*)
794 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
795 IF ( istamping == 1) THEN
796 WRITE(istdo,'(A)')'The run encountered a problem in an in
797 .terface Type 7.'
798 WRITE(istdo,'(A)')'You may need to check if there is enou
799 .gh clearance between the tools,'
800 WRITE(istdo,'(A)')'and that they do not penetrate each ot
801 .her during their travel'
802 WRITE(iout, '(A)')'The run encountered a problem in an in
803 .terface Type 7.'
804 WRITE(iout, '(A)')'You may need to check if there is enou
805 .gh clearance between the tools,'
806 WRITE(iout, '(A)')'and that they do not penetrate each ot
807 .her during their travel'
808 ENDIF
809#include "lockoff.inc"
810 ENDIF
811 ELSEIF (inconv==1)THEN
812 IF(istop>0)THEN
813 mstop = 2
814#include "lockon.inc"
815 WRITE(iout,*)
816 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
817 WRITE(istdo,*)
818 . ' **ERROR : NODAL TIME STEP LESS OR EQUAL DTMIN N=',istop
819#include "lockoff.inc"
820 ELSEIF(istop<0)THEN
821 mstop = 2
822#include "lockon.inc"
823 WRITE(iout,*)
824 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
825 WRITE(istdo,*)
826 . ' **ERROR : NEGATIVE STIFFNESS NODE',-istop
827 IF ( istamping == 1) THEN
828 WRITE(istdo,'(A)')'The run encountered a problem in an in
829 .terface Type 7.'
830 WRITE(istdo,'(A)')'You may need to check if there is enou
831 .gh clearance between the tools,'
832 WRITE(istdo,'(A)')'and that they do not penetrate each ot
833 .her during their travel'
834 WRITE(iout, '(A)')'The run encountered a problem in an in
835 .terface Type 7.'
836 WRITE(iout, '(A)')'You may need to check if there is enou
837 .gh clearance between the tools,'
838 WRITE(iout, '(A)')'and that they do not penetrate each ot
839 .her during their travel'
840 ENDIF
841#include "lockoff.inc"
842 ENDIF
843 ENDIF
844C
845 IF(iparit==0) THEN
846 IF(iroddl==0) THEN
847 DO n = nodft, nodlt
848 stifn(n) = stifn(n)*weight(n)
849 ENDDO
850 ELSE
851 DO n = nodft, nodlt
852 stifn(n) = stifn(n)*weight(n)
853 stifr(n) = stifr(n)*weight(n)
854 ENDDO
855 ENDIF
856 ENDIF
857
858 ENDIF
859C
860 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
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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