cbasumg3.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/.
!||====================================================================
!||    cbasumg3     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    cbake3       ../engine/source/elements/shell/coqueba/cbake3.F
!||--- calls      -----------------------------------------------------
!||    cbaprojk     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    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 cbasumg3(
     1            JFT    ,JLT    ,VQN    ,VQ     ,NPLAT   ,IPLAT   ,
     2                     K11,K12,K13,K14,K22,K23,K24,K33,K34,K44,
     3                     M11,M12,M13,M14,M22,M23,M24,M33,M34,M44,
     4                     MF11,MF12,MF13,MF14,MF22,MF23,MF24,MF33, 
     5                     MF34,MF44,FM12,FM13,FM14,FM23,FM24,FM34, 
     6                     KE11,KE22,KE33,KE44,KE12,KE13,KE14,KE23,
     7                     KE24,KE34,VCORE,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,NPLAT ,IPLAT(*),IDRIL,IORTH
      my_real 
     .   VQN(MVSIZ,3,3,4),VQ(MVSIZ,3,3)
      my_real
     .    K11(3,3,*),K12(3,3,*),K13(3,3,*),K14(3,3,*),
     .    K22(3,3,*),K23(3,3,*),K24(3,3,*),K33(3,3,*),
     .    M11(3,3,*),M12(3,3,*),M13(3,3,*),M14(3,3,*),
     .    m22(3,3,*),m23(3,3,*),m24(3,3,*),m33(3,3,*),
     .    mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),mf14(3,3,*),
     .    mf22(3,3,*),mf23(3,3,*),mf24(3,3,*),mf33(3,3,*),
     .    fm12(3,3,*),fm13(3,3,*),fm14(3,3,*),
     .    fm23(3,3,*),fm24(3,3,*),fm34(3,3,*),
     .    k34(3,3,*),k44(3,3,*),m34(3,3,*),m44(3,3,*),
     .    mf34(3,3,*),mf44(3,3,*),
     .    ke11(6,6,*),ke22(6,6,*),ke33(6,6,*),ke44(6,6,*),
     .    ke12(6,6,*),ke13(6,6,*),ke14(6,6,*),ke23(6,6,*),
     .    ke24(6,6,*),ke34(6,6,*),vcore(mvsiz,3,4)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I, J, K,EP,IS,IAS,NF,MI,MJ,M
      my_real 
     .     Q(3,3,MVSIZ),QN(3,3,4,MVSIZ),CORELV(MVSIZ,2,4),Z1(MVSIZ)
      DATA IS/1/,IAS/0/ 
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
C---------------------------------------
C   TRANS LOCAL-->GLOBAL ET 5DDL-->6DDL w/  rigid mode projection
C---------------------------------------
        DO i=1,3 
        DO j=1,3 
#include "vectorize.inc"
        DO m=jft,nplat
         ep=iplat(m)
         q(j,i,m)=vq(ep,i,j)
        ENDDO
       ENDDO
       ENDDO
        CALL cbatran2(jft,nplat,q,k11,q,is)
        CALL cbatran2(jft,nplat,q,k22,q,is)
        CALL cbatran2(jft,nplat,q,k33,q,is)
        CALL cbatran2(jft,nplat,q,k44,q,is)
        CALL cbatran2(jft,nplat,q,k12,q,ias)
        CALL cbatran2(jft,nplat,q,k13,q,ias)
        CALL cbatran2(jft,nplat,q,k14,q,ias)
        CALL cbatran2(jft,nplat,q,k23,q,ias)
        CALL cbatran2(jft,nplat,q,k24,q,ias)
        CALL cbatran2(jft,nplat,q,k34,q,ias)
       IF (iorth >0 .AND.idril>0) THEN
        CALL cbatran3(jft,nplat,q,m11,q,is)
        CALL cbatran3(jft,nplat,q,m22,q,is)
        CALL cbatran3(jft,nplat,q,m33,q,is)
        CALL cbatran3(jft,nplat,q,m44,q,is)
        CALL cbatran3(jft,nplat,q,m12,q,ias)
        CALL cbatran3(jft,nplat,q,m13,q,ias)
        CALL cbatran3(jft,nplat,q,m14,q,ias)
        CALL cbatran3(jft,nplat,q,m23,q,ias)
        CALL cbatran3(jft,nplat,q,m24,q,ias)
        CALL cbatran3(jft,nplat,q,m34,q,ias)
       ELSE
        CALL cbatran2(jft,nplat,q,m11,q,is)
        CALL cbatran2(jft,nplat,q,m22,q,is)
        CALL cbatran2(jft,nplat,q,m33,q,is)
        CALL cbatran2(jft,nplat,q,m44,q,is)
        CALL cbatran2(jft,nplat,q,m12,q,ias)
        CALL cbatran2(jft,nplat,q,m13,q,ias)
        CALL cbatran2(jft,nplat,q,m14,q,ias)
        CALL cbatran2(jft,nplat,q,m23,q,ias)
        CALL cbatran2(jft,nplat,q,m24,q,ias)
        CALL cbatran2(jft,nplat,q,m34,q,ias)
       END IF !(IORTH >0.AND.IDRIL>0)
C        
       IF (iorth >0) THEN
        CALL cbatran3(jft,nplat,q,mf11,q,ias)
        CALL cbatran3(jft,nplat,q,mf12,q,ias)
        CALL cbatran3(jft,nplat,q,mf13,q,ias)
        CALL cbatran3(jft,nplat,q,mf14,q,ias)
        CALL cbatran3(jft,nplat,q,mf22,q,ias)
        CALL cbatran3(jft,nplat,q,mf23,q,ias)
        CALL cbatran3(jft,nplat,q,mf24,q,ias)
        CALL cbatran3(jft,nplat,q,mf33,q,ias)
        CALL cbatran3(jft,nplat,q,mf34,q,ias)
        CALL cbatran3(jft,nplat,q,mf44,q,ias)
        CALL cbatran3(jft,nplat,q,fm12,q,ias)
        CALL cbatran3(jft,nplat,q,fm13,q,ias)
        CALL cbatran3(jft,nplat,q,fm14,q,ias)
        CALL cbatran3(jft,nplat,q,fm23,q,ias)
        CALL cbatran3(jft,nplat,q,fm24,q,ias)
        CALL cbatran3(jft,nplat,q,fm34,q,ias)
       ELSEIF (idril>0) THEN
        CALL cbatran233(jft,nplat,q,mf11,q)
        CALL cbatran233(jft,nplat,q,mf12,q)
        CALL cbatran233(jft,nplat,q,mf13,q)
        CALL cbatran233(jft,nplat,q,mf14,q)
        CALL cbatran233(jft,nplat,q,mf22,q)
        CALL cbatran233(jft,nplat,q,mf23,q)
        CALL cbatran233(jft,nplat,q,mf24,q)
        CALL cbatran233(jft,nplat,q,mf33,q)
        CALL cbatran233(jft,nplat,q,mf34,q)
        CALL cbatran233(jft,nplat,q,mf44,q)
        CALL cbatran233(jft,nplat,q,fm12,q)
        CALL cbatran233(jft,nplat,q,fm13,q)
        CALL cbatran233(jft,nplat,q,fm14,q)
        CALL cbatran233(jft,nplat,q,fm23,q)
        CALL cbatran233(jft,nplat,q,fm24,q)
        CALL cbatran233(jft,nplat,q,fm34,q)
       ELSE
        CALL cbatran232(jft,nplat,q,mf11,q)
        CALL cbatran232(jft,nplat,q,mf12,q)
        CALL cbatran232(jft,nplat,q,mf13,q)
        CALL cbatran232(jft,nplat,q,mf14,q)
        CALL cbatran232(jft,nplat,q,mf22,q)
        CALL cbatran232(jft,nplat,q,mf23,q)
        CALL cbatran232(jft,nplat,q,mf24,q)
        CALL cbatran232(jft,nplat,q,mf33,q)
        CALL cbatran232(jft,nplat,q,mf34,q)
        CALL cbatran232(jft,nplat,q,mf44,q)
        CALL cbatran223(jft,nplat,q,fm12,q)
        CALL cbatran223(jft,nplat,q,fm13,q)
        CALL cbatran223(jft,nplat,q,fm14,q)
        CALL cbatran223(jft,nplat,q,fm23,q)
        CALL cbatran223(jft,nplat,q,fm24,q)
        CALL cbatran223(jft,nplat,q,fm34,q)
       END IF
C---------------------------------------
C   ASSEMBLAGE
C---------------------------------------
C---------KII -------- 
       DO i=1,3 
        mi=i+3
        DO j=i,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,nplat
          ep=iplat(m)
          ke11(i,j,ep)=k11(i,j,m) 
          ke11(mi,mj,ep)=m11(i,j,m)
          ke22(i,j,ep)=k22(i,j,m)
          ke22(mi,mj,ep)=m22(i,j,m)
          ke33(i,j,ep)=k33(i,j,m)
          ke33(mi,mj,ep)=m33(i,j,m)
          ke44(i,j,ep)=k44(i,j,m)
          ke44(mi,mj,ep)=m44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,3 
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,nplat
          ep=iplat(m)
          ke11(i,mj,ep)=mf11(i,j,m)
          ke22(i,mj,ep)=mf22(i,j,m)
          ke33(i,mj,ep)=mf33(i,j,m)
          ke44(i,mj,ep)=mf44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
C---------KIJ -------- 
       DO i=1,3 
        mi=i+3
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,nplat
          ep=iplat(m)
          ke12(i,j,ep)=k12(i,j,m)
          ke12(i,mj,ep)=mf12(i,j,m)
          ke12(mi,j,ep)=fm12(i,j,m)
          ke12(mi,mj,ep)=m12(i,j,m)
          ke13(i,j,ep)=k13(i,j,m)
          ke13(i,mj,ep)=mf13(i,j,m)
          ke13(mi,j,ep)=fm13(i,j,m)
          ke13(mi,mj,ep)=m13(i,j,m)
          ke14(i,j,ep)=k14(i,j,m)
          ke14(i,mj,ep)=mf14(i,j,m)
          ke14(mi,j,ep)=fm14(i,j,m)
          ke14(mi,mj,ep)=m14(i,j,m)
          ke23(i,j,ep)=k23(i,j,m)
          ke23(i,mj,ep)=mf23(i,j,m)
          ke23(mi,j,ep)=fm23(i,j,m)
          ke23(mi,mj,ep)=m23(i,j,m)
          ke24(i,j,ep)=k24(i,j,m)
          ke24(i,mj,ep)=mf24(i,j,m)
          ke24(mi,j,ep)=fm24(i,j,m)
          ke24(mi,mj,ep)=m24(i,j,m)
          ke34(i,j,ep)=k34(i,j,m)
          ke34(i,mj,ep)=mf34(i,j,m)
          ke34(mi,j,ep)=fm34(i,j,m)
          ke34(mi,mj,ep)=m34(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C----------------warped elements--------------
       nf=nplat+1
       IF (nf > jlt) RETURN
C       
       DO i=1,3 
       DO j=1,3 
#include "vectorize.inc"
        DO m=nf,jlt 
         ep=iplat(m)
         q(j,i,m)=vq(ep,i,j)
        ENDDO
       ENDDO
       ENDDO
C--------projection free Rigid rotation---- 
       DO j=1,4 
         DO i=1,2 
#include "vectorize.inc"
          DO m=nf,jlt 
           ep=iplat(m)
           corelv(m,i,j)=vcore(ep,i,j)
          ENDDO
         ENDDO
#include "vectorize.inc"
         DO m=nf,jlt 
           ep=iplat(m)
           z1(m)=vcore(ep,3,1)
         ENDDO
         DO i=1,3 
         DO k=1,3 
#include "vectorize.inc"
          DO m=nf,jlt 
           ep=iplat(m)
           qn(i,k,j,m)=vqn(ep,i,k,j)
          ENDDO
         ENDDO
         ENDDO
       END DO
        CALL cbaprojk(
     1               nf    ,jlt    ,qn    ,q     ,
     3               k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
     4               m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
     5               mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33, 
     6               mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34, 
     7               corelv,z1   )
C---------------------------------------
C   ASSEMBLAGE
C---------------------------------------
C---------KII -------- 
       DO i=1,3 
        mi=i+3
        DO j=i,3 
         mj=j+3
#include "vectorize.inc"
         DO m=nf,jlt
          ep=iplat(m)
          ke11(i,j,ep)=k11(i,j,m)
          ke11(mi,mj,ep)=m11(i,j,m)
          ke22(i,j,ep)=k22(i,j,m)
          ke22(mi,mj,ep)=m22(i,j,m)
          ke33(i,j,ep)=k33(i,j,m)
          ke33(mi,mj,ep)=m33(i,j,m)
          ke44(i,j,ep)=k44(i,j,m)
          ke44(mi,mj,ep)=m44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,3 
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=nf,jlt
          ep=iplat(m)
          ke11(i,mj,ep)=mf11(i,j,m)
          ke22(i,mj,ep)=mf22(i,j,m)
          ke33(i,mj,ep)=mf33(i,j,m)
          ke44(i,mj,ep)=mf44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C---------KIJ -------- 
       DO i=1,3 
        mi=i+3
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=nf,jlt
          ep=iplat(m)
          ke12(i,j,ep)=k12(i,j,m)
          ke13(i,j,ep)=k13(i,j,m)
          ke14(i,j,ep)=k14(i,j,m)
          ke23(i,j,ep)=k23(i,j,m)
          ke24(i,j,ep)=k24(i,j,m)
          ke34(i,j,ep)=k34(i,j,m)
          ke12(i,mj,ep)=mf12(i,j,m)
          ke13(i,mj,ep)=mf13(i,j,m)
          ke14(i,mj,ep)=mf14(i,j,m)
          ke23(i,mj,ep)=mf23(i,j,m)
          ke24(i,mj,ep)=mf24(i,j,m)
          ke34(i,mj,ep)=mf34(i,j,m)
          ke12(mi,j,ep)=fm12(i,j,m)
          ke13(mi,j,ep)=fm13(i,j,m)
          ke14(mi,j,ep)=fm14(i,j,m)
          ke23(mi,j,ep)=fm23(i,j,m)
          ke24(mi,j,ep)=fm24(i,j,m)
          ke34(mi,j,ep)=fm34(i,j,m)
          ke12(mi,mj,ep)=m12(i,j,m)
          ke13(mi,mj,ep)=m13(i,j,m)
          ke14(mi,mj,ep)=m14(i,j,m)
          ke23(mi,mj,ep)=m23(i,j,m)
          ke24(mi,mj,ep)=m24(i,j,m)
          ke34(mi,mj,ep)=m34(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,6 
        DO j=i+1,6 
         DO m=jft,jlt
          ke11(j,i,m)=ke11(i,j,m)
          ke22(j,i,m)=ke22(i,j,m)
          ke33(j,i,m)=ke33(i,j,m)
          ke44(j,i,m)=ke44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
      RETURN
      END
!||====================================================================
!||    cbatran3    ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    c3sumg3     ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||    cbasumg3    ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    czsumg3     ../engine/source/elements/shell/coquez/czsumg3.F
!||    mstiforth   ../engine/source/elements/solid/solide8z/mstiforth.F
!||====================================================================
      SUBROUTINE cbatran3(JFT   ,JLT    ,VQI   ,KK,VQJ,ISYM) 
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,ISYM
      my_real 
     .   VQI(3,3,*), VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
       IF (isym==1) THEN
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(kk(1,1,ep)*vqj(1,j,ep)+
     1                  kk(1,2,ep)*vqj(2,j,ep)+kk(1,3,ep)*vqj(3,j,ep))+
     2              vqi(2,i,ep)*(kk(1,2,ep)*vqj(1,j,ep)+
     3                  kk(2,2,ep)*vqj(2,j,ep)+kk(2,3,ep)*vqj(3,j,ep))+
     4              vqi(3,i,ep)*(kk(1,3,ep)*vqj(1,j,ep)+
     5                  kk(2,3,ep)*vqj(2,j,ep)+kk(3,3,ep)*vqj(3,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
       ELSE
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(kk(1,1,ep)*vqj(1,j,ep)+
     1                  kk(1,2,ep)*vqj(2,j,ep)+kk(1,3,ep)*vqj(3,j,ep))+
     2              vqi(2,i,ep)*(kk(2,1,ep)*vqj(1,j,ep)+
     3                  kk(2,2,ep)*vqj(2,j,ep)+kk(2,3,ep)*vqj(3,j,ep))+
     4              vqi(3,i,ep)*(kk(3,1,ep)*vqj(1,j,ep)+
     5                  kk(3,2,ep)*vqj(2,j,ep)+kk(3,3,ep)*vqj(3,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
       ENDIF
      RETURN
      END
!||====================================================================
!||    cbatran2   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    c3sumg3    ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||    cbasumg3   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    czsumg3    ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE cbatran2(JFT   ,JLT    ,VQI   ,KK,VQJ,ISYM) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP,ISYM
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
       IF (isym==1) THEN
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(
     1                  kk(1,1,ep)*vqj(1,j,ep)+kk(1,2,ep)*vqj(2,j,ep))+
     2              vqi(2,i,ep)*(
     3                  kk(1,2,ep)*vqj(1,j,ep)+kk(2,2,ep)*vqj(2,j,ep))+
     4              vqi(3,i,ep)*kk(3,3,ep)*vqj(3,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
       ELSE
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(
     1                  kk(1,1,ep)*vqj(1,j,ep)+kk(1,2,ep)*vqj(2,j,ep))+
     2              vqi(2,i,ep)*(
     3                  kk(2,1,ep)*vqj(1,j,ep)+kk(2,2,ep)*vqj(2,j,ep))+
     4              vqi(3,i,ep)*kk(3,3,ep)*vqj(3,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
       ENDIF
      RETURN
      END
!||====================================================================
!||    cbatran32   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    czsumg3     ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE cbatran32(JFT   ,JLT    ,VQI   ,KK,VQJ) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(kk(1,1,ep)*vqj(1,j,ep)+
     1                           kk(1,2,ep)*vqj(2,j,ep))+
     2              vqi(2,i,ep)*(kk(2,1,ep)*vqj(1,j,ep)+
     3                           kk(2,2,ep)*vqj(2,j,ep))+
     4              vqi(3,i,ep)*(kk(3,1,ep)*vqj(1,j,ep)+
     5                           kk(3,2,ep)*vqj(2,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
      RETURN
      END
!||====================================================================
!||    cbatran23   ../engine/source/elements/shell/coqueba/cbasumg3.f
!||--- called by ------------------------------------------------------
!||    czsumg3     ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE cbatran23(JFT   ,JLT    ,VQI   ,KK,VQJ) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(1,i,ep)*(kk(1,1,ep)*vqj(1,j,ep)+
     1                  kk(1,2,ep)*vqj(2,j,ep)+kk(1,3,ep)*vqj(3,j,ep))+
     2              vqi(2,i,ep)*(kk(2,1,ep)*vqj(1,j,ep)+
     3                  kk(2,2,ep)*vqj(2,j,ep)+kk(2,3,ep)*vqj(3,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
      RETURN
      END
!||====================================================================
!||    cbatran232   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    c3sumg3      ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||    cbasumg3     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    czsumg3      ../engine/source/elements/shell/coquez/czsumg3.f
!||====================================================================
      SUBROUTINE cbatran232(JFT   ,JLT    ,VQI   ,KK,VQJ) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=vqi(3,i,ep)*(kk(3,1,ep)*vqj(1,j,ep)+
     1                           kk(3,2,ep)*vqj(2,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
      RETURN
      END
!||====================================================================
!||    cbatran223   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    c3sumg3      ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||    cbasumg3     ../engine/source/elements/shell/coqueba/cbasumg3.f
!||    czsumg3      ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE cbatran223(JFT   ,JLT    ,VQI   ,KK,VQJ) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=(vqi(1,i,ep)*kk(1,3,ep)+
     1               vqi(2,i,ep)*kk(2,3,ep))*vqj(3,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
      RETURN
      END
!||====================================================================
!||    cbatran233   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    c3sumg3      ../engine/source/elements/sh3n/coque3n/c3sumg3.F
!||    cbasumg3     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    czsumg3      ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE cbatran233(JFT   ,JLT    ,VQI   ,KK,VQJ) 
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
      my_real 
     .   VQI(3,3,*),VQJ(3,3,*),KK(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP
      my_real
     .    k(3,3,mvsiz)
C-----------------------------------------------
C----- QI^tKQJ K(1,3)>0,K(2,3)>0,K(3,1)>0,K(3,2)>0-------
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k(i,j,ep)=(vqi(1,i,ep)*kk(1,3,ep)+
     1               vqi(2,i,ep)*kk(2,3,ep))*vqj(3,j,ep)+
     3               vqi(3,i,ep)*(kk(3,1,ep)*vqj(1,j,ep)+
     4                            kk(3,2,ep)*vqj(2,j,ep))
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kk(i,j,ep)= k(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
      RETURN
      END
!||====================================================================
!||    cbaprojk     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    cbasumg3     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- calls      -----------------------------------------------------
!||    set_rsj1     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    setprojkba   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE cbaprojk(
     1                    JFT    ,JLT    ,VQN    ,VQ     ,
     3                     K11,K12,K13,K14,K22,K23,K24,K33,K34,K44,
     4                     M11,M12,M13,M14,M22,M23,M24,M33,M34,M44,
     5                     MF11,MF12,MF13,MF14,MF22,MF23,MF24,MF33,
     6                     MF34,MF44,FM12,FM13,FM14,FM23,FM24,FM34,
     7                     CORELV,Z1   )
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
      my_real
     .    K11(3,3,*),K12(3,3,*),K13(3,3,*),K14(3,3,*),
     .    K22(3,3,*),K23(3,3,*),K24(3,3,*),K33(3,3,*),
     .    M11(3,3,*),M12(3,3,*),M13(3,3,*),M14(3,3,*),
     .    M22(3,3,*),M23(3,3,*),M24(3,3,*),M33(3,3,*),
     .    MF11(3,3,*),MF12(3,3,*),MF13(3,3,*),MF14(3,3,*),
     .    MF22(3,3,*),MF23(3,3,*),MF24(3,3,*),MF33(3,3,*),
     .    FM12(3,3,*),FM13(3,3,*),FM14(3,3,*),
     .    FM23(3,3,*),FM24(3,3,*),FM34(3,3,*),
     .    K34(3,3,*),K44(3,3,*),M34(3,3,*),M44(3,3,*),
     .    MF34(3,3,*),MF44(3,3,*),
     .    CORELV(MVSIZ,2,4),Z1(*),VQN(9,4,*),VQ(9,*)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I, J, K,L,EP,IS,IAS,NF,MI,MJ,M,ND
      my_real
     .    DR(3,3,MVSIZ),
     .    R1(3,3,MVSIZ),R2(3,3,MVSIZ),R3(3,3,MVSIZ),R4(3,3,MVSIZ),
     .    DI(6),Z2,DETA,D(6),
     .    XX,YY,ZZ,XY,XZ,YZ,ABC,XXYZ2,YYXZ2,ZZXY2
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
C-------transport Mij to element local system first---------
        DO I=jft,jlt
         z2 = z1(i)*z1(i)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
         xx = corelv(i,1,1)*corelv(i,1,1)+corelv(i,1,2)*corelv(i,1,2)
     1       +corelv(i,1,3)*corelv(i,1,3)+corelv(i,1,4)*corelv(i,1,4)
         yy = corelv(i,2,1)*corelv(i,2,1)+corelv(i,2,2)*corelv(i,2,2)
     1       +corelv(i,2,3)*corelv(i,2,3)+corelv(i,2,4)*corelv(i,2,4)
         xy = corelv(i,1,1)*corelv(i,2,1)+corelv(i,1,2)*corelv(i,2,2)
     1       +corelv(i,1,3)*corelv(i,2,3)+corelv(i,1,4)*corelv(i,2,4)
         xz =(corelv(i,1,1)-corelv(i,1,2)+corelv(i,1,3)-corelv(i,1,4))
     .           *z1(i)
         yz =(corelv(i,2,1)-corelv(i,2,2)+corelv(i,2,3)-corelv(i,2,4))
     .           *z1(i)
         zz = four*z2
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
         d(1)= yy+zz+four
         d(2)= xx+zz+four
         d(3)= xx+yy+four
         d(4)= -xy
         d(5)= -xz
         d(6)= -yz
         abc = d(1)*d(2)*d(3)
         xxyz2 = d(1)*d(6)*d(6)
         yyxz2 = d(2)*d(5)*d(5)
         zzxy2 = d(3)*d(4)*d(4)
         deta = abs(abc+two*d(4)*d(5)*d(6)-xxyz2-yyxz2-zzxy2)
         deta = one/max(deta,em20)
         di(1) = (abc-xxyz2)*deta/max(d(1),em20)
         di(2) = (abc-yyxz2)*deta/max(d(2),em20)
         di(3) = (abc-zzxy2)*deta/max(d(3),em20)
         di(4) = (d(5)*d(6)-d(4)*d(3))*deta
         di(5) = (d(6)*d(4)-d(5)*d(2))*deta
         di(6) = (d(4)*d(5)-d(6)*d(1))*deta
C
         dr(1,1,i)=  di(1)
         dr(2,2,i)=  di(2)
         dr(3,3,i)=  di(3)
         dr(1,2,i)=  di(4)
         dr(1,3,i)=  di(5)
         dr(2,3,i)=  di(6)
         dr(2,1,i)=  dr(1,2,i)
         dr(3,1,i)=  dr(1,3,i)
         dr(3,2,i)=  dr(2,3,i)
        END DO
C
        CALL set_rsj1(r1     ,r2     ,r3     ,r4    ,z1    ,
     .                jft    ,jlt    ,corelv)
C -----------PROJECTION---------
        CALL setprojkba(dr    ,r1     ,r2     ,r3     ,r4    ,
     3                k11,k12,k13,k14,k22,k23,k24,k33,k34,k44,
     4                m11,m12,m13,m14,m22,m23,m24,m33,m34,m44,
     5                mf11,mf12,mf13,mf14,mf22,mf23,mf24,mf33,
     6                mf34,mf44,fm12,fm13,fm14,fm23,fm24,fm34,
     7                vq  ,vqn ,jft ,jlt  )
C
      RETURN
      END
!||====================================================================
!||    set_rsj1   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    cbaprojk   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    czprojkr   ../engine/source/elements/shell/coquez/czsumg3.F
!||--- calls      -----------------------------------------------------
!||    set_ri33   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE set_rsj1(R1     ,R2     ,R3     ,R4    ,Z1    ,
     .                    JFT    ,JLT    ,CORELV)
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
      my_real
     .    CORELV(MVSIZ,2,4),
     .    R1(3,3,*),R2(3,3,*),R3(3,3,*),R4(3,3,*),Z1(*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER J,M,L
      my_real
     .    S,XI(MVSIZ),YI(MVSIZ),ZI(MVSIZ)
C-------------------------------------------------------------
        DO M=jft,jlt
         DO l=1,3
          DO j=1,3
           r1(l,j,m)=zero
           r2(l,j,m)=zero
           r3(l,j,m)=zero
           r4(l,j,m)=zero
          ENDDO
         ENDDO
        END DO
C
        DO m=jft,jlt
         xi(m)=corelv(m,1,1)
         yi(m)=corelv(m,2,1)
         zi(m)=z1(m)
        END DO
        CALL set_ri33(xi ,yi, zi  ,r1  ,jft,jlt)
        DO m=jft,jlt
         xi(m)=corelv(m,1,2)
         yi(m)=corelv(m,2,2)
         zi(m)=-z1(m)
        END DO
        CALL set_ri33(xi ,yi, zi  ,r2  ,jft,jlt)
        DO m=jft,jlt
         xi(m)=corelv(m,1,3)
         yi(m)=corelv(m,2,3)
         zi(m)=z1(m)
        END DO
        CALL set_ri33(xi ,yi, zi  ,r3  ,jft,jlt)
        DO m=jft,jlt
         xi(m)=corelv(m,1,4)
         yi(m)=corelv(m,2,4)
         zi(m)=-z1(m)
        END DO
        CALL set_ri33(xi ,yi, zi  ,r4  ,jft,jlt)
C-----------
      RETURN
      END
!||====================================================================
!||    set_ri33   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    s6ccumg3   ../engine/source/elements/thickshell/solide6c/s6ccumg3.F
!||    set_rsj1   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    set_rsj2   ../engine/source/elements/shell/coquez/czsumg3.F
!||====================================================================
      SUBROUTINE set_ri33(XI ,YI, ZI  ,RI  ,JFT,JLT)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT
      my_real
     .   XI(*) ,YI(*), ZI(*),RI(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,L
         DO I=jft,jlt
          ri(1,2,i)=zi(i)
          ri(1,3,i)=-yi(i)
          ri(2,1,i)=-ri(1,2,i)
          ri(2,3,i)=xi(i)
          ri(3,1,i)=-ri(1,3,i)
          ri(3,2,i)=-ri(2,3,i)
         ENDDO
C
      RETURN
      END
!||====================================================================
!||    setprojkba    ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    cbaprojk      ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- calls      -----------------------------------------------------
!||    trankl1       ../engine/source/elements/shell/coquez/czsumg3.f
!||    tranklq       ../engine/source/elements/shell/coquez/czsumg3.F
!||    tranqikqj     ../engine/source/elements/shell/coquez/czsumg3.F
!||    tranqikqj33   ../engine/source/elements/shell/coqueba/cbasumg3.f
!||    tranqnkq      ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE setprojkba(DR    ,R1     ,R2     ,R3     ,R4    ,
     3                     K11,K12,K13,K14,K22,K23,K24,K33,K34,K44,
     4                     M11,M12,M13,M14,M22,M23,M24,M33,M34,M44,
     5                     MF11,MF12,MF13,MF14,MF22,MF23,MF24,MF33, 
     6                     MF34,MF44,FM12,FM13,FM14,FM23,FM24,FM34, 
     .                     VQ  ,VQN ,JFT  ,JLT   ) 
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
      my_real 
     .    DR(3,3,*),VQ(3,3,*),VQN(3,3,4,*),
     .    R1(3,3,*),R2(3,3,*),R3(3,3,*),R4(3,3,*),
     .    K11(3,3,*),K12(3,3,*),K13(3,3,*),K14(3,3,*),
     .    K22(3,3,*),K23(3,3,*),K24(3,3,*),K33(3,3,*),
     .    M11(3,3,*),M12(3,3,*),M13(3,3,*),M14(3,3,*),
     .    m22(3,3,*),m23(3,3,*),m24(3,3,*),m33(3,3,*),
     .    mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),mf14(3,3,*),
     .    mf22(3,3,*),mf23(3,3,*),mf24(3,3,*),mf33(3,3,*),
     .    fm12(3,3,*),fm13(3,3,*),fm14(3,3,*),
     .    fm23(3,3,*),fm24(3,3,*),fm34(3,3,*),
     .    k34(3,3,*),k44(3,3,*),m34(3,3,*),m44(3,3,*),
     .    mf34(3,3,*),mf44(3,3,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP,IS,IAS,IT,IAT
      my_real
     .    kl(6,6,mvsiz),kq(6,6,mvsiz),vq1(3,3,mvsiz),vq2(3,3,mvsiz),
     .    vq3(3,3,mvsiz),vq4(3,3,mvsiz)
         DATA is/1/,ias/0/,it/1/,iat/0/
      my_real,
     .  DIMENSION(:,:,:), ALLOCATABLE:: p,ke
C-------------------------------------------------------------
        ALLOCATE(p(24,24,mvsiz))
        ALLOCATE(ke(24,24,mvsiz))
C
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          vq1(i,j,ep)= vqn(j,i,1,ep)
          vq2(i,j,ep)= vqn(j,i,2,ep)
          vq3(i,j,ep)= vqn(j,i,3,ep)
          vq4(i,j,ep)= vqn(j,i,4,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P11=Q1Pr11Q
       CALL tranqikqj33(jft   ,jlt    ,r1  ,dr , r1 ,kl, is) 
       CALL trankl1(jft   ,jlt    ,kl  ,is ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq1  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i,j,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          ke(i,j,ep)= k11(i,j,ep)
          ke(i+3,j+3,ep)= m11(i,j,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i,j+3,ep)= mf11(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P22=Q2Pr22Q
       CALL tranqikqj33(jft   ,jlt    ,r2  ,dr , r2 ,kl, is) 
       CALL trankl1(jft   ,jlt    ,kl  ,is ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq  ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq2  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+6,j+6,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          ke(i+6,j+6,ep)= k22(i,j,ep)
          ke(i+9,j+9,ep)= m22(i,j,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+6,j+9,ep)= mf22(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P33=Q3Pr33Q
       CALL tranqikqj33(jft   ,jlt    ,r3  ,dr , r3 ,kl, is) 
       CALL trankl1(jft   ,jlt    ,kl  ,is ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq3  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+12,j+12,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          ke(i+12,j+12,ep)= k33(i,j,ep)
          ke(i+15,j+15,ep)= m33(i,j,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+12,j+15,ep)= mf33(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P44=Q4Pr44Q
       CALL tranqikqj33(jft   ,jlt    ,r4  ,dr , r4 ,kl, is) 
       CALL trankl1(jft   ,jlt    ,kl  ,is ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq4  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+18,j+18,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          ke(i+18,j+18,ep)= k44(i,j,ep)
          ke(i+21,j+21,ep)= m44(i,j,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+18,j+21,ep)= mf44(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P12=Q1Pr12Q
       CALL tranqikqj33(jft   ,jlt    ,r1  ,dr , r2 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq1  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i,j+6,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i,j+6,ep)= k12(i,j,ep)
          ke(i+3,j+9,ep)= m12(i,j,ep)
          ke(i,j+9,ep)= mf12(i,j,ep)
          ke(i+3,j+6,ep)= fm12(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P21=Q2Pr21Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq  ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq2  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+6,j,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P13=Q1Pr13Q
       CALL tranqikqj33(jft   ,jlt    ,r1  ,dr , r3 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq  ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq1  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i,j+12,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i,j+12,ep)= k13(i,j,ep)
          ke(i+3,j+15,ep)= m13(i,j,ep)
          ke(i,j+15,ep)= mf13(i,j,ep)
          ke(i+3,j+12,ep)= fm13(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P31=Q3Pr31Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq3  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+12,j,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P14=Q1Pr14Q
       CALL tranqikqj33(jft   ,jlt    ,r1  ,dr , r4 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq1  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i,j+18,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i,j+18,ep)= k14(i,j,ep)
          ke(i+3,j+21,ep)= m14(i,j,ep)
          ke(i,j+21,ep)= mf14(i,j,ep)
          ke(i+3,j+18,ep)= fm14(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P41=Q4P41Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq4  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+18,j,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P23=Q2Pr23Q
       CALL tranqikqj33(jft   ,jlt    ,r2  ,dr , r3 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq2  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+6,j+12,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+6,j+12,ep)= k23(i,j,ep)
          ke(i+9,j+15,ep)= m23(i,j,ep)
          ke(i+6,j+15,ep)= mf23(i,j,ep)
          ke(i+9,j+12,ep)= fm23(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P32=Q3Pr32Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq3  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+12,j+6,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P24=Q2Pr24Q
       CALL tranqikqj33(jft   ,jlt    ,r2  ,dr , r4 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq2  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+6,j+18,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+6,j+18,ep)= k24(i,j,ep)
          ke(i+9,j+21,ep)= m24(i,j,ep)
          ke(i+6,j+21,ep)= mf24(i,j,ep)
          ke(i+9,j+18,ep)= fm24(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P42=Q4Pr42Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq4  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+18,j+6,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P34=Q3Pr34Q
       CALL tranqikqj33(jft   ,jlt    ,r3  ,dr , r4 ,kl, ias) 
       CALL trankl1(jft   ,jlt    ,kl  ,ias ) 
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,it ) 
       CALL tranqnkq(jft  ,jlt    ,vq3  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+12,j+18,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          ke(i+12,j+18,ep)= k34(i,j,ep)
          ke(i+15,j+21,ep)= m34(i,j,ep)
          ke(i+12,j+21,ep)= mf34(i,j,ep)
          ke(i+15,j+18,ep)= fm34(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------P43=Q4Pr43Q
       CALL tranklq(jft   ,jlt    ,vq   ,kl ,kq ,iat ) 
       CALL tranqnkq(jft  ,jlt    ,vq4  ,kq   ) 
        DO i=1,6 
        DO j=1,6 
         DO ep=jft,jlt 
          p(i+18,j+12,ep)= kq(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------
        DO i=1,24 
        DO j=i+1,24 
         DO ep=jft,jlt 
          ke(j,i,ep)= ke(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------
        CALL tranqikqj(jft   ,jlt    ,p  ,ke,p ,24 ,is ) 
C-----------after projection----
C-----------K11
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k11(i,j,ep) =ke(i,j,ep)
          m11(i,j,ep) =ke(i+3,j+3,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          mf11(i,j,ep) = ke(i,j+3,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K22
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k22(i,j,ep) = ke(i+6,j+6,ep)
          m22(i,j,ep) = ke(i+9,j+9,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          mf22(i,j,ep) = ke(i+6,j+9,ep) 
         ENDDO
        ENDDO
        ENDDO
C-----------K33
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k33(i,j,ep) = ke(i+12,j+12,ep)
          m33(i,j,ep) = ke(i+15,j+15,ep) 
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          mf33(i,j,ep) = ke(i+12,j+15,ep) 
         ENDDO
        ENDDO
        ENDDO
C-----------K44
        DO i=1,3 
        DO j=i,3 
         DO ep=jft,jlt 
          k44(i,j,ep) = ke(i+18,j+18,ep)
          m44(i,j,ep) = ke(i+21,j+21,ep)
         ENDDO
        ENDDO
        DO j=1,3 
         DO ep=jft,jlt 
          mf44(i,j,ep) = ke(i+18,j+21,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K12
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k12(i,j,ep) =ke(i,j+6,ep) 
          m12(i,j,ep) =ke(i+3,j+9,ep)
          mf12(i,j,ep)=ke(i,j+9,ep)
          fm12(i,j,ep)=ke(i+3,j+6,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K13
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k13(i,j,ep) = ke(i,j+12,ep)
          m13(i,j,ep) = ke(i+3,j+15,ep) 
          mf13(i,j,ep) = ke(i,j+15,ep)
          fm13(i,j,ep) = ke(i+3,j+12,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K14
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k14(i,j,ep) =ke(i,j+18,ep)
          m14(i,j,ep) =ke(i+3,j+21,ep)
          mf14(i,j,ep)=ke(i,j+21,ep)
          fm14(i,j,ep)=ke(i+3,j+18,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K23
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k23(i,j,ep) = ke(i+6,j+12,ep) 
          m23(i,j,ep) = ke(i+9,j+15,ep) 
          mf23(i,j,ep) =ke(i+6,j+15,ep) 
          fm23(i,j,ep) =ke(i+9,j+12,ep) 
         ENDDO
        ENDDO
        ENDDO
C-----------K24
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k24(i,j,ep) = ke(i+6,j+18,ep)
          m24(i,j,ep) = ke(i+9,j+21,ep)
          mf24(i,j,ep) =ke(i+6,j+21,ep)
          fm24(i,j,ep) =ke(i+9,j+18,ep)
         ENDDO
        ENDDO
        ENDDO
C-----------K34
        DO i=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          k34(i,j,ep) = ke(i+12,j+18,ep) 
          m34(i,j,ep) = ke(i+15,j+21,ep) 
          mf34(i,j,ep) =ke(i+12,j+21,ep) 
          fm34(i,j,ep) =ke(i+15,j+18,ep) 
         ENDDO
        ENDDO
        ENDDO
C-----------
        DEALLOCATE(p)
        DEALLOCATE(ke)
      RETURN
      END
!||====================================================================
!||    tranqikqj33   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    setprojkba    ../engine/source/elements/shell/coqueba/cbasumg3.F
!||    setprojkz1    ../engine/source/elements/shell/coquez/czsumg3.f
!||====================================================================
      SUBROUTINE tranqikqj33(JFT   ,JLT    ,RI  ,RD , RJ,KD ,ISYM)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT,ISYM
      my_real
     .   ri(3,3,*), rj(3,3,*),rd(3,3,*),kd(6,6,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP,L,I1,J1
      my_real
     .    K(3,3)
C--------------[KD]=|RI| |RD| |RJ|^t---------------------------------
C--------------     | I|      |I |---------------------------------
       IF (ISYM==1) then
        DO i=1,3
        DO j=i,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+ri(i,1,ep)*rd(1,l,ep)*rj(j,l,ep)+
     1                   ri(i,2,ep)*rd(2,l,ep)*rj(j,l,ep)+
     1                   ri(i,3,ep)*rd(3,l,ep)*rj(j,l,ep)
          ENDDO
          kd(i,j,ep)= k(i,j)
          kd(j,i,ep)= k(i,j)
         ENDDO
C
         i1=i+3
         j1=j+3
         DO ep=jft,jlt
          kd(i1,j1,ep)= rd(i,j,ep)
          kd(j1,i1,ep)= rd(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3
        DO j=1,3
         i1=i+3
         j1=j+3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+ri(i,l,ep)*rd(l,j,ep)
          ENDDO
          kd(i,j1,ep)= k(i,j)
          kd(j1,i,ep)= k(i,j)
         ENDDO
        ENDDO
        ENDDO
C
       ELSE
        DO i=1,3
        DO j=1,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+ri(i,1,ep)*rd(1,l,ep)*rj(j,l,ep)+
     1                   ri(i,2,ep)*rd(2,l,ep)*rj(j,l,ep)+
     1                   ri(i,3,ep)*rd(3,l,ep)*rj(j,l,ep)
          ENDDO
          kd(i,j,ep)= k(i,j)
         ENDDO
C
         i1=i+3
         j1=j+3
         DO ep=jft,jlt
          kd(i1,j1,ep)= rd(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
        DO j=1,3
         j1=j+3
        DO i=1,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+ri(i,l,ep)*rd(l,j,ep)
          ENDDO
          kd(i,j1,ep)= k(i,j)
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3
         i1=i+3
        DO j=1,3
         DO ep=jft,jlt
          k(i,j)=zero
          DO l=1,3
           k(i,j)=k(i,j)+rd(i,l,ep)*rj(j,l,ep)
          ENDDO
          kd(i1,j,ep)= k(i,j)
         ENDDO
        ENDDO
        ENDDO
C
       ENDIF
      RETURN
      END
!||====================================================================
!||    tranqnkq     ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    setprojkba   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE tranqnkq(JFT   ,JLT    ,VQN   ,KQ   ) 
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,IT
      my_real 
     .   vqn(3,3,*), kq(6,6,*)
C-----------------------------------------------
C   LOCAL  A R G U M E N T S
C-----------------------------------------------
      INTEGER I,J,EP,K,L,J1,I1
      my_real 
     .   KD(3,3,MVSIZ),KK(3,3,MVSIZ)
C--------------KQ<-VQ*KQ----VQ=|I   0 |
C------------------------------|0 VQN|---------------------
        DO I=1,3 
        DO j=1,3 
         DO ep=jft,jlt 
          kd(i,j,ep)= zero
          kk(i,j,ep)= zero
         ENDDO
        ENDDO
        ENDDO
C        
        DO j=1,3 
           j1=j+3
        DO i=1,3 
         DO ep=jft,jlt 
          DO k=1,3 
            kd(i,j,ep)=kd(i,j,ep)+vqn(i,k,ep)*kq(k+3,j,ep)
            kk(i,j,ep)=kk(i,j,ep)+vqn(i,k,ep)*kq(k+3,j1,ep)
          ENDDO 
         ENDDO
        ENDDO
        ENDDO
C
        DO i=1,3 
           i1=i+3
        DO j=1,3 
           j1=j+3
         DO ep=jft,jlt 
            kq(i1,j,ep)=kd(i,j,ep)
            kq(i1,j1,ep)=kk(i,j,ep)
         ENDDO
        ENDDO
        ENDDO
C
      RETURN
      END
!||====================================================================
!||    cn4sumg3   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE cn4sumg3(
     1                     JFT    ,JLT    ,IPLAT   ,
     2                     K11,K12,K13,K14,K22,K23,K24,K33,K34,K44,
     3                     M11,M12,M13,M14,M22,M23,M24,M33,M34,M44,
     4                     MF11,MF12,MF13,MF14,MF22,MF23,MF24,MF33, 
     5                     MF34,MF44,FM12,FM13,FM14,FM23,FM24,FM34, 
     6                     KE11,KE22,KE33,KE44,KE12,KE13,KE14,KE23,
     7                     KE24,KE34)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include      "implicit_f.inc"
C-----------------------------------------------
C   D U M M Y   A R G U M E N T S
C-----------------------------------------------
      INTEGER JFT,JLT,IPLAT(*)
      my_real
     .    k11(3,3,*),k12(3,3,*),k13(3,3,*),k14(3,3,*),
     .    k22(3,3,*),k23(3,3,*),k24(3,3,*),k33(3,3,*),
     .    m11(3,3,*),m12(3,3,*),m13(3,3,*),m14(3,3,*),
     .    m22(3,3,*),m23(3,3,*),m24(3,3,*),m33(3,3,*),
     .    mf11(3,3,*),mf12(3,3,*),mf13(3,3,*),mf14(3,3,*),
     .    mf22(3,3,*),mf23(3,3,*),mf24(3,3,*),mf33(3,3,*),
     .    fm12(3,3,*),fm13(3,3,*),fm14(3,3,*),
     .    fm23(3,3,*),fm24(3,3,*),fm34(3,3,*),
     .    k34(3,3,*),k44(3,3,*),m34(3,3,*),m44(3,3,*),
     .    mf34(3,3,*),mf44(3,3,*),
     .    ke11(6,6,*),ke22(6,6,*),ke33(6,6,*),ke44(6,6,*),
     .    ke12(6,6,*),ke13(6,6,*),ke14(6,6,*),ke23(6,6,*),
     .    ke24(6,6,*),ke34(6,6,*)
C-----------------------------------------------
C   L O C A L   V A R I A B L E S
C-----------------------------------------------
      INTEGER I, J, K,EP,M,MI,MJ
C---------KII -------- 
       DO I=1,3 
        mi=i+3
        DO j=i,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,jlt
          ep=iplat(m)
          ke11(i,j,ep)=k11(i,j,m)
          ke11(mi,mj,ep)=m11(i,j,m)
          ke22(i,j,ep)=k22(i,j,m)
          ke22(mi,mj,ep)=m22(i,j,m)
          ke33(i,j,ep)=k33(i,j,m)
          ke33(mi,mj,ep)=m33(i,j,m)
          ke44(i,j,ep)=k44(i,j,m)
          ke44(mi,mj,ep)=m44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,3 
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,jlt
          ep=iplat(m)
          ke11(i,mj,ep)=mf11(i,j,m)
          ke22(i,mj,ep)=mf22(i,j,m)
          ke33(i,mj,ep)=mf33(i,j,m)
          ke44(i,mj,ep)=mf44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
C---------KIJ -------- 
       DO i=1,3 
        mi=i+3
        DO j=1,3 
         mj=j+3
#include "vectorize.inc"
         DO m=jft,jlt
          ep=iplat(m)
          ke12(i,j,ep)=k12(i,j,m)
          ke12(i,mj,ep)=mf12(i,j,m)
          ke12(mi,j,ep)=fm12(i,j,m)
          ke12(mi,mj,ep)=m12(i,j,m)
          ke13(i,j,ep)=k13(i,j,m)
          ke13(i,mj,ep)=mf13(i,j,m)
          ke13(mi,j,ep)=fm13(i,j,m)
          ke13(mi,mj,ep)=m13(i,j,m)
          ke14(i,j,ep)=k14(i,j,m)
          ke14(i,mj,ep)=mf14(i,j,m)
          ke14(mi,j,ep)=fm14(i,j,m)
          ke14(mi,mj,ep)=m14(i,j,m)
          ke23(i,j,ep)=k23(i,j,m)
          ke23(i,mj,ep)=mf23(i,j,m)
          ke23(mi,j,ep)=fm23(i,j,m)
          ke23(mi,mj,ep)=m23(i,j,m)
          ke24(i,j,ep)=k24(i,j,m)
          ke24(i,mj,ep)=mf24(i,j,m)
          ke24(mi,j,ep)=fm24(i,j,m)
          ke24(mi,mj,ep)=m24(i,j,m)
          ke34(i,j,ep)=k34(i,j,m)
          ke34(i,mj,ep)=mf34(i,j,m)
          ke34(mi,j,ep)=fm34(i,j,m)
          ke34(mi,mj,ep)=m34(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
       DO i=1,6 
        DO j=i+1,6 
         DO m=jft,jlt
          ke11(j,i,m)=ke11(i,j,m)
          ke22(j,i,m)=ke22(i,j,m)
          ke33(j,i,m)=ke33(i,j,m)
          ke44(j,i,m)=ke44(i,j,m)
         ENDDO
        ENDDO
       ENDDO
C
      RETURN
      END
!||====================================================================
!||    impkctmp   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- calls      -----------------------------------------------------
!||    writekc4   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||====================================================================
      SUBROUTINE impkctmp( JFT,JLT,IUGEO,
     1                    KE11   ,KE12   ,KE13   ,KE14   ,KE22 ,
     2                    KE23   ,KE24   ,KE33   ,KE34   ,KE44 )
C
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#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,IUGEO
C     REAL
      my_real    
     .   ke11(6,6,*),ke22(6,6,*),ke33(6,6,*),ke44(6,6,*),
     .   ke12(6,6,*),ke13(6,6,*),ke14(6,6,*),ke23(6,6,*),
     .   ke24(6,6,*),ke34(6,6,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NT,IG(MVSIZ)
C=======================================================================
C     SHELL
C=======================================================================
      CALL writekc4(iugeo,jft,jlt,'K11',ke11)
      CALL writekc4(iugeo,jft,jlt,'K12',ke12)
      CALL writekc4(iugeo,jft,jlt,'K13',ke13)
      CALL writekc4(iugeo,jft,jlt,'K14',ke14)
      CALL writekc4(iugeo,jft,jlt,'K22',ke22)
      CALL writekc4(iugeo,jft,jlt,'K23',ke23)
      CALL writekc4(iugeo,jft,jlt,'K24',ke24)
      CALL writekc4(iugeo,jft,jlt,'K33',ke33)
      CALL writekc4(iugeo,jft,jlt,'K34',ke34)
      CALL writekc4(iugeo,jft,jlt,'K44',ke44)
C
      RETURN
      END
!||====================================================================
!||    writekc4   ../engine/source/elements/shell/coqueba/cbasumg3.F
!||--- called by ------------------------------------------------------
!||    impkctmp   ../engine/source/elements/shell/coqueba/cbasumg3.f
!||====================================================================
      SUBROUTINE writekc4( IN,JFT,JLT,CH,KIJ)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT,JLT,IN
      CHARACTER CH*3
C     REAL
      my_real    
     .   kij(6,6,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,N,NT
      CHARACTER KEY*10,KEY1*23
C-----------------------------------------------
       key='/SHELL_'//ch
       key1='#3d Shell Elements '//ch
       WRITE(in,'(A)') key
       WRITE(in,'(A)')key1
       WRITE(in,'(A)')
     .     '#FORMAT: (6(/,1P6E12.5),/) '
       WRITE(in,'(2A)')'#SYSSHEL USRSHEL  K(I,J)  I=1,6;J=1,6'
       DO n= jft,jlt
        WRITE(in,'(6(/,1P6E12.5),/)'
     .    )((kij(i,j,n),i=1,6),j=1,6)
       ENDDO 
      RETURN
      END
C