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 "comlock.inc"
#include "parit_c.inc"
#include "scr18_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 508 of file cupdt3.F.

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

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

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