gfhour_or.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    gfhour_or    ../engine/source/elements/solid/solidez/gfhour_or.F
!||--- called by ------------------------------------------------------
!||    szhour3_or   ../engine/source/elements/solid/solidez/szhour3_or.F
!||====================================================================
      SUBROUTINE gfhour_or(LFT,LLT,
     .   FHOUR,JR0,JS0,JT0,FCL,
     .   HGX1, HGX2, HGX3, HGX4,
     .   HGY1, HGY2, HGY3, HGY4,
     .   HGZ1, HGZ2, HGZ3, HGZ4,
     .   H11 , H22 , H33 , 
     .   H12 , H13 , H23 , 
     .   JR_1,JS_1 , JT_1, NU ,NU2 ,
     .   CC  ,CG   ,G33  ,NFHOUR,NEL)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LFT,LLT,NEL
      my_real
     .   FHOUR(NEL,3,4),JR0(*),JS0(*),JT0(*) ,NU(*),NU2(*),
     .   H11(*), H22(*), H33(*),FCL(*),
     .   H12(*), H13(*), H23(*),
     .   HGX1(*), HGX2(*), HGX3(*), HGX4(*),
     .   HGY1(*), HGY2(*), HGY3(*), HGY4(*),
     .   HGZ1(*), HGZ2(*), HGZ3(*), HGZ4(*),
     .   jr_1(*),js_1(*),jt_1(*),nfhour(mvsiz,3,4)
      my_real
     .   cc(mvsiz,3,3),cg(mvsiz,3,3),g33(mvsiz,3,3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, MX, J,K
      my_real
     .   T13,T22,T31,T32,SXY,SYZ,SXZ,SYX,SZY,SZX,
     .   s1211,s1222,s1311,s1333,s2322,s2333,
     .   t1211,t1222,t1311,t1333,t2322,t2333,t12,t23
      my_real
     .   fhourt(3,4),nucc(mvsiz,3,3),r1,r2,r3
C-----------------------------------------------
       DO j=1,3
       DO k=j,3
       DO i=lft,llt
        nucc(i,j,k) = nu2(i)*cc(i,j,k)
        nucc(i,k,j) = nucc(i,j,k)
       ENDDO
       ENDDO
       ENDDO
       DO i=lft,llt
        fhourt(1,1) = fhour(i,1,1)*jr0(i)+fcl(i)*hgx1(i)
        fhourt(1,2) = fhour(i,1,2)*jr0(i)+fcl(i)*hgx2(i)
        fhourt(1,3) = fhour(i,1,3)*jr0(i)+fcl(i)*hgx3(i)
        fhourt(1,4) = fhour(i,1,4)*jr0(i)+fcl(i)*hgx4(i)
        fhourt(2,1) = fhour(i,2,1)*js0(i)+fcl(i)*hgy1(i)
        fhourt(2,2) = fhour(i,2,2)*js0(i)+fcl(i)*hgy2(i)
        fhourt(2,3) = fhour(i,2,3)*js0(i)+fcl(i)*hgy3(i)
        fhourt(2,4) = fhour(i,2,4)*js0(i)+fcl(i)*hgy4(i)
        fhourt(3,1) = fhour(i,3,1)*jt0(i)+fcl(i)*hgz1(i)
        fhourt(3,2) = fhour(i,3,2)*jt0(i)+fcl(i)*hgz2(i)
        fhourt(3,3) = fhour(i,3,3)*jt0(i)+fcl(i)*hgz3(i)
        fhourt(3,4) = fhour(i,3,4)*jt0(i)+fcl(i)*hgz4(i)
C-----
        t31 = nu2(i)*cg(i,3,1)
        t12 = nu2(i)*cg(i,1,2)
        t23 = nu2(i)*cg(i,2,3)
        sxy = (cg(i,1,1)-t31)*fhourt(1,2)
        syx = (cg(i,2,1)-t31)*fhourt(2,1)
        syz = (cg(i,2,2)-t12)*fhourt(2,3)
        szy = (cg(i,3,2)-t12)*fhourt(3,2)
        sxz = (cg(i,1,3)-t23)*fhourt(1,3)
        szx = (cg(i,3,3)-t23)*fhourt(3,1)
        s1211 = jr0(i)*js_1(i)*fhourt(1,1)
        s1222 = js0(i)*jr_1(i)*fhourt(2,2)
        s1311 = jr0(i)*jt_1(i)*fhourt(1,1)
        s1333 = jt0(i)*jr_1(i)*fhourt(3,3)
        s2322 = js0(i)*jt_1(i)*fhourt(2,2)
        s2333 = jt0(i)*js_1(i)*fhourt(3,3)
        t1211 = s1211*g33(i,1,1)
        t1222 = s1222*g33(i,1,1)
C-------verify w/ Radioss convention    
        t1311 = s1311*g33(i,3,3)
        t1333 = s1333*g33(i,3,3)
        t2322 = s2322*g33(i,2,2)
        t2333 = s2333*g33(i,2,2)
        nfhour(i,1,1) = h12(i)*(sxy+t1211)+h22(i)*(syx+t1222)+
     .                  h13(i)*(sxz+t1311)+h33(i)*(szx+t1333)
        nfhour(i,2,2) = h11(i)*(sxy+t1211)+h12(i)*(syx+t1222)+
     .                  h23(i)*(syz+t2322)+h33(i)*(szy+t2333)
        nfhour(i,3,3) = h11(i)*(sxz+t1311)+h13(i)*(szx+t1333)+
     .                  h22(i)*(syz+t2322)+h23(i)*(szy+t2333)
c       
        nfhour(i,1,2) = h11(i)*fhourt(1,2)*(
     .   (cc(i,1,1)-nucc(i,1,3)-nu2(i)*(cc(i,3,1)-nucc(i,3,3))))+
     .                  h12(i)*fhourt(2,1)*(
     .   (cc(i,1,2)-nucc(i,1,3)-nu2(i)*(cc(i,3,2)-nucc(i,3,3))))+
     .   (cg(i,1,1)-t31)*(h11(i)*s1211+h12(i)*s1222)
        nfhour(i,1,3) =h11(i)*fhourt(1,3)*(
     .   (cc(i,1,1)-nucc(i,1,2)-nu2(i)*(cc(i,2,1)-nucc(i,2,2))))+
     .                  h13(i)*fhourt(3,1)*(
     .   (cc(i,1,3)-nucc(i,1,2)-nu2(i)*(cc(i,2,3)-nucc(i,2,2))))+
     .   (cg(i,1,3)-t23)*(h11(i)*s1311+h13(i)*s1333)
        nfhour(i,1,4) = third*h11(i)*fhourt(1,4)*(
     .       (cc(i,1,1)-nu(i)*(two*(cc(i,1,2)+cc(i,1,3)-nu(i)*cc(i,2,3))-
     .                         nu(i)*(cc(i,2,2)+cc(i,3,3)))))
C     
        nfhour(i,2,1) = h12(i)*fhourt(1,2)*(
     .   (cc(i,2,1)-nucc(i,2,3)-nu2(i)*(cc(i,3,1)-nucc(i,3,3))))+
     .                  h22(i)*fhourt(2,1)*(
     .   (cc(i,2,2)-nucc(i,2,3)-nu2(i)*(cc(i,3,2)-nucc(i,3,3))))+
     .   (cg(i,2,1)-t31)*(h12(i)*s1211+h22(i)*s1222)
        nfhour(i,2,3) = h22(i)*fhourt(2,3)*(
     .   (cc(i,2,2)-nucc(i,2,1)-nu2(i)*(cc(i,1,2)-nucc(i,1,1))))+
     .                  h23(i)*fhourt(3,2)*(
     .   (cc(i,2,3)-nucc(i,2,1)-nu2(i)*(cc(i,1,3)-nucc(i,1,1))))+
     .   (cg(i,2,2)-t12)*(h22(i)*s2322+h23(i)*s2333)
        nfhour(i,2,4) = third*h22(i)*fhourt(2,4)*(
     .       (cc(i,2,2)-nu(i)*(two*(cc(i,1,2)+cc(i,2,3)-nu(i)*cc(i,1,3))-
     .                         nu(i)*(cc(i,1,1)+cc(i,3,3)))))
c
        nfhour(i,3,1) = h13(i)*fhourt(1,3)*(
     .   (cc(i,3,1)-nucc(i,3,2)-nu2(i)*(cc(i,2,1)-nucc(i,2,2))))+
     .                  h33(i)*fhourt(3,1)*(
     .   (cc(i,3,3)-nucc(i,3,2)-nu2(i)*(cc(i,2,3)-nucc(i,2,2))))+
     .   (cg(i,3,3)-t23)*(h13(i)*s1311+h33(i)*s1333)
        nfhour(i,3,2) = h23(i)*fhourt(2,3)*(
     .   (cc(i,3,2)-nucc(i,3,1)-nu2(i)*(cc(i,1,2)-nucc(i,1,1))))+
     .                  h33(i)*fhourt(3,2)*(
     .   (cc(i,3,3)-nucc(i,3,1)-nu2(i)*(cc(i,1,3)-nucc(i,1,1))))+
     .   (cg(i,3,2)-t12)*(h23(i)*s2322+h33(i)*s2333)
        nfhour(i,3,4) = third*h33(i)*fhourt(3,4)*(
     .       (cc(i,3,3)-nu(i)*(two*(cc(i,1,3)+cc(i,2,3)-nu(i)*cc(i,1,2))-
     .                         nu(i)*(cc(i,1,1)+cc(i,2,2)))))
       ENDDO
C
      RETURN
      END