c3sumg3.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/.
!||====================================================================
!||    c3sumg3      ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||--- called by ------------------------------------------------------
!||    c3ke3        ../engine/source/elements/sh3n/coque3n/c3ke3.F
!||--- calls      -----------------------------------------------------
!||    cbatran2     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    cbatran223   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    cbatran232   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    cbatran233   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    cbatran3     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE c3sumg3(JFT ,JLT ,
     1                     R11,R12,R13,R21,R22,R23,R31,R32,R33,
     2                     K11,K12,K13,K22,K23,K33,
     3                     M11,M12,M13,M22,M23,M33,
     4                     MF11,MF12,MF13,MF22,MF23,MF33, 
     5                     FM12,FM13,FM23, 
     6                     KE11,KE22,KE33,KE12,KE13,KE23,
     7                     IDRIL,IORTH)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT,IDRIL,IORTH
      my_real 
     .    R11(*),R12(*),R13(*),
     .    R21(*),R22(*),R23(*),
     .    R31(*),R32(*),R33(*)
       my_real
     .    K11(3,3,*),K12(3,3,*),K13(3,3,*),
     .    k22(3,3,*),k23(3,3,*),k33(3,3,*),
     .    m11(3,3,*),m12(3,3,*),m13(3,3,*),
     .    m22(3,3,*),m23(3,3,*),m33(3,3,*),
     .    mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),
     .    mf22(3,3,*),mf23(3,3,*),mf33(3,3,*),
     .    fm12(3,3,*),fm13(3,3,*),fm23(3,3,*),
     .    ke11(6,6,*),ke22(6,6,*),ke33(6,6,*),
     .    ke12(6,6,*),ke13(6,6,*),ke23(6,6,*)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I, J, EP,IS,IAS,MI,MJ
      my_real 
     .     Q(3,3,MVSIZ)
      DATA IS/1/,IAS/0/
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
C---------------------------------------
C   TRANS LOCAL-->GLOBAL ET 5DDL-->6DDL
C---------------------------------------
       DO i=jft,jlt
        q(1,1,i)=r11(i)
        q(1,2,i)=r21(i)
        q(1,3,i)=r31(i)
        q(2,1,i)=r12(i)
        q(2,2,i)=r22(i)
        q(2,3,i)=r32(i)
        q(3,1,i)=r13(i)
        q(3,2,i)=r23(i)
        q(3,3,i)=r33(i)
       ENDDO 
C-----      CBATRAN233     QI^tKQJ K(1,3)>0,K(2,3)>0,K(3,1)>0,K(3,2)>0-------
       CALL cbatran2(jft,jlt,q,k11,q,is)
       CALL cbatran2(jft,jlt,q,k22,q,is)
       CALL cbatran2(jft,jlt,q,k33,q,is)
       CALL cbatran2(jft,jlt,q,k12,q,ias)
       CALL cbatran2(jft,jlt,q,k13,q,ias)
       CALL cbatran2(jft,jlt,q,k23,q,ias)
       IF (iorth >0 .AND.idril>0) THEN
        CALL cbatran3(jft,jlt,q,m11,q,is)
        CALL cbatran3(jft,jlt,q,m22,q,is)
        CALL cbatran3(jft,jlt,q,m33,q,is)
        CALL cbatran3(jft,jlt,q,m12,q,ias)
        CALL cbatran3(jft,jlt,q,m13,q,ias)
        CALL cbatran3(jft,jlt,q,m23,q,ias)
       ELSE
        CALL cbatran2(jft,jlt,q,m11,q,is)
        CALL cbatran2(jft,jlt,q,m22,q,is)
        CALL cbatran2(jft,jlt,q,m33,q,is)
        CALL cbatran2(jft,jlt,q,m12,q,ias)
        CALL cbatran2(jft,jlt,q,m13,q,ias)
        CALL cbatran2(jft,jlt,q,m23,q,ias)
       END IF !(IORTH >0.AND.IDRIL>0)
       IF (iorth >0) THEN
       CALL cbatran3(jft,jlt,q,mf11,q,ias)
       CALL cbatran3(jft,jlt,q,mf12,q,ias)
       CALL cbatran3(jft,jlt,q,mf13,q,ias)
       CALL cbatran3(jft,jlt,q,mf22,q,ias)
       CALL cbatran3(jft,jlt,q,mf23,q,ias)
       CALL cbatran3(jft,jlt,q,mf33,q,ias)
       CALL cbatran3(jft,jlt,q,fm12,q,ias)
       CALL cbatran3(jft,jlt,q,fm13,q,ias)
       CALL cbatran3(jft,jlt,q,fm23,q,ias)
       ELSEIF (idril>0) THEN
        CALL cbatran233(jft,jlt,q,mf11,q)
        CALL cbatran233(jft,jlt,q,mf12,q)
        CALL cbatran233(jft,jlt,q,mf13,q)
        CALL cbatran233(jft,jlt,q,mf22,q)
        CALL cbatran233(jft,jlt,q,mf23,q)
        CALL cbatran233(jft,jlt,q,mf33,q)
        CALL cbatran233(jft,jlt,q,fm12,q)
        CALL cbatran233(jft,jlt,q,fm13,q)
        CALL cbatran233(jft,jlt,q,fm23,q)
       ELSE
        CALL cbatran232(jft,jlt,q,mf11,q)
        CALL cbatran232(jft,jlt,q,mf12,q)
        CALL cbatran232(jft,jlt,q,mf13,q)
        CALL cbatran232(jft,jlt,q,mf22,q)
        CALL cbatran232(jft,jlt,q,mf23,q)
        CALL cbatran232(jft,jlt,q,mf33,q)
        CALL cbatran223(jft,jlt,q,fm12,q)
        CALL cbatran223(jft,jlt,q,fm13,q)
        CALL cbatran223(jft,jlt,q,fm23,q)
       END IF
C---------------------------------------
C   ASSEMBLAGE
C---------------------------------------
C---------KII -------- 
       DO i=1,3 
        mi=i+3
        DO j=i,3 
         mj=j+3
         DO ep=jft,jlt
          ke11(i,j,ep)=k11(i,j,ep)
          ke11(mi,mj,ep)=m11(i,j,ep)
          ke22(i,j,ep)=k22(i,j,ep)
          ke22(mi,mj,ep)=m22(i,j,ep)
          ke33(i,j,ep)=k33(i,j,ep)
          ke33(mi,mj,ep)=m33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,3 
        DO j=1,3 
         mj=j+3
         DO ep=jft,jlt
          ke11(i,mj,ep)=mf11(i,j,ep)
          ke22(i,mj,ep)=mf22(i,j,ep)
          ke33(i,mj,ep)=mf33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,6 
        DO j=i,6 
         DO ep=jft,jlt
          ke11(j,i,ep)=ke11(i,j,ep)
          ke22(j,i,ep)=ke22(i,j,ep)
          ke33(j,i,ep)=ke33(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C---------KIJ -------- 
       DO i=1,3 
        mi=i+3
        DO j=1,3 
         mj=j+3
         DO ep=jft,jlt
          ke12(i,j,ep)=k12(i,j,ep)
          ke12(i,mj,ep)=mf12(i,j,ep)
          ke12(mi,j,ep)=fm12(i,j,ep)
          ke12(mi,mj,ep)=m12(i,j,ep)
          ke13(i,j,ep)=k13(i,j,ep)
          ke13(i,mj,ep)=mf13(i,j,ep)
          ke13(mi,j,ep)=fm13(i,j,ep)
          ke13(mi,mj,ep)=m13(i,j,ep)
          ke23(i,j,ep)=k23(i,j,ep)
          ke23(i,mj,ep)=mf23(i,j,ep)
          ke23(mi,j,ep)=fm23(i,j,ep)
          ke23(mi,mj,ep)=m23(i,j,ep)
         ENDDO
        ENDDO
       ENDDO
C
      RETURN
      END