C
C =====================================================================
C ======================== A S S E M B ================================
C =====================================================================
C
      SUBROUTINE ASSEMB(SKG,SKGL,R,U,IDOF,JDIAG,NTSK,MBAND,I_OUT)
C
C =====================================================================
C I                                                                   I
C I   P R O G R A M                                                   I
C I                                                                   I
C I   SUBROUTINE ASSEMB ASSEMBLES THE GLOBAL STIFFNESS MATRIX AND/OR  I
C I   STORES THE NODE NUMBERS OF THE CURRENT ELEMENT AND THE POSITION I
C I   OF THE ELEMENT MATRICES IN THE GLOBAL MATRICES.                 I
C I                                                                   I
C I                                                                   I
C I   A R G U M E N T     L I S T                                     I
C I                                                                   I
C I   SKG(I)   =  GLOBAL STIFFNESS MATRIX STORED IN A ONE DIMENSIONAL I
C I               ARRAY USING THE SKYLINE METHOD                      I
C I   R(I)     =  LOAD VECTOR                                         I
C I   U(I)     =  VECTOR OF THE IMPOSED NODAL DISPLACEMENTS           I
C I   IDOF(I)  =  VECTOR CONTAINING THE D.O.F. NUMBERS THE JOINTS     I
C I   JDIAG(I) =  LOCATION OF THE DIAGONAL TERMS OF EACH COLUMN IN    I
C I               THE GLOBAL STIFFNESS MATRIX 'SKG'                   I
C I   NTSK     =  NUMBER OF TERMS IN THE SKG MATRIX                   I
C I   SYMMETRIC   =  TRUE; SYMMETRIC STIFFNESS MATRIX                 I
C I                  FALSE; NONSYMMETRIC STIFFNESS MATRIX             I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEMENTS,MAX_ELEM_NODES,MAX_ELEM_STIFF,MNNDF
      INTEGER STRS_STRN_REL,AXISYMMETRIC
      PARAMETER (AXISYMMETRIC=3)
      PARAMETER (MAX_ELEMENTS=400,MAX_ELEM_NODES=20)
      PARAMETER (MAX_ELEM_STIFF=60,MNNDF=3)
      INTEGER ELNUM,ELEM_TYPE,SAVED_ETYPE,I1,I2,IDIM,INCREMENTS
      INTEGER ISTART,ITERATIONS,I_OUT,JDOF,K,K1,K2,LINES,LOCA,LOCD
      INTEGER MATNUM,MBAN,MBAND,NCB,NDOF,NELEM,NINODE,NOP,NIP,INTCOD
      INTEGER NNDF,NNEL,NNODES,NRB,NTSK,IDOF(*),II,JDIAG(*)
      INTEGER NIPXI,NIPETA,NIPSI
      REAL*8 THICK,R(*),SK,SKG(*),SKGL(*),U(*),ZERO
      LOGICAL LINEAR,SYMMETRIC
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT8/NNODES,NELEM,NNDF,INCREMENTS,ITERATIONS,LINEAR,
     .              SYMMETRIC,IDIM,NINODE
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/ELST1/SK(MAX_ELEM_STIFF,MAX_ELEM_STIFF)
      COMMON/ASSEM2/II(MAX_ELEM_STIFF)
C
      DATA ZERO /0.0D0/
C
C        INITIALIZE THE GLOBAL STIFFNESS MATRIX TO ZERO
C
      IF (SYMMETRIC) THEN
        DO K1 = 1 , NTSK
          SKG( K1 )=ZERO
        END DO
      ELSE
        DO K1 = 1 , NTSK/2
          SKG( K1 ) = ZERO
          SKGL( K1 ) = ZERO
        END DO
      END IF
C
C           NCB = NUMBER OF COLUMNS IN THE <B> MATRIX.
C           NRB = NUMBER OF ROWS IN THE <B> MATRIX.
C           NNEL = NUMBER OF NODES IN THE ELEMENT.
C           MBAN = FULL BANDWIDTH OF THE STIFFNESS MATRIX
C
      MBAN = MBAND*2 - 1
      SAVED_ETYPE = 0
      DO ELNUM = 1 , NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NNEL,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        IF (ELEM_TYPE.NE.SAVED_ETYPE) THEN
          IF (ELEM_TYPE.GT.300) THEN
            NCB = 3*NNEL
            NRB = 6
            IF (INTCOD.GE.140) THEN
              CALL ISH3DI(ELEM_TYPE,NNEL)
            ELSE
              CALL ISH3DG(ELEM_TYPE,NNEL)
            END IF
          ELSE
            NCB = 2*NNEL
            CALL ISH2DG(ELEM_TYPE,NNEL)
            IF (STRS_STRN_REL.EQ.AXISYMMETRIC) THEN
              NRB = 4
            ELSE
              NRB = 3
            END IF
          END IF
        END IF
        SAVED_ETYPE = ELEM_TYPE
        DO K1 = 1 , NNEL
          I1 = NNDF*(K1 - 1)
          I2 = NNDF*(NOP(K1 , ELNUM) - 1)
          DO K2 = 1 , NNDF
            K = I1 + K2
            II( K ) = I2 + K2
          END DO
        END DO
C
C              GEOMETRICALLY NONLINEAR PROBLEMS
C
        IF (.NOT.LINEAR) THEN
          IF (ELEM_TYPE.GT.300) THEN
            CALL ES3DNS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .                  SYMMETRIC,I_OUT)
          ELSE
            CALL ES2DNS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .                  SYMMETRIC,I_OUT)
          END IF
C
C              GEOMETRICALLY LINEAR PROBLEMS
C
        ELSE IF(LINEAR) THEN
          IF (ELEM_TYPE.GT.300) THEN
            CALL ES3DLS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .                  SYMMETRIC,I_OUT)
          ELSE
            CALL ES2DLS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .                  SYMMETRIC,I_OUT)
          END IF
        END IF
        DO K1 = 1 , NCB
          NDOF = IDOF(II( K1 ))
          IF (NDOF.GT.0) THEN
            LOCD = JDIAG( NDOF )
            DO K2 = 1 , NCB
              JDOF = IDOF(II( K2 ))
              IF (SYMMETRIC) THEN
                IF (NDOF.GE.JDOF.AND.JDOF.GT.0) THEN
                  LOCA = LOCD + NDOF - JDOF
                  SKG( LOCA ) = SKG( LOCA ) + SK(K1 , K2)
                END IF
              ELSE
                IF (NDOF.GE.JDOF.AND.JDOF.GT.0) THEN
                  LOCA = LOCD - NDOF + JDOF
                  SKG( LOCA ) = SKG( LOCA ) + SK(K2 , K1)
                  SKGL( LOCA ) = SKGL( LOCA ) + SK(K1 , K2)
                END IF
              END IF
            END DO
          ELSE IF(NDOF.LT.0) THEN
            DO K2 = 1 , NCB
              JDOF = IDOF(II( K2 ))
              IF (JDOF.GT.0) THEN
                R( JDOF ) = R( JDOF ) - SK(K1 , K2)*U(II( K1 ))
              END IF
            END DO
          END IF
        END DO
      END DO
C
      END
C
C =====================================================================
C ========================== E L S T I F ==============================
C =====================================================================
C
      SUBROUTINE ELSTIF
C
C =====================================================================
C I                                                                   I
C I   P R O G R A M                                                   I
C I                                                                   I
C I   ELSTIF EVALUATES THE STIFFNESS MATIRIX OF EACH ELEM.            I
C I                                                                   I
C I   E N T R Y    P O I N T S                                        I
C I                                                                   I
C I   ES2DLS: FOR 2D PLANE STRESS, PLANE STRAIN AND AXISYMMETRIC      I
C I           PROBLEMS WITHOUT GEOMETRIC NONLIARITY.                  I
C I                                                                   I
C I   ES2DNS: FOR 2D PLANE STRESS, PLANE STRAIN AND AXISYMMETRIC      I
C I           PROBLEMS WITH GEOMETRIC NONLIEARITY.                    I
C I                                                                   I
C I   ES3DLS: FOR 3D STRAIN FIELDS WITHOUT GEOM. NONLINEARITY         I
C I                                                                   I
C I   ES3DNS: FOR 3D STRAIN FIELDS WITH GEOMETRIC NONLINEARITY        I
C I                                                                   I
C I                                                                   I
C I   A R G U M E N T     L I S T                                     I
C I                                                                   I
C I   ELNUM     = ELEMENT NUMBER                                      I
C I                                                                   I
C I   NNEL      = NUMBER OF NODES IN THE ELEMENT                      I
C I                                                                   I
C I   NRB       = NUMBER OF ROWS OF THE <B> MATRIX                    I
C I                                                                   I
C I   NCB       = NUMBER OF COLUMNS OF THE <B> MATRIX                 I
C I                                                                   I
C I   NIP       = TOTAL NUMBER OF INTEGRATION POINTS IN THE ELEM.     I
C I                                                                   I
C I   MATNUM    = MATERIAL NUMBER FOR THE ELEMENT                     I
C I                                                                   I
C I   STRS_STRN_REL = 1(PLANE_STRESS): PLANE STRESS PROBLEM (ES2DLS , I
C I                                    ES2DNS ONLY)                   I
C I                   2(PLANE_STRAIN): PLANE STRAIN PROBLEM (ES2DLS , I
C I                                    ES2DNS ONLY)                   I
C I                   3(AXISYMMETRIC): AXISYMMETRIC PROBLEM (ES2DLS , I
C I                                    ES2DNS ONLY)                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEM_NODES,MAX_GAUSS_PTS,MAX_ELEM_STIFF
      INTEGER STRS_STRN_REL,AXISYMMETRIC
      INTEGER EVAL_STIFF
      PARAMETER (EVAL_STIFF=0)
      PARAMETER (AXISYMMETRIC=3)
      PARAMETER (MAX_ELEM_NODES=20,MAX_GAUSS_PTS=27,MAX_ELEM_STIFF=60)
      REAL*8 N,NXI,NETA,NSI,NX,NY,NZ,B1,B2,B3,B4,CST,DETJAC,RAD,SX,SXY
      REAL*8 SXZ,SY,SYZ,SZ,THICK,STRESS(6),W,SK,ZERO,ONE
      INTEGER ELNUM,ELEM_TYPE,INTGPN,I_OUT,K1,K11,K12,K13,K2,K21,K22
      INTEGER K23,LDEV,LDEV1,LDEV2,LDEV3,LDEV4,LDEVST,MATNUM,NCB,NIP
      INTEGER NNDF,NNEL,NRB
      LOGICAL SYMMETRIC
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/ISHAP2/W(MAX_GAUSS_PTS)
      COMMON/ELST1/SK(MAX_ELEM_STIFF,MAX_ELEM_STIFF)
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
      COMMON/ISHAP1/N(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NXI(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NETA(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NSI(MAX_ELEM_NODES,MAX_GAUSS_PTS)
      COMMON/JACOB1/NX(MAX_ELEM_NODES),NY(MAX_ELEM_NODES),
     .              NZ(MAX_ELEM_NODES)
C
      DATA ZERO,ONE /0.0D0,1.0D0/
C
C ======================== E N T R Y    E S 2 D L S ===================
C
      ENTRY ES2DLS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .             SYMMETRIC,I_OUT)
      CALL ZEROSK(NCB)
      DO INTGPN = 1 , NIP
        CALL JACB2D(INTGPN,ELNUM,NNEL,DETJAC)
        IF(STRS_STRN_REL.EQ.AXISYMMETRIC)
     .              CALL AXISYM(INTGPN,ELNUM,NNEL,RAD,THICK)
        CALL B2DLS(INTGPN,NNEL,RAD)
        CST = DETJAC*THICK*W( INTGPN )
        CALL MATMOD(ELNUM,ELEM_TYPE,MATNUM,INTGPN,STRS_STRN_REL,
     .              I_OUT,EVAL_STIFF)
        CALL BTDB(SYMMETRIC,NRB,NCB,CST)
      END DO
      CALL SKTRAN(ELNUM,NNEL,NNDF,NCB,2)
      RETURN
C
C ======================== E N T R Y    E S 2 D N S ===================
C
      ENTRY ES2DNS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .             SYMMETRIC,I_OUT)
      CALL ZEROSK(NCB)
      RAD = ONE
      DO INTGPN = 1 , NIP
        CALL JACB2D(INTGPN,ELNUM,NNEL,DETJAC)
        IF(STRS_STRN_REL.EQ.AXISYMMETRIC)
     .               CALL AXISYM(INTGPN,ELNUM,NNEL,RAD,THICK)
        CALL B2DNS(INTGPN,NNEL,RAD)
        CALL MATMOD(ELNUM,ELEM_TYPE,MATNUM,INTGPN,STRS_STRN_REL,
     .              I_OUT,EVAL_STIFF)
        CST = DETJAC*THICK*W( INTGPN )
        CALL BTDB(SYMMETRIC,NRB,NCB,CST)
        READ(LDEV) STRESS
        SX = STRESS( 1 )
        SY = STRESS( 2 )
        SZ = STRESS( 4 )
        SXY = STRESS( 3 )
        IF(STRS_STRN_REL.NE.AXISYMMETRIC) SZ = ZERO
C
C --- CALCULATION OF <G>TR <M><G>.
C
        DO K1 = 1 , NNEL
          K12 = 2*K1
          K11 = K12 - 1
          B1 = (NX(K1)*SX+NY(K1)*SXY)*CST
          B2 = (NX(K1)*SXY+NY(K1)*SY)*CST
          B3 = N(K1,INTGPN)*SZ*CST/RAD**2
          DO K2 = 1 , NNEL
            K22 = 2*K2
            K21 = K22 - 1
            B4 = NX(K2)*B1+NY(K2)*B2
            SK(K11,K21) = SK(K11,K21)+B4+N(K2,INTGPN)*B3
            SK(K12,K22) = SK(K12,K22)+B4
          END DO
        END DO
      END DO
      CALL SKTRAN(ELNUM,NNEL,NNDF,NCB,2)
      RETURN
C
C ======================== E N T R Y    E S 3 D L S ===================
C
      ENTRY ES3DLS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .             SYMMETRIC,I_OUT)
      CALL ZEROSK(NCB)
      DO INTGPN = 1 , NIP
        CALL JACB3D(INTGPN,ELNUM,NNEL,DETJAC)
        CALL B3DLS(NNEL)
        CALL MATMOD(ELNUM,ELEM_TYPE,MATNUM,INTGPN,STRS_STRN_REL,
     .              I_OUT,EVAL_STIFF)
        CST = DETJAC*W( INTGPN )
        CALL BTDB(SYMMETRIC,NRB,NCB,CST)
      END DO
      CALL SKTRAN(ELNUM,NNEL,NNDF,NCB,3)
      RETURN
C
C ======================== E N T R Y    E S 3 D N S ===================
C
      ENTRY ES3DNS(ELNUM,ELEM_TYPE,NNEL,NNDF,NRB,NCB,NIP,MATNUM,
     .             SYMMETRIC,I_OUT)
      CALL ZEROSK(NCB)
      DO INTGPN = 1 , NIP
        CALL JACB3D(INTGPN,ELNUM,NNEL,DETJAC)
        CALL B3DNS(NNEL)
        CALL MATMOD(ELNUM,ELEM_TYPE,MATNUM,INTGPN,STRS_STRN_REL,
     .              I_OUT,EVAL_STIFF)
        CST = DETJAC*W( INTGPN )
        CALL BTDB(SYMMETRIC,NRB,NCB,CST)
        READ(LDEV)STRESS
        SX = STRESS( 1 )
        SY = STRESS( 2 )
        SZ = STRESS( 3 )
        SXY = STRESS( 4 )
        SYZ = STRESS( 5 )
        SXZ = STRESS( 6 )
C
C --- CALCULATION OF <G>TR <M><G>.
C
        DO K1 = 1 , NNEL
          K13 = 3*K1
          K12 = K13 - 1
          K11 = K13 - 2
          B1 = (NX(K1)*SX + NY(K1)*SXY + NZ(K1)*SXZ)*CST
          B2 = (NX(K1)*SXY + NY(K1)*SY + NZ(K1)*SYZ)*CST
          B3 = (NX(K1)*SXZ + NY(K1)*SYZ + NZ(K1)*SZ)*CST
          DO K2 = 1 , NNEL
            K23 = 3*K2
            K22 = K23 - 1
            K21 = K23 - 2
            B4 = NX(K2)*B1 + NY(K2)*B2 + NZ(K2)*B3
            SK(K11,K21) = SK(K11,K21) + B4
            SK(K12,K22) = SK(K12,K22) + B4
            SK(K13,K23) = SK(K13,K23) + B4
          END DO
        END DO
      END DO
      CALL SKTRAN(ELNUM,NNEL,NNDF,NCB,3)
C
      END
C
C =====================================================================
C ======================= Z E R O S K =================================
C =====================================================================
C
      SUBROUTINE ZEROSK(N)
      IMPLICIT NONE
      INTEGER MAX_ELEM_STIFF
      PARAMETER (MAX_ELEM_STIFF=60)
      INTEGER K1,K2,N
      REAL*8 SK,ZERO
      COMMON/ELST1/SK(MAX_ELEM_STIFF,MAX_ELEM_STIFF)
C
      DATA ZERO /0.0D0/
C
      DO K2 = 1 , N
        DO K1 = 1 , N
          SK(K1 , K2) = ZERO
        END DO
      END DO
C
      END
C
C =====================================================================
C ========================== S K T R A N ==============================
C =====================================================================
C
      SUBROUTINE SKTRAN(ELNUM,NNEL,NNDF,NCB,IDIM)
C
C =====================================================================
C I                                                                   I
C I   P R O G R A M                                                   I
C I                                                                   I
C I   SKTRAN MODIFIES THE ELEMENT STIFFNESS MATRIX FOR THE SKEW       I
C I   BOUNDARY CONDITIONS USING <T>T<SK><T> TRANSFORMATION.           I
C I                                                                   I
C I   A R G U M E N T     L I S T                                     I
C I                                                                   I
C I   ELNUM     = ELEMENT NUMBER                                      I
C I                                                                   I
C I   NNEL      = NUMBER OF NODES IN THE ELEMENT                      I
C I                                                                   I
C I   NNDF      = NUMBER OF NODAL DEGREES OF FREEDOM                  I
C I                                                                   I
C I   NCB       = NUMBER OF COLUMNS OF THE <B> MATRIX                 I
C I                                                                   I
C I   IDIM      = PHYSICAL DIMENSION OF THE PROBLEM (I.E.,2D OR 3D)   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_ELEM_STIFF
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_ELEM_STIFF=60)
      INTEGER ELNUM,I,ICODE,ID,IDIM,IDIR,K1,K2,K3,NCB,NNDF,NNEL,NODE
      INTEGER ISPB,NOP
      REAL*8 CST(3),DC,SK,ZERO
      COMMON/ELST1/SK(MAX_ELEM_STIFF,MAX_ELEM_STIFF)
      COMMON/TRANS/DC(3,3)
      COMMON/INPUTE/ISPB(MAX_NODES)
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
C
      DATA ZERO /0.0D0/
C
      DO K1 = 1 , NNEL
        NODE = NOP(K1 , ELNUM)
        ICODE = ISPB(NODE)
        IF (ICODE.GT.0) THEN
          I = NNDF*(K1 - 1)
          CALL DIRCOS(ICODE,IDIM)
          DO K2 = 1 , NCB
            DO K3 = 1 , IDIM
              CST( K3 ) = ZERO
              DO IDIR = 1 , IDIM
                ID = I + IDIR
                CST( K3 ) = CST( K3 ) + SK(K2 , ID)*DC(IDIR , K3)
              END DO
            END DO
            DO K3 = 1 , IDIM
              ID = I + K3
              SK(K2 , ID) = CST( K3 )
            END DO
          END DO
          DO K2 = 1 , NCB
            DO K3 = 1 , IDIM
              CST( K3 ) = ZERO
              DO IDIR = 1 , IDIM
                ID = I + IDIR
                CST( K3 ) = CST( K3 ) + SK(ID , K2)*DC(IDIR , K3)
              END DO
            END DO
            DO K3 = 1 , IDIM
              ID = I + K3
              SK(ID , K2) = CST( K3 )
            END DO
          END DO
        END IF
      END DO
C
      END
C
C =====================================================================
C ========================== D I R C O S ==============================
C =====================================================================
C
      SUBROUTINE DIRCOS(ICODE,IDIM)
C
C =====================================================================
C I                                                                   I
C I   P R O G R A M                                                   I
C I                                                                   I
C I   DIRCOS EVALUATES THE DIRECTION COSINES OF THE Y_PRIM AND        I
C I   THE Z_PRIM AXES FOR SKEW BOUNDARY CONDITIONS USING THE          I
C I   DIRECTION COSINES OF THE X_PRIM (WHICH IS THE AXIS NORMAL TO    I
C I   THE PLANE OF THE ROLLER).                                       I
C I                                                                   I
C I                                                                   I
C I   A R G U M E N T     L I S T                                     I
C I                                                                   I
C I   ICODE     = ADDRESS OF THE DIRECTION COSINES OF THE X_PRIM      I
C I                                                                   I
C I   IDIM      = PHYSICAL DIMENSION OF THE PROBLEM (I.E.,2D OR 3D)   I
C I                                                                   I
C I                                                                   I
C I   C O M M O N    B L O C K S                                      I
C I                                                                   I
C I   COSTX(ICODE)  =  COSINE OF THETA_X                              I
C I                                                                   I
C I   COSTY(ICODE)  =  COSINE OF THETA_Y                              I
C I                                                                   I
C I   COSTZ(ICODE)  =  COSINE OF THETA_Z                              I
C I                                                                   I
C I   DC(I,J)       =  TRANSFORMATION MATRIX WHICH HAS ITS COLUMNS    I
C I                    EQUAL TO THE DIRECTION COSINES OF THE          I
C I                    X_PRIM, Y_PRIM, AND Z_PRIM AXES.               I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_SKEW_BC,ICODE,IDIM
      REAL*8 CNORM,TX,TY,TZ,COSTX,COSTY,COSTZ,DC,ZERO,ONE
      PARAMETER (MAX_SKEW_BC=300)
      COMMON/INPUTD/COSTX(MAX_SKEW_BC),COSTY(MAX_SKEW_BC),
     .              COSTZ(MAX_SKEW_BC)
      COMMON/TRANS/DC(3,3)
C
      DATA ZERO,ONE /0.0D0,1.0D0/
C
      IF(IDIM.EQ.2) THEN
        DC(1 , 1) = COSTX( ICODE )
        DC(2 , 1) = COSTY( ICODE )
        DC(1 , 2) = -COSTY( ICODE )
        DC(2 , 2) = COSTX( ICODE )
      ELSE IF(IDIM.EQ.3) THEN
        TX = COSTX( ICODE )
        TY = COSTY( ICODE )
        TZ = COSTZ( ICODE )
        DC(1 , 1) = TX
        DC(2 , 1) = TY
        DC(3 , 1) = TZ
        CNORM = DSQRT(TY**2 + TX**2)
        DC(1 , 2) = -TY/CNORM
        DC(2 , 2) = TX/CNORM
        DC(3 , 2) = ZERO
        CNORM=DSQRT((TX/TY)**2+ONE+(TX**2/(TY*TZ)+TY/TZ)**2)
        DC(1,3)=TX/(TY*CNORM)
        DC(2,3)=ONE/CNORM
        DC(3,3)=-(TX**2/(TY*TZ)+TY/TZ)/CNORM
      END IF
C
      END
C
C =====================================================================
C ============================ B T D B ================================
C =====================================================================
C
      SUBROUTINE BTDB(SYMMETRIC,NRB,NCB,CST)
C
C =====================================================================
C I                                                                   I
C I   SUBPROGRAM BTDB EVALUATES <BT><DEP><B>CST, WHERE                I
C I                                                                   I
C I      <BT> = TRANSPOSE OF THE <B> MATRIX                           I
C I      <DEP> = MATERIAL STIFFNESS MATRIX                            I
C I      CST   = CONSTANT VALUE TO BE MULT. WITH EACH TERM OF THE     I
C I              RESULTING MATRIX.                                    I
C I                                                                   I
C I   A R G U M E N T      L I S T                                    I
C I                                                                   I
C I      SYMMETRIC = TRUE; FOR SYMMETRIC STIFFNESS MATRIX             I
C I                  FALSE; FOR NONSYMMETRIC STIFFNESS MATRIX         I
C I                                                                   I
C I      NRB  = NUMBER OF ROWS IN THE <B> BATRIX                      I
C I                                                                   I
C I      NCB  = NUMBER OF COLUMNS IN THE <B> MATRIX                   I
C I                                                                   I
C I      CST  = INTEGRATION CONSTANT                                  I
C I                                                                   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEM_STIFF
      PARAMETER (MAX_ELEM_STIFF=60)
      REAL*8 SK,B,DEP,CST,DUMMY(6),ZERO
      INTEGER K1,K2,K3,K4,K5,NCB,NRB
      LOGICAL SYMMETRIC
      COMMON/ELST1/SK(MAX_ELEM_STIFF,MAX_ELEM_STIFF)
      COMMON/B1/B(6,MAX_ELEM_STIFF)
      COMMON/MATER1/DEP(6,6)
C
      DATA ZERO /0.0D0/
C
C --- B(K3,K1) IS THE TRANSPOSE OF THE B(K1,K3)
C
      DO K1 = 1 , NRB
        DO K2 = 1 , NRB
          DEP(K1 , K2) = DEP(K1 , K2)*CST
        END DO
      END DO
      IF (SYMMETRIC) THEN
        DO K1 = 1,NCB
          DO K2 = 1,NRB
            DUMMY(K2) = ZERO
            DO K3 = 1,NRB
              DUMMY(K2) = DUMMY(K2)+B(K3,K1)*DEP(K3,K2)
            END DO
          END DO
          DO K4 = 1,K1
            DO K5 = 1,NRB
              SK(K1,K4) = SK(K1,K4) + DUMMY( K5 )*B(K5 , K4)
            END DO
            SK(K4,K1) = SK(K1,K4)
          END DO
        END DO
      ELSE IF(.NOT.SYMMETRIC) THEN
        DO K1 = 1,NCB
          DO K2 = 1,NRB
            DUMMY(K2) = ZERO
            DO K3 = 1,NRB
              DUMMY(K2) = DUMMY(K2)+B(K3,K1)*DEP(K3,K2)
            END DO
          END DO
          DO K4 = 1,NCB
            DO K5 = 1,NRB
              SK(K1,K4) = SK(K1,K4) + DUMMY( K5 )*B(K5 , K4)
            END DO
          END DO
        END DO
      END IF
C
      END
