OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensgpstrain.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine tensgpstrain (elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
subroutine gpsstrain_skin (elbuf_tab, func1, func2, iparg, ixs, ixs10, ixs16, ixs20, x, itagps, pm, tag_skin_nd)

Function/Subroutine Documentation

◆ gpsstrain_skin()

subroutine gpsstrain_skin ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
func1,
func2,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
x,
integer, dimension(*) itagps,
pm,
integer, dimension(*) tag_skin_nd )

Definition at line 607 of file tensgpstrain.F.

610C-----------------------------------------------
611C M o d u l e s
612C-----------------------------------------------
613 USE initbuf_mod
614 USE elbufdef_mod
615 USE my_alloc_mod
616 use element_mod , only : nixs
617C-----------------------------------------------
618C I m p l i c i t T y p e s
619C-----------------------------------------------
620#include "implicit_f.inc"
621C-----------------------------------------------
622C C o m m o n B l o c k s
623C-----------------------------------------------
624#include "vect01_c.inc"
625#include "mvsiz_p.inc"
626#include "com01_c.inc"
627#include "com04_c.inc"
628#include "param_c.inc"
629C-----------------------------------------------
630C D u m m y A r g u m e n t s
631C-----------------------------------------------
632 my_real func1(3,*),func2(3,*),x(3,*), pm(npropm,*)
633 INTEGER IPARG(NPARG,*),IXS(NIXS,*),IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,ITAGPS(*) ,TAG_SKIN_ND(*)
634 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
635C-----------------------------------------------
636C L o c a l V a r i a b l e s
637C-----------------------------------------------
638 my_real gama(6),
639 .
640 .
641 . a_gauss_r,a_gauss_s,a_gauss_t,n1,
642 . a_gauss_r1,a_gauss_s1,a_gauss_t1,
643 . a_gauss_p_r,a_gauss_p_s,a_gauss_p_t
644 my_real,ALLOCATABLE,DIMENSION(:,:) :: evar
645 INTEGER I,II, NG, NEL,KCVT,
646 . N, J, MLW,
647 .
648 . NN1,K,
649 . ISOLNOD, NPTR, NPTS, NPTT,
650 . IS, IR, IT,NC(20,MVSIZ),NNOD,ILAY,
651 . ICSIG,IVISC,JJ(6),IP,ITSH
652 INTEGER MLW2,NLAY
653 TYPE(G_BUFEL_) ,POINTER :: GBUF
654 TYPE(L_BUFEL_) ,POINTER :: LBUF
655 my_real
656 . a_gauss(9,9),evar_tmp(6),alpha,beta,alpha_1,beta_1,
657 .
658 .
659 .
660 .
661 .
662 .
663 .
664 .
665 .
666 .
667 .
668 .
669 .
670 . str_is24(mvsiz,6,8),
671 . evar_t10(6,10)
672 INTEGER
673 . SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2,ISKIN(MVSIZ)
674 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
675 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
676C=======================================================================
677 DATA a_gauss /
678 1 0. ,0. ,0. ,
679 1 0. ,0. ,0. ,
680 1 0. ,0. ,0. ,
681 2 -.577350269189626,0.577350269189626,0. ,
682 2 0. ,0. ,0. ,
683 2 0. ,0. ,0. ,
684 3 -.774596669241483,0. ,0.774596669241483,
685 3 0. ,0. ,0. ,
686 3 0. ,0. ,0. ,
687 4 -.861136311594053,-.339981043584856,0.339981043584856,
688 4 0.861136311594053,0. ,0. ,
689 4 0. ,0. ,0. ,
690 5 -.906179845938664,-.538469310105683,0. ,
691 5 0.538469310105683,0.906179845938664,0. ,
692 5 0. ,0. ,0. ,
693 6 -.932469514203152,-.661209386466265,-.238619186083197,
694 6 0.238619186083197,0.661209386466265,0.932469514203152,
695 6 0. ,0. ,0. ,
696 7 -.949107912342759,-.741531185599394,-.405845151377397,
697 7 0. ,0.405845151377397,0.741531185599394,
698 7 0.949107912342759,0. ,0. ,
699 8 -.960289856497536,-.796666477413627,-.525532409916329,
700 8 -.183434642495650,0.183434642495650,0.525532409916329,
701 8 0.796666477413627,0.960289856497536,0. ,
702 9 -.968160239507626,-.836031107326636,-.613371432700590,
703 9 -.324253423403809,0. ,0.324253423403809,
704 9 0.613371432700590,0.836031107326636,0.968160239507626/
705 DATA sol_node /
706 1 -1 ,-1 ,-1 ,
707 2 -1 ,-1 , 1 ,
708 3 1 ,-1 , 1 ,
709 4 1 ,-1 ,-1 ,
710 5 -1 , 1 ,-1 ,
711 6 -1 , 1 , 1 ,
712 7 1 , 1 , 1 ,
713 8 1 , 1 ,-1 /
714C=======================================================================
715 alpha = zep1381966
716 beta = zep5854102
717 CALL my_alloc(evar,6,numnod)
718 DO i=1,numnod
719 evar(1,i) = zero
720 evar(2,i) = zero
721 evar(3,i) = zero
722 evar(4,i) = zero
723 evar(5,i) = zero
724 evar(6,i) = zero
725 ENDDO
726 DO ng=1,ngroup
727 ivisc = iparg(61,ng)
728 gbuf => elbuf_tab(ng)%GBUF
729 CALL initbuf(iparg ,ng ,
730 2 mlw ,nel ,nft ,iad ,ity ,
731 3 npt ,jale ,ismstr ,jeul ,jtur ,
732 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
733 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
734 6 irep ,iint ,igtyp ,israt ,isrot ,
735 7 icsen ,isorth ,isorthg ,ifailure,jsms )
736 mlw2 = mlw
737 IF (iparg(8,ng)==1.OR.mlw==0.OR.mlw==13) cycle
738 icsig=iparg(17,ng)
739 isolnod = iparg(28,ng)
740 lft=1
741 llt=nel
742 nnod = 0
743
744 DO i=1,6
745 jj(i) = nel*(i-1)
746 ENDDO
747
748C-----------------------------------------------
749C SOLID 8N
750C-----------------------------------------------
751 IF (ity == 1.AND.(igtyp==14.OR.igtyp==6)) THEN
752 gbuf => elbuf_tab(ng)%GBUF
753 IF (kcvt==1.AND.isorth/=0) kcvt=2
754 nnod = isolnod
755 iskin(1:nel) = 0
756 DO i=lft,llt
757 n = i + nft
758 IF(isolnod == 8)THEN
759 DO j = 1,isolnod
760 nc(j,i) = ixs(j+1,n)
761 ENDDO
762 DO j=1,8
763 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
764 END DO
765 ELSEIF(isolnod == 4)THEN
766 nc(1,i)=ixs(2,n)
767 nc(2,i)=ixs(4,n)
768 nc(3,i)=ixs(7,n)
769 nc(4,i)=ixs(6,n)
770 DO j=1,4
771 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
772 END DO
773 ELSEIF(isolnod == 6)THEN
774 nc(1,i)=ixs(2,n)
775 nc(2,i)=ixs(3,n)
776 nc(3,i)=ixs(4,n)
777 nc(4,i)=ixs(6,n)
778 nc(5,i)=ixs(7,n)
779 nc(6,i)=ixs(8,n)
780 ELSEIF(isolnod == 10)THEN
781 nc(1,i)=ixs(2,n)
782 nc(2,i)=ixs(4,n)
783 nc(3,i)=ixs(7,n)
784 nc(4,i)=ixs(6,n)
785 nn1 = n - numels8
786 DO j=1,6
787 nc(j+4,i) = ixs10(j,nn1)
788 ENDDO
789 DO j=1,4
790 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
791 END DO
792 ELSEIF(isolnod == 16)THEN
793 DO j = 1,8
794 nc(j,i) = ixs(j+1,n)
795 ENDDO
796 nn1 = n - (numels8+numels10+numels20)
797 DO j=1,8
798 nc(j+8,i) = ixs16(j,nn1)
799 ENDDO
800 ELSEIF(isolnod == 20)THEN
801 DO j = 1,8
802 nc(j,i) = ixs(j+1,n)
803 ENDDO
804 nn1 = n - (numels8+numels10)
805 DO j=1,12
806 nc(j+8,i) = ixs20(j,nn1)
807 ENDDO
808 DO j=1,8
809 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
810 END DO
811 ENDIF
812 ENDDO
813
814 nptr = elbuf_tab(ng)%NPTR
815 npts = elbuf_tab(ng)%NPTS
816 nptt = elbuf_tab(ng)%NPTT
817 nlay = elbuf_tab(ng)%NLAY
818 npt = nptr*npts*nptt
819 nnod = isolnod
820 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
821 itsh=1
822 ELSE
823 itsh=0
824 ENDIF
825 IF (jhbe == 24) THEN
826 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
827 nptr = 2
828 npts = 2
829 nptt = 2
830 CALL szstraingps(lbuf%STRA, str_is24, gbuf%STRHG,nel)
831 ENDIF
832C----------
833 IF((isolnod == 4.AND. isrot/=1).OR.(isolnod == 8.AND. jhbe<9))THEN
834
835 DO i=lft,llt
836 IF (iskin(i)==0) cycle
837 n = i + nft
838 IF (kcvt /= 0) THEN
839 IF(kcvt==2)THEN
840 gama(1) = gbuf%GAMA(jj(1) + i)
841 gama(2) = gbuf%GAMA(jj(2) + i)
842 gama(3) = gbuf%GAMA(jj(3) + i)
843 gama(4) = gbuf%GAMA(jj(4) + i)
844 gama(5) = gbuf%GAMA(jj(5) + i)
845 gama(6) = gbuf%GAMA(jj(6) + i)
846 ELSE
847 gama(1)=one
848 gama(2)=zero
849 gama(3)=zero
850 gama(4)=zero
851 gama(5)=one
852 gama(6)=zero
853 END IF
854 END IF
855 n1 = fourth
856 ilay = 1
857 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
858 evar_tmp(1) = lbuf%STRA(jj(1) + i)
859 evar_tmp(2) = lbuf%STRA(jj(2) + i)
860 evar_tmp(3) = lbuf%STRA(jj(3) + i)
861 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
862 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
863 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
864 IF (kcvt /= 0)CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
865 DO j=1,isolnod
866 evar(1:6,nc(j,i)) = evar(1:6,nc(j,i)) + evar_tmp(1:6)
867 ENDDO
868 ENDDO
869 ELSEIF(isolnod == 6 .OR. isolnod == 8 .OR. isolnod == 16 .OR. isolnod == 20)THEN
870
871c T_SHELL ( JHBE = 15/16 )
872 IF(itsh > 0 .AND. jhbe /= 14) THEN
873 DO i=lft,llt
874 IF (iskin(i)==0) cycle
875 ii = 6*(i-1)
876 n = i + nft
877 IF (kcvt /= 0) THEN
878 IF(kcvt==2)THEN
879 gama(1) = gbuf%GAMA(jj(1) + i)
880 gama(2) = gbuf%GAMA(jj(2) + i)
881 gama(3) = gbuf%GAMA(jj(3) + i)
882 gama(4) = gbuf%GAMA(jj(4) + i)
883 gama(5) = gbuf%GAMA(jj(5) + i)
884 gama(6) = gbuf%GAMA(jj(6) + i)
885 ELSE
886 gama(1)=one
887 gama(2)=zero
888 gama(3)=zero
889 gama(4)=zero
890 gama(5)=one
891 gama(6)=zero
892 END IF
893 END IF
894 npts = nlay
895C
896 DO j=1,8
897 DO k=1,8
898 IF(sol_node(2,k) == sol_node(2,j)) THEN
899
900 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1) ir = 1
901 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1) ir = max(1,nptr-1)
902 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1) ir = nptr
903 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1) ir = min(nptr,2)
904 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1) is = 1
905 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1) is = max(1,npts-1)
906 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1) is = npts
907 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1) is = min(npts,2)
908 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1) it = 1
909 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1) it = max(1,nptt-1)
910 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1) it = nptt
911 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1) it = min(nptt,2)
912
913 a_gauss_p_r = zero
914 a_gauss_p_s = zero
915 a_gauss_p_t = zero
916
917 IF (nptr == 1)THEN
918 a_gauss_p_r = zero
919 ELSEIF (sol_node(1,j) == -1 )THEN
920 a_gauss_r = a_gauss(1,nptr)
921 a_gauss_r1 = a_gauss(2,nptr)
922 a_gauss_p_r = (-one-half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
923 ELSEIF(sol_node(1,j) == 1 )THEN
924 a_gauss_r = a_gauss(nptr-1,nptr)
925 a_gauss_r1 = a_gauss(nptr,nptr)
926 a_gauss_p_r = (one+half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
927 ENDIF
928
929 IF (npts == 1)THEN
930 a_gauss_p_s = zero
931 ELSEIF (sol_node(2,j) == -1 )THEN
932 a_gauss_s = a_gauss(1,npts)
933 a_gauss_s1 = a_gauss(2,npts)
934 a_gauss_p_s = (-one-half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
935 ELSEIF(sol_node(2,j) == 1 )THEN
936 a_gauss_s = a_gauss(npts-1,npts)
937 a_gauss_s1 = a_gauss(npts,npts)
938 a_gauss_p_s = (one+half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
939 ENDIF
940
941 IF (nptt == 1)THEN
942 a_gauss_p_t = zero
943 ELSEIF (sol_node(3,j) == -1 )THEN
944 a_gauss_t = a_gauss(1,nptt)
945 a_gauss_t1 = a_gauss(2,nptt)
946 a_gauss_p_t =(-one-half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
947 ELSEIF(sol_node(3,j) == 1 )THEN
948 a_gauss_t = a_gauss(nptt-1,nptt)
949 a_gauss_t1 = a_gauss(nptt,nptt)
950 a_gauss_p_t = (one+half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
951 ENDIF
952
953 IF (jhbe == 15 .OR. jhbe == 16) THEN
954 ilay = is
955 is = 1
956 n1 = fourth*((one+sol_node(1,k) * a_gauss_p_r) * (one+sol_node(3,k) * a_gauss_p_t) )
957 ENDIF
958c STRHG(NEL,6,8)
959 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
960 ip = ir + ( (is-1) + (it-1)*2 )*2
961 evar_tmp(1) = lbuf%STRA(jj(1) + i)
962 evar_tmp(2) = lbuf%STRA(jj(2) + i)
963 evar_tmp(3) = lbuf%STRA(jj(3) + i)
964 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
965 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
966 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
967 IF (kcvt /= 0) CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
968 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
969 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
970 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
971 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
972 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
973 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
974 ENDIF
975 ENDDO
976 ENDDO
977 ENDDO
978 ELSE
979 DO i=lft,llt
980 IF (iskin(i)==0) cycle
981 ii = 6*(i-1)
982 n = i + nft
983 IF (kcvt /= 0) THEN
984 IF(kcvt==2)THEN
985 gama(1) = gbuf%GAMA(jj(1) + i)
986 gama(2) = gbuf%GAMA(jj(2) + i)
987 gama(3) = gbuf%GAMA(jj(3) + i)
988 gama(4) = gbuf%GAMA(jj(4) + i)
989 gama(5) = gbuf%GAMA(jj(5) + i)
990 gama(6) = gbuf%GAMA(jj(6) + i)
991 ELSE
992 gama(1)=one
993 gama(2)=zero
994 gama(3)=zero
995 gama(4)=zero
996 gama(5)=one
997 gama(6)=zero
998 END IF
999 END IF
1000 IF(itsh>0) nptt = nlay
1001 DO j=1,8
1002 DO k=1,8
1003 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1) is = 1
1004 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1) is = max(1,npts-1)
1005 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1) is = npts
1006 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1) is = min(npts,2)
1007 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1) it = 1
1008 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1) it = max(1,nptt-1)
1009 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1) it = nptt
1010 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1) it = min(nptt,2)
1011 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1) ir = 1
1012 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1) ir = max(1,nptr-1)
1013 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1) ir = nptr
1014 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1) ir = min(nptr,2)
1015
1016 a_gauss_p_r = zero
1017 a_gauss_p_s = zero
1018 a_gauss_p_t = zero
1019
1020 IF (nptr == 1)THEN
1021 a_gauss_p_r = zero
1022 ELSEIF (sol_node(1,j) == -1 )THEN
1023 a_gauss_r = a_gauss(1,nptr)
1024 a_gauss_r1 = a_gauss(2,nptr)
1025 a_gauss_p_r = (-one-half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
1026 ELSEIF(sol_node(1,j) == 1 )THEN
1027 a_gauss_r = a_gauss(nptr-1,nptr)
1028 a_gauss_r1 = a_gauss(nptr,nptr)
1029 a_gauss_p_r = (one+half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
1030 ENDIF
1031
1032 IF (npts == 1)THEN
1033 a_gauss_p_s = zero
1034 ELSEIF (sol_node(2,j) == -1 )THEN
1035 a_gauss_s = a_gauss(1,npts)
1036 a_gauss_s1 = a_gauss(2,npts)
1037 a_gauss_p_s = (-one-half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
1038 ELSEIF(sol_node(2,j) == 1 )THEN
1039 a_gauss_s = a_gauss(npts-1,npts)
1040 a_gauss_s1 = a_gauss(npts,npts)
1041 a_gauss_p_s = (one+half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
1042 ENDIF
1043
1044 IF (nptt == 1)THEN
1045 a_gauss_p_t = zero
1046 ELSEIF (sol_node(3,j) == -1 )THEN
1047 a_gauss_t = a_gauss(1,nptt)
1048 a_gauss_t1 = a_gauss(2,nptt)
1049 a_gauss_p_t = (-one-half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
1050 ELSEIF(sol_node(3,j) == 1 )THEN
1051 a_gauss_t = a_gauss(nptt-1,nptt)
1052 a_gauss_t1 = a_gauss(nptt,nptt)
1053 a_gauss_p_t = (one+half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
1054 ENDIF
1055
1056 n1 = one_over_8*((one+sol_node(1,k)*a_gauss_p_r)*(one+sol_node(2,k)*a_gauss_p_s)*(one+sol_node(3,k)*a_gauss_p_t))
1057
1058 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
1059 ilay = it
1060 it = 1
1061 ELSE
1062 ilay = 1
1063 ENDIF
1064
1065 IF (jhbe == 24 .AND. gbuf%G_STRHG > 0) THEN
1066 ip = ir + ( (is-1) + (it-1)*2 )*2
1067 evar_tmp(1) = str_is24(i,1,ip)
1068 evar_tmp(2) = str_is24(i,2,ip)
1069 evar_tmp(3) = str_is24(i,3,ip)
1070 evar_tmp(4) = str_is24(i,4,ip)
1071 evar_tmp(5) = str_is24(i,5,ip)
1072 evar_tmp(6) = str_is24(i,6,ip)
1073 ELSE
1074 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
1075 evar_tmp(1) = lbuf%STRA(jj(1) + i)
1076 evar_tmp(2) = lbuf%STRA(jj(2) + i)
1077 evar_tmp(3) = lbuf%STRA(jj(3) + i)
1078 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
1079 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
1080 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
1081 ENDIF
1082 IF (kcvt /= 0) CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
1083 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
1084 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
1085 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
1086 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
1087 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
1088 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
1089 ENDDO
1090 ENDDO
1091 ENDDO
1092 ENDIF
1093
1094 ELSEIF(isolnod == 10)THEN
1095
1096 alpha_1 = -alpha/(beta-alpha)
1097 beta_1 = (one-alpha)/(beta-alpha)
1098 DO i=lft,llt
1099 IF (iskin(i)==0) cycle
1100 n = i + nft
1101 IF (kcvt /= 0) THEN
1102 IF(kcvt==2)THEN
1103 gama(1) = gbuf%GAMA(jj(1) + i)
1104 gama(2) = gbuf%GAMA(jj(2) + i)
1105 gama(3) = gbuf%GAMA(jj(3) + i)
1106 gama(4) = gbuf%GAMA(jj(4) + i)
1107 gama(5) = gbuf%GAMA(jj(5) + i)
1108 gama(6) = gbuf%GAMA(jj(6) + i)
1109 ELSE
1110 gama(1)=one
1111 gama(2)=zero
1112 gama(3)=zero
1113 gama(4)=zero
1114 gama(5)=one
1115 gama(6)=zero
1116 END IF
1117 END IF
1118 DO j=1,4
1119 evar_t10(1:6,j)=zero
1120 DO k=1,4
1121 ir = k
1122 is = 1
1123 it = 1
1124 IF (j==k) THEN
1125 n1 = beta_1
1126 ELSE
1127 n1 = alpha_1
1128 ENDIF
1129 ilay = 1
1130 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
1131 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%STRA(jj(1) + i)
1132 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%STRA(jj(2) + i)
1133 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%STRA(jj(3) + i)
1134 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%STRA(jj(4) + i)*half
1135 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%STRA(jj(5) + i)*half
1136 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%STRA(jj(6) + i)*half
1137 ENDDO
1138 IF (kcvt /= 0) CALL srota6(x, ixs(1,n), kcvt, evar_t10(1,j), gama, jhbe, igtyp, isorth)
1139 ENDDO
1140 DO j=5,10
1141 nn1=iperm1(j)
1142 nn2=iperm2(j)
1143 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
1144 END DO
1145 DO j=1,10
1146 evar(1,nc(j,i)) = evar(1,nc(j,i)) + evar_t10(1,j)
1147 evar(2,nc(j,i)) = evar(2,nc(j,i)) + evar_t10(2,j)
1148 evar(3,nc(j,i)) = evar(3,nc(j,i)) + evar_t10(3,j)
1149 evar(4,nc(j,i)) = evar(4,nc(j,i)) + evar_t10(4,j)
1150 evar(5,nc(j,i)) = evar(5,nc(j,i)) + evar_t10(5,j)
1151 evar(6,nc(j,i)) = evar(6,nc(j,i)) + evar_t10(6,j)
1152 ENDDO
1153 ENDDO
1154 ENDIF
1155 DO i=lft,llt
1156 IF (iskin(i)==0) cycle
1157 DO j = 1,nnod
1158 n = nc(j,i)
1159 IF (n>0)THEN
1160 DO k = 1,3
1161 func1(k,n) = evar(k,n)
1162 func2(k,n) = evar(k+3,n)
1163 ENDDO
1164 itagps(n) = itagps(n)+1
1165 ENDIF
1166 ENDDO
1167 ENDDO
1168 ENDIF
1169
1170 ENDDO ! next ng
1171 DEALLOCATE(evar)
1172C-----------------------------------------------
1173 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
srota6
subroutine srota6(x, ixs, kcvt, tens, gama)
Definition srota6.F:33
szstraingps
subroutine szstraingps(strain, str_pi, strhg, nel)
Definition szstraingps.F:32

◆ tensgpstrain()

subroutine tensgpstrain ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
func1,
func2,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
x,
integer, dimension(*) itagps,
pm )

Definition at line 40 of file tensgpstrain.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE initbuf_mod
48 USE elbufdef_mod
49 USE outmax_mod
50 USE my_alloc_mod
51 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "vect01_c.inc"
60#include "mvsiz_p.inc"
61#include "com01_c.inc"
62#include "com04_c.inc"
63#include "param_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 my_real func1(3,*),func2(3,*),geo(npropg,*),x(3,*),pm(npropm,*)
68 INTEGER IPARG(NPARG,*),
69 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
70 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
71 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,ITAGPS(*)
72 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 my_real gama(6),
77 .
78 .
79 . a_gauss_r,a_gauss_s,a_gauss_t,n1,
80 . a_gauss_r1,a_gauss_s1,a_gauss_t1,
81 . a_gauss_p_r,a_gauss_p_s,a_gauss_p_t
82 my_real,ALLOCATABLE,DIMENSION(:,:) :: evar
83 INTEGER I,II, NG, NEL,KCVT,
84 . N, J, MLW,
85 .
86 . NN1,K,
87 . ISOLNOD, NPTR, NPTS, NPTT,
88 . IS, IR, IT,NC(20,MVSIZ),NNOD,ILAY,
89 . ICSIG,IVISC,JJ(6),IP
90 INTEGER MLW2,NLAY
91 TYPE(G_BUFEL_) ,POINTER :: GBUF
92 TYPE(L_BUFEL_) ,POINTER :: LBUF
93 my_real
94 . a_gauss(9,9),evar_tmp(6),alpha,beta,alpha_1,beta_1,
95 .
96 .
97 .
98 .
99 .
100 .
101 .
102 .
103 .
104 .
105 .
106 .
107 .
108 . str_is24(mvsiz,6,8),
109 . evar_t10(6,10)
110 INTEGER
111 . SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2,ITSH
112 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
113 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
114C=======================================================================
115 DATA a_gauss /
116 1 0. ,0. ,0. ,
117 1 0. ,0. ,0. ,
118 1 0. ,0. ,0. ,
119 2 -.577350269189626,0.577350269189626,0. ,
120 2 0. ,0. ,0. ,
121 2 0. ,0. ,0. ,
122 3 -.774596669241483,0. ,0.774596669241483,
123 3 0. ,0. ,0. ,
124 3 0. ,0. ,0. ,
125 4 -.861136311594053,-.339981043584856,0.339981043584856,
126 4 0.861136311594053,0. ,0. ,
127 4 0. ,0. ,0. ,
128 5 -.906179845938664,-.538469310105683,0. ,
129 5 0.538469310105683,0.906179845938664,0. ,
130 5 0. ,0. ,0. ,
131 6 -.932469514203152,-.661209386466265,-.238619186083197,
132 6 0.238619186083197,0.661209386466265,0.932469514203152,
133 6 0. ,0. ,0. ,
134 7 -.949107912342759,-.741531185599394,-.405845151377397,
135 7 0. ,0.405845151377397,0.741531185599394,
136 7 0.949107912342759,0. ,0. ,
137 8 -.960289856497536,-.796666477413627,-.525532409916329,
138 8 -.183434642495650,0.183434642495650,0.525532409916329,
139 8 0.796666477413627,0.960289856497536,0. ,
140 9 -.968160239507626,-.836031107326636,-.613371432700590,
141 9 -.324253423403809,0. ,0.324253423403809,
142 9 0.613371432700590,0.836031107326636,0.968160239507626/
143 DATA sol_node /
144 1 -1 ,-1 ,-1 ,
145 2 -1 ,-1 , 1 ,
146 3 1 ,-1 , 1 ,
147 4 1 ,-1 ,-1 ,
148 5 -1 , 1 ,-1 ,
149 6 -1 , 1 , 1 ,
150 7 1 , 1 , 1 ,
151 8 1 , 1 ,-1 /
152C=======================================================================
153 alpha = zep1381966
154 beta = zep5854102
155 CALL my_alloc(evar,6,numnod)
156 DO i=1,numnod
157 evar(1,i) = zero
158 evar(2,i) = zero
159 evar(3,i) = zero
160 evar(4,i) = zero
161 evar(5,i) = zero
162 evar(6,i) = zero
163 ENDDO
164 DO ng=1,ngroup
165 IF (lmax_nstra >0 .AND. ipart_ok(ng,2)==0) cycle
166 ivisc = iparg(61,ng)
167 gbuf => elbuf_tab(ng)%GBUF
168 CALL initbuf(iparg ,ng ,
169 2 mlw ,nel ,nft ,iad ,ity ,
170 3 npt ,jale ,ismstr ,jeul ,jtur ,
171 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
172 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
173 6 irep ,iint ,igtyp ,israt ,isrot ,
174 7 icsen ,isorth ,isorthg ,ifailure,jsms )
175 mlw2 = mlw
176 IF (iparg(8,ng)==1.OR.mlw==0.OR.mlw==13) cycle
177 icsig=iparg(17,ng)
178 isolnod = iparg(28,ng)
179 lft=1
180 llt=nel
181 nnod = 0
182!
183 DO i=1,6
184 jj(i) = nel*(i-1)
185 ENDDO
186!
187C-----------------------------------------------
188C SOLID 8N
189C-----------------------------------------------
190 IF (ity == 1) THEN
191 gbuf => elbuf_tab(ng)%GBUF
192 IF (kcvt==1.AND.isorth/=0) kcvt=2
193 nnod = isolnod
194 DO i=lft,llt
195 n = i + nft
196 IF(isolnod == 8)THEN
197 DO j = 1,isolnod
198 nc(j,i) = ixs(j+1,n)
199 ENDDO
200 ELSEIF(isolnod == 4)THEN
201 nc(1,i)=ixs(2,n)
202 nc(2,i)=ixs(4,n)
203 nc(3,i)=ixs(7,n)
204 nc(4,i)=ixs(6,n)
205 ELSEIF(isolnod == 6)THEN
206 nc(1,i)=ixs(2,n)
207 nc(2,i)=ixs(3,n)
208 nc(3,i)=ixs(4,n)
209 nc(4,i)=ixs(6,n)
210 nc(5,i)=ixs(7,n)
211 nc(6,i)=ixs(8,n)
212 ELSEIF(isolnod == 10)THEN
213 nc(1,i)=ixs(2,n)
214 nc(2,i)=ixs(4,n)
215 nc(3,i)=ixs(7,n)
216 nc(4,i)=ixs(6,n)
217 nn1 = n - numels8
218 DO j=1,6
219 nc(j+4,i) = ixs10(j,nn1)
220 ENDDO
221 ELSEIF(isolnod == 16)THEN
222 DO j = 1,8
223 nc(j,i) = ixs(j+1,n)
224 ENDDO
225 nn1 = n - (numels8+numels10+numels20)
226 DO j=1,8
227 nc(j+8,i) = ixs16(j,nn1)
228 ENDDO
229 ELSEIF(isolnod == 20)THEN
230 DO j = 1,8
231 nc(j,i) = ixs(j+1,n)
232 ENDDO
233 nn1 = n - (numels8+numels10)
234 DO j=1,12
235 nc(j+8,i) = ixs20(j,nn1)
236 ENDDO
237 ENDIF
238 ENDDO
239 nptr = elbuf_tab(ng)%NPTR
240 npts = elbuf_tab(ng)%NPTS
241 nptt = elbuf_tab(ng)%NPTT
242 nlay = elbuf_tab(ng)%NLAY
243 npt = nptr*npts*nptt
244 nnod = isolnod
245 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
246 itsh=1
247 ELSE
248 itsh=0
249 ENDIF
250 IF (jhbe == 24) THEN
251 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
252 nptr = 2
253 npts = 2
254 nptt = 2
255 CALL szstraingps(lbuf%STRA, str_is24, gbuf%STRHG,nel)
256 ENDIF
257C----------
258 IF((isolnod == 4.AND. isrot/=1).OR.(isolnod == 8.AND. jhbe<9))THEN
259
260 DO i=lft,llt
261 n = i + nft
262 IF (kcvt /= 0) THEN
263 IF(kcvt==2)THEN
264 gama(1) = gbuf%GAMA(jj(1) + i)
265 gama(2) = gbuf%GAMA(jj(2) + i)
266 gama(3) = gbuf%GAMA(jj(3) + i)
267 gama(4) = gbuf%GAMA(jj(4) + i)
268 gama(5) = gbuf%GAMA(jj(5) + i)
269 gama(6) = gbuf%GAMA(jj(6) + i)
270 ELSE
271 gama(1)=one
272 gama(2)=zero
273 gama(3)=zero
274 gama(4)=zero
275 gama(5)=one
276 gama(6)=zero
277 END IF
278 END IF
279 n1 = fourth
280 ilay = 1
281 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
282 evar_tmp(1) = lbuf%STRA(jj(1) + i)
283 evar_tmp(2) = lbuf%STRA(jj(2) + i)
284 evar_tmp(3) = lbuf%STRA(jj(3) + i)
285 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
286 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
287 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
288 IF (kcvt /= 0)CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
289 DO j=1,isolnod
290 evar(1:6,nc(j,i)) = evar(1:6,nc(j,i)) +evar_tmp(1:6)
291 ENDDO
292 ENDDO
293 ELSEIF(isolnod == 6 .OR. isolnod == 8 .OR. isolnod == 16 .OR. isolnod == 20)THEN
294
295c T_SHELL ( JHBE = 15/16 )
296 IF(itsh > 0 .AND. jhbe /= 14) THEN
297 DO i=lft,llt
298 ii = 6*(i-1)
299 n = i + nft
300 IF (kcvt /= 0) THEN
301 IF(kcvt==2)THEN
302 gama(1) = gbuf%GAMA(jj(1) + i)
303 gama(2) = gbuf%GAMA(jj(2) + i)
304 gama(3) = gbuf%GAMA(jj(3) + i)
305 gama(4) = gbuf%GAMA(jj(4) + i)
306 gama(5) = gbuf%GAMA(jj(5) + i)
307 gama(6) = gbuf%GAMA(jj(6) + i)
308 ELSE
309 gama(1)=one
310 gama(2)=zero
311 gama(3)=zero
312 gama(4)=zero
313 gama(5)=one
314 gama(6)=zero
315 END IF
316 END IF
317 npts = nlay
318
319 DO j=1,8
320 DO k=1,8
321 IF(sol_node(2,k) == sol_node(2,j)) THEN
322 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1) ir = 1
323 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1) ir = max(1,nptr-1)
324 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1) ir = nptr
325 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1) ir = min(nptr,2)
326 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1) is = 1
327 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1) is = max(1,npts-1)
328 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1) is = npts
329 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1) is = min(npts,2)
330 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1) it = 1
331 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1) it = max(1,nptt-1)
332 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1) it = nptt
333 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1) it = min(nptt,2)
334
335 a_gauss_p_r = zero
336 a_gauss_p_s = zero
337 a_gauss_p_t = zero
338
339 IF (nptr == 1)THEN
340 a_gauss_p_r = zero
341 ELSEIF (sol_node(1,j) == -1 )THEN
342 a_gauss_r = a_gauss(1,nptr)
343 a_gauss_r1 = a_gauss(2,nptr)
344 a_gauss_p_r = (-one-half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
345 ELSEIF(sol_node(1,j) == 1 )THEN
346 a_gauss_r = a_gauss(nptr-1,nptr)
347 a_gauss_r1 = a_gauss(nptr,nptr)
348 a_gauss_p_r = (one+half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
349 ENDIF
350
351 IF (npts == 1)THEN
352 a_gauss_p_s = zero
353 ELSEIF (sol_node(2,j) == -1 )THEN
354 a_gauss_s = a_gauss(1,npts)
355 a_gauss_s1 = a_gauss(2,npts)
356 a_gauss_p_s = (-one-half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
357 ELSEIF(sol_node(2,j) == 1 )THEN
358 a_gauss_s = a_gauss(npts-1,npts)
359 a_gauss_s1 = a_gauss(npts,npts)
360 a_gauss_p_s = (one+half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
361 ENDIF
362
363 IF (nptt == 1)THEN
364 a_gauss_p_t = zero
365 ELSEIF (sol_node(3,j) == -1 )THEN
366 a_gauss_t = a_gauss(1,nptt)
367 a_gauss_t1 = a_gauss(2,nptt)
368 a_gauss_p_t = (-one-half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
369 ELSEIF(sol_node(3,j) == 1 )THEN
370 a_gauss_t = a_gauss(nptt-1,nptt)
371 a_gauss_t1 = a_gauss(nptt,nptt)
372 a_gauss_p_t = (one+half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
373 ENDIF
374
375 IF (jhbe == 15 .OR. jhbe == 16) THEN
376 ilay = is
377 is = 1
378 n1 = fourth*( (one+sol_node(1,k) * a_gauss_p_r) * (one+sol_node(3,k) * a_gauss_p_t) )
379 ENDIF
380c STRHG(NEL,6,8)
381 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
382 ip = ir + ( (is-1) + (it-1)*2 )*2
383 evar_tmp(1) = lbuf%STRA(jj(1) + i)
384 evar_tmp(2) = lbuf%STRA(jj(2) + i)
385 evar_tmp(3) = lbuf%STRA(jj(3) + i)
386 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
387 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
388 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
389 IF (kcvt /= 0)CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
390 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
391 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
392 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
393 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
394 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
395 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
396 ENDIF
397 ENDDO
398 ENDDO
399 ENDDO
400 ELSE
401 DO i=lft,llt
402 ii = 6*(i-1)
403 n = i + nft
404 IF (kcvt /= 0) THEN
405 IF(kcvt==2)THEN
406 gama(1) = gbuf%GAMA(jj(1) + i)
407 gama(2) = gbuf%GAMA(jj(2) + i)
408 gama(3) = gbuf%GAMA(jj(3) + i)
409 gama(4) = gbuf%GAMA(jj(4) + i)
410 gama(5) = gbuf%GAMA(jj(5) + i)
411 gama(6) = gbuf%GAMA(jj(6) + i)
412 ELSE
413 gama(1)=one
414 gama(2)=zero
415 gama(3)=zero
416 gama(4)=zero
417 gama(5)=one
418 gama(6)=zero
419 END IF
420 END IF
421 IF(itsh>0) nptt = nlay
422 DO j=1,8
423 DO k=1,8
424 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1) is = 1
425 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1) is = max(1,npts-1)
426 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1) is = npts
427 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1) is = min(npts,2)
428 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1) it = 1
429 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1) it = max(1,nptt-1)
430 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1) it = nptt
431 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1) it = min(nptt,2)
432 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1) ir = 1
433 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1) ir = max(1,nptr-1)
434 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1) ir = nptr
435 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1) ir = min(nptr,2)
436 a_gauss_p_r = zero
437 a_gauss_p_s = zero
438 a_gauss_p_t = zero
439 IF (nptr == 1)THEN
440 a_gauss_p_r = zero
441 ELSEIF (sol_node(1,j) == -1 )THEN
442 a_gauss_r = a_gauss(1,nptr)
443 a_gauss_r1 = a_gauss(2,nptr)
444 a_gauss_p_r = (-one-half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
445 ELSEIF(sol_node(1,j) == 1 )THEN
446 a_gauss_r = a_gauss(nptr-1,nptr)
447 a_gauss_r1 = a_gauss(nptr,nptr)
448 a_gauss_p_r = (one+half*(a_gauss_r1+a_gauss_r))/(half*(a_gauss_r1-a_gauss_r))
449 ENDIF
450c
451 IF (npts == 1)THEN
452 a_gauss_p_s = zero
453 ELSEIF (sol_node(2,j) == -1 )THEN
454 a_gauss_s = a_gauss(1,npts)
455 a_gauss_s1 = a_gauss(2,npts)
456 a_gauss_p_s = (-one-half*(a_gauss_s1+a_gauss_s))/ (half*(a_gauss_s1-a_gauss_s))
457 ELSEIF(sol_node(2,j) == 1 )THEN
458 a_gauss_s = a_gauss(npts-1,npts)
459 a_gauss_s1 = a_gauss(npts,npts)
460 a_gauss_p_s = (one+half*(a_gauss_s1+a_gauss_s))/(half*(a_gauss_s1-a_gauss_s))
461 ENDIF
462
463 IF (nptt == 1)THEN
464 a_gauss_p_t = zero
465 ELSEIF (sol_node(3,j) == -1 )THEN
466 a_gauss_t = a_gauss(1,nptt)
467 a_gauss_t1 = a_gauss(2,nptt)
468 a_gauss_p_t = (-one-half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
469 ELSEIF(sol_node(3,j) == 1 )THEN
470 a_gauss_t = a_gauss(nptt-1,nptt)
471 a_gauss_t1 = a_gauss(nptt,nptt)
472 a_gauss_p_t = (one+half*(a_gauss_t1+a_gauss_t))/(half*(a_gauss_t1-a_gauss_t))
473 ENDIF
474
475 n1 = one_over_8*((one+sol_node(1,k)*a_gauss_p_r)*(one+sol_node(2,k)*a_gauss_p_s)*(one+sol_node(3,k)*a_gauss_p_t))
476
477 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
478 ilay = it
479 it = 1
480 ELSE
481 ilay = 1
482 ENDIF
483
484 IF (jhbe == 24 .AND. gbuf%G_STRHG > 0) THEN
485 ip = ir + ( (is-1) + (it-1)*2 )*2
486 evar_tmp(1) = str_is24(i,1,ip)
487 evar_tmp(2) = str_is24(i,2,ip)
488 evar_tmp(3) = str_is24(i,3,ip)
489 evar_tmp(4) = str_is24(i,4,ip)*half
490 evar_tmp(5) = str_is24(i,5,ip)*half
491 evar_tmp(6) = str_is24(i,6,ip)*half
492 ELSE
493 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
494 evar_tmp(1) = lbuf%STRA(jj(1) + i)
495 evar_tmp(2) = lbuf%STRA(jj(2) + i)
496 evar_tmp(3) = lbuf%STRA(jj(3) + i)
497 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
498 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
499 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
500 ENDIF
501 IF (kcvt /= 0)CALL srota6(x, ixs(1,n), kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
502 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
503 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
504 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
505 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
506 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
507 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
508 ENDDO
509 ENDDO
510 ENDDO
511 ENDIF
512
513 ELSEIF(isolnod == 10)THEN
514
515 alpha_1 = -alpha/(beta-alpha)
516 beta_1 = (one-alpha)/(beta-alpha)
517 DO i=lft,llt
518 n = i + nft
519 IF (kcvt /= 0) THEN
520 IF(kcvt==2)THEN
521 gama(1) = gbuf%GAMA(jj(1) + i)
522 gama(2) = gbuf%GAMA(jj(2) + i)
523 gama(3) = gbuf%GAMA(jj(3) + i)
524 gama(4) = gbuf%GAMA(jj(4) + i)
525 gama(5) = gbuf%GAMA(jj(5) + i)
526 gama(6) = gbuf%GAMA(jj(6) + i)
527 ELSE
528 gama(1)=one
529 gama(2)=zero
530 gama(3)=zero
531 gama(4)=zero
532 gama(5)=one
533 gama(6)=zero
534 END IF
535 END IF
536 DO j=1,4
537 evar_t10(1:6,j)=zero
538 DO k=1,4
539 ir = k
540 is = 1
541 it = 1
542 IF (j==k) THEN
543 n1 = beta_1
544 ELSE
545 n1 = alpha_1
546 ENDIF
547 ilay = 1
548 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
549 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%STRA(jj(1) + i)
550 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%STRA(jj(2) + i)
551 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%STRA(jj(3) + i)
552 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%STRA(jj(4) + i)*half
553 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%STRA(jj(5) + i)*half
554 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%STRA(jj(6) + i)*half
555 ENDDO
556 IF (kcvt /= 0)CALL srota6(x, ixs(1,n), kcvt, evar_t10(1,j), gama, jhbe, igtyp, isorth)
557 ENDDO
558 DO j=5,10
559 nn1=iperm1(j)
560 nn2=iperm2(j)
561 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
562 END DO
563 DO j=1,10
564 evar(1,nc(j,i)) = evar(1,nc(j,i)) + evar_t10(1,j)
565 evar(2,nc(j,i)) = evar(2,nc(j,i)) + evar_t10(2,j)
566 evar(3,nc(j,i)) = evar(3,nc(j,i)) + evar_t10(3,j)
567 evar(4,nc(j,i)) = evar(4,nc(j,i)) + evar_t10(4,j)
568 evar(5,nc(j,i)) = evar(5,nc(j,i)) + evar_t10(5,j)
569 evar(6,nc(j,i)) = evar(6,nc(j,i)) + evar_t10(6,j)
570 ENDDO
571 ENDDO
572 ENDIF
573 DO i=lft,llt
574 DO j = 1,nnod
575 n = nc(j,i)
576 IF (n>0)THEN
577 DO k = 1,3
578 func1(k,n) = evar(k,n)
579 func2(k,n) = evar(k+3,n)
580 ENDDO
581 itagps(n) = itagps(n)+1
582 ENDIF
583 ENDDO
584 ENDDO
585 ENDIF
586
587 ENDDO ! next NG
588 DEALLOCATE(evar)
589C-----------------------------------------------
590 RETURN
outmax_mod
Definition outmax_mod.F:52
outmax_mod::ipart_ok
integer, dimension(:,:), allocatable ipart_ok
Definition outmax_mod.F:72
outmax_mod::lmax_nstra
integer lmax_nstra
Definition outmax_mod.F:63