OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srefsta3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine srefsta3 (elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
subroutine sdefot3 (nel, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz)
subroutine sordeft3 (nel, mxx, mxy, mxz, myx, myy, myz, mzx, mzy, mzz, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
subroutine srefderi3 (nel, jeul, vol, veul, geo, igeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det)
subroutine szrefderi3 (nel, jeul, vol, veul, geo, igeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac1, jac2, jac3, jac4, jac5, jac6, jac9, ngl, ngeo, det)

Function/Subroutine Documentation

◆ sdefot3()

subroutine sdefot3 ( integer nel,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
vx1,
vx2,
vx3,
vx4,
vx5,
vx6,
vx7,
vx8,
vy1,
vy2,
vy3,
vy4,
vy5,
vy6,
vy7,
vy8,
vz1,
vz2,
vz3,
vz4,
vz5,
vz6,
vz7,
vz8,
dxx,
dxy,
dxz,
dyx,
dyy,
dyz,
dzx,
dzy,
dzz )

Definition at line 657 of file srefsta3.F.

665C-----------------------------------------------
666C I m p l i c i t T y p e s
667C-----------------------------------------------
668#include "implicit_f.inc"
669C-----------------------------------------------
670C G l o b a l P a r a m e t e r s
671C-----------------------------------------------
672#include "mvsiz_p.inc"
673C-----------------------------------------------
674C D u m m y A r g u m e n t s
675C-----------------------------------------------
676 INTEGER :: NEL
677 my_real
678 . vx1(*), vx2(*), vx3(*), vx4(*), vx5(*), vx6(*), vx7(*), vx8(*),
679 . vy1(*), vy2(*), vy3(*), vy4(*), vy5(*), vy6(*), vy7(*), vy8(*),
680 . vz1(*), vz2(*), vz3(*), vz4(*), vz5(*), vz6(*), vz7(*), vz8(*),
681 . px1(*), px2(*), px3(*), px4(*),
682 . py1(*), py2(*), py3(*), py4(*),
683 . pz1(*), pz2(*), pz3(*), pz4(*),
684 . dxx(*), dxy(*), dxz(*),
685 . dyx(*), dyy(*), dyz(*),
686 . dzx(*), dzy(*), dzz(*)
687C-----------------------------------------------
688C L o c a l V a r i a b l e s
689C-----------------------------------------------
690 INTEGER I
691 my_real
692 . vx17(mvsiz), vy17(mvsiz), vz17(mvsiz),
693 . vx28(mvsiz), vy28(mvsiz), vz28(mvsiz),
694 . vx35(mvsiz), vy35(mvsiz), vz35(mvsiz),
695 . vx46(mvsiz), vy46(mvsiz), vz46(mvsiz)
696C-----------------------------------------------
697 DO i=1,nel
698 vx17(i)=vx1(i)-vx7(i)
699 vx28(i)=vx2(i)-vx8(i)
700 vx35(i)=vx3(i)-vx5(i)
701 vx46(i)=vx4(i)-vx6(i)
702 vy17(i)=vy1(i)-vy7(i)
703 vy28(i)=vy2(i)-vy8(i)
704 vy35(i)=vy3(i)-vy5(i)
705 vy46(i)=vy4(i)-vy6(i)
706 vz17(i)=vz1(i)-vz7(i)
707 vz28(i)=vz2(i)-vz8(i)
708 vz35(i)=vz3(i)-vz5(i)
709 vz46(i)=vz4(i)-vz6(i)
710 ENDDO
711
712C 12
713 DO i=1,nel
714 dxx(i)=px1(i)*vx17(i)+px2(i)*vx28(i)+
715 . px3(i)*vx35(i)+px4(i)*vx46(i)
716 dyy(i)=py1(i)*vy17(i)+py2(i)*vy28(i)+
717 . py3(i)*vy35(i)+py4(i)*vy46(i)
718 dzz(i)=pz1(i)*vz17(i)+pz2(i)*vz28(i)+
719 . pz3(i)*vz35(i)+pz4(i)*vz46(i)
720 dxy(i)=py1(i)*vx17(i)+py2(i)*vx28(i)+
721 . py3(i)*vx35(i)+py4(i)*vx46(i)
722 dxz(i)=pz1(i)*vx17(i)+pz2(i)*vx28(i)+
723 . pz3(i)*vx35(i)+pz4(i)*vx46(i)
724 dyx(i)=px1(i)*vy17(i)+px2(i)*vy28(i)+
725 . px3(i)*vy35(i)+px4(i)*vy46(i)
726 dyz(i)=pz1(i)*vy17(i)+pz2(i)*vy28(i)+
727 . pz3(i)*vy35(i)+pz4(i)*vy46(i)
728 dzx(i)=px1(i)*vz17(i)+px2(i)*vz28(i)+
729 . px3(i)*vz35(i)+px4(i)*vz46(i)
730 dzy(i)=py1(i)*vz17(i)+py2(i)*vz28(i)+
731 . py3(i)*vz35(i)+py4(i)*vz46(i)
732 ENDDO
733C-----------
734 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ sordeft3()

subroutine sordeft3 ( integer nel,
mxx,
mxy,
mxz,
myx,
myy,
myz,
mzx,
mzy,
mzz,
g1x,
g1y,
g1z,
g2x,
g2y,
g2z,
g3x,
g3y,
g3z )

Definition at line 741 of file srefsta3.F.

744C-----------------------------------------------
745C I m p l i c i t T y p e s
746C-----------------------------------------------
747#include "implicit_f.inc"
748C-----------------------------------------------
749C D u m m y A r g u m e n t s
750C-----------------------------------------------
751 INTEGER :: NEL
752 my_real
753 . mxx(*), mxy(*), mxz(*),myx(*), myy(*), myz(*),
754 . mzx(*), mzy(*), mzz(*),g1x(*),g1y(*),g1z(*),
755 . g2x(*),g2y(*),g2z(*),g3x(*),g3y(*),g3z(*)
756C-----------------------------------------------
757C L o c a l V a r i a b l e s
758C-----------------------------------------------
759 INTEGER I
760 my_real
761 . sx,sy,sz,fxx,fxy,fxz,fyx,fyy,fyz,fzx,fzy,fzz
762C-----------------------------------------------
763 DO i=1,nel
764 sx = mxx(i)*g1x(i)+myx(i)*g1y(i)+mzx(i)*g1z(i)
765 sy = mxy(i)*g1x(i)+myy(i)*g1y(i)+mzy(i)*g1z(i)
766 sz = mxz(i)*g1x(i)+myz(i)*g1y(i)+mzz(i)*g1z(i)
767 fxx = sx*g1x(i)+sy*g1y(i)+sz*g1z(i)
768 fxy = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
769 fxz = sx*g3x(i)+sy*g3y(i)+sz*g3z(i)
770 sx = mxx(i)*g2x(i)+myx(i)*g2y(i)+mzx(i)*g2z(i)
771 sy = mxy(i)*g2x(i)+myy(i)*g2y(i)+mzy(i)*g2z(i)
772 sz = mxz(i)*g2x(i)+myz(i)*g2y(i)+mzz(i)*g2z(i)
773 fyx = sx*g1x(i)+sy*g1y(i)+sz*g1z(i)
774 fyy = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
775 fyz = sx*g3x(i)+sy*g3y(i)+sz*g3z(i)
776 sx = mxx(i)*g3x(i)+myx(i)*g3y(i)+mzx(i)*g3z(i)
777 sy = mxy(i)*g3x(i)+myy(i)*g3y(i)+mzy(i)*g3z(i)
778 sz = mxz(i)*g3x(i)+myz(i)*g3y(i)+mzz(i)*g3z(i)
779 fzx = sx*g1x(i)+sy*g1y(i)+sz*g1z(i)
780 fzy = sx*g2x(i)+sy*g2y(i)+sz*g2z(i)
781 fzz = sx*g3x(i)+sy*g3y(i)+sz*g3z(i)
782 mxx(i)=fxx
783 mxy(i)=fxy
784 mxz(i)=fxz
785 myx(i)=fyx
786 myy(i)=fyy
787 myz(i)=fyz
788 mzx(i)=fzx
789 mzy(i)=fzy
790 mzz(i)=fzz
791 ENDDO
792C-----------
793 RETURN

◆ srefderi3()

subroutine srefderi3 ( integer nel,
integer jeul,
vol,
veul,
geo,
integer, dimension(npropgi,*) igeo,
x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
jac1,
jac2,
jac3,
jac4,
jac5,
jac6,
integer, dimension(*) ngl,
integer, dimension(*) ngeo,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
det )

Definition at line 804 of file srefsta3.F.

812C-----------------------------------------------
813C M o d u l e s
814C-----------------------------------------------
815 USE message_mod
816C-----------------------------------------------
817C I m p l i c i t T y p e s
818C-----------------------------------------------
819#include "implicit_f.inc"
820C-----------------------------------------------
821C G l o b a l P a r a m e t e r s
822C-----------------------------------------------
823#include "mvsiz_p.inc"
824C-----------------------------------------------
825C C o m m o n B l o c k s
826C-----------------------------------------------
827#include "param_c.inc"
828#include "scr03_c.inc"
829C-----------------------------------------------
830C D u m m y A r g u m e n t s
831C-----------------------------------------------
832 INTEGER :: NEL,JEUL,IGEO(NPROPGI,*),NGL(*),NGEO(*)
833C
834 my_real
835 . vol(*), veul(lveul,*),geo(npropg,*),
836 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*),
837 . x7(*), x8(*), y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*),
838 . y8(*), z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
839 . jac1(*), jac2(*), jac3(*), jac4(*), jac5(*), jac6(*),
840 . px1(*), px2(*), px3(*), px4(*),
841 . py1(*), py2(*), py3(*), py4(*),
842 . pz1(*), pz2(*), pz3(*), pz4(*), det(*)
843C-----------------------------------------------
844C L o c a l V a r i a b l e s
845C-----------------------------------------------
846 INTEGER I,J
847
848 double precision
849 . x1_copy(mvsiz), x2_copy(mvsiz), x3_copy(mvsiz), x4_copy(mvsiz),
850 . x5_copy(mvsiz), x6_copy(mvsiz), x7_copy(mvsiz), x8_copy(mvsiz),
851 . y1_copy(mvsiz), y2_copy(mvsiz), y3_copy(mvsiz), y4_copy(mvsiz),
852 . y5_copy(mvsiz), y6_copy(mvsiz), y7_copy(mvsiz), y8_copy(mvsiz),
853 . z1_copy(mvsiz), z2_copy(mvsiz), z3_copy(mvsiz), z4_copy(mvsiz),
854 . z5_copy(mvsiz), z6_copy(mvsiz), z7_copy(mvsiz), z8_copy(mvsiz)
855C
856 my_real
857 . jac7(mvsiz), jac8(mvsiz), jac9(mvsiz),
858 . x_17_46(mvsiz) , x_28_35(mvsiz) ,
859 . y_17_46(mvsiz) , y_28_35(mvsiz) ,
860 . z_17_46(mvsiz) , z_28_35(mvsiz)
861 my_real
862 . dett(mvsiz),
863 . jaci1(mvsiz), jaci2(mvsiz), jaci3(mvsiz),
864 . jaci4(mvsiz), jaci5(mvsiz), jaci6(mvsiz),
865 . jaci7(mvsiz), jaci8(mvsiz), jaci9(mvsiz),
866 . x17(mvsiz), x28(mvsiz), x35(mvsiz), x46(mvsiz),
867 . y17(mvsiz), y28(mvsiz), y35(mvsiz), y46(mvsiz),
868 . z17(mvsiz), z28(mvsiz), z35(mvsiz), z46(mvsiz),
869 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
870 . jaci12(mvsiz), jaci45(mvsiz), jaci78(mvsiz)
871C=======================================================================
872 DO i=1,nel
873 x1_copy(i)=x1(i)
874 x2_copy(i)=x2(i)
875 x3_copy(i)=x3(i)
876 x4_copy(i)=x4(i)
877 x5_copy(i)=x5(i)
878 x6_copy(i)=x6(i)
879 x7_copy(i)=x7(i)
880 x8_copy(i)=x8(i)
881C
882 y1_copy(i)=y1(i)
883 y2_copy(i)=y2(i)
884 y3_copy(i)=y3(i)
885 y4_copy(i)=y4(i)
886 y5_copy(i)=y5(i)
887 y6_copy(i)=y6(i)
888 y7_copy(i)=y7(i)
889 y8_copy(i)=y8(i)
890C
891 z1_copy(i)=z1(i)
892 z2_copy(i)=z2(i)
893 z3_copy(i)=z3(i)
894 z4_copy(i)=z4(i)
895 z5_copy(i)=z5(i)
896 z6_copy(i)=z6(i)
897 z7_copy(i)=z7(i)
898 z8_copy(i)=z8(i)
899 ENDDO
900
901 DO i=1,nel
902 x17(i)=x7_copy(i)-x1_copy(i)
903 x28(i)=x8_copy(i)-x2_copy(i)
904 x35(i)=x5_copy(i)-x3_copy(i)
905 x46(i)=x6_copy(i)-x4_copy(i)
906 y17(i)=y7_copy(i)-y1_copy(i)
907 y28(i)=y8_copy(i)-y2_copy(i)
908 y35(i)=y5_copy(i)-y3_copy(i)
909 y46(i)=y6_copy(i)-y4_copy(i)
910 z17(i)=z7_copy(i)-z1_copy(i)
911 z28(i)=z8_copy(i)-z2_copy(i)
912 z35(i)=z5_copy(i)-z3_copy(i)
913 z46(i)=z6_copy(i)-z4_copy(i)
914 ENDDO
915C
916C Jacobian matrix JAC()
917 DO i=1,nel
918 jac1(i)=x17(i)+x28(i)-x35(i)-x46(i)
919 jac2(i)=y17(i)+y28(i)-y35(i)-y46(i)
920 jac3(i)=z17(i)+z28(i)-z35(i)-z46(i)
921 x_17_46(i)=x17(i)+x46(i)
922 x_28_35(i)=x28(i)+x35(i)
923 y_17_46(i)=y17(i)+y46(i)
924 y_28_35(i)=y28(i)+y35(i)
925 z_17_46(i)=z17(i)+z46(i)
926 z_28_35(i)=z28(i)+z35(i)
927 ENDDO
928C
929 DO i=1,nel
930 jac4(i)=x_17_46(i)+x_28_35(i)
931 jac5(i)=y_17_46(i)+y_28_35(i)
932 jac6(i)=z_17_46(i)+z_28_35(i)
933 jac7(i)=x_17_46(i)-x_28_35(i)
934 jac8(i)=y_17_46(i)-y_28_35(i)
935 jac9(i)=z_17_46(i)-z_28_35(i)
936 ENDDO
937C
938 DO i=1,nel
939 jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
940 jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
941 jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
942 ENDDO
943C
944 DO i=1,nel
945 det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
946 vol(i)=det(i)
947 ENDDO
948C
949 IF(jeul /= 0)THEN
950 DO i=1,nel
951 veul(32,i) = vol(i)
952 ENDDO
953 ENDIF
954C
955 DO i=1,nel
956 IF (det(i) > zero) cycle
957 IF (igeo(11,ngeo(i))/=0 .AND. igeo(11,ngeo(i))/=43) THEN
958 CALL ancmsg(msgid=245,
959 . msgtype=msgerror,
960 . anmode=aninfo,
961 . i1=ngl(i))
962 ELSE
963 CALL ancmsg(msgid=635,
964 . msgtype=msgwarning,
965 . anmode=aninfo,
966 . i1=ngl(i))
967 ENDIF
968 ENDDO
969C
970 IF( jeul==0 .AND. nxref==0) RETURN
971C
972 DO i=1,nel
973 dett(i)=one_over_64/max(det(i),em20)
974 ENDDO
975C
976C Jacobian matrix inverse JACI()
977 DO i=1,nel
978 jaci1(i)=dett(i)*jac_59_68(i)
979 jaci4(i)=dett(i)*jac_67_49(i)
980 jaci7(i)=dett(i)*jac_48_57(i)
981 jaci2(i)=dett(i)*(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
982 jaci5(i)=dett(i)*( jac1(i)*jac9(i)-jac3(i)*jac7(i))
983 jaci8(i)=dett(i)*(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
984 jaci3(i)=dett(i)*( jac2(i)*jac6(i)-jac3(i)*jac5(i))
985 jaci6(i)=dett(i)*(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
986 jaci9(i)=dett(i)*( jac1(i)*jac5(i)-jac2(i)*jac4(i))
987 ENDDO
988C
989 DO i=1,nel
990 jaci12(i)=jaci1(i)-jaci2(i)
991 jaci45(i)=jaci4(i)-jaci5(i)
992 jaci78(i)=jaci7(i)-jaci8(i)
993 ENDDO
994
995 DO i=1,nel
996 px3(i)= jaci12(i)+jaci3(i)
997 py3(i)= jaci45(i)+jaci6(i)
998 pz3(i)= jaci78(i)+jaci9(i)
999 px4(i)= jaci12(i)-jaci3(i)
1000 py4(i)= jaci45(i)-jaci6(i)
1001 pz4(i)= jaci78(i)-jaci9(i)
1002 ENDDO
1003
1004 DO i=1,nel
1005 jaci12(i)=jaci1(i)+jaci2(i)
1006 jaci45(i)=jaci4(i)+jaci5(i)
1007 jaci78(i)=jaci7(i)+jaci8(i)
1008 ENDDO
1009
1010 DO i=1,nel
1011 px1(i)=-jaci12(i)-jaci3(i)
1012 py1(i)=-jaci45(i)-jaci6(i)
1013 pz1(i)=-jaci78(i)-jaci9(i)
1014 px2(i)=-jaci12(i)+jaci3(i)
1015 py2(i)=-jaci45(i)+jaci6(i)
1016 pz2(i)=-jaci78(i)+jaci9(i)
1017 ENDDO
1018C---
1019 IF(jeul /= 0)THEN
1020 DO i=1,nel
1021 veul(1,i) = px1(i)
1022 veul(2,i) = px2(i)
1023 veul(3,i) = px3(i)
1024 veul(4,i) = px4(i)
1025 veul(5,i) = py1(i)
1026 veul(6,i) = py2(i)
1027 veul(7,i) = py3(i)
1028 veul(8,i) = py4(i)
1029 veul(9,i) = pz1(i)
1030 veul(10,i)= pz2(i)
1031 veul(11,i)= pz3(i)
1032 veul(12,i)= pz4(i)
1033 END DO
1034 IF (igeo(11,ngeo(1)) == 15) THEN
1035 DO i=1,nel
1036 vol(i)=vol(i)*geo(1,ngeo(i))
1037 END DO
1038 END IF
1039 END IF
1040C-----------
1041 RETURN
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895

◆ srefsta3()

subroutine srefsta3 ( type (elbuf_struct_), target elbuf_str,
integer, dimension(nixs,*) ixs,
pm,
geo,
integer, dimension(*) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(*) igeo,
skew,
x,
xrefs,
integer nel,
integer, dimension(*) iparts,
integer, dimension(lipart1,*) ipart,
bufmat,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
integer, dimension(*) npf,
tf,
integer, intent(in) nummat )

Definition at line 45 of file srefsta3.F.

49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE mat_elem_mod
53 USE message_mod
54 USE names_and_titles_mod , ONLY : nchartitle
55 use element_mod , only : nixs
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "param_c.inc"
68#include "scr03_c.inc"
69#include "scr17_c.inc"
70#include "vect01_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER ,INTENT(IN) :: NUMMAT
75 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*), IGEO(*),
76 . IPM(NPROPMI,*),IPART(LIPART1,*), NEL, NPF(*)
77 my_real
78 . pm(npropm,*), x(3,*), xrefs(8,3,*), geo(npropg,*),
79 . skew(lskew,*), bufmat(*), tf(*)
80 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
81 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER NF1, I,II(6), N, JHBE, IREP, IGTYP, ITRS, IBID,
86 . NITSAV,J,I1,I2,ID,IMAT,MAT_ID
87 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
88 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
89 . IX5(MVSIZ),IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ)
90 my_real
91 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
92 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
93 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
94 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
95 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,volu(mvsiz),
96 . sx(mvsiz) ,sy(mvsiz) ,sz(mvsiz) ,
97 . tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
98 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
99 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),
100 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
101 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
102 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
103 . px1(mvsiz) ,px2(mvsiz) ,px3(mvsiz), px4(mvsiz),
104 . py1(mvsiz) ,py2(mvsiz) ,py3(mvsiz), py4(mvsiz),
105 . pz1(mvsiz) ,pz2(mvsiz) ,pz3(mvsiz), pz4(mvsiz),
106 . mfxx(mvsiz), mfxy(mvsiz), mfyx(mvsiz),
107 . mfyy(mvsiz), mfyz(mvsiz), mfzy(mvsiz),
108 . mfzz(mvsiz), mfzx(mvsiz), mfxz(mvsiz),
109 . voln(mvsiz), dvol(mvsiz),
110 . xr(mvsiz,8) ,yr(mvsiz,8) ,zr(mvsiz,8) ,
111 . vxl(mvsiz,8),vyl(mvsiz,8),vzl(mvsiz,8),
112 . vx1(mvsiz),vx2(mvsiz),vx3(mvsiz),vx4(mvsiz),
113 . vx5(mvsiz),vx6(mvsiz),vx7(mvsiz),vx8(mvsiz),
114 . vy1(mvsiz),vy2(mvsiz),vy3(mvsiz),vy4(mvsiz),
115 . vy5(mvsiz),vy6(mvsiz),vy7(mvsiz),vy8(mvsiz),
116 . vz1(mvsiz),vz2(mvsiz),vz3(mvsiz),vz4(mvsiz),
117 . vz5(mvsiz),vz6(mvsiz),vz7(mvsiz),vz8(mvsiz),
118 . dxx(mvsiz),dxy(mvsiz),dxz(mvsiz),
119 . dyx(mvsiz),dyy(mvsiz),dyz(mvsiz),
120 . dzx(mvsiz),dzy(mvsiz),dzz(mvsiz),
121 . d4(mvsiz) ,d5(mvsiz) ,d6(mvsiz) ,
122 . s1(mvsiz) , s2(mvsiz), s3(mvsiz),
123 . s4(mvsiz) , s5(mvsiz), s6(mvsiz),
124 . wxx(mvsiz), wyy(mvsiz), wzz(mvsiz),
125 . g1x(mvsiz),g2x(mvsiz),g3x(mvsiz),
126 . g1y(mvsiz),g2y(mvsiz),g3y(mvsiz),
127 . g1z(mvsiz),g2z(mvsiz),g3z(mvsiz),
128 . vbid(lveul,mvsiz)
129 my_real
130 . fac, xt, yt, zt
131C-----
132 TYPE(G_BUFEL_) ,POINTER :: GBUF
133 CHARACTER(LEN=NCHARTITLE):: TITR
134C-----------------------------------------------
135C S o u r c e L i n e s
136C=======================================================================
137 gbuf => elbuf_str%GBUF
138 jeul = iparg(11)
139 jhbe = iparg(23)
140 irep = iparg(35)
141 jcvt = iparg(37)
142 igtyp = iparg(38)
143 isorth= iparg(42)
144 nf1=nft+1
145C
146 nitsav=nitrs
147C Case total strain, rather for computing Eint, stress will also be calculated at initial time in Engine
148C but NITRS=1 (before), for nonlinear elastic, Eint is too approximative
149 IF (ismstr >= 10) nitrs=10
150 ibid = 0
151 DO j=1,6
152 ii(j) = nel*(j-1)
153 ENDDO
154C--------------------------------------------------
155C Reference metrics
156C--------------------------------------------------
157 IF (nxref > 0 .AND. jlag/=0 .AND. jsph==0)THEN
158
159 IF(mtn /= 35 .AND.mtn /= 38 .AND. mtn /= 42 .AND.
160 . mtn /= 70 .AND. mtn /= 90.AND. mtn /= 1)THEN
161 nitrs=nitsav
162C message moved to hm_read_xref
163 RETURN
164 END IF
165
166 IF (jcvt <= 0 .OR. (jhbe/=1.AND.jhbe/=2.
167 . and.jhbe/=24.AND.jhbe/=14.AND.jhbe/=17))THEN
168 nitrs=nitsav
169C message
170 RETURN
171 END IF
172C---------------------------------------------------------
173C Element connectivities, material number, property number
174C---------------------------------------------------------
175 mat(1) = 0
176 DO i=1,nel
177 n=nft+i
178 mat(i)=ixs(1,n)
179 ix1(i)=ixs(2,n)
180 ix2(i)=ixs(3,n)
181 ix3(i)=ixs(4,n)
182 ix4(i)=ixs(5,n)
183 ix5(i)=ixs(6,n)
184 ix6(i)=ixs(7,n)
185 ix7(i)=ixs(8,n)
186 ix8(i)=ixs(9,n)
187 pid(i)=ixs(nixs-1,n)
188 ngl(i)=ixs(nixs,n)
189 END DO
190 imat = mat(1)
191C----------------------------
192C Coordinates
193C----------------------------
194 DO i=1,nel
195 xt = xrefs(8,1,nft+i)
196 yt = xrefs(8,2,nft+i)
197 zt = xrefs(8,3,nft+i)
198 xr(i,1) = xrefs(1,1,nft+i)-xt
199 yr(i,1) = xrefs(1,2,nft+i)-yt
200 zr(i,1) = xrefs(1,3,nft+i)-zt
201 xr(i,2) = xrefs(2,1,nft+i)-xt
202 yr(i,2) = xrefs(2,2,nft+i)-yt
203 zr(i,2) = xrefs(2,3,nft+i)-zt
204 xr(i,3) = xrefs(3,1,nft+i)-xt
205 yr(i,3) = xrefs(3,2,nft+i)-yt
206 zr(i,3) = xrefs(3,3,nft+i)-zt
207 xr(i,4) = xrefs(4,1,nft+i)-xt
208 yr(i,4) = xrefs(4,2,nft+i)-yt
209 zr(i,4) = xrefs(4,3,nft+i)-zt
210 xr(i,5) = xrefs(5,1,nft+i)-xt
211 yr(i,5) = xrefs(5,2,nft+i)-yt
212 zr(i,5) = xrefs(5,3,nft+i)-zt
213 xr(i,6) = xrefs(6,1,nft+i)-xt
214 yr(i,6) = xrefs(6,2,nft+i)-yt
215 zr(i,6) = xrefs(6,3,nft+i)-zt
216 xr(i,7) = xrefs(7,1,nft+i)-xt
217 yr(i,7) = xrefs(7,2,nft+i)-yt
218 zr(i,7) = xrefs(7,3,nft+i)-zt
219 xr(i,8) = zero
220 yr(i,8) = zero
221 zr(i,8) = zero
222 END DO
223C
224C Isoparametric frame, convected frame, orthotropic frame
225 CALL srepiso3(
226 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
227 . xr(1,5) ,xr(1,6) ,xr(1,7) ,xr(1,8) ,
228 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
229 . yr(1,5) ,yr(1,6) ,yr(1,7) ,yr(1,8) ,
230 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
231 . zr(1,5) ,zr(1,6) ,zr(1,7) ,zr(1,8) ,
232 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,
233 . tz ,f1x ,f1y ,f1z ,f2x ,f2y ,f2z )
234
235 IF (jhbe == 24) THEN
236C HEPH
237 CALL sortho3(
238 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
239 . e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,e1x ,e1y ,e1z )
240 ELSE
241 CALL sortho3(
242 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
243 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z )
244 ENDIF
245C
246 IF (igtyp == 6)THEN
247 IF(jhbe /=24)THEN
248 CALL srorth3(jhbe ,gbuf%GAMA ,
249 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
250 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
251 . xr(1,5) ,xr(1,6) ,xr(1,7) ,xr(1,8) ,
252 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
253 . yr(1,5) ,yr(1,6) ,yr(1,7) ,yr(1,8) ,
254 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
255 . zr(1,5) ,zr(1,6) ,zr(1,7) ,zr(1,8) ,nel)
256 END IF
257 END IF
258
259 DO i=1,nel
260 xt=x(1,ix8(i))
261 yt=x(2,ix8(i))
262 zt=x(3,ix8(i))
263 x1(i)=x(1,ix1(i))-xt
264 y1(i)=x(2,ix1(i))-yt
265 z1(i)=x(3,ix1(i))-zt
266 x2(i)=x(1,ix2(i))-xt
267 y2(i)=x(2,ix2(i))-yt
268 z2(i)=x(3,ix2(i))-zt
269 x3(i)=x(1,ix3(i))-xt
270 y3(i)=x(2,ix3(i))-yt
271 z3(i)=x(3,ix3(i))-zt
272 x4(i)=x(1,ix4(i))-xt
273 y4(i)=x(2,ix4(i))-yt
274 z4(i)=x(3,ix4(i))-zt
275 x5(i)=x(1,ix5(i))-xt
276 y5(i)=x(2,ix5(i))-yt
277 z5(i)=x(3,ix5(i))-zt
278 x6(i)=x(1,ix6(i))-xt
279 y6(i)=x(2,ix6(i))-yt
280 z6(i)=x(3,ix6(i))-zt
281 x7(i)=x(1,ix7(i))-xt
282 y7(i)=x(2,ix7(i))-yt
283 z7(i)=x(3,ix7(i))-zt
284 x8(i)=zero
285 y8(i)=zero
286 z8(i)=zero
287 END DO
288C
289C Isoparametric frame, convected frame, orthotropic frame
290 CALL srepiso3(
291 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
292 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
293 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
294 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,
295 . tz ,f1x ,f1y ,f1z ,f2x ,f2y ,f2z )
296
297 IF (jhbe == 24) THEN
298C HEPH
299 CALL sortho3(
300 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
301 . e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,e1x ,e1y ,e1z )
302 ELSE
303 CALL sortho3(
304 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
305 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z )
306 ENDIF
307
308 CALL srrota3(e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
309 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
310 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
311 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 )
312
313C
314 IF (igtyp == 6)THEN
315 IF(jhbe /=24)THEN
316 CALL srorth3(jhbe ,gbuf%GAMA ,
317 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
318 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
319 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
320 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,nel)
321 END IF
322 END IF
323C
324 DO i=1,nel
325 xt = xrefs(8,1,nft+i)
326 yt = xrefs(8,2,nft+i)
327 zt = xrefs(8,3,nft+i)
328 xr(i,1) = xrefs(1,1,nft+i)-xt
329 yr(i,1) = xrefs(1,2,nft+i)-yt
330 zr(i,1) = xrefs(1,3,nft+i)-zt
331 xr(i,2) = xrefs(2,1,nft+i)-xt
332 yr(i,2) = xrefs(2,2,nft+i)-yt
333 zr(i,2) = xrefs(2,3,nft+i)-zt
334 xr(i,3) = xrefs(3,1,nft+i)-xt
335 yr(i,3) = xrefs(3,2,nft+i)-yt
336 zr(i,3) = xrefs(3,3,nft+i)-zt
337 xr(i,4) = xrefs(4,1,nft+i)-xt
338 yr(i,4) = xrefs(4,2,nft+i)-yt
339 zr(i,4) = xrefs(4,3,nft+i)-zt
340 xr(i,5) = xrefs(5,1,nft+i)-xt
341 yr(i,5) = xrefs(5,2,nft+i)-yt
342 zr(i,5) = xrefs(5,3,nft+i)-zt
343 xr(i,6) = xrefs(6,1,nft+i)-xt
344 yr(i,6) = xrefs(6,2,nft+i)-yt
345 zr(i,6) = xrefs(6,3,nft+i)-zt
346 xr(i,7) = xrefs(7,1,nft+i)-xt
347 yr(i,7) = xrefs(7,2,nft+i)-yt
348 zr(i,7) = xrefs(7,3,nft+i)-zt
349 xr(i,8) = zero
350 yr(i,8) = zero
351 zr(i,8) = zero
352 END DO
353 fac=one/float(nitrs)
354 DO i=1,nel
355 xt=x(1,ix8(i))
356 yt=x(2,ix8(i))
357 zt=x(3,ix8(i))
358 vx1(i)=(x(1,ix1(i))-xt-xr(i,1))*fac
359 vy1(i)=(x(2,ix1(i))-yt-yr(i,1))*fac
360 vz1(i)=(x(3,ix1(i))-zt-zr(i,1))*fac
361 vx2(i)=(x(1,ix2(i))-xt-xr(i,2))*fac
362 vy2(i)=(x(2,ix2(i))-yt-yr(i,2))*fac
363 vz2(i)=(x(3,ix2(i))-zt-zr(i,2))*fac
364 vx3(i)=(x(1,ix3(i))-xt-xr(i,3))*fac
365 vy3(i)=(x(2,ix3(i))-yt-yr(i,3))*fac
366 vz3(i)=(x(3,ix3(i))-zt-zr(i,3))*fac
367 vx4(i)=(x(1,ix4(i))-xt-xr(i,4))*fac
368 vy4(i)=(x(2,ix4(i))-yt-yr(i,4))*fac
369 vz4(i)=(x(3,ix4(i))-zt-zr(i,4))*fac
370 vx5(i)=(x(1,ix5(i))-xt-xr(i,5))*fac
371 vy5(i)=(x(2,ix5(i))-yt-yr(i,5))*fac
372 vz5(i)=(x(3,ix5(i))-zt-zr(i,5))*fac
373 vx6(i)=(x(1,ix6(i))-xt-xr(i,6))*fac
374 vy6(i)=(x(2,ix6(i))-yt-yr(i,6))*fac
375 vz6(i)=(x(3,ix6(i))-zt-zr(i,6))*fac
376 vx7(i)=(x(1,ix7(i))-xt-xr(i,7))*fac
377 vy7(i)=(x(2,ix7(i))-yt-yr(i,7))*fac
378 vz7(i)=(x(3,ix7(i))-zt-zr(i,7))*fac
379 vx8(i)=zero
380 vy8(i)=zero
381 vz8(i)=zero
382 END DO
383C
384 DO itrs=1,nitrs
385
386 fac=float(itrs)
387C
388 IF (ismstr >= 10 ) THEN
389C Case total strain first in global system
390 IF (ismstr == 10.OR.ismstr == 12) THEN
391 CALL sjac_i(
392 . xr(1,1),xr(1,2),xr(1,3),xr(1,4),xr(1,5),xr(1,6),xr(1,7),xr(1,8),
393 . yr(1,1),yr(1,2),yr(1,3),yr(1,4),yr(1,5),yr(1,6),yr(1,7),yr(1,8),
394 . zr(1,1),zr(1,2),zr(1,3),zr(1,4),zr(1,5),zr(1,6),zr(1,7),zr(1,8),
395 . gbuf%JAC_I,nel)
396 END IF
397 IF (jhbe == 24) THEN
398 CALL szrefderi3(nel ,jeul ,
399 . voln ,vbid ,geo ,igeo ,
400 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
401 . xr(1,5) ,xr(1,6) ,xr(1,7) ,xr(1,8) ,
402 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
403 . yr(1,5) ,yr(1,6) ,yr(1,7) ,yr(1,8) ,
404 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
405 . zr(1,5) ,zr(1,6) ,zr(1,7) ,zr(1,8) ,
406 . px1 ,px2 ,px3 ,px4 ,
407 . py1 ,py2 ,py3 ,py4 ,
408 . pz1 ,pz2 ,pz3 ,pz4 ,
409 . rx ,ry ,rz ,sx ,sy ,sz ,tz ,
410 . ngl ,pid ,volu )
411 ELSE
412 CALL srefderi3(nel ,jeul ,
413 . voln ,vbid ,geo ,igeo ,
414 . xr(1,1) ,xr(1,2) ,xr(1,3) ,xr(1,4) ,
415 . xr(1,5) ,xr(1,6) ,xr(1,7) ,xr(1,8) ,
416 . yr(1,1) ,yr(1,2) ,yr(1,3) ,yr(1,4) ,
417 . yr(1,5) ,yr(1,6) ,yr(1,7) ,yr(1,8) ,
418 . zr(1,1) ,zr(1,2) ,zr(1,3) ,zr(1,4) ,
419 . zr(1,5) ,zr(1,6) ,zr(1,7) ,zr(1,8) ,
420 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
421 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
422 . pz1 ,pz2 ,pz3 ,pz4 ,volu )
423 ENDIF
424C
425 CALL sdefot3(nel,
426 . px1, px2, px3, px4,
427 . py1, py2, py3, py4,
428 . pz1, pz2, pz3, pz4,
429 . vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8,
430 . vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8,
431 . vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8,
432 . mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz)
433C
434 DO i=1,nel
435 mfxx(i)=fac*mfxx(i)
436 mfyy(i)=fac*mfyy(i)
437 mfzz(i)=fac*mfzz(i)
438 mfxy(i)=fac*mfxy(i)
439 mfxz(i)=fac*mfxz(i)
440 mfyx(i)=fac*mfyx(i)
441 mfyz(i)=fac*mfyz(i)
442 mfzx(i)=fac*mfzx(i)
443 mfzy(i)=fac*mfzy(i)
444 ENDDO
445C
446 END IF !(ISMSTR >= 10 )
447C
448C Reference state
449 DO i=1,nel
450 x1(i)=xr(i,1)+fac*vx1(i)
451 y1(i)=yr(i,1)+fac*vy1(i)
452 z1(i)=zr(i,1)+fac*vz1(i)
453 x2(i)=xr(i,2)+fac*vx2(i)
454 y2(i)=yr(i,2)+fac*vy2(i)
455 z2(i)=zr(i,2)+fac*vz2(i)
456 x3(i)=xr(i,3)+fac*vx3(i)
457 y3(i)=yr(i,3)+fac*vy3(i)
458 z3(i)=zr(i,3)+fac*vz3(i)
459 x4(i)=xr(i,4)+fac*vx4(i)
460 y4(i)=yr(i,4)+fac*vy4(i)
461 z4(i)=zr(i,4)+fac*vz4(i)
462 x5(i)=xr(i,5)+fac*vx5(i)
463 y5(i)=yr(i,5)+fac*vy5(i)
464 z5(i)=zr(i,5)+fac*vz5(i)
465 x6(i)=xr(i,6)+fac*vx6(i)
466 y6(i)=yr(i,6)+fac*vy6(i)
467 z6(i)=zr(i,6)+fac*vz6(i)
468 x7(i)=xr(i,7)+fac*vx7(i)
469 y7(i)=yr(i,7)+fac*vy7(i)
470 z7(i)=zr(i,7)+fac*vz7(i)
471 x8(i)=xr(i,8)+fac*vx8(i)
472 y8(i)=yr(i,8)+fac*vy8(i)
473 z8(i)=zr(i,8)+fac*vz8(i)
474 END DO
475C
476C Isoparametric frame, convected frame, orthotropic frame
477 CALL srepiso3(
478 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
479 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
480 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
481 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,
482 . tz ,f1x ,f1y ,f1z ,f2x ,f2y ,f2z )
483
484 IF (jhbe == 24) THEN
485C HEPH
486 CALL sortho3(
487 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
488 . e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,e1x ,e1y ,e1z )
489 ELSE
490 CALL sortho3(
491 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
492 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z )
493 ENDIF
494 IF (ismstr == 1 .OR. ismstr == 11) THEN
495 DO i=1,nel
496 x1(i)=xr(i,1)
497 y1(i)=yr(i,1)
498 z1(i)=zr(i,1)
499 x2(i)=xr(i,2)
500 y2(i)=yr(i,2)
501 z2(i)=zr(i,2)
502 x3(i)=xr(i,3)
503 y3(i)=yr(i,3)
504 z3(i)=zr(i,3)
505 x4(i)=xr(i,4)
506 y4(i)=yr(i,4)
507 z4(i)=zr(i,4)
508 x5(i)=xr(i,5)
509 y5(i)=yr(i,5)
510 z5(i)=zr(i,5)
511 x6(i)=xr(i,6)
512 y6(i)=yr(i,6)
513 z6(i)=zr(i,6)
514 x7(i)=xr(i,7)
515 y7(i)=yr(i,7)
516 z7(i)=zr(i,7)
517 x8(i)=xr(i,8)
518 y8(i)=yr(i,8)
519 z8(i)=zr(i,8)
520 END DO
521 END IF
522
523 CALL srrota3(e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
524 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
525 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
526 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 )
527
528 IF (igtyp == 6)THEN
529 IF(jhbe /=24)THEN
530 CALL srorth3(jhbe ,gbuf%GAMA ,
531 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
532 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
533 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
534 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,nel)
535 END IF
536 END IF
537 IF (ismstr >= 10 ) THEN
538 CALL sordeft3(nel,mfxx, mfxy, mfxz, mfyx, mfyy, mfyz,
539 . mfzx, mfzy, mfzz,
540 . e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
541 END IF
542C-----------
543 IF (jhbe == 24) THEN
544 CALL szrefderi3(nel ,jeul ,
545 . voln ,vbid ,geo ,igeo ,
546 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
547 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
548 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
549 . px1 ,px2 ,px3 ,px4 ,
550 . py1 ,py2 ,py3 ,py4 ,
551 . pz1 ,pz2 ,pz3 ,pz4 ,
552 . rx ,ry ,rz ,sx ,sy ,sz ,tz ,
553 . ngl ,pid ,volu )
554 ELSE
555 CALL srefderi3(nel ,jeul ,
556 . voln ,vbid ,geo ,igeo ,
557 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
558 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
559 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
560 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
561 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
562 . pz1 ,pz2 ,pz3 ,pz4 ,volu )
563 ENDIF
564C-----------
565 DO i=1,nel
566 vxl(i,1)=vx1(i)
567 vyl(i,1)=vy1(i)
568 vzl(i,1)=vz1(i)
569 vxl(i,2)=vx2(i)
570 vyl(i,2)=vy2(i)
571 vzl(i,2)=vz2(i)
572 vxl(i,3)=vx3(i)
573 vyl(i,3)=vy3(i)
574 vzl(i,3)=vz3(i)
575 vxl(i,4)=vx4(i)
576 vyl(i,4)=vy4(i)
577 vzl(i,4)=vz4(i)
578 vxl(i,5)=vx5(i)
579 vyl(i,5)=vy5(i)
580 vzl(i,5)=vz5(i)
581 vxl(i,6)=vx6(i)
582 vyl(i,6)=vy6(i)
583 vzl(i,6)=vz6(i)
584 vxl(i,7)=vx7(i)
585 vyl(i,7)=vy7(i)
586 vzl(i,7)=vz7(i)
587 vxl(i,8)=vx8(i)
588 vyl(i,8)=vy8(i)
589 vzl(i,8)=vz8(i)
590 END DO
591 CALL srrota3(e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
592 . vxl(1,1) ,vxl(1,2) ,vxl(1,3) ,vxl(1,4) ,
593 . vxl(1,5) ,vxl(1,6) ,vxl(1,7) ,vxl(1,8) ,
594 . vyl(1,1) ,vyl(1,2) ,vyl(1,3) ,vyl(1,4) ,
595 . vyl(1,5) ,vyl(1,6) ,vyl(1,7) ,vyl(1,8) ,
596 . vzl(1,1) ,vzl(1,2) ,vzl(1,3) ,vzl(1,4) ,
597 . vzl(1,5) ,vzl(1,6) ,vzl(1,7) ,vzl(1,8) )
598
599 CALL sdefo3(
600 . px1, px2, px3, px4,
601 . py1, py2, py3, py4,
602 . pz1, pz2, pz3, pz4,
603 . vxl(1,1), vxl(1,2), vxl(1,3), vxl(1,4),
604 . vxl(1,5), vxl(1,6), vxl(1,7), vxl(1,8),
605 . vyl(1,1), vyl(1,2), vyl(1,3), vyl(1,4),
606 . vyl(1,5), vyl(1,6), vyl(1,7), vyl(1,8),
607 . vzl(1,1), vzl(1,2), vzl(1,3), vzl(1,4),
608 . vzl(1,5), vzl(1,6), vzl(1,7), vzl(1,8),
609 . dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6,
610 . wxx, wyy, wzz)
611C-----------
612C
613 IF (igtyp == 6)THEN
614 IF(jhbe ==24)THEN
615 CALL storth3(isorth,nel,
616 . g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z,
617 . gbuf%GAMA)
618 CALL szordef3(nel,dxx,dyy,dzz,d4,d5,d6,
619 . g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
620 END IF
621 END IF
622C-----------
623 CALL srho3(pm, gbuf%VOL, gbuf%RHO, gbuf%EINT, dxx,
624 . dyy, dzz, voln, dvol, mat)
625 DO i=1,nel
626 s1(i) = gbuf%SIG(ii(1) + i)
627 s2(i) = gbuf%SIG(ii(2) + i)
628 s3(i) = gbuf%SIG(ii(3) + i)
629 s4(i) = gbuf%SIG(ii(4) + i)
630 s5(i) = gbuf%SIG(ii(5) + i)
631 s6(i) = gbuf%SIG(ii(6) + i)
632 END DO
633C-----------
634 CALL mmain(pm ,elbuf_str,ixs ,nixs ,x ,
635 2 geo ,iparg ,nel ,skew ,bufmat ,
636 3 ipart ,iparts ,nummat ,mat_param,
637 4 imat ,ipm ,ngl ,pid ,npf ,
638 5 tf ,mfxx ,mfxy ,mfxz ,mfyx ,
639 6 mfyy ,mfyz ,mfzx ,mfzy ,mfzz ,
640 7 rx ,ry ,rz ,sx ,sy ,
641 8 sz ,gbuf%GAMA,voln ,dvol ,s1 ,
642 b s2 ,s3 ,s4 ,s5 ,s6 ,
643 9 dxx ,dyy ,dzz ,d4 ,d5 ,
644 a d6 ,wxx ,wyy ,wzz )
645 END DO ! ITRS=1,NITRS
646 END IF ! NXREF > 0 .AND. JLAG/=0 .AND. JSPH==0
647C ======================================================================
648 nitrs=nitsav
649 RETURN
mmain
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
sdefot3
subroutine sdefot3(nel, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz)
Definition srefsta3.F:665
szrefderi3
subroutine szrefderi3(nel, jeul, vol, veul, geo, igeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac1, jac2, jac3, jac4, jac5, jac6, jac9, ngl, ngeo, det)
Definition srefsta3.F:1062
srefderi3
subroutine srefderi3(nel, jeul, vol, veul, geo, igeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det)
Definition srefsta3.F:812
sordeft3
subroutine sordeft3(nel, mxx, mxy, mxz, myx, myy, myz, mzx, mzy, mzz, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
Definition srefsta3.F:744
srorth3
subroutine srorth3(jhbe, gama, r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, nel)
Definition srorth3.F:33
sdefo3
subroutine sdefo3(px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, dxx, dxy, dxz, dyx, dyy, dyz, dzx, dzy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition sdefo3.F:37
sjac_i
subroutine sjac_i(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, jac_i, nel)
Definition sderi3.F:264
sortho3
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition sortho3.F:33
srepiso3
subroutine srepiso3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, f1x, f1y, f1z, f2x, f2y, f2z)
Definition srepiso3.F:35
srho3
subroutine srho3(pm, volo, rhon, eint, dxx, dyy, dzz, voln, dvol, mat)
Definition srho3.F:31
srrota3
subroutine srrota3(r11, r12, r13, r21, r22, r23, r31, r32, r33, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition srrota3.F:33
storth3
subroutine storth3(isorth, nel, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z, gama)
Definition szorth3.F:30
szordef3
subroutine szordef3(nel, dxx, dyy, dzz, d4, d5, d6, g1x, g1y, g1z, g2x, g2y, g2z, g3x, g3y, g3z)
Definition szorth3.F:84

◆ szrefderi3()

subroutine szrefderi3 ( integer nel,
integer jeul,
vol,
veul,
geo,
integer, dimension(npropgi,*) igeo,
x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
jac1,
jac2,
jac3,
jac4,
jac5,
jac6,
jac9,
integer, dimension(*) ngl,
integer, dimension(*) ngeo,
det )

Definition at line 1052 of file srefsta3.F.

1062C-----------------------------------------------
1063C M o d u l e s
1064C-----------------------------------------------
1065 USE message_mod
1066C-----------------------------------------------
1067C I m p l i c i t T y p e s
1068C-----------------------------------------------
1069#include "implicit_f.inc"
1070C-----------------------------------------------
1071C G l o b a l P a r a m e t e r s
1072C-----------------------------------------------
1073#include "mvsiz_p.inc"
1074C-----------------------------------------------
1075C C o m m o n B l o c k s
1076C-----------------------------------------------
1077#include "param_c.inc"
1078#include "scr03_c.inc"
1079C-----------------------------------------------
1080C D u m m y A r g u m e n t s
1081C-----------------------------------------------
1082 INTEGER :: NEL,JEUL,IGEO(NPROPGI,*),NGL(*),NGEO(*)
1083 my_real
1084 . vol(*), veul(lveul,*),geo(npropg,*),
1085 . jac1(*), jac2(*), jac3(*), jac4(*), jac5(*), jac6(*), jac9(*),
1086 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
1087 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
1088 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*),
1089 . px1(*), px2(*), px3(*), px4(*),
1090 . py1(*), py2(*), py3(*), py4(*),
1091 . pz1(*), pz2(*), pz3(*), pz4(*),det(*)
1092C-----------------------------------------------
1093C L o c a l V a r i a b l e s
1094C-----------------------------------------------
1095 INTEGER I
1096
1097 double precision
1098 . x1_copy(mvsiz), x2_copy(mvsiz), x3_copy(mvsiz), x4_copy(mvsiz),
1099 . x5_copy(mvsiz), x6_copy(mvsiz), x7_copy(mvsiz), x8_copy(mvsiz),
1100 . y1_copy(mvsiz), y2_copy(mvsiz), y3_copy(mvsiz), y4_copy(mvsiz),
1101 . y5_copy(mvsiz), y6_copy(mvsiz), y7_copy(mvsiz), y8_copy(mvsiz),
1102 . z1_copy(mvsiz), z2_copy(mvsiz), z3_copy(mvsiz), z4_copy(mvsiz),
1103 . z5_copy(mvsiz), z6_copy(mvsiz), z7_copy(mvsiz), z8_copy(mvsiz)
1104
1105 my_real
1106 . dett(mvsiz) , jac7(mvsiz) , jac8(mvsiz) ,
1107 . jaci1(mvsiz), jaci2(mvsiz), jaci3(mvsiz), jaci4(mvsiz),
1108 . jaci5(mvsiz), jaci6(mvsiz), jaci7(mvsiz), jaci8(mvsiz), jaci9(mvsiz),
1109 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
1110 . jaci12(mvsiz), jaci45(mvsiz), jaci78(mvsiz),
1111 . x_17_46(mvsiz),x_28_35(mvsiz),y_17_46(mvsiz),
1112 . y_28_35(mvsiz),z_17_46(mvsiz),z_28_35(mvsiz),
1113 . x17(mvsiz) , x28(mvsiz) , x35(mvsiz) , x46(mvsiz),
1114 . y17(mvsiz) , y28(mvsiz) , y35(mvsiz) , y46(mvsiz),
1115 . z17(mvsiz) , z28(mvsiz) , z35(mvsiz) , z46(mvsiz)
1116C=======================================================================
1117 DO i=1,nel
1118 x1_copy(i)=x1(i)
1119 x2_copy(i)=x2(i)
1120 x3_copy(i)=x3(i)
1121 x4_copy(i)=x4(i)
1122 x5_copy(i)=x5(i)
1123 x6_copy(i)=x6(i)
1124 x7_copy(i)=x7(i)
1125 x8_copy(i)=x8(i)
1126C
1127 y1_copy(i)=y1(i)
1128 y2_copy(i)=y2(i)
1129 y3_copy(i)=y3(i)
1130 y4_copy(i)=y4(i)
1131 y5_copy(i)=y5(i)
1132 y6_copy(i)=y6(i)
1133 y7_copy(i)=y7(i)
1134 y8_copy(i)=y8(i)
1135C
1136 z1_copy(i)=z1(i)
1137 z2_copy(i)=z2(i)
1138 z3_copy(i)=z3(i)
1139 z4_copy(i)=z4(i)
1140 z5_copy(i)=z5(i)
1141 z6_copy(i)=z6(i)
1142 z7_copy(i)=z7(i)
1143 z8_copy(i)=z8(i)
1144 ENDDO
1145
1146 DO i=1,nel
1147 x17(i)=x7_copy(i)-x1_copy(i)
1148 x28(i)=x8_copy(i)-x2_copy(i)
1149 x35(i)=x5_copy(i)-x3_copy(i)
1150 x46(i)=x6_copy(i)-x4_copy(i)
1151 y17(i)=y7_copy(i)-y1_copy(i)
1152 y28(i)=y8_copy(i)-y2_copy(i)
1153 y35(i)=y5_copy(i)-y3_copy(i)
1154 y46(i)=y6_copy(i)-y4_copy(i)
1155 z17(i)=z7_copy(i)-z1_copy(i)
1156 z28(i)=z8_copy(i)-z2_copy(i)
1157 z35(i)=z5_copy(i)-z3_copy(i)
1158 z46(i)=z6_copy(i)-z4_copy(i)
1159 ENDDO
1160C
1161C Jacobian matrix
1162 DO i=1,nel
1163 jac4(i)=x17(i)+x28(i)-x35(i)-x46(i)
1164 jac5(i)=y17(i)+y28(i)-y35(i)-y46(i)
1165 jac6(i)=z17(i)+z28(i)-z35(i)-z46(i)
1166 x_17_46(i)=x17(i)+x46(i)
1167 x_28_35(i)=x28(i)+x35(i)
1168 y_17_46(i)=y17(i)+y46(i)
1169 y_28_35(i)=y28(i)+y35(i)
1170 z_17_46(i)=z17(i)+z46(i)
1171 z_28_35(i)=z28(i)+z35(i)
1172 ENDDO
1173C
1174 DO i=1,nel
1175 jac7(i)=x_17_46(i)+x_28_35(i)
1176 jac8(i)=y_17_46(i)+y_28_35(i)
1177 jac9(i)=z_17_46(i)+z_28_35(i)
1178 jac1(i)=x_17_46(i)-x_28_35(i)
1179 jac2(i)=y_17_46(i)-y_28_35(i)
1180 jac3(i)=z_17_46(i)-z_28_35(i)
1181 ENDDO
1182C
1183C
1184 DO i=1,nel
1185 jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
1186 jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
1187 jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
1188 ENDDO
1189C
1190 DO i=1,nel
1191 det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
1192 vol(i)=det(i)
1193 ENDDO
1194C
1195 DO i=1,nel
1196 IF(det(i) <= zero) THEN
1197 CALL ancmsg(msgid=245,
1198 . msgtype=msgerror,
1199 . anmode=aninfo,
1200 . i1=ngl(i))
1201 ENDIF
1202 ENDDO
1203C
1204 IF (jeul == 0 .AND. nxref == 0) RETURN
1205C
1206 DO i=1,nel
1207 dett(i)=one_over_64/det(i)
1208 ENDDO
1209C
1210C Jacobian matric inverse
1211 DO i=1,nel
1212 jaci1(i)=dett(i)*jac_59_68(i)
1213 jaci4(i)=dett(i)*jac_67_49(i)
1214 jaci7(i)=dett(i)*jac_48_57(i)
1215 jaci2(i)=dett(i)*(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
1216 jaci5(i)=dett(i)*( jac1(i)*jac9(i)-jac3(i)*jac7(i))
1217 jaci8(i)=dett(i)*(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
1218 jaci3(i)=dett(i)*( jac2(i)*jac6(i)-jac3(i)*jac5(i))
1219 jaci6(i)=dett(i)*(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
1220 jaci9(i)=dett(i)*( jac1(i)*jac5(i)-jac2(i)*jac4(i))
1221 ENDDO
1222C
1223 DO i=1,nel
1224 jaci12(i)=jaci1(i)-jaci2(i)
1225 jaci45(i)=jaci4(i)-jaci5(i)
1226 jaci78(i)=jaci7(i)-jaci8(i)
1227 ENDDO
1228C
1229 DO i=1,nel
1230 px2(i)= jaci12(i)-jaci3(i)
1231 py2(i)= jaci45(i)-jaci6(i)
1232 pz2(i)= jaci78(i)-jaci9(i)
1233 px4(i)=-jaci12(i)-jaci3(i)
1234 py4(i)=-jaci45(i)-jaci6(i)
1235 pz4(i)=-jaci78(i)-jaci9(i)
1236 ENDDO
1237C
1238 DO i=1,nel
1239 jaci12(i)=jaci1(i)+jaci2(i)
1240 jaci45(i)=jaci4(i)+jaci5(i)
1241 jaci78(i)=jaci7(i)+jaci8(i)
1242 ENDDO
1243C
1244 DO i=1,nel
1245 px1(i)=-jaci12(i)-jaci3(i)
1246 py1(i)=-jaci45(i)-jaci6(i)
1247 pz1(i)=-jaci78(i)-jaci9(i)
1248 px3(i)=jaci12(i)-jaci3(i)
1249 py3(i)=jaci45(i)-jaci6(i)
1250 pz3(i)=jaci78(i)-jaci9(i)
1251 ENDDO
1252C
1253 IF(jeul /= 0)THEN
1254 DO i=1,nel
1255 veul(3,i) = px3(i)
1256 veul(4,i) = py3(i)
1257 veul(7,i) = pz3(i)
1258 veul(8,i) = px4(i)
1259 veul(11,i)= py4(i)
1260 veul(12,i)= pz4(i)
1261 veul(1,i) = px1(i)
1262 veul(2,i) = py1(i)
1263 veul(5,i) = pz1(i)
1264 veul(6,i) = px2(i)
1265 veul(9,i) = py2(i)
1266 veul(10,i)= pz2(i)
1267 END DO
1268 IF (igeo(11,ngeo(1)) == 15) THEN
1269 DO i=1,nel
1270 vol(i)=vol(i)*geo(1,ngeo(i))
1271 ENDDO
1272 ENDIF
1273 ENDIF
1274C-----------
1275 RETURN