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 656 of file srefsta3.F.

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

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

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

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

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