s8cke3.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/.
!||====================================================================
!||    s8cke3         ../engine/source/elements/thickshell/solide8c/s8cke3.F
!||--- called by ------------------------------------------------------
!||    imp_glob_k     ../engine/source/implicit/imp_glob_k.F
!||    imp_glob_k0    ../engine/source/implicit/imp_glob_k.f
!||--- calls      -----------------------------------------------------
!||    assem_s8       ../engine/source/implicit/assem_s8.F
!||    mmat_h1        ../engine/source/elements/solid/solide8z/mmat_h1.F
!||    mmats          ../engine/source/elements/solid/solide8z/mmats.F
!||    mmstifs        ../engine/source/elements/solid/solide8z/mmstifs.F
!||    s8eoff         ../engine/source/elements/solid/solide8/s8eoff.F
!||    s8zcumg3       ../engine/source/elements/solid/solide8z/s8zcumg3.f
!||    s8zderi3       ../engine/source/elements/solid/solide8z/s8zderi3.f
!||    s8zderict3     ../engine/source/elements/solid/solide8z/s8zderict3.F
!||    s8zkgei3       ../engine/source/elements/solid/solide8z/s8zkgei3.F
!||    s8zkgeo3       ../engine/source/elements/solid/solide8z/s8zkgeo3.F
!||    s8zlke3        ../engine/source/elements/solid/solide8z/s8zlke3.f
!||    s8zlkep3       ../engine/source/elements/solid/solide8z/s8zlkep3.F
!||    s8zsigp3       ../engine/source/elements/solid/solide8z/s8zsigp3.F
!||    srcoork        ../engine/source/elements/solid/solide8z/srcoork.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||====================================================================
      SUBROUTINE s8cke3(
     1   PM,       GEO,      IXS,      X,
     2   ELBUF_STR,NEL,      ICP,      ICSIG,
     3   ETAG,     IDDL,     NDOF,     K_DIAG,
     4   K_LT,     IADK,     JDIK,     IPM,
     5   IGEO,     IKGEO,    BUFMAT,   NFT,
     6   MTN,      JHBE,     JCVT,     IGTYP,
     7   ISORTH,   IREP,     ISMSTR)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod            
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: IREP
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(IN) :: MTN
      INTEGER, INTENT(IN) :: JHBE
      INTEGER, INTENT(IN) :: JCVT
      INTEGER, INTENT(IN) :: IGTYP
      INTEGER, INTENT(IN) :: ISORTH
      INTEGER  NEL ,ICP, ICSIG,IKGEO
      INTEGER NDOF(*)  ,IADK(*) ,JDIK(*),
     .   ixs(nixs,*),ipm(npropmi,*),igeo(npropgi,*),etag(*),iddl(*)  
C
      my_real
     .   pm(npropm,*), geo(npropg,*), x(*),
     .   k11(9,mvsiz) , k12(9,mvsiz)  ,k13(9,mvsiz) ,k14(9,mvsiz)  ,
     .   k15(9,mvsiz) , k16(9,mvsiz)  ,k17(9,mvsiz) ,k18(9,mvsiz)  ,
     .   k22(9,mvsiz)  ,k23(9,mvsiz)  ,k24(9,mvsiz) ,k25(9,mvsiz) ,
     .   k26(9,mvsiz)  ,k27(9,mvsiz)  ,k28(9,mvsiz) ,k33(9,mvsiz) ,
     .   k34(9,mvsiz)  ,k35(9,mvsiz)  ,k36(9,mvsiz) ,k37(9,mvsiz) ,
     .   k38(9,mvsiz)  ,k44(9,mvsiz)  ,k45(9,mvsiz) ,k46(9,mvsiz) ,
     .   k47(9,mvsiz)  ,k48(9,mvsiz)  ,k55(9,mvsiz) ,k56(9,mvsiz) ,
     .   k57(9,mvsiz)  ,k58(9,mvsiz)  ,k66(9,mvsiz) ,k67(9,mvsiz) ,
     .   k68(9,mvsiz)  ,k77(9,mvsiz)  ,k78(9,mvsiz) ,k88(9,mvsiz) ,
     .   offg(mvsiz)    ,bufmat(*)   ,k_diag(*)   ,k_lt(*)
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER LCO,NF1,IFLAG,NB3S,I,J,IKSUP,IKORTH,IADBUF,IPREDU
      INTEGER IR, IS, IT,IL,IP,ICR,ICS,ICT,ICPG,PID,
     .     NPTR,NPTS,NPTT,NLAY,IAD0,NPPT,MX
      INTEGER MXT(MVSIZ),NGL(MVSIZ),NGEO(MVSIZ),IDEG(MVSIZ)
      my_real
     . VOLN(MVSIZ), DELTAX(MVSIZ),
     . AJC1(MVSIZ) , AJC2(MVSIZ) , AJC3(MVSIZ) ,
     . ajc4(mvsiz) , ajc5(mvsiz) , ajc6(mvsiz) ,
     . ajc7(mvsiz) , ajc8(mvsiz) , ajc9(mvsiz) ,
     . aj1(mvsiz) , aj2(mvsiz) , aj3(mvsiz) ,
     . aj4(mvsiz) , aj5(mvsiz) , aj6(mvsiz) , 
     . aj7(mvsiz) , aj8(mvsiz) , aj9(mvsiz) 
C----------------
      INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ), 
     .        NC5(MVSIZ), NC6(MVSIZ), NC7(MVSIZ), NC8(MVSIZ)
      my_real
     .   OFF(MVSIZ) , RHOO(MVSIZ),
     .   X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
     .   X5(MVSIZ), X6(MVSIZ), X7(MVSIZ), X8(MVSIZ),
     .   Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
     .   y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
     .   z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .   z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
     .  vx1(mvsiz),vx2(mvsiz),vx3(mvsiz),vx4(mvsiz),
     .  vx5(mvsiz),vx6(mvsiz),vx7(mvsiz),vx8(mvsiz),
     .  vy1(mvsiz),vy2(mvsiz),vy3(mvsiz),vy4(mvsiz),
     .  vy5(mvsiz),vy6(mvsiz),vy7(mvsiz),vy8(mvsiz),
     .  vz1(mvsiz),vz2(mvsiz),vz3(mvsiz),vz4(mvsiz),
     .  vz5(mvsiz),vz6(mvsiz),vz7(mvsiz),vz8(mvsiz),
     .  hx1(mvsiz),hx2(mvsiz),hx3(mvsiz),hx4(mvsiz),
     .  hy1(mvsiz),hy2(mvsiz),hy3(mvsiz),hy4(mvsiz),
     .  hz1(mvsiz),hz2(mvsiz),hz3(mvsiz),hz4(mvsiz),
     .  px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
     .  px5(mvsiz),px6(mvsiz),px7(mvsiz),px8(mvsiz),
     .  py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
     .  py5(mvsiz),py6(mvsiz),py7(mvsiz),py8(mvsiz),
     .  pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
     .  pz5(mvsiz),pz6(mvsiz),pz7(mvsiz),pz8(mvsiz),
     .  pxy1(mvsiz),pxy2(mvsiz),pxy3(mvsiz),pxy4(mvsiz),
     .  pxy5(mvsiz),pxy6(mvsiz),pxy7(mvsiz),pxy8(mvsiz),
     .  pyx1(mvsiz),pyx2(mvsiz),pyx3(mvsiz),pyx4(mvsiz),
     .  pyx5(mvsiz),pyx6(mvsiz),pyx7(mvsiz),pyx8(mvsiz),
     .  pxz1(mvsiz),pxz2(mvsiz),pxz3(mvsiz),pxz4(mvsiz),
     .  pxz5(mvsiz),pxz6(mvsiz),pxz7(mvsiz),pxz8(mvsiz),
     .  pzx1(mvsiz),pzx2(mvsiz),pzx3(mvsiz),pzx4(mvsiz),
     .  pzx5(mvsiz),pzx6(mvsiz),pzx7(mvsiz),pzx8(mvsiz),
     .  pyz1(mvsiz),pyz2(mvsiz),pyz3(mvsiz),pyz4(mvsiz),
     .  pyz5(mvsiz),pyz6(mvsiz),pyz7(mvsiz),pyz8(mvsiz),
     .  pzy1(mvsiz),pzy2(mvsiz),pzy3(mvsiz),pzy4(mvsiz),
     .  pzy5(mvsiz),pzy6(mvsiz),pzy7(mvsiz),pzy8(mvsiz),
     .  pxc1(mvsiz),pxc2(mvsiz),pxc3(mvsiz),pxc4(mvsiz),
     .  pyc1(mvsiz),pyc2(mvsiz),pyc3(mvsiz),pyc4(mvsiz),
     .  pzc1(mvsiz),pzc2(mvsiz),pzc3(mvsiz),pzc4(mvsiz),
     .  bxy1(mvsiz),bxy2(mvsiz),bxy3(mvsiz),bxy4(mvsiz),
     .  bxy5(mvsiz),bxy6(mvsiz),bxy7(mvsiz),bxy8(mvsiz),
     .  byx1(mvsiz),byx2(mvsiz),byx3(mvsiz),byx4(mvsiz),
     .  byx5(mvsiz),byx6(mvsiz),byx7(mvsiz),byx8(mvsiz),
     .  bxz1(mvsiz),bxz2(mvsiz),bxz3(mvsiz),bxz4(mvsiz),
     .  bxz5(mvsiz),bxz6(mvsiz),bxz7(mvsiz),bxz8(mvsiz),
     .  bzx1(mvsiz),bzx2(mvsiz),bzx3(mvsiz),bzx4(mvsiz),
     .  bzx5(mvsiz),bzx6(mvsiz),bzx7(mvsiz),bzx8(mvsiz),
     .  byz1(mvsiz),byz2(mvsiz),byz3(mvsiz),byz4(mvsiz),
     .  byz5(mvsiz),byz6(mvsiz),byz7(mvsiz),byz8(mvsiz),
     .  bzy1(mvsiz),bzy2(mvsiz),bzy3(mvsiz),bzy4(mvsiz),
     .  bzy5(mvsiz),bzy6(mvsiz),bzy7(mvsiz),bzy8(mvsiz),
     .  px1h1(mvsiz),px2h1(mvsiz),px3h1(mvsiz),px4h1(mvsiz),
     .  px1h2(mvsiz),px2h2(mvsiz),px3h2(mvsiz),px4h2(mvsiz),
     .  px1h3(mvsiz),px2h3(mvsiz),px3h3(mvsiz),px4h3(mvsiz),
     .  px1h4(mvsiz),px2h4(mvsiz),px3h4(mvsiz),px4h4(mvsiz),
     .   hx(mvsiz,4), hy(mvsiz,4),  hz(mvsiz,4) 
      my_real
     .   r11(mvsiz),r12(mvsiz),r13(mvsiz),
     .   r21(mvsiz),r22(mvsiz),r23(mvsiz),
     .   r31(mvsiz),r32(mvsiz),r33(mvsiz),
     .   g1x(mvsiz),g2x(mvsiz),g3x(mvsiz),
     .   g1y(mvsiz),g2y(mvsiz),g3y(mvsiz),
     .   g1z(mvsiz),g2z(mvsiz),g3z(mvsiz)
      my_real
     .   bid,wi,smax(mvsiz),volg(mvsiz),nu(mvsiz),pp(mvsiz),usb(mvsiz),
     .   volm(mvsiz),sigm(mvsiz),nu1(mvsiz),gama(mvsiz,6)
      TYPE(g_bufel_)  ,POINTER :: GBUF     
      TYPE(L_BUFEL_)  ,POINTER :: LBUF     
      my_real
     .  W_GAUSS(9,9),A_GAUSS(9,9)
      DATA w_gauss / 
     1 2.               ,0.               ,0.               ,
     1 0.               ,0.               ,0.               ,
     1 0.               ,0.               ,0.               ,
     2 1.               ,1.               ,0.               ,
     2 0.               ,0.               ,0.               ,
     2 0.               ,0.               ,0.               ,
     3 0.555555555555556,0.888888888888889,0.555555555555556,
     3 0.               ,0.               ,0.               ,
     3 0.               ,0.               ,0.               ,
     4 0.347854845137454,0.652145154862546,0.652145154862546,
     4 0.347854845137454,0.               ,0.               ,
     4 0.               ,0.               ,0.               ,
     5 0.236926885056189,0.478628670499366,0.568888888888889,
     5 0.478628670499366,0.236926885056189,0.               ,
     5 0.               ,0.               ,0.               ,
     6 0.171324492379170,0.360761573048139,0.467913934572691,
     6 0.467913934572691,0.360761573048139,0.171324492379170,
     6 0.               ,0.               ,0.               ,
     7 0.129484966168870,0.279705391489277,0.381830050505119,
     7 0.417959183673469,0.381830050505119,0.279705391489277,
     7 0.129484966168870,0.               ,0.               ,
     8 0.101228536290376,0.222381034453374,0.313706645877887,
     8 0.362683783378362,0.362683783378362,0.313706645877887,
     8 0.222381034453374,0.101228536290376,0.               ,
     9 0.081274388361574,0.180648160694857,0.260610696402935,
     9 0.312347077040003,0.330239355001260,0.312347077040003,
     9 0.260610696402935,0.180648160694857,0.081274388361574/
      DATA a_gauss / 
     1 0.               ,0.               ,0.               ,
     1 0.               ,0.               ,0.               ,
     1 0.               ,0.               ,0.               ,
     2 -.577350269189626,0.577350269189626,0.               ,
     2 0.               ,0.               ,0.               ,
     2 0.               ,0.               ,0.               ,
     3 -.774596669241483,0.               ,0.774596669241483,
     3 0.               ,0.               ,0.               ,
     3 0.               ,0.               ,0.               ,
     4 -.861136311594053,-.339981043584856,0.339981043584856,
     4 0.861136311594053,0.               ,0.               ,
     4 0.               ,0.               ,0.               ,
     5 -.906179845938664,-.538469310105683,0.               ,
     5 0.538469310105683,0.906179845938664,0.               ,
     5 0.               ,0.               ,0.               ,
     6 -.932469514203152,-.661209386466265,-.238619186083197,
     6 0.238619186083197,0.661209386466265,0.932469514203152,
     6 0.               ,0.               ,0.               ,
     7 -.949107912342759,-.741531185599394,-.405845151377397,
     7 0.               ,0.405845151377397,0.741531185599394,
     7 0.949107912342759,0.               ,0.               ,
     8 -.960289856497536,-.796666477413627,-.525532409916329,
     8 -.183434642495650,0.183434642495650,0.525532409916329,
     8 0.796666477413627,0.960289856497536,0.               ,
     9 -.968160239507626,-.836031107326636,-.613371432700590,
     9 -.324253423403809,0.               ,0.324253423403809,
     9 0.613371432700590,0.836031107326636,0.968160239507626/
 
       my_real
     .      hh(2,mvsiz),fac(mvsiz),c1,e0(mvsiz),dd(9,mvsiz),gg(mvsiz),
     .      dm(9,mvsiz),gm(9,mvsiz),dgm(9,mvsiz),dg(9,mvsiz),
     .      g33(9,mvsiz),hh1(2,mvsiz)
C----HH(1,):lamda,HH(2,):G; HH1 :effective lamda,g for Icpre=1
      DOUBLE PRECISION 
     .   VOLDP(MVSIZ)
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      gbuf => elbuf_str%GBUF
      nlay = elbuf_str%NLAY
      nptr = elbuf_str%NPTR
      npts = elbuf_str%NPTS
      nptt = elbuf_str%NPTT
      iad0 = 1
      IF (isorth > 0) iad0 = 1 + 6*nel
      IF (igtyp == 21.OR.igtyp == 22) THEN
       ikorth=2
      ELSEIF (isorth>0) THEN
       ikorth=1
      ELSE
       ikorth=0
      ENDIF
C-----------
      nf1=nft+1
C-----------
      CALL srcoork(
     1   x,         ixs(1,nf1),x1,        x2,
     2   x3,        x4,        x5,        x6,
     3   x7,        x8,        y1,        y2,
     4   y3,        y4,        y5,        y6,
     5   y7,        y8,        z1,        z2,
     6   z3,        z4,        z5,        z6,
     7   z7,        z8,        gbuf%OFF,  offg,
     8   gbuf%SMSTR,r11,       r12,       r13,
     9   r21,       r22,       r23,       r31,
     a   r32,       r33,       nc1,       nc2,
     b   nc3,       nc4,       nc5,       nc6,
     c   nc7,       nc8,       ngl,       mxt,
     d   ngeo,      k11,       k12,       k13,
     e   k14,       k15,       k16,       k17,
     f   k18,       k22,       k23,       k24,
     g   k25,       k26,       k27,       k28,
     h   k33,       k34,       k35,       k36,
     i   k37,       k38,       k44,       k45,
     j   k46,       k47,       k48,       k55,
     k   k56,       k57,       k58,       k66,
     l   k67,       k68,       k77,       k78,
     m   k88,       jhbe,      gbuf%GAMA, gama,
     n   nel,       ismstr,    jhbe,      jcvt,
     o   irep,      igtyp,     isorth)
C
      pid=ngeo(1)
C      IGTYP=NINT(GEO(12,PID))
C      CALL GET_GAMA(MTN,NEL,NBGAMA,JCVT,PM,IXS(1,NF1),IGTYP)
      mx = mxt(1)
      DO i=1,nel
        nu(i)=min(half,pm(21,mx))
        c1 =pm(32,mx)
        e0(i) =three*(one-two*nu(1))*c1
        deltax(i)=ep30
                ideg(i)=0
      ENDDO
      IF (jhbe/=14.AND.jhbe<20) THEN
        DO i=1,nel
          nu(i)=zero
        ENDDO
      ENDIF 
      icpg = icp
      IF (jhbe/=14.AND.jhbe/=17.AND.jhbe/=24) THEN
        icpg = 1
      ENDIF 
c
      CALL s8zderict3(
     1   offg,    volg,    ngl,     x1,
     2   x2,      x3,      x4,      x5,
     3   x6,      x7,      x8,      y1,
     4   y2,      y3,      y4,      y5,
     5   y6,      y7,      y8,      z1,
     6   z2,      z3,      z4,      z5,
     7   z6,      z7,      z8,      pxc1,
     8   pxc2,    pxc3,    pxc4,    pyc1,
     9   pyc2,    pyc3,    pyc4,    pzc1,
     a   pzc2,    pzc3,    pzc4,    px1h1,
     b   px1h2,   px1h3,   px1h4,   px2h1,
     c   px2h2,   px2h3,   px2h4,   px3h1,
     d   px3h2,   px3h3,   px3h4,   px4h1,
     e   px4h2,   px4h3,   px4h4,   hx,
     f   hy,      hz,      ajc1,    ajc2,
     g   ajc3,    ajc4,    ajc5,    ajc6,
     h   ajc7,    ajc8,    ajc9,    smax,
     i   nel)
      IF (icpg==2) THEN
       CALL s8zsigp3(1  ,nel       ,gbuf%SIG,e0  ,gbuf%PLA,
     2               fac  ,gbuf%G_PLA,nel     )
       DO i=1,nel
        nu1(i)=nu(i)+(half-nu(i))*fac(i)
       ENDDO
      ELSE
       DO i=1,nel
        nu1(i)=nu(i)
       ENDDO
      ENDIF 
      IF (mtn>=28) THEN
       iadbuf = ipm(7,mxt(1))
      ELSE
       iadbuf = 1
      ENDIF
      nppt = npts*nptt*nptr*nlay
      CALL mmats(1    ,nel     ,pm    ,mxt    ,hh    ,
     .           mtn    ,ikorth  ,ipm   ,igeo   ,gama  ,
     .           bufmat(iadbuf)  ,dm    ,dgm    ,gm    ,
     .           jhbe  ,gbuf%SIG ,bid   ,nppt   ,nel   )
      CALL mmat_h1(
     1   hh,      hh1,     fac,     icpg,
     2   ipredu,  nel,     mtn,     ismstr,
     3   jhbe)
 
C-----------Matrix B----------
C-----------Begin integrating points-----
      it = 1
      DO ir=1,nptr
       DO is=1,npts
        DO il=1,nlay
         lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
C-----------
         ip = ir + ( (is-1) + (il-1)*npts )*nptr
         wi = w_gauss(ir,nptr)*w_gauss(is,npts)*w_gauss(il,nptt)
C
         CALL s8zderi3(
     1   offg,            off,             voln,            ngl,
     2   a_gauss(ir,nptr),a_gauss(is,npts),a_gauss(il,nptt),wi,
     3   pxc1,            pxc2,            pxc3,            pxc4,
     4   pyc1,            pyc2,            pyc3,            pyc4,
     5   pzc1,            pzc2,            pzc3,            pzc4,
     6   px1h1,           px1h2,           px1h3,           px1h4,
     7   px2h1,           px2h2,           px2h3,           px2h4,
     8   px3h1,           px3h2,           px3h3,           px3h4,
     9   px4h1,           px4h2,           px4h3,           px4h4,
     a   hx,              hy,              hz,              px1,
     b   px2,             px3,             px4,             px5,
     c   px6,             px7,             px8,             py1,
     d   py2,             py3,             py4,             py5,
     e   py6,             py7,             py8,             pz1,
     f   pz2,             pz3,             pz4,             pz5,
     g   pz6,             pz7,             pz8,             pxy1,
     h   pxy2,            pxy3,            pxy4,            pxy5,
     i   pxy6,            pxy7,            pxy8,            pyx1,
     j   pyx2,            pyx3,            pyx4,            pyx5,
     k   pyx6,            pyx7,            pyx8,            pxz1,
     l   pxz2,            pxz3,            pxz4,            pxz5,
     m   pxz6,            pxz7,            pxz8,            pzx1,
     n   pzx2,            pzx3,            pzx4,            pzx5,
     o   pzx6,            pzx7,            pzx8,            pyz1,
     p   pyz2,            pyz3,            pyz4,            pyz5,
     q   pyz6,            pyz7,            pyz8,            pzy1,
     r   pzy2,            pzy3,            pzy4,            pzy5,
     s   pzy6,            pzy7,            pzy8,            bxy1,
     t   bxy2,            bxy3,            bxy4,            bxy5,
     u   bxy6,            bxy7,            bxy8,            byx1,
     v   byx2,            byx3,            byx4,            byx5,
     w   byx6,            byx7,            byx8,            bxz1,
     x   bxz2,            bxz3,            bxz4,            bxz5,
     y   bxz6,            bxz7,            bxz8,            bzx1,
     z   bzx2,            bzx3,            bzx4,            bzx5,
     1   bzx6,            bzx7,            bzx8,            byz1,
     2   byz2,            byz3,            byz4,            byz5,
     3   byz6,            byz7,            byz8,            bzy1,
     4   bzy2,            bzy3,            bzy4,            bzy5,
     5   bzy6,            bzy7,            bzy8,            ajc1,
     6   ajc2,            ajc3,            ajc4,            ajc5,
     7   ajc6,            ajc7,            ajc8,            ajc9,
     8   aj1,             aj2,             aj3,             aj4,
     9   aj5,             aj6,             smax,            deltax,
     a   nu1,             icpg,            ideg,            voldp,
     b   nel,             mtn,             ismstr,          jhbe)
       CALL mmstifs(
     1   pm,      mxt,     hh1,     voln,
     2   icsig,   dd,      gg,      dg,
     3   g33,     dm,      gm,      dgm,
     4   ikorth,  lbuf%SIG,ir,      is,
     5   il,      nel,     jhbe,    mtn)
C-----------  check MPT sont memes entre KE et forc3----     
       CALL s8zlke3(
     1   px1,     px2,     px3,     px4,
     2   py1,     py2,     py3,     py4,
     3   pz1,     pz2,     pz3,     pz4,
     4   px5,     px6,     px7,     px8,
     5   py5,     py6,     py7,     py8,
     6   pz5,     pz6,     pz7,     pz8,
     7   pxy1,    pxy2,    pxy3,    pxy4,
     8   pxy5,    pxy6,    pxy7,    pxy8,
     9   pyx1,    pyx2,    pyx3,    pyx4,
     a   pyx5,    pyx6,    pyx7,    pyx8,
     b   pxz1,    pxz2,    pxz3,    pxz4,
     c   pxz5,    pxz6,    pxz7,    pxz8,
     d   pzx1,    pzx2,    pzx3,    pzx4,
     e   pzx5,    pzx6,    pzx7,    pzx8,
     f   pyz1,    pyz2,    pyz3,    pyz4,
     g   pyz5,    pyz6,    pyz7,    pyz8,
     h   pzy1,    pzy2,    pzy3,    pzy4,
     i   pzy5,    pzy6,    pzy7,    pzy8,
     j   bxy1,    bxy2,    bxy3,    bxy4,
     k   bxy5,    bxy6,    bxy7,    bxy8,
     l   byx1,    byx2,    byx3,    byx4,
     m   byx5,    byx6,    byx7,    byx8,
     n   bxz1,    bxz2,    bxz3,    bxz4,
     o   bxz5,    bxz6,    bxz7,    bxz8,
     p   bzx1,    bzx2,    bzx3,    bzx4,
     q   bzx5,    bzx6,    bzx7,    bzx8,
     r   byz1,    byz2,    byz3,    byz4,
     s   byz5,    byz6,    byz7,    byz8,
     t   bzy1,    bzy2,    bzy3,    bzy4,
     u   bzy5,    bzy6,    bzy7,    bzy8,
     v   k11,     k12,     k13,     k14,
     w   k15,     k16,     k17,     k18,
     x   k22,     k23,     k24,     k25,
     y   k26,     k27,     k28,     k33,
     z   k34,     k35,     k36,     k37,
     1   k38,     k44,     k45,     k46,
     2   k47,     k48,     k55,     k56,
     3   k57,     k58,     k66,     k67,
     4   k68,     k77,     k78,     k88,
     5   dd,      gg,      icpg,    offg,
     6   ikorth,  dg,      g33,     nel)
      IF (ikgeo<0.AND.jhbe==14) THEN
       CALL s8zkgei3(
     1   lbuf%SIG,voln,    px1,     px2,
     2   px3,     px4,     py1,     py2,
     3   py3,     py4,     pz1,     pz2,
     4   pz3,     pz4,     px5,     px6,
     5   px7,     px8,     py5,     py6,
     6   py7,     py8,     pz5,     pz6,
     7   pz7,     pz8,     k11,     k12,
     8   k13,     k14,     k15,     k16,
     9   k17,     k18,     k22,     k23,
     a   k24,     k25,     k26,     k27,
     b   k28,     k33,     k34,     k35,
     c   k36,     k37,     k38,     k44,
     d   k45,     k46,     k47,     k48,
     e   k55,     k56,     k57,     k58,
     f   k66,     k67,     k68,     k77,
     g   k78,     k88,     nel)
      ENDIF 
        ENDDO 
       ENDDO 
      ENDDO
C-------------      
      IF (ipredu > 0) THEN
       CALL s8zlkep3(
     1   pxc1,    pxc2,    pxc3,    pxc4,
     2   pyc1,    pyc2,    pyc3,    pyc4,
     3   pzc1,    pzc2,    pzc3,    pzc4,
     4   k11,     k12,     k13,     k14,
     5   k15,     k16,     k17,     k18,
     6   k22,     k23,     k24,     k25,
     7   k26,     k27,     k28,     k33,
     8   k34,     k35,     k36,     k37,
     9   k38,     k44,     k45,     k46,
     a   k47,     k48,     k55,     k56,
     b   k57,     k58,     k66,     k67,
     c   k68,     k77,     k78,     k88,
     d   hh,      volg,    fac,     icpg,
     e   nel)
      END IF 
C------due to the generic form, only the mean geometrical stiffness is considered
      IF (ikgeo>0) THEN
       CALL s8zkgeo3(
     1   gbuf%SIG,volg,    pxc1,    pxc2,
     2   pxc3,    pxc4,    pyc1,    pyc2,
     3   pyc3,    pyc4,    pzc1,    pzc2,
     4   pzc3,    pzc4,    k11,     k12,
     5   k13,     k14,     k15,     k16,
     6   k17,     k18,     k22,     k23,
     7   k24,     k25,     k26,     k27,
     8   k28,     k33,     k34,     k35,
     9   k36,     k37,     k38,     k44,
     a   k45,     k46,     k47,     k48,
     b   k55,     k56,     k57,     k58,
     c   k66,     k67,     k68,     k77,
     d   k78,     k88,     nel)
      ENDIF 
C----------------------------
C     CONVECTE --> GLOBAL.
C----------------------------
      CALL s8zcumg3(
     1   r11,     r21,     r31,     r12,
     2   r22,     r32,     r13,     r23,
     3   r33,     k11,     k12,     k13,
     4   k14,     k15,     k16,     k17,
     5   k18,     k22,     k23,     k24,
     6   k25,     k26,     k27,     k28,
     7   k33,     k34,     k35,     k36,
     8   k37,     k38,     k44,     k45,
     9   k46,     k47,     k48,     k55,
     a   k56,     k57,     k58,     k66,
     b   k67,     k68,     k77,     k78,
     c   k88,     nel)
     
      IF (neig>0) CALL s8eoff(
     1   1, nel, ixs(1,nf1), etag, offg)
      CALL assem_s8(
     1    ixs(1,nf1),nel   ,iddl  ,ndof  ,k_diag,
     2    k_lt  ,iadk  ,jdik  ,k11   ,k12   ,     
     3    k13   ,k14   ,k15   ,k16   ,k17   ,
     4    k18   ,k22   ,k23   ,k24   ,k25   ,
     5    k26   ,k27   ,k28   ,k33   ,k34   ,
     6    k35   ,k36   ,k37   ,k38   ,k44   ,
     7    k45   ,k46   ,k47   ,k48   ,k55   ,
     8    k56   ,k57   ,k58   ,k66   ,k67   ,
     9    k68   ,k77   ,k78   ,k88   ,offg   )     
C-----------
      RETURN
      END