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 604 of file tensgpstrain.F.

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

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