OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cupdt3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "vectorize.inc"
#include "scr18_c.inc"
#include "comlock.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cupdt3f (jft, jlt, i8f, i8m, nvc, offg, off, sti, stir, i8stifn, i8stifr, ixc, pm, area, thk, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, nodadt_therm)
subroutine cupdt3 (jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixc, pm, area, thk, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, jthe, them, fthe, condn, conde, nodadt_therm)
subroutine cupdt3p (jft, jlt, offg, off, sti, stir, fsky, fskyv, iadc, ixc, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, eint, partsav, mat, ipartc, pm, area, thk, jthe, them, fthesky, condnsky, conde, nodadt_therm)

Function/Subroutine Documentation

◆ cupdt3()

subroutine cupdt3 ( integer jft,
integer jlt,
f,
m,
integer nvc,
offg,
off,
sti,
stir,
stifn,
stifr,
integer, dimension(nixc,mvsiz) ixc,
pm,
area,
thk,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
m11,
m12,
m13,
m14,
m21,
m22,
m23,
m24,
m31,
m32,
m33,
m34,
eint,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) ipartc,
integer jthe,
them,
fthe,
condn,
conde,
integer, intent(in) nodadt_therm )

Definition at line 513 of file cupdt3.F.

523 use element_mod , only : nixc
524C-----------------------------------------------
525C I m p l i c i t T y p e s
526C-----------------------------------------------
527#include "implicit_f.inc"
528C-----------------------------------------------
529C G l o b a l P a r a m e t e r s
530C-----------------------------------------------
531#include "mvsiz_p.inc"
532C-----------------------------------------------
533C C o m m o n B l o c k s
534C-----------------------------------------------
535#include "param_c.inc"
536#include "scr18_c.inc"
537C-----------------------------------------------
538C D u m m y A r g u m e n t s
539C-----------------------------------------------
540 INTEGER ,INTENT(IN) :: NODADT_THERM
541 INTEGER JFT, JLT, NVC, JTHE
542 INTEGER IXC(NIXC,MVSIZ),MAT(MVSIZ),IPARTC(*)
543C REAL
544 my_real
545 . f(3,*), m(3,*), offg(*), off(*), sti(*), stir(*),
546 . stifn(*), stifr(*),
547 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
548 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
549 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
550 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
551 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
552 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
553 . eint(jlt,2),pm(npropm,*),partsav(npsav,*) ,area(*) ,thk(*),
554 . them(mvsiz,4) ,fthe(*),condn(*),conde(mvsiz)
555C-----------------------------------------------
556C L o c a l V a r i a b l e s
557C-----------------------------------------------
558 INTEGER NVC1, NVC2, NVC3, NVC4, I
559 my_real
560 . off_l
561C=======================================================================
562C
563C cumulative energy of deleted elements at the moment of deletion
564 off_l = zero
565 DO i=jft,jlt
566 IF (off(i) < one) offg(i) = off(i)
567 off_l = min(off_l,offg(i))
568 ENDDO
569 IF(off_l<zero)THEN
570 DO i=jft,jlt
571 IF(offg(i)<zero)THEN
572 f11(i)=zero
573 f21(i)=zero
574 f31(i)=zero
575 m11(i)=zero
576 m21(i)=zero
577 m31(i)=zero
578 f12(i)=zero
579 f22(i)=zero
580 f32(i)=zero
581 m12(i)=zero
582 m22(i)=zero
583 m32(i)=zero
584 f13(i)=zero
585 f23(i)=zero
586 f33(i)=zero
587 m13(i)=zero
588 m23(i)=zero
589 m33(i)=zero
590 f14(i)=zero
591 f24(i)=zero
592 f34(i)=zero
593 m14(i)=zero
594 m24(i)=zero
595 m34(i)=zero
596 sti(i)=zero
597 stir(i)=zero
598 conde(i)=zero
599 ENDIF
600 ENDDO
601 ENDIF
602C
603 nvc1= nvc/8
604 nvc2=(nvc-nvc1*8)/4
605 nvc3=(nvc-nvc1*8-nvc2*4)/2
606 nvc4=(nvc-nvc1*8-nvc2*4-nvc3*2)
607C
608 IF(nvc1 == 0)THEN
609 IF(jthe == 0 ) THEN
610#include "vectorize.inc"
611 DO i=jft,jlt
612 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
613 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
614 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
615 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
616 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
617 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
618 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
619 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
620 ENDDO
621 ELSE
622 IF(nodadt_therm == 1 ) THEN
623#include "vectorize.inc"
624 DO i=jft,jlt
625 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
626 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
627 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
628 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
629 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
630 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
631 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
632 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
633 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
634 condn(ixc(2,i))=condn(ixc(2,i))+conde(i)
635 ENDDO
636 ELSE
637#include "vectorize.inc"
638 DO i=jft,jlt
639 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
640 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
641 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
642 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
643 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
644 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
645 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
646 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
647 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
648 ENDDO
649 ENDIF
650
651 ENDIF
652C
653 ELSE
654 IF(jthe == 0 ) THEN
655 DO i=jft,jlt
656 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
657 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
658 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
659 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
660 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
661 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
662 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
663 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
664 ENDDO
665 ELSE
666 IF(nodadt_therm == 1 ) THEN
667 DO i=jft,jlt
668 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
669 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
670 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
671 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
672 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
673 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
674 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
675 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
676 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
677 condn(ixc(2,i))=condn(ixc(2,i))+conde(i)
678 ENDDO
679 ELSE
680 DO i=jft,jlt
681 f(1,ixc(2,i))=f(1,ixc(2,i))-f11(i)
682 f(2,ixc(2,i))=f(2,ixc(2,i))-f21(i)
683 f(3,ixc(2,i))=f(3,ixc(2,i))-f31(i)
684 m(1,ixc(2,i))=m(1,ixc(2,i))-m11(i)
685 m(2,ixc(2,i))=m(2,ixc(2,i))-m21(i)
686 m(3,ixc(2,i))=m(3,ixc(2,i))-m31(i)
687 stifn(ixc(2,i))=stifn(ixc(2,i))+sti(i)
688 stifr(ixc(2,i))=stifr(ixc(2,i))+stir(i)
689 fthe(ixc(2,i))=fthe(ixc(2,i)) + them(i,1)
690 ENDDO
691 ENDIF
692 ENDIF
693C
694 ENDIF
695C
696 IF(nvc2 == 0)THEN
697 IF(jthe == 0 ) THEN
698#include "vectorize.inc"
699 DO i=jft,jlt
700 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
701 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
702 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
703 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
704 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
705 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
706 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
707 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
708 ENDDO
709 ELSE
710 IF(nodadt_therm == 1 ) THEN
711#include "vectorize.inc"
712 DO i=jft,jlt
713 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
714 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
715 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
716 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
717 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
718 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
719 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
720 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
721 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
722 condn(ixc(3,i))=condn(ixc(3,i))+conde(i)
723 ENDDO
724 ELSE
725#include "vectorize.inc"
726 DO i=jft,jlt
727 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
728 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
729 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
730 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
731 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
732 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
733 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
734 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
735 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
736 ENDDO
737 ENDIF
738 ENDIF
739C
740 ELSE
741 IF(jthe == 0 ) THEN
742 DO i=jft,jlt
743 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
744 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
745 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
746 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
747 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
748 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
749 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
750 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
751 ENDDO
752 ELSE
753 IF(nodadt_therm == 1 ) THEN
754 DO i=jft,jlt
755 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
756 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
757 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
758 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
759 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
760 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
761 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
762 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
763 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
764 condn(ixc(3,i))=condn(ixc(3,i))+conde(i)
765 ENDDO
766 ELSE
767 DO i=jft,jlt
768 f(1,ixc(3,i))=f(1,ixc(3,i))-f12(i)
769 f(2,ixc(3,i))=f(2,ixc(3,i))-f22(i)
770 f(3,ixc(3,i))=f(3,ixc(3,i))-f32(i)
771 m(1,ixc(3,i))=m(1,ixc(3,i))-m12(i)
772 m(2,ixc(3,i))=m(2,ixc(3,i))-m22(i)
773 m(3,ixc(3,i))=m(3,ixc(3,i))-m32(i)
774 stifn(ixc(3,i))=stifn(ixc(3,i))+sti(i)
775 stifr(ixc(3,i))=stifr(ixc(3,i))+stir(i)
776 fthe(ixc(3,i))=fthe(ixc(3,i)) + them(i,2)
777 ENDDO
778 ENDIF
779 ENDIF
780C
781 ENDIF
782C
783 IF(nvc3 == 0)THEN
784 IF(jthe == 0 )THEN
785#include "vectorize.inc"
786 DO i=jft,jlt
787 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
788 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
789 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
790 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
791 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
792 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
793 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
794 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
795 ENDDO
796 ELSE
797 IF(nodadt_therm == 1 ) THEN
798#include "vectorize.inc"
799 DO i=jft,jlt
800 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
801 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
802 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
803 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
804 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
805 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
806 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
807 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
808 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
809 condn(ixc(4,i))=condn(ixc(4,i))+conde(i)
810 ENDDO
811 ELSE
812#include "vectorize.inc"
813 DO i=jft,jlt
814 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
815 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
816 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
817 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
818 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
819 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
820 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
821 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
822 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
823 ENDDO
824 ENDIF
825 ENDIF
826 ELSE
827 IF(jthe == 0 ) THEN
828 DO i=jft,jlt
829 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
830 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
831 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
832 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
833 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
834 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
835 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
836 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
837 ENDDO
838 ELSE
839 IF(nodadt_therm == 1 ) THEN
840 DO i=jft,jlt
841 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
842 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
843 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
844 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
845 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
846 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
847 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
848 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
849 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
850 condn(ixc(4,i))=condn(ixc(4,i))+conde(i)
851 ENDDO
852 ELSE
853 DO i=jft,jlt
854 f(1,ixc(4,i))=f(1,ixc(4,i))-f13(i)
855 f(2,ixc(4,i))=f(2,ixc(4,i))-f23(i)
856 f(3,ixc(4,i))=f(3,ixc(4,i))-f33(i)
857 m(1,ixc(4,i))=m(1,ixc(4,i))-m13(i)
858 m(2,ixc(4,i))=m(2,ixc(4,i))-m23(i)
859 m(3,ixc(4,i))=m(3,ixc(4,i))-m33(i)
860 stifn(ixc(4,i))=stifn(ixc(4,i))+sti(i)
861 stifr(ixc(4,i))=stifr(ixc(4,i))+stir(i)
862 fthe(ixc(4,i))=fthe(ixc(4,i)) + them(i,3)
863 ENDDO
864 ENDIF
865 ENDIF
866C
867 ENDIF
868C
869 IF(nvc4 == 0)THEN
870 IF(jthe == 0 ) THEN
871#include "vectorize.inc"
872 DO i=jft,jlt
873 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
874 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
875 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
876 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
877 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
878 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
879 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
880 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
881 ENDDO
882 ELSE
883 IF(nodadt_therm == 1 ) THEN
884#include "vectorize.inc"
885 DO i=jft,jlt
886 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
887 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
888 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
889 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
890 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
891 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
892 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
893 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
894 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
895 condn(ixc(5,i))=condn(ixc(5,i))+conde(i)
896 ENDDO
897 ELSE
898#include "vectorize.inc"
899 DO i=jft,jlt
900 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
901 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
902 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
903 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
904 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
905 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
906 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
907 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
908 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
909 ENDDO
910 ENDIF
911 ENDIF
912C
913 ELSE
914 IF(jthe == 0 ) THEN
915 DO i=jft,jlt
916 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
917 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
918 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
919 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
920 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
921 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
922 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
923 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
924 ENDDO
925 ELSE
926 IF(nodadt_therm == 1 ) THEN
927 DO i=jft,jlt
928 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
929 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
930 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
931 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
932 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
933 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
934 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
935 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
936 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
937 condn(ixc(5,i))=condn(ixc(5,i))+conde(i)
938 ENDDO
939 ELSE
940 DO i=jft,jlt
941 f(1,ixc(5,i))=f(1,ixc(5,i))-f14(i)
942 f(2,ixc(5,i))=f(2,ixc(5,i))-f24(i)
943 f(3,ixc(5,i))=f(3,ixc(5,i))-f34(i)
944 m(1,ixc(5,i))=m(1,ixc(5,i))-m14(i)
945 m(2,ixc(5,i))=m(2,ixc(5,i))-m24(i)
946 m(3,ixc(5,i))=m(3,ixc(5,i))-m34(i)
947 stifn(ixc(5,i))=stifn(ixc(5,i))+sti(i)
948 stifr(ixc(5,i))=stifr(ixc(5,i))+stir(i)
949 fthe(ixc(5,i))=fthe(ixc(5,i)) + them(i,4)
950 ENDDO
951 ENDIF
952 ENDIF
953C
954 ENDIF
955C
956 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20

◆ cupdt3f()

subroutine cupdt3f ( integer jft,
integer jlt,
integer*8, dimension(3,3,*) i8f,
integer*8, dimension(3,3,*) i8m,
integer nvc,
offg,
off,
sti,
stir,
integer*8, dimension(3,*) i8stifn,
integer*8, dimension(3,*) i8stifr,
integer, dimension(nixc,mvsiz) ixc,
pm,
area,
thk,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
m11,
m12,
m13,
m14,
m21,
m22,
m23,
m24,
m31,
m32,
m33,
m34,
eint,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) ipartc,
integer, intent(in) nodadt_therm )

Definition at line 34 of file cupdt3.F.

43 use element_mod , only : nixc
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ,INTENT(IN) :: NODADT_THERM
60 INTEGER JFT, JLT, NVC
61 INTEGER IXC(NIXC,MVSIZ),MAT(MVSIZ),IPARTC(*)
62 integer*8 I8F(3,3,*), I8M(3,3,*), I8STIFN(3,*), I8STIFR(3,*)
63C REAL
64 my_real
65 . offg(*), off(*), sti(*), stir(*),
66 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
67 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
68 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
69 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
70 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
71 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
72 . eint(jlt,2),pm(npropm,*),partsav(npsav,*) ,area(*) ,thk(*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 integer*8
77 . I8STI(3,MVSIZ), I8STIR(3,MVSIZ),
78 . I8F11(3,MVSIZ), I8F12(3,MVSIZ), I8F13(3,MVSIZ), I8F14(3,MVSIZ),
79 . I8F21(3,MVSIZ), I8F22(3,MVSIZ), I8F23(3,MVSIZ), I8F24(3,MVSIZ),
80 . I8F31(3,MVSIZ), I8F32(3,MVSIZ), I8F33(3,MVSIZ), I8F34(3,MVSIZ),
81 . I8M11(3,MVSIZ), I8M12(3,MVSIZ), I8M13(3,MVSIZ), I8M14(3,MVSIZ),
82 . I8M21(3,MVSIZ), I8M22(3,MVSIZ), I8M23(3,MVSIZ), I8M24(3,MVSIZ),
83 . I8M31(3,MVSIZ), I8M32(3,MVSIZ), I8M33(3,MVSIZ), I8M34(3,MVSIZ)
84C-----------------------------------------------
85 INTEGER NVC1, NVC2, NVC3, NVC4, I, N
86 my_real off_l
87C=======================================================================
88C cumulative energy of deleted elements at the moment of deletion
89 off_l = zero
90 DO i=jft,jlt
91 IF(off(i)<1.)offg(i) = off(i)
92 off_l = min(off_l,offg(i))
93 ENDDO
94 IF(off_l<0.)THEN
95 DO i=jft,jlt
96 IF(offg(i)<zero)THEN
97 f11(i)=zero
98 f21(i)=zero
99 f31(i)=zero
100 m11(i)=zero
101 m21(i)=zero
102 m31(i)=zero
103 f12(i)=zero
104 f22(i)=zero
105 f32(i)=zero
106 m12(i)=zero
107 m22(i)=zero
108 m32(i)=zero
109 f13(i)=zero
110 f23(i)=zero
111 f33(i)=zero
112 m13(i)=zero
113 m23(i)=zero
114 m33(i)=zero
115 f14(i)=zero
116 f24(i)=zero
117 f34(i)=zero
118 m14(i)=zero
119 m24(i)=zero
120 m34(i)=zero
121 sti(i)=zero
122 stir(i)=zero
123 ENDIF
124 ENDDO
125 ENDIF
126C
127 nvc1= nvc/8
128 nvc2=(nvc-nvc1*8)/4
129 nvc3=(nvc-nvc1*8-nvc2*4)/2
130 nvc4=(nvc-nvc1*8-nvc2*4-nvc3*2)
131C
132 CALL double_flot_ieee(jft,jlt,f11,f11,i8f11)
133 CALL double_flot_ieee(jft,jlt,f12,f12,i8f12)
134 CALL double_flot_ieee(jft,jlt,f13,f13,i8f13)
135 CALL double_flot_ieee(jft,jlt,f14,f14,i8f14)
136 CALL double_flot_ieee(jft,jlt,f21,f21,i8f21)
137 CALL double_flot_ieee(jft,jlt,f22,f22,i8f22)
138 CALL double_flot_ieee(jft,jlt,f23,f23,i8f23)
139 CALL double_flot_ieee(jft,jlt,f24,f24,i8f24)
140 CALL double_flot_ieee(jft,jlt,f31,f31,i8f31)
141 CALL double_flot_ieee(jft,jlt,f32,f32,i8f32)
142 CALL double_flot_ieee(jft,jlt,f33,f33,i8f33)
143 CALL double_flot_ieee(jft,jlt,f34,f34,i8f34)
144C
145 CALL double_flot_ieee(jft,jlt,m11,m11,i8m11)
146 CALL double_flot_ieee(jft,jlt,m12,m12,i8m12)
147 CALL double_flot_ieee(jft,jlt,m13,m13,i8m13)
148 CALL double_flot_ieee(jft,jlt,m14,m14,i8m14)
149 CALL double_flot_ieee(jft,jlt,m21,m21,i8m21)
150 CALL double_flot_ieee(jft,jlt,m22,m22,i8m22)
151 CALL double_flot_ieee(jft,jlt,m23,m23,i8m23)
152 CALL double_flot_ieee(jft,jlt,m24,m24,i8m24)
153 CALL double_flot_ieee(jft,jlt,m31,m31,i8m31)
154 CALL double_flot_ieee(jft,jlt,m32,m32,i8m32)
155 CALL double_flot_ieee(jft,jlt,m33,m33,i8m33)
156 CALL double_flot_ieee(jft,jlt,m34,m34,i8m34)
157C
158 CALL double_flot_ieee(jft,jlt,sti,sti,i8sti)
159 CALL double_flot_ieee(jft,jlt,stir,stir,i8stir)
160C
161 IF(nvc1 == 0)THEN
162#include "vectorize.inc"
163 DO i=jft,jlt
164c F(1,IXC(2,I))=F(1,IXC(2,I))-F11(I)
165c F(2,IXC(2,I))=F(2,IXC(2,I))-F21(I)
166c F(3,IXC(2,I))=F(3,IXC(2,I))-F31(I)
167c M(1,N)=M(1,N)-M11(I)
168c M(2,N)=M(2,N)-M21(I)
169c M(3,N)=M(3,N)-M31(I)
170c STIFN(N)=STIFN(N)+STI(I)
171c STIFR(N)=STIFR(N)+STIR(I)
172c <ent1.dec1,dec2> = <ent1.dec1,dec2> - F11(I)
173 n = ixc(2,i)
174c___________________________________________________
175 i8f(1,1,n) = i8f(1,1,n) - i8f11(1,i)
176 i8f(2,1,n) = i8f(2,1,n) - i8f11(2,i)
177 i8f(3,1,n) = i8f(3,1,n) - i8f11(3,i)
178c___________________________________________________
179 i8f(1,2,n) = i8f(1,2,n) - i8f21(1,i)
180 i8f(2,2,n) = i8f(2,2,n) - i8f21(2,i)
181 i8f(3,2,n) = i8f(3,2,n) - i8f21(3,i)
182c___________________________________________________
183 i8f(1,3,n) = i8f(1,3,n) - i8f31(1,i)
184 i8f(2,3,n) = i8f(2,3,n) - i8f31(1,i)
185 i8f(3,3,n) = i8f(3,3,n) - i8f31(1,i)
186c___________________________________________________
187 i8m(1,1,n) = i8m(1,1,n) - i8m11(1,i)
188 i8m(2,1,n) = i8m(2,1,n) - i8m11(2,i)
189 i8m(3,1,n) = i8m(3,1,n) - i8m11(3,i)
190c___________________________________________________
191 i8m(1,2,n) = i8m(1,2,n) - i8m21(1,i)
192 i8m(2,2,n) = i8m(2,2,n) - i8m21(2,i)
193 i8m(3,2,n) = i8m(3,2,n) - i8m21(3,i)
194c___________________________________________________
195 i8m(1,3,n) = i8m(1,3,n) - i8m31(1,i)
196 i8m(2,3,n) = i8m(2,3,n) - i8m31(2,i)
197 i8m(3,3,n) = i8m(3,3,n) - i8m31(3,i)
198c___________________________________________________
199 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
200 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
201 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
202c___________________________________________________
203 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
204 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
205 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
206c___________________________________________________
207 ENDDO
208C
209 ELSE
210 DO i=jft,jlt
211 n = ixc(2,i)
212c___________________________________________________
213 i8f(1,1,n) = i8f(1,1,n) - i8f11(1,i)
214 i8f(2,1,n) = i8f(2,1,n) - i8f11(2,i)
215 i8f(3,1,n) = i8f(3,1,n) - i8f11(3,i)
216c___________________________________________________
217 i8f(1,2,n) = i8f(1,2,n) - i8f21(1,i)
218 i8f(2,2,n) = i8f(2,2,n) - i8f21(2,i)
219 i8f(3,2,n) = i8f(3,2,n) - i8f21(3,i)
220c___________________________________________________
221 i8f(1,3,n) = i8f(1,3,n) - i8f31(1,i)
222 i8f(2,3,n) = i8f(2,3,n) - i8f31(1,i)
223 i8f(3,3,n) = i8f(3,3,n) - i8f31(1,i)
224c___________________________________________________
225 i8m(1,1,n) = i8m(1,1,n) - i8m11(1,i)
226 i8m(2,1,n) = i8m(2,1,n) - i8m11(2,i)
227 i8m(3,1,n) = i8m(3,1,n) - i8m11(3,i)
228c___________________________________________________
229 i8m(1,2,n) = i8m(1,2,n) - i8m21(1,i)
230 i8m(2,2,n) = i8m(2,2,n) - i8m21(2,i)
231 i8m(3,2,n) = i8m(3,2,n) - i8m21(3,i)
232c___________________________________________________
233 i8m(1,3,n) = i8m(1,3,n) - i8m31(1,i)
234 i8m(2,3,n) = i8m(2,3,n) - i8m31(2,i)
235 i8m(3,3,n) = i8m(3,3,n) - i8m31(3,i)
236c___________________________________________________
237 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
238 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
239 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
240c___________________________________________________
241 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
242 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
243 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
244c___________________________________________________
245 ENDDO
246 ENDIF
247C
248 IF(nvc2 == 0)THEN
249#include "vectorize.inc"
250 DO i=jft,jlt
251c F(1,IXC(3,I))=F(1,IXC(3,I))-F12(I)
252c F(2,IXC(3,I))=F(2,IXC(3,I))-F22(I)
253c F(3,IXC(3,I))=F(3,IXC(3,I))-F32(I)
254c M(1,IXC(3,I))=M(1,IXC(3,I))-M12(I)
255c M(2,IXC(3,I))=M(2,IXC(3,I))-M22(I)
256c M(3,IXC(3,I))=M(3,IXC(3,I))-M32(I)
257c STIFN(IXC(3,I))=STIFN(IXC(3,I))+STI(I)
258c STIFR(IXC(3,I))=STIFR(IXC(3,I))+STIR(I)
259 n = ixc(3,i)
260c___________________________________________________
261 i8f(1,1,n) = i8f(1,1,n) - i8f12(1,i)
262 i8f(2,1,n) = i8f(2,1,n) - i8f12(2,i)
263 i8f(3,1,n) = i8f(3,1,n) - i8f12(3,i)
264c___________________________________________________
265 i8f(1,2,n) = i8f(1,2,n) - i8f22(1,i)
266 i8f(2,2,n) = i8f(2,2,n) - i8f22(2,i)
267 i8f(3,2,n) = i8f(3,2,n) - i8f22(3,i)
268c___________________________________________________
269 i8f(1,3,n) = i8f(1,3,n) - i8f32(1,i)
270 i8f(2,3,n) = i8f(2,3,n) - i8f32(1,i)
271 i8f(3,3,n) = i8f(3,3,n) - i8f32(1,i)
272c___________________________________________________
273 i8m(1,1,n) = i8m(1,1,n) - i8m12(1,i)
274 i8m(2,1,n) = i8m(2,1,n) - i8m12(2,i)
275 i8m(3,1,n) = i8m(3,1,n) - i8m12(3,i)
276c___________________________________________________
277 i8m(1,2,n) = i8m(1,2,n) - i8m22(1,i)
278 i8m(2,2,n) = i8m(2,2,n) - i8m22(2,i)
279 i8m(3,2,n) = i8m(3,2,n) - i8m22(3,i)
280c___________________________________________________
281 i8m(1,3,n) = i8m(1,3,n) - i8m32(1,i)
282 i8m(2,3,n) = i8m(2,3,n) - i8m32(2,i)
283 i8m(3,3,n) = i8m(3,3,n) - i8m32(3,i)
284c___________________________________________________
285 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
286 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
287 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
288c___________________________________________________
289 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
290 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
291 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
292c___________________________________________________
293 ENDDO
294 ELSE
295 DO i=jft,jlt
296 n = ixc(3,i)
297c___________________________________________________
298 i8f(1,1,n) = i8f(1,1,n) - i8f12(1,i)
299 i8f(2,1,n) = i8f(2,1,n) - i8f12(2,i)
300 i8f(3,1,n) = i8f(3,1,n) - i8f12(3,i)
301c___________________________________________________
302 i8f(1,2,n) = i8f(1,2,n) - i8f22(1,i)
303 i8f(2,2,n) = i8f(2,2,n) - i8f22(2,i)
304 i8f(3,2,n) = i8f(3,2,n) - i8f22(3,i)
305c___________________________________________________
306 i8f(1,3,n) = i8f(1,3,n) - i8f32(1,i)
307 i8f(2,3,n) = i8f(2,3,n) - i8f32(1,i)
308 i8f(3,3,n) = i8f(3,3,n) - i8f32(1,i)
309c___________________________________________________
310 i8m(1,1,n) = i8m(1,1,n) - i8m12(1,i)
311 i8m(2,1,n) = i8m(2,1,n) - i8m12(2,i)
312 i8m(3,1,n) = i8m(3,1,n) - i8m12(3,i)
313c___________________________________________________
314 i8m(1,2,n) = i8m(1,2,n) - i8m22(1,i)
315 i8m(2,2,n) = i8m(2,2,n) - i8m22(2,i)
316 i8m(3,2,n) = i8m(3,2,n) - i8m22(3,i)
317c___________________________________________________
318 i8m(1,3,n) = i8m(1,3,n) - i8m32(1,i)
319 i8m(2,3,n) = i8m(2,3,n) - i8m32(2,i)
320 i8m(3,3,n) = i8m(3,3,n) - i8m32(3,i)
321c___________________________________________________
322 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
323 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
324 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
325c___________________________________________________
326 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
327 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
328 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
329c___________________________________________________
330 ENDDO
331 ENDIF
332C
333 IF(nvc3 == 0)THEN
334#include "vectorize.inc"
335 DO i=jft,jlt
336c F(1,IXC(4,I))=F(1,IXC(4,I))-F13(I)
337c F(2,IXC(4,I))=F(2,IXC(4,I))-F23(I)
338c F(3,IXC(4,I))=F(3,IXC(4,I))-F33(I)
339c M(1,IXC(4,I))=M(1,IXC(4,I))-M13(I)
340c M(2,IXC(4,I))=M(2,IXC(4,I))-M23(I)
341c M(3,IXC(4,I))=M(3,IXC(4,I))-M33(I)
342c STIFN(IXC(4,I))=STIFN(IXC(4,I))+STI(I)
343c STIFR(IXC(4,I))=STIFR(IXC(4,I))+STIR(I)
344 n = ixc(4,i)
345c___________________________________________________
346 i8f(1,1,n) = i8f(1,1,n) - i8f13(1,i)
347 i8f(2,1,n) = i8f(2,1,n) - i8f13(2,i)
348 i8f(3,1,n) = i8f(3,1,n) - i8f13(3,i)
349c___________________________________________________
350 i8f(1,2,n) = i8f(1,2,n) - i8f23(1,i)
351 i8f(2,2,n) = i8f(2,2,n) - i8f23(2,i)
352 i8f(3,2,n) = i8f(3,2,n) - i8f23(3,i)
353c___________________________________________________
354 i8f(1,3,n) = i8f(1,3,n) - i8f33(1,i)
355 i8f(2,3,n) = i8f(2,3,n) - i8f33(1,i)
356 i8f(3,3,n) = i8f(3,3,n) - i8f33(1,i)
357c___________________________________________________
358 i8m(1,1,n) = i8m(1,1,n) - i8m13(1,i)
359 i8m(2,1,n) = i8m(2,1,n) - i8m13(2,i)
360 i8m(3,1,n) = i8m(3,1,n) - i8m13(3,i)
361c___________________________________________________
362 i8m(1,2,n) = i8m(1,2,n) - i8m23(1,i)
363 i8m(2,2,n) = i8m(2,2,n) - i8m23(2,i)
364 i8m(3,2,n) = i8m(3,2,n) - i8m23(3,i)
365c___________________________________________________
366 i8m(1,3,n) = i8m(1,3,n) - i8m33(1,i)
367 i8m(2,3,n) = i8m(2,3,n) - i8m33(2,i)
368 i8m(3,3,n) = i8m(3,3,n) - i8m33(3,i)
369c___________________________________________________
370 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
371 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
372 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
373c___________________________________________________
374 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
375 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
376 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
377c___________________________________________________
378 ENDDO
379 ELSE
380 DO i=jft,jlt
381 n = ixc(4,i)
382c___________________________________________________
383 i8f(1,1,n) = i8f(1,1,n) - i8f13(1,i)
384 i8f(2,1,n) = i8f(2,1,n) - i8f13(2,i)
385 i8f(3,1,n) = i8f(3,1,n) - i8f13(3,i)
386c___________________________________________________
387 i8f(1,2,n) = i8f(1,2,n) - i8f23(1,i)
388 i8f(2,2,n) = i8f(2,2,n) - i8f23(2,i)
389 i8f(3,2,n) = i8f(3,2,n) - i8f23(3,i)
390c___________________________________________________
391 i8f(1,3,n) = i8f(1,3,n) - i8f33(1,i)
392 i8f(2,3,n) = i8f(2,3,n) - i8f33(1,i)
393 i8f(3,3,n) = i8f(3,3,n) - i8f33(1,i)
394c___________________________________________________
395 i8m(1,1,n) = i8m(1,1,n) - i8m13(1,i)
396 i8m(2,1,n) = i8m(2,1,n) - i8m13(2,i)
397 i8m(3,1,n) = i8m(3,1,n) - i8m13(3,i)
398c___________________________________________________
399 i8m(1,2,n) = i8m(1,2,n) - i8m23(1,i)
400 i8m(2,2,n) = i8m(2,2,n) - i8m23(2,i)
401 i8m(3,2,n) = i8m(3,2,n) - i8m23(3,i)
402c___________________________________________________
403 i8m(1,3,n) = i8m(1,3,n) - i8m33(1,i)
404 i8m(2,3,n) = i8m(2,3,n) - i8m33(2,i)
405 i8m(3,3,n) = i8m(3,3,n) - i8m33(3,i)
406c___________________________________________________
407 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
408 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
409 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
410c___________________________________________________
411 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
412 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
413 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
414c___________________________________________________
415 ENDDO
416 ENDIF
417C
418 IF(nvc4 == 0)THEN
419#include "vectorize.inc"
420 DO i=jft,jlt
421c F(1,IXC(5,I))=F(1,IXC(5,I))-F14(I)
422c F(2,IXC(5,I))=F(2,IXC(5,I))-F24(I)
423c F(3,IXC(5,I))=F(3,IXC(5,I))-F34(I)
424c M(1,IXC(5,I))=M(1,IXC(5,I))-M14(I)
425c M(2,IXC(5,I))=M(2,IXC(5,I))-M24(I)
426c M(3,IXC(5,I))=M(3,IXC(5,I))-M34(I)
427c STIFN(IXC(5,I))=STIFN(IXC(5,I))+STI(I)
428c STIFR(IXC(5,I))=STIFR(IXC(5,I))+STIR(I)
429 n = ixc(5,i)
430c___________________________________________________
431 i8f(1,1,n) = i8f(1,1,n) - i8f14(1,i)
432 i8f(2,1,n) = i8f(2,1,n) - i8f14(2,i)
433 i8f(3,1,n) = i8f(3,1,n) - i8f14(3,i)
434c___________________________________________________
435 i8f(1,2,n) = i8f(1,2,n) - i8f24(1,i)
436 i8f(2,2,n) = i8f(2,2,n) - i8f24(2,i)
437 i8f(3,2,n) = i8f(3,2,n) - i8f24(3,i)
438c___________________________________________________
439 i8f(1,3,n) = i8f(1,3,n) - i8f34(1,i)
440 i8f(2,3,n) = i8f(2,3,n) - i8f34(1,i)
441 i8f(3,3,n) = i8f(3,3,n) - i8f34(1,i)
442c___________________________________________________
443 i8m(1,1,n) = i8m(1,1,n) - i8m14(1,i)
444 i8m(2,1,n) = i8m(2,1,n) - i8m14(2,i)
445 i8m(3,1,n) = i8m(3,1,n) - i8m14(3,i)
446c___________________________________________________
447 i8m(1,2,n) = i8m(1,2,n) - i8m24(1,i)
448 i8m(2,2,n) = i8m(2,2,n) - i8m24(2,i)
449 i8m(3,2,n) = i8m(3,2,n) - i8m24(3,i)
450c___________________________________________________
451 i8m(1,3,n) = i8m(1,3,n) - i8m34(1,i)
452 i8m(2,3,n) = i8m(2,3,n) - i8m34(2,i)
453 i8m(3,3,n) = i8m(3,3,n) - i8m34(3,i)
454c___________________________________________________
455 i8stifn(1,n) = i8stifn(1,n) - i8sti(1,i)
456 i8stifn(2,n) = i8stifn(2,n) - i8sti(2,i)
457 i8stifn(3,n) = i8stifn(3,n) - i8sti(3,i)
458c___________________________________________________
459 i8stifr(1,n) = i8stifr(1,n) - i8stir(1,i)
460 i8stifr(2,n) = i8stifr(2,n) - i8stir(2,i)
461 i8stifr(3,n) = i8stifr(3,n) - i8stir(3,i)
462c___________________________________________________
463 ENDDO
464 ELSE
465 DO i=jft,jlt
466 n = ixc(5,i)
467c___________________________________________________
468 i8f(1,1,n) = i8f(1,1,n) - i8f14(1,i)
469 i8f(2,1,n) = i8f(2,1,n) - i8f14(2,i)
470 i8f(3,1,n) = i8f(3,1,n) - i8f14(3,i)
471c___________________________________________________
472 i8f(1,2,n) = i8f(1,2,n) - i8f24(1,i)
473 i8f(2,2,n) = i8f(2,2,n) - i8f24(2,i)
474 i8f(3,2,n) = i8f(3,2,n) - i8f24(3,i)
475c___________________________________________________
476 i8f(1,3,n) = i8f(1,3,n) - i8f34(1,i)
477 i8f(2,3,n) = i8f(2,3,n) - i8f34(1,i)
478 i8f(3,3,n) = i8f(3,3,n) - i8f34(1,i)
479c___________________________________________________
480 i8m(1,1,n) = i8m(1,1,n) - i8m14(1,i)
481 i8m(2,1,n) = i8m(2,1,n) - i8m14(2,i)
482 i8m(3,1,n) = i8m(3,1,n) - i8m14(3,i)
483c___________________________________________________
484 i8m(1,2,n) = i8m(1,2,n) - i8m24(1,i)
485 i8m(2,2,n) = i8m(2,2,n) - i8m24(2,i)
486 i8m(3,2,n) = i8m(3,2,n) - i8m24(3,i)
487c___________________________________________________
488 i8m(1,3,n) = i8m(1,3,n) - i8m34(1,i)
489 i8m(2,3,n) = i8m(2,3,n) - i8m34(2,i)
490 i8m(3,3,n) = i8m(3,3,n) - i8m34(3,i)
491c___________________________________________________
492 i8stifn(1,n) = i8stifn(1,n) + i8sti(1,i)
493 i8stifn(2,n) = i8stifn(2,n) + i8sti(2,i)
494 i8stifn(3,n) = i8stifn(3,n) + i8sti(3,i)
495c___________________________________________________
496 i8stifr(1,n) = i8stifr(1,n) + i8stir(1,i)
497 i8stifr(2,n) = i8stifr(2,n) + i8stir(2,i)
498 i8stifr(3,n) = i8stifr(3,n) + i8stir(3,i)
499c___________________________________________________
500 ENDDO
501 ENDIF
502C
503 RETURN
double_flot_ieee
subroutine double_flot_ieee(jft, jlt, i8, r8, i8f)
Definition cinmas.F:27

◆ cupdt3p()

subroutine cupdt3p ( integer jft,
integer jlt,
offg,
off,
sti,
stir,
fsky,
fskyv,
integer, dimension(4,*) iadc,
integer, dimension(nixc,mvsiz) ixc,
f11,
f12,
f13,
f14,
f21,
f22,
f23,
f24,
f31,
f32,
f33,
f34,
m11,
m12,
m13,
m14,
m21,
m22,
m23,
m24,
m31,
m32,
m33,
m34,
eint,
partsav,
integer, dimension(mvsiz) mat,
integer, dimension(*) ipartc,
pm,
area,
thk,
integer jthe,
them,
fthesky,
condnsky,
conde,
integer, intent(in) nodadt_therm )

Definition at line 966 of file cupdt3.F.

976 use element_mod , only : nixc
977C-----------------------------------------------
978C I m p l i c i t T y p e s
979C-----------------------------------------------
980#include "implicit_f.inc"
981#include "comlock.inc"
982C-----------------------------------------------
983C G l o b a l P a r a m e t e r s
984C-----------------------------------------------
985#include "mvsiz_p.inc"
986C-----------------------------------------------
987C C o m m o n B l o c k s
988C-----------------------------------------------
989#include "param_c.inc"
990#include "parit_c.inc"
991#include "scr18_c.inc"
992C-----------------------------------------------
993C D u m m y A r g u m e n t s
994C-----------------------------------------------
995 INTEGER ,INTENT(IN) :: NODADT_THERM
996 INTEGER JFT, JLT, JTHE
997 INTEGER IXC(NIXC,MVSIZ),MAT(MVSIZ),IPARTC(*),IADC(4,*)
998 my_real
999 . offg(*), off(*), sti(*), stir(*),
1000 . fskyv(lsky,8), fsky(8,lsky)
1001 my_real
1002 . f11(mvsiz), f12(mvsiz), f13(mvsiz), f14(mvsiz),
1003 . f21(mvsiz), f22(mvsiz), f23(mvsiz), f24(mvsiz),
1004 . f31(mvsiz), f32(mvsiz), f33(mvsiz), f34(mvsiz),
1005 . m11(mvsiz), m12(mvsiz), m13(mvsiz), m14(mvsiz),
1006 . m21(mvsiz), m22(mvsiz), m23(mvsiz), m24(mvsiz),
1007 . m31(mvsiz), m32(mvsiz), m33(mvsiz), m34(mvsiz),
1008 . conde(mvsiz),
1009 . eint(jlt,2),pm(npropm,*),partsav(npsav,*), area(*) ,thk(*),
1010 . fthesky(lsky),them(mvsiz,4),condnsky(*)
1011C-----------------------------------------------
1012C L o c a l V a r i a b l e s
1013C-----------------------------------------------
1014 INTEGER I, K
1015 my_real off_l
1016C=======================================================================
1017C cumulative energy of deleted elements at the moment of deletion
1018 off_l = zero
1019 DO i=jft,jlt
1020 IF (off(i) < one) offg(i) = off(i)
1021 off_l = min(off_l,offg(i))
1022 ENDDO
1023 IF (off_l < zero) THEN
1024 DO i=jft,jlt
1025 IF (offg(i) < zero) THEN
1026 f11(i) = zero
1027 f21(i) = zero
1028 f31(i) = zero
1029 m11(i) = zero
1030 m21(i) = zero
1031 m31(i) = zero
1032 f12(i) = zero
1033 f22(i) = zero
1034 f32(i) = zero
1035 m12(i) = zero
1036 m22(i) = zero
1037 m32(i) = zero
1038 f13(i) = zero
1039 f23(i) = zero
1040 f33(i) = zero
1041 m13(i) = zero
1042 m23(i) = zero
1043 m33(i) = zero
1044 f14(i) = zero
1045 f24(i) = zero
1046 f34(i) = zero
1047 m14(i) = zero
1048 m24(i) = zero
1049 m34(i) = zero
1050 sti(i) = zero
1051 stir(i) = zero
1052 conde(i)= zero
1053 ENDIF
1054 ENDDO
1055 ENDIF
1056C
1057 IF (ivector == 1) THEN
1058#include "vectorize.inc"
1059 DO i=jft,jlt
1060 fskyv(iadc(1,i),1)=-f11(i)
1061 fskyv(iadc(1,i),2)=-f21(i)
1062 fskyv(iadc(1,i),3)=-f31(i)
1063 fskyv(iadc(1,i),4)=-m11(i)
1064 fskyv(iadc(1,i),5)=-m21(i)
1065 fskyv(iadc(1,i),6)=-m31(i)
1066 fskyv(iadc(1,i),7)=sti(i)
1067 fskyv(iadc(1,i),8)=stir(i)
1068C
1069 fskyv(iadc(2,i),1)=-f12(i)
1070 fskyv(iadc(2,i),2)=-f22(i)
1071 fskyv(iadc(2,i),3)=-f32(i)
1072 fskyv(iadc(2,i),4)=-m12(i)
1073 fskyv(iadc(2,i),5)=-m22(i)
1074 fskyv(iadc(2,i),6)=-m32(i)
1075 fskyv(iadc(2,i),7)=sti(i)
1076 fskyv(iadc(2,i),8)=stir(i)
1077C
1078 fskyv(iadc(3,i),1)=-f13(i)
1079 fskyv(iadc(3,i),2)=-f23(i)
1080 fskyv(iadc(3,i),3)=-f33(i)
1081 fskyv(iadc(3,i),4)=-m13(i)
1082 fskyv(iadc(3,i),5)=-m23(i)
1083 fskyv(iadc(3,i),6)=-m33(i)
1084 fskyv(iadc(3,i),7)=sti(i)
1085 fskyv(iadc(3,i),8)=stir(i)
1086C
1087 fskyv(iadc(4,i),1)=-f14(i)
1088 fskyv(iadc(4,i),2)=-f24(i)
1089 fskyv(iadc(4,i),3)=-f34(i)
1090 fskyv(iadc(4,i),4)=-m14(i)
1091 fskyv(iadc(4,i),5)=-m24(i)
1092 fskyv(iadc(4,i),6)=-m34(i)
1093 fskyv(iadc(4,i),7)=sti(i)
1094 fskyv(iadc(4,i),8)=stir(i)
1095 ENDDO
1096C
1097 IF (jthe > 0 ) THEN
1098#include "vectorize.inc"
1099 DO i=jft,jlt
1100 fthesky(iadc(1,i)) = them(i,1)
1101 fthesky(iadc(2,i)) = them(i,2)
1102 fthesky(iadc(3,i)) = them(i,3)
1103 fthesky(iadc(4,i)) = them(i,4)
1104 ENDDO
1105 IF (nodadt_therm == 1) THEN
1106#include "vectorize.inc"
1107 DO i=jft,jlt
1108 condnsky(iadc(1,i)) = conde(i)
1109 condnsky(iadc(2,i)) = conde(i)
1110 condnsky(iadc(3,i)) = conde(i)
1111 condnsky(iadc(4,i)) = conde(i)
1112 ENDDO
1113 ENDIF
1114 ENDIF
1115C----------
1116 ELSE ! Scalar (IVECTOR=0)
1117c----------
1118 DO i=jft,jlt
1119C
1120C Prefetch test for HP
1121C
1122C$DIR PREFETCH IADC(1,I+12)
1123C$DIR PREFETCH FSKY(1,IADC(1,I+4))
1124C$DIR PREFETCH FSKY(8,IADC(1,I+4))
1125C$DIR PREFETCH FSKY(1,IADC(2,I+4))
1126C$DIR PREFETCH FSKY(8,IADC(2,I+4))
1127C$DIR PREFETCH FSKY(1,IADC(3,I+4))
1128C$DIR PREFETCH FSKY(8,IADC(3,I+4))
1129C$DIR PREFETCH FSKY(1,IADC(4,I+4))
1130C$DIR PREFETCH FSKY(8,IADC(4,I+4))
1131C
1132c End of Prefetch
1133C
1134C prefetch FSKY
1135 k = iadc(1,i)
1136 fsky(1,k)=-f11(i)
1137 fsky(2,k)=-f21(i)
1138 fsky(3,k)=-f31(i)
1139 fsky(4,k)=-m11(i)
1140 fsky(5,k)=-m21(i)
1141 fsky(6,k)=-m31(i)
1142 fsky(7,k)=sti(i)
1143 fsky(8,k)=stir(i)
1144C
1145 k = iadc(2,i)
1146 fsky(1,k)=-f12(i)
1147 fsky(2,k)=-f22(i)
1148 fsky(3,k)=-f32(i)
1149 fsky(4,k)=-m12(i)
1150 fsky(5,k)=-m22(i)
1151 fsky(6,k)=-m32(i)
1152 fsky(7,k)=sti(i)
1153 fsky(8,k)=stir(i)
1154C
1155 k = iadc(3,i)
1156 fsky(1,k)=-f13(i)
1157 fsky(2,k)=-f23(i)
1158 fsky(3,k)=-f33(i)
1159 fsky(4,k)=-m13(i)
1160 fsky(5,k)=-m23(i)
1161 fsky(6,k)=-m33(i)
1162 fsky(7,k)=sti(i)
1163 fsky(8,k)=stir(i)
1164C
1165 k = iadc(4,i)
1166 fsky(1,k)=-f14(i)
1167 fsky(2,k)=-f24(i)
1168 fsky(3,k)=-f34(i)
1169 fsky(4,k)=-m14(i)
1170 fsky(5,k)=-m24(i)
1171 fsky(6,k)=-m34(i)
1172 fsky(7,k)=sti(i)
1173 fsky(8,k)=stir(i)
1174 ENDDO
1175C
1176 IF(jthe > 0 ) THEN
1177 DO i=jft,jlt
1178 fthesky(iadc(1,i)) = them(i,1)
1179 fthesky(iadc(2,i)) = them(i,2)
1180 fthesky(iadc(3,i)) = them(i,3)
1181 fthesky(iadc(4,i)) = them(i,4)
1182 ENDDO
1183 IF(nodadt_therm == 1) THEN
1184 DO i=jft,jlt
1185 condnsky(iadc(1,i)) = conde(i)
1186 condnsky(iadc(2,i)) = conde(i)
1187 condnsky(iadc(3,i)) = conde(i)
1188 condnsky(iadc(4,i)) = conde(i)
1189 ENDDO
1190 ENDIF
1191 ENDIF
1192C
1193 ENDIF
1194C-----------
1195 RETURN