C
C =====================================================================
C ========================= B 2 D 3 D =================================
C =====================================================================
C
      SUBROUTINE B2D3D
C
C =====================================================================
C I                                                                   I
C I   SUBPROGRAM B2D3D EVALUATES THE 'B' MATRIX FOR THE 2D AND 3D     I
C I   SMALL STRAIN PROBLEMS.                                          I
C I                                                                   I
C I      ENTRY POINTS:                                                I
C I      B2DLS : FOR 2D PLANE STRESS, PLANE STRAIN AND AXISYMMETRIC   I
C I               PROBLEMS WITHOUT GEOMETRIC NONLINEARITY.            I
C I                                                                   I
C I      B2DNS: FOR 2D PLANE STRESS, PLANE STRAIN AND AXISYMMETRIC    I
C I               PROBLEMS WITH GEOMETRIC NONLINEARITY.               I
C I                                                                   I
C I      B3DLS : FOR 3D STRAIN FIELDS WITHOUT GEOMETRIC NONLINEARITY  I
C I                                                                   I
C I      B3DNS: FOR 3D STRAIN FIELDS WITH GEOMETRIC NONLINEARITY      I
C I                                                                   I
C I     B(I,J)      =  VARIATIONAL STRAIN-DISPLACEMENT STIFFNESS      I
C I                    MATRIX.                                        I
C I                                                                   I
C I                                                                   I
C I   NX(K) = PARTIAL DERIVATIVE OF N(K) WITH RESPECT TO X;           I
C I   NY(K) = PARTIAL DERIVATIVE OF N(K) WITH RESPECT TO Y;           I
C I   NZ(K) = PARTIAL DERIVATIVE OF N(K) WITH RESPECT TO Z;           I
C I                                                                   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER STRS_STRN_REL,AXISYMMETRIC
      INTEGER MAX_NODES,MAX_ELEM_NODES,MAX_GAUSS_PTS,MAX_ELEM_STIFF,
     .        MNNDF,MAX_NODES_DOF
      PARAMETER (AXISYMMETRIC=3)
      PARAMETER (MAX_NODES=3000,MAX_ELEM_NODES=20,MAX_GAUSS_PTS=27,
     .           MAX_ELEM_STIFF=60,MNNDF=3,
     .           MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER NNEL,INTGPN,K1,K11,K12,K13,II
      REAL*8 A5,DUDX,DVDX,DWDX,DUDY,DVDY,DWDY,DUDZ,DVDZ,DWDZ,RAD,THICK
      REAL*8 B,N,NETA,NSI,NX,NXI,NY,NZ,UTOTAL,ZERO,ONE
      COMMON/INPUT9/THICK,STRS_STRN_REL
      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/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/ASSEM2/II(MAX_ELEM_STIFF)
      COMMON/JACOB1/NX(MAX_ELEM_NODES),NY(MAX_ELEM_NODES),
     .              NZ(MAX_ELEM_NODES)
      COMMON/B1/B(6,MAX_ELEM_STIFF)
      COMMON/B2/DUDX,DVDX,DWDX,DUDY,DVDY,DWDY,DUDZ,DVDZ,DWDZ,A5
C
      DATA ZERO,ONE /0.0D0,1.0D0/
C
C ======================== E N T R Y    B 2 D L S =====================
C
      ENTRY B2DLS(INTGPN,NNEL,RAD)
C
C --- CALCULATION OF THE <B> MATRIX
C
      DO K1 = 1,NNEL
        K12 = 2*K1
        K11 = K12 - 1
        B(1,K11) = NX(K1)
        B(1,K12) = ZERO
        B(2,K11) = ZERO
        B(2,K12) = NY(K1)
        B(3,K11) = NY(K1)
        B(3,K12) = NX(K1)
      END DO
C
C --- CALCULATION OF THE ADDITIONAL ROW OF <B> FOR THE AXISYM. CASE.
C
      IF (STRS_STRN_REL.EQ.AXISYMMETRIC) THEN
        DO K1 = 1 , NNEL
          K12 = 2*K1
          K11 = K12 - 1
          B(4,K11) = N(K1,INTGPN)/RAD
          B(4,K12) = ZERO
        END DO
      END IF
      RETURN
C
C ======================== E N T R Y    B 2 D N S =====================
C
      ENTRY B2DNS(INTGPN,NNEL,RAD)
C
C --- CALCULATION OF THE <B> MATRIX
C
      DUDX = ZERO
      DVDX = ZERO
      DUDY = ZERO
      DVDY = ZERO
      A5 = ZERO
      DO K1 = 1,NNEL
        K12 = 2*K1
        K11 = K12 - 1
        DUDX = DUDX + NX(K1)*UTOTAL(II(K11))
        DVDX = DVDX + NX(K1)*UTOTAL(II(K12))
        DUDY = DUDY + NY(K1)*UTOTAL(II(K11))
        DVDY = DVDY + NY(K1)*UTOTAL(II(K12))
        A5 = A5 + N(K1,INTGPN)*UTOTAL(II(K11))
      END DO
      DO K1 = 1,NNEL
        K12 = 2*K1
        K11 = K12 - 1
        B(1,K11)=(ONE + DUDX)*NX(K1)
        B(1,K12)=DVDX*NX(K1)
        B(2,K11)=DUDY*NY(K1)
        B(2,K12)=(ONE + DVDY)*NY(K1)
        B(3,K11)=DUDY*NX(K1) + (ONE + DUDX)*NY(K1)
        B(3,K12)=DVDX*NY(K1) + (ONE + DVDY)*NX(K1)
      END DO
C
C --- CALCULATION OF THE ADDITIONAL ROW OF <B> FOR THE AXISYM CASE.
C
      IF (STRS_STRN_REL.EQ.AXISYMMETRIC) THEN
        A5 = A5/RAD
        DO K1 = 1 , NNEL
          K12 = 2*K1
          K11 = K12 - 1
          B(4,K11) = (A5 + ONE)*N(K1,INTGPN)/RAD
          B(4,K12) = ZERO
        END DO
      END IF
      RETURN
C
C ======================== E N T R Y    B 3 D L S =====================
C
      ENTRY B3DLS(NNEL)
C
C --- CALCULATION OF THE <B> MATRIX
C
      DO K1 = 1,NNEL
        K13 = 3*K1
        K12 = K13 - 1
        K11 = K13 - 2
        B(1,K11) = NX(K1)
        B(1,K12) = ZERO
        B(1,K13) = ZERO
        B(2,K11) = ZERO
        B(2,K12) = NY(K1)
        B(2,K13) = ZERO
        B(3,K11) = ZERO
        B(3,K12) = ZERO
        B(3,K13) = NZ(K1)
        B(4,K11) = NY(K1)
        B(4,K12) = NX(K1)
        B(4,K13) = ZERO
        B(5,K11) = ZERO
        B(5,K12) = NZ(K1)
        B(5,K13) = NY(K1)
        B(6,K11) = NZ(K1)
        B(6,K12) = ZERO
        B(6,K13) = NX(K1)
      END DO
      RETURN
C
C ======================== E N T R Y    B 3 D N S =====================
C
      ENTRY B3DNS(NNEL)
C
C --- CALCULATION OF THE <B> MATRIX
C
      DUDX = ZERO
      DVDX = ZERO
      DWDX = ZERO
      DUDY = ZERO
      DVDY = ZERO
      DWDY = ZERO
      DUDZ = ZERO
      DVDZ = ZERO
      DWDZ = ZERO
      DO K1 = 1,NNEL
        K13 = 3*K1
        K12 = K13 - 1
        K11 = K13 - 2
        DUDX = DUDX + NX(K1)*UTOTAL(II(K11))
        DVDX = DVDX + NX(K1)*UTOTAL(II(K12))
        DWDX = DWDX + NX(K1)*UTOTAL(II(K13))
        DUDY = DUDY + NY(K1)*UTOTAL(II(K11))
        DVDY = DVDY + NY(K1)*UTOTAL(II(K12))
        DWDY = DWDY + NY(K1)*UTOTAL(II(K13))
        DUDZ = DUDZ + NZ(K1)*UTOTAL(II(K11))
        DVDZ = DVDZ + NZ(K1)*UTOTAL(II(K12))
        DWDZ = DWDZ + NZ(K1)*UTOTAL(II(K13))
      END DO
      DO K1 = 1,NNEL
        K13 = 3*K1
        K12 = K13 - 1
        K11 = K13 - 2
        B(1,K11) = (ONE + DUDX)*NX(K1)
        B(1,K12) = DVDX*NX(K1)
        B(1,K13) = DWDX*NX(K1)
        B(2,K11) = DUDY*NY(K1)
        B(2,K12) = (ONE + DVDY)*NY(K1)
        B(2,K13) = DWDY*NY(K1)
        B(3,K11) = DUDZ*NZ(K1)
        B(3,K12) = DVDZ*NZ(K1)
        B(3,K13) = (ONE + DWDZ)*NZ(K1)
        B(4,K11) = DUDY*NX(K1) + (ONE + DUDX)*NY(K1)
        B(4,K12) = DVDX*NY(K1) + (ONE + DVDY)*NX(K1)
        B(4,K13) = DWDY*NX(K1) + DWDX*NY(K1)
        B(5,K11) = DUDZ*NY(K1) + DUDY*NZ(K1)
        B(5,K12) = DVDZ*NY(K1) + (ONE + DVDY)*NZ(K1)
        B(5,K13) = DWDY*NZ(K1) + (ONE + DWDZ)*NY(K1)
        B(6,K11) = DUDZ*NX(K1) + (ONE + DUDX)*NZ(K1)
        B(6,K12) = DVDX*NZ(K1) + DVDZ*NX(K1)
        B(6,K13) = DWDX*NZ(K1) + (ONE + DWDZ)*NX(K1)
      END DO
C
      END
C
C =====================================================================
C ========================= A X I S Y M ===============================
C =====================================================================
C
      SUBROUTINE AXISYM(INTGPN,ELNUM,NNEL,RAD,THICK)
C
C =====================================================================
C I                                                                   I
C I      SUBPROGRAM AXISYM EVALUATES THE RADIUS OF THE INTEGRATION    I
C I      POINT FROM THE AXIS OF SYMMETRY FOR AXISYMMETRIC PROBLEMS.   I
C I      THE AXIS OF SYMMETRY IS ASSUMED TO BE THE Y AXIS.            I
C I                                                                   I
C I         INTGPN  = INTEGRATION POINT NUMBER                        I
C I         ELNUM   = ELEMENT NUMBER                                  I
C I         NNEL    = NUMBER OF NODES IN THE ELEMENT                  I
C I         RAD     = RADIUS OF THE INTEGRATION POINT                 I
C I         THICK   = CIRCUMFERENCE OF THE AXISYMMETRIC SOLID         I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_GAUSS_PTS
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_GAUSS_PTS=27)
      INTEGER INTGPN,K1,NNEL,NOP,ELNUM
      REAL*8 RAD,THICK,N,NXI,NETA,NSI,ZERO,ONE,TWO,FOUR,TWOPI
      REAL*4 X,Y,Z
      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/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT3/X(MAX_NODES),Y(MAX_NODES),Z(MAX_NODES)
C
      DATA ZERO,ONE,TWO,FOUR /0.0D0,1.0D0,2.0D0,4.0D0/
C
      TWOPI=TWO*FOUR*DATAN(ONE)
      RAD = ZERO
      DO K1 = 1 , NNEL
        RAD = RAD + N(K1 , INTGPN)*X(NOP(K1 , ELNUM))
      END DO
      THICK = TWOPI*RAD
C
      END
C
C =====================================================================
C ========================= G A U S S =================================
C =====================================================================
C
      SUBROUTINE GAUSS(NIP,W,GCOORD)
C
C =====================================================================
C I                                                                   I
C I      SUBPROGRAM GAUSS STORES THE COORDINATES XI AND ETA OF THE    I
C I      NUMERICAL INTEGRATION POINTS AND THEIR WEIGHTING FUNCTIONS   I
C I      FOR THE FOUR POINT AND THE NINE POINT INTEGRATION.           I
C I                                                                   I
C I          NIP       = NUMBER OF THE INTEGRATION POINTS             I
C I          W(I)      = WEIGTH FUNCTION                              I
C I          GCOORD(I) = COORDINATES OF THE GAUSSIAN POINTS           I
C I                      FROM THE NEGATIVE TO POSITIVE                I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      REAL*8 W(3),GCOORD(3)
      INTEGER NIP
C
      IF (NIP.EQ.1) THEN
        W( 1 ) = 2.D0
        GCOORD( 1 ) = 0.D0
      ELSE IF (NIP.EQ.2) THEN
        W( 1 ) = 1.D0
        W( 2 ) = 1.D0
        GCOORD( 1 ) = -0.577350269189626D0
        GCOORD( 2 ) = 0.577350269189626D0
      ELSE IF (NIP.EQ.3) THEN
        W( 1 ) = 5.D0/9.D0
        W( 2 ) = 8.D0/9.D0
        W( 3 ) = W( 1 )
        GCOORD( 1 ) = -0.774596669241483D0
        GCOORD( 2 ) = 0.D0
        GCOORD( 3 ) = 0.774596669241483D0
      END IF
C
      END
C
C =====================================================================
C ========================== I R O N S ================================
C =====================================================================
C
      SUBROUTINE IRONS(A1,B6,C8,B,C,NIP,INTCOD)
C
C =====================================================================
C I                                                                   I
C I      SUBPROGRAM IRONS STORES THE COORDINATES RETURNS THE COORD.   I
C I      AND THE WEIGHT FUNCTIONS FOR THE OPTIMUM INTEGRATION         I
C I      POINTS INTRODUCED BY BRUCE M. IRONS.                         I
C I                                                                   I
C I      FOR THE DESCRIPTION OF VARIABLES REFER TO THE REFERENCE      I
C I      PUBLICATION.                                                 I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER INTCOD,NIP
      REAL*8 A1,B,B6,C,C8
C
      IF (INTCOD.EQ.150) THEN
        NIP = 15
        A1 = 1.564444444444D0
        B6 = 0.3555555555556D0
        C8 = 0.5377777777778D0
        B = 1.D0
        C = 0.674199862D0
      ELSE IF(INTCOD.EQ.151) THEN
        NIP = 15
        A1 = 0.712137436D0
        B6 = 0.686227234D0
        C8 = 0.396312395D0
        B = 0.848418011D0
        C = 0.727662441D0
      ELSE IF(INTCOD.EQ.140) THEN
        NIP = 14
        A1 = 0.D0
        B6 = .886426593D0
        C8 = .335180055D0
        B = 0.795822426D0
        C = 0.758786911D0
      END IF
C
      END
C
C =====================================================================
C ======================= I S H A P E =================================
C =====================================================================
C
      SUBROUTINE ISHAPE
C
C =====================================================================
C I                                                                   I
C I   THIS PROGRAM EVALUATES THE SHAPE FUNCTIONS, THEIR DERIVATIVES   I
C I   WITH RESPECT TO THE NATURAL COORDINATES, AND THE WEIGHT         I
C I   FUNCTIONS AT EACH INTEGRATION POINT.                            I
C I                                                                   I
C I   ENTRY POINTS:                                                   I
C I       ISH2DG     (FOR 2D ELEMENTS)                                I
C I       ISH3DG     (FOR 3D ELEMENTS)                                I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEM_NODES,MAX_GAUSS_PTS
      PARAMETER (MAX_ELEM_NODES=20,MAX_GAUSS_PTS=27)
      INTEGER ELEM_TYPE,I,IETA,INTCOD,ISI,IXI,J,NIP,NIPETA,NIPSI,NIPXI
      INTEGER NNEL
      REAL*8 A,A1,AETA,ASI,AXI,B,B6,C,C8,ETA(3),F(MAX_ELEM_NODES)
      REAL*8 FETA(MAX_ELEM_NODES),FSI(MAX_ELEM_NODES),XI(3),ZERO
      REAL*8 FXI(MAX_ELEM_NODES),SI(3),W,WETA(3),WSI(3),WXI(3)
      COMMON/ISHAP2/W(MAX_GAUSS_PTS)
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
C
      DATA ZERO /0.0D0/
C
C         EVALUATE THE SHAPE FUNCTIONS OF THE 2D ISOPARAMETRIC ELEMENTS
C
C ======================== E N T R Y    I S H 2 D G ===================
C
      ENTRY ISH2DG(ELEM_TYPE,NNEL)
C
C       GET THE NATURAL COORDINATES OF THE INTEGRATION POINTS
C
      CALL GAUSS(NIPXI,WXI,XI)
      CALL GAUSS(NIPETA,WETA,ETA)
      NIP = NIPXI*NIPETA
C
C       NIP = TOTAL NUMBER OF THE INTEGRATION POINTS FOR THE ELEMENT
C       IETA = ROW NUMBER OF THE GAUSSIAN POINT FROM THE BOTTOM
C       IXI = COLUMN NUMBER OF THE GAUSSIAN POINT FROM LEFT
C
      DO IETA = 1 , NIPETA
        DO IXI = 1 , NIPXI
          J = (IETA - 1)*NIPXI + IXI
          W( J ) = WXI( IXI )*WETA( IETA )
          AXI = XI( IXI )
          AETA = ETA( IETA )
          CALL ISOP2D(AXI,AETA,F,FXI,FETA,ELEM_TYPE)
          CALL ISHEXT(NNEL,J,F,FXI,FETA,FSI)
        END DO
      END DO
      RETURN
C
C         EVALUATE THE SHAPE FUNCTIONS OF THE 3D ISOPARAMETRIC ELEMENTS
C
C ======================== E N T R Y    I S H 3 D G ===================
C
      ENTRY ISH3DG(ELEM_TYPE,NNEL)
      CALL GAUSS(NIPXI,WXI,XI)
      CALL GAUSS(NIPETA,WETA,ETA)
      CALL GAUSS(NIPSI,WSI,SI)
      NIP = NIPXI*NIPETA*NIPSI
      I = NIPXI*NIPETA
      DO ISI = 1 , NIPSI
        DO IETA = 1 , NIPETA
          DO IXI = 1 , NIPXI
            J = (ISI - 1)*I + (IETA - 1)*NIPXI + IXI
            W( J ) = WXI( IXI )*WETA( IETA )*WSI( ISI )
            AXI = XI( IXI )
            AETA = ETA( IETA )
            ASI = SI( ISI )
            CALL ISOP3D(AXI,AETA,ASI,F,FXI,FETA,FSI,ELEM_TYPE)
            CALL ISHEXT(NNEL,J,F,FXI,FETA,FSI)
          END DO
        END DO
      END DO
      RETURN
C
C ======================== E N T R Y    I S H 3 D I ===================
C
      ENTRY ISH3DI(ELEM_TYPE,NNEL)
      CALL IRONS(A1,B6,C8,B,C,NIP,INTCOD)
      AXI = B
      AETA = ZERO
      ASI = ZERO
      DO J = 1 , 6
        W( J ) = B6
        CALL ISOP3D(AXI,AETA,ASI,F,FXI,FETA,FSI,ELEM_TYPE)
        CALL ISHEXT(NNEL,J,F,FXI,FETA,FSI)
        A = AETA
        AETA = -AXI
        AXI  = -ASI
        ASI  = -A
      END DO
      AXI = C
      AETA = C
      ASI = C
      DO J = 7 , 14
        W( J ) = C8
        CALL ISOP3D(AXI,AETA,ASI,F,FXI,FETA,FSI,ELEM_TYPE)
        CALL ISHEXT(NNEL,J,F,FXI,FETA,FSI)
        AXI  = -AXI
        A = AETA
        AETA = -ASI
        IF (J.EQ.10) AETA = ASI
        ASI  =  A
      END DO
      IF (INTCOD.GE.150) THEN
        W( 15 ) = A1
        AXI = ZERO
        AETA = ZERO
        ASI = ZERO
        CALL ISOP3D(AXI,AETA,ASI,F,FXI,FETA,FSI,ELEM_TYPE)
        CALL ISHEXT(NNEL,15,F,FXI,FETA,FSI)
      END IF
C
      END
C
C =====================================================================
C =========================== I S H E X T =============================
C =====================================================================
C
      SUBROUTINE ISHEXT(NNEL,J,F,FXI,FETA,FSI)
      IMPLICIT NONE
      INTEGER MAX_ELEM_NODES,MAX_GAUSS_PTS
      PARAMETER (MAX_ELEM_NODES=20,MAX_GAUSS_PTS=27)
      REAL*8 N,NXI,NETA,NSI,FETA(MAX_ELEM_NODES),FSI(MAX_ELEM_NODES)
      REAL*8 F(MAX_ELEM_NODES),FXI(MAX_ELEM_NODES)
      INTEGER J,NN,NNEL
      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)
C
      DO NN = 1 , NNEL
        N(NN , J) = F( NN )
        NXI(NN , J) = FXI( NN )
        NETA(NN , J) = FETA( NN )
        NSI(NN , J) = FSI( NN )
      END DO
C
      END
C
C =====================================================================
C =========================== E L M L I B =============================
C =====================================================================
C
      SUBROUTINE ELMLIB
C
C =====================================================================
C I                                                                   I
C I      SUBPROGRAM ELMLIB CALCULATES THE SHAPE FUNCTIONS AND THE     I
C I      PARTIAL DRIVATIVES OF THE SHAPE FUNCTIONS WRT THE LOCAL      I
C I      COORDINATES 'XI', 'ETA' AND 'SI'.                            I
C I                                                                   I
C I              N(I)     = SHAPE FUNCTIONS OF THE ELEMENT            I
C I              NXI(I) = PARTIAL DRIVATIVE OF 'N' WRT 'XI'           I
C I              NETA(I) =    PARTIAL DRIVATIVE OF 'N' WRT 'ETA'      I
C I              NSI(I) = PARTIAL DERIVATIVE OF 'N' WRT 'SI'          I
C I                                                                   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEM_NODES
      INTEGER ELEM_TYPE,PLN_STRN_4N,PLN_STRN_8N,BRICK_8N,BRICK_20N
      PARAMETER (PLN_STRN_4N=204,PLN_STRN_8N=208,BRICK_8N=308,
     .           BRICK_20N=320)
      PARAMETER (MAX_ELEM_NODES=20)
      REAL*8 XI,ETA,SI,N(MAX_ELEM_NODES),NXI(MAX_ELEM_NODES),XI0,ETA0
      REAL*8 NETA(MAX_ELEM_NODES),NSI(MAX_ELEM_NODES),SI0
      REAL*8 EIGHTH,QUARTER,HALF,ONE,TWO,FOUR
      REAL*4 ETAI,SII,XII
      INTEGER K,K1,K2
      COMMON/ELLIB1/XII(MAX_ELEM_NODES),ETAI(MAX_ELEM_NODES),
     .              SII(MAX_ELEM_NODES)
C
      DATA EIGHTH,QUARTER,HALF,ONE,TWO,FOUR/0.125D0,0.25D0,0.5D0,
     .        1.0D0,2.0D0,4.0D0/
C
C ======================== E N T R Y    I S O P 2 D ===================
C
      ENTRY ISOP2D(XI,ETA,N,NXI,NETA,ELEM_TYPE)
C
C       DRIVATIVE OF SHAPE FUNCTIONS FOR 2D ISOPARAMETRIC ELEMENTS.
C
      NXI(1) = -QUARTER*(ONE- ETA)
      NXI(2) =  QUARTER*(ONE- ETA)
      NXI(3) =  QUARTER*(ONE+ ETA)
      NXI(4) = -QUARTER*(ONE+ ETA)
      NETA(1) = -QUARTER*(ONE- XI)
      NETA(2) = -QUARTER*(ONE+ XI)
      NETA(3) =  QUARTER*(ONE+ XI)
      NETA(4) =  QUARTER*(ONE- XI)
      IF(ELEM_TYPE.EQ.PLN_STRN_4N) GO TO 10
C
C        ADDITIONAL TERMS FOR THE EIGHT NODE ISOPARAMETRIC EL.
C
      NXI(5) = - XI*(ONE- ETA)
      NXI(6) = HALF*(ONE- ETA**2)
      NXI(7) = - XI*(ONE+ ETA)
      NXI(8) = -HALF*(ONE- ETA**2)
      NETA(5) = -HALF*(ONE- XI**2)
      NETA(6) = -(ONE+ XI)* ETA
      NETA(7) = HALF*(ONE- XI**2)
      NETA(8) = -(ONE- XI)* ETA
      NXI(1) = NXI(1)-HALF*(NXI(5)+NXI(8))
      NXI(2) = NXI(2)-HALF*(NXI(5)+NXI(6))
      NXI(3) = NXI(3)-HALF*(NXI(7)+NXI(6))
      NXI(4) = NXI(4)-HALF*(NXI(7)+NXI(8))
      NETA(1) = NETA(1)-HALF*(NETA(5)+NETA(8))
      NETA(2) = NETA(2)-HALF*(NETA(5)+NETA(6))
      NETA(3) = NETA(3)-HALF*(NETA(7)+NETA(6))
      NETA(4) = NETA(4)-HALF*(NETA(7)+NETA(8))
      IF(ELEM_TYPE.EQ.PLN_STRN_8N) GO TO 10
C
C       ADDITIONAL TERMS FOR THE NINE NODE LAGRANGIAN ELEMENT
C
      NXI(9) = -TWO*XI*(ONE- ETA**2)
      NXI(1) = NXI(1)+NXI(9)/FOUR
      NXI(2) = NXI(2)+NXI(9)/FOUR
      NXI(3) = NXI(3)+NXI(9)/FOUR
      NXI(4) = NXI(4)+NXI(9)/FOUR
      NXI(5) = NXI(5)-NXI(9)/TWO
      NXI(6) = NXI(6)-NXI(9)/TWO
      NXI(7) = NXI(7)-NXI(9)/TWO
      NXI(8) = NXI(8)-NXI(9)/TWO
      NETA(9) = -TWO* ETA*(ONE- XI**2)
      NETA(1) = NETA(1)+NETA(9)/FOUR
      NETA(2) = NETA(2)+NETA(9)/FOUR
      NETA(3) = NETA(3)+NETA(9)/FOUR
      NETA(4) = NETA(4)+NETA(9)/FOUR
      NETA(5) = NETA(5)-NETA(9)/TWO
      NETA(6) = NETA(6)-NETA(9)/TWO
      NETA(7) = NETA(7)-NETA(9)/TWO
      NETA(8) = NETA(8)-NETA(9)/TWO
C
C ======================== E N T R Y    N 2 D =========================
C
      ENTRY N2D(XI,ETA,N,ELEM_TYPE)
C
C       SHAPE FUNCTIONS  FOR 2D ISOPARAMETRIC ELEMENTS.
C
  10  N(1) = QUARTER*(ONE- XI)*(ONE- ETA)
      N(2) = QUARTER*(ONE+ XI)*(ONE- ETA)
      N(3) = QUARTER*(ONE+ XI)*(ONE+ ETA)
      N(4) = QUARTER*(ONE- XI)*(ONE+ ETA)
      IF(ELEM_TYPE.EQ.PLN_STRN_4N) RETURN
C
C        ADDITIONAL TERMS FOR THE EIGHT NODE ISOPARAMETRIC EL.
C
      N(5) = HALF*(ONE- XI**2)*(ONE- ETA)
      N(6) = HALF*(ONE+ XI)*(ONE- ETA**2)
      N(7) = HALF*(ONE- XI**2)*(ONE+ ETA)
      N(8) = HALF*(ONE- XI)*(ONE- ETA**2)
      N(1) = N(1)-HALF*(N(5)+N(8))
      N(2) = N(2)-HALF*(N(5)+N(6))
      N(3) = N(3)-HALF*(N(7)+N(6))
      N(4) = N(4)-HALF*(N(7)+N(8))
      IF(ELEM_TYPE.EQ.PLN_STRN_8N) RETURN
C
C       ADDITIONAL TERMS FOR THE NINE NODE LAGRANGIAN ELEMENT
C
      N(9) = (ONE- ETA**2)*(ONE- XI**2)
      N(1) = N(1)+N(9)/FOUR
      N(2) = N(2)+N(9)/FOUR
      N(3) = N(3)+N(9)/FOUR
      N(4) = N(4)+N(9)/FOUR
      N(5) = N(5)-N(9)/TWO
      N(6) = N(6)-N(9)/TWO
      N(7) = N(7)-N(9)/TWO
      N(8) = N(8)-N(9)/TWO
      RETURN
C
C     SHAPE FUNCTIONS AND THEIR DERIVATIVES FOR THE 3D ISOP. EL.
C
C ======================== E N T R Y    I S O P 3 D ===================
C
      ENTRY ISOP3D(XI,ETA,SI,N,NXI,NETA,NSI,ELEM_TYPE)
      IF(ELEM_TYPE.EQ.BRICK_8N) THEN
        DO K = 1 , 8
          CALL ELMEXT(XI,ETA,SI,K,XI0,ETA0,SI0)
          N(K)   = EIGHTH*(ONE + XI0)*(ONE+ETA0)*(ONE+SI0)
          NXI(K) = EIGHTH*(ONE + ETA0)*(ONE + SI0)*XII( K )
          NETA(K)= EIGHTH*(ONE + XI0)*(ONE + SI0)*ETAI( K )
          NSI(K) = EIGHTH*(ONE + XI0)*(ONE + ETA0)*SII( K )
        END DO
      ELSE IF (ELEM_TYPE.EQ.BRICK_20N) THEN
C
C        HEXAHYDRON SOLID ELEMENT
C        SHAPE FUNCTIONS AND THIE DERIVATIVES FOR NODES 1-8.
C
        DO  K= 1 , 8
          CALL ELMEXT(XI,ETA,SI,K,XI0,ETA0,SI0)
          N(K)=EIGHTH*(ONE+XI0)*(ONE+ETA0)*(ONE+SI0)*(XI0+ETA0+
     .         SI0-TWO)
          NXI(K)=EIGHTH*(ONE+ETA0)*(ONE+SI0)*(TWO*XI0+ETA0+SI0-ONE)
     .           *XII(K)
          NETA(K)=EIGHTH*(ONE+XI0)*(ONE+SI0)*(XI0+TWO*ETA0+SI0-ONE)
     .            *ETAI(K)
          NSI(K)=EIGHTH*(ONE+ETA0)*(ONE+XI0)*(XI0+ETA0+TWO*SI0-ONE)
     .           *SII(K)
        END DO
        K1 = 9
        K2 = 10
C
C        SHAPE FUNCTIONS AND THEIR DERIVATIVES FOR NODES 13-16.
C
        DO K = 13 , 16
          CALL ELMEXT(XI,ETA,SI,K,XI0,ETA0,SI0)
          N(K)=QUARTER*(ONE+XI0)*(ONE+ETA0)*(ONE-SI**2)
          NXI(K)=QUARTER*(ONE+ETA0)*(ONE-SI**2)*XII(K)
          NETA(K)=QUARTER*(ONE+XI0)*(ONE-SI**2)*ETAI(K)
          NSI(K)=-HALF*(ONE+ETA0)*(ONE+XI0)*SI
C
C        SHAPE FUNCTIONS AND THEIR DERIVATIVES FOR NODES 9,11,17,19.
C
          CALL ELMEXT(XI,ETA,SI,K1,XI0,ETA0,SI0)
          N(K1)=QUARTER*(ONE-XI**2)*(ONE+ETA0)*(ONE+SI0)
          NXI(K1)=-HALF*(ONE+ETA0)*(ONE+SI0)*XI
          NETA(K1)=QUARTER*(ONE-XI**2)*(ONE+SI0)*ETAI(K1)
          NSI(K1)=QUARTER*(ONE+ETA0)*(ONE-XI**2)*SII(K1)
C
C        SHAPE FUNCTIONS AND THEIR DERIVATIVES FOR NODES 10,12,18,20.
C
          CALL ELMEXT(XI,ETA,SI,K2,XI0,ETA0,SI0)
          N(K2)=QUARTER*(ONE+XI0)*(ONE-ETA**2)*(ONE+SI0)
          NXI(K2)=QUARTER*(ONE-ETA**2)*(ONE+SI0)*XII(K2)
          NETA(K2)=-HALF*(ONE+XI0)*(ONE+SI0)*ETA
          NSI(K2)=QUARTER*(ONE-ETA**2)*(ONE+XI0)*SII(K2)
          IF (K1.EQ.11) THEN
            K1 = 17
            K2 = 18
          ELSE
            K1 = K1 + 2
            K2 = K2 + 2
          END IF
        END DO
      END IF
C
      END
C
C =====================================================================
C ======================== E L M E X T ================================
C =====================================================================
C
      SUBROUTINE ELMEXT(XI,ETA,SI,K,XI0,ETA0,SI0)
C
C =====================================================================
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_ELEM_NODES,K
      PARAMETER (MAX_ELEM_NODES=20)
      REAL*8 XI,ETA,SI,XI0,ETA0,SI0
      REAL*4 ETAI,SII,XII
      COMMON/ELLIB1/XII(MAX_ELEM_NODES),ETAI(MAX_ELEM_NODES),
     .              SII(MAX_ELEM_NODES)
C
      XI0 = XI*XII( K )
      ETA0 =  ETA*ETAI( K )
      SI0 = SI*SII( K )
C
      END
C
C =====================================================================
C ========================== J A C O B I ==============================
C =====================================================================
C
      SUBROUTINE JACOBI
C
C =====================================================================
C I                                                                   I
C I        THIS PROGRAM CALCULATES THE JACOBIAN OF THE                I
C I        TRANSFORMATION BETWEEN THE LOCAL COORDINATES               I
C I        XI AND ETA AND THE GLOBAL COORDINATES X AND Y              I
C I        FOR INTEGRATION POINT 'INTGPN' OF ELEMENT NUMBER 'NREL'.   I
C I                                                                   I
C I   INTGPN  =    INTEGRATION POINT NUMBER                           I
C I   NREL    =    ELEMENT NUMBER                                     I
C I   DETJAC  =    DETERMINANT OF THE JACOBIAN                        I
C I   NX(I)   =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO X       I
C I   NY(I)   =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO Y       I
C I   NZ(I)   =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO Z       I
C I   NNEL    =    NUMBER OF NODES(SHAPE FUNCTIONS) PER ELEMENT       I
C I                                                                   I
C I   NXI(I)  =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO XI      I
C I   NETA(I) =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO ETA     I
C I   NSI(I)  =    PARTIAL DERIVATIVE OF N(I) WITH RESPECT TO SI      I
C I   X(IK)   =    NODE COORDINATE  X,  IK=GLOBAL NODE NUMBER,        I
C I   Y(IK)   =    NODE COORDINATE  Y,  IK=GLOBAL NODE NUMBER,        I
C I   Z(IK)   =    NODE COORDINATE  Z,  IK=GLOBAL NODE NUMBER,        I
C I   XXI     =    PARTIAL DERIVATIVE OF X WITH RESPECT TO XI         I
C I   XETA    =    PARTIAL DERIVATIVE OF X WITH RESPECT TO ETA        I
C I   XSI     =    PARTIAL DERIVATIVE OF X WITH RESPECT TO SI         I
C I   YXI     =    PARTIAL DERIVATIVE OF Y WITH RESPECT TO XI         I
C I   YETA    =    PARTIAL DERIVATIVE OF Y WITH RESPECT TO ETA        I
C I   YSI     =    PARTIAL DERIVATIVE OF Y WITH RESPECT TO SI         I
C I   ZXI     =    PARTIAL DERIVATIVE OF Z WITH RESPECT TO XI         I
C I   ZETA    =    PARTIAL DERIVATIVE OF Z WITH RESPECT TO ETA        I
C I   ZSI     =    PARTIAL DERIVATIVE OF Z WITH RESPECT TO SI         I
C I                                                                   I
C I                                                                   I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_GAUSS_PTS
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_GAUSS_PTS=27)
      REAL*8 N,NXI,NETA,NSI,NX,NY,NZ,DETJAC,XETA,XSI,XXI,YETA,YSI
      REAL*8 YXI,ZETA,ZSI,ZXI,ZERO
      REAL*4 X,Y,Z
      INTEGER INTGPN,K,K1,NNEL,NODE,NREL,NOP
      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/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT3/X(MAX_NODES),Y(MAX_NODES),Z(MAX_NODES)
      COMMON/JACOB1/NX(MAX_ELEM_NODES),NY(MAX_ELEM_NODES),
     .              NZ(MAX_ELEM_NODES)
C
      DATA ZERO /0.0D0/
C
C ======================== E N T R Y    J A C B 2 D ===================
C
      ENTRY JACB2D(INTGPN,NREL,NNEL,DETJAC)
      XXI = ZERO
      XETA = ZERO
      YXI = ZERO
      YETA = ZERO
      DO K1 = 1 , NNEL
        NODE = NOP(K1 , NREL)
        XXI  = XXI + NXI(K1,INTGPN)*X( NODE )
        XETA = XETA + NETA(K1,INTGPN)*X( NODE )
        YXI  = YXI + NXI(K1,INTGPN)*Y( NODE )
        YETA = YETA + NETA(K1,INTGPN)*Y( NODE )
      END DO
      DETJAC = XXI*YETA - YXI*XETA
      DO K = 1 , NNEL
        NX(K) = (YETA*NXI(K,INTGPN) - YXI*NETA(K,INTGPN))/DETJAC
        NY(K) = (-XETA*NXI(K,INTGPN) + XXI*NETA(K,INTGPN))/DETJAC
      END DO
      RETURN
C
C ======================== E N T R Y    J A C B 3 D ===================
C
      ENTRY JACB3D(INTGPN,NREL,NNEL,DETJAC)
      XXI = ZERO
      XETA = ZERO
      XSI = ZERO
      YXI = ZERO
      YETA = ZERO
      YSI = ZERO
      ZXI = ZERO
      ZETA = ZERO
      ZSI = ZERO
      DO K1=1,NNEL
        NODE = NOP(K1 , NREL)
        XXI  = XXI + NXI(K1,INTGPN)*X( NODE )
        XETA = XETA + NETA(K1,INTGPN)*X( NODE )
        XSI  = XSI + NSI(K1,INTGPN)*X( NODE )
        YXI  = YXI + NXI(K1,INTGPN)*Y( NODE )
        YETA = YETA + NETA(K1,INTGPN)*Y( NODE )
        YSI  = YSI + NSI(K1,INTGPN)*Y( NODE )
        ZXI  = ZXI + NXI(K1,INTGPN)*Z( NODE )
        ZETA = ZETA + NETA(K1,INTGPN)*Z( NODE )
        ZSI  = ZSI + NSI(K1,INTGPN)*Z( NODE )
      END DO
      DETJAC= XXI*(YETA*ZSI - ZETA*YSI) - YXI*(XETA*ZSI - ZETA*XSI) +
     .        ZXI*(XETA*YSI - YETA*XSI)
      DO K = 1 , NNEL
        NX(K) = ((YETA*ZSI - ZETA*YSI)*NXI(K,INTGPN)
     .          -(YXI*ZSI - ZXI*YSI)*NETA(K,INTGPN)
     .          +(YXI*ZETA - ZXI*YETA)*NSI(K,INTGPN))/DETJAC
        NY(K) = (-(XETA*ZSI - ZETA*XSI)*NXI(K,INTGPN)
     .          +(XXI*ZSI - ZXI*XSI)*NETA(K,INTGPN)
     .         -(XXI*ZETA - ZXI*XETA)*NSI(K,INTGPN))/DETJAC
        NZ(K) = ((XETA*YSI - YETA*XSI)*NXI(K,INTGPN)
     .         -(XXI*YSI - YXI*XSI)*NETA(K,INTGPN)
     .         +(XXI*YETA - YXI*XETA)*NSI(K,INTGPN))/DETJAC
      END DO
C
      END
C
C =====================================================================
C =========================== E L I N F O =============================
C =====================================================================
C
      SUBROUTINE ELINFO(ELNUM,ELEM_TYPE,NNEL,MATNUM,STRS_STRN_REL,
     .                  ISTART,LINES)
C
C =====================================================================
C I                                                                   I
C I    P R O G R A M                                                  I
C I                                                                   I
C I    PROGRAM 'ELINFO' EXTRACTS ELEMENT INFORMATION FROM THE ARRAY   I
C I    'INFOEL'.                                                      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 PASSED BY THE CALLING ROUTINE       I
C I                                                                   I
C I    ELEM_TYPE = ELEMENT TYPE PASSED TO THE CALLING ROUTINE         I
C I                                                                   I
C I    NNEL      = NUMBER OF NODES IN THE ELEMNT PASSED TO THE        I
C I                CALLING ROUTINE                                    I
C I                                                                   I
C I    MATNUM    = MATERIAL I.D. NUMBER FOR THE ELEMENT PASSED TO THE I
C I                CALLING ROUTINE                                    I
C I                                                                   I
C I    ISTART    = STARTING POSITION OF THE LINE CONNECTIVITY DATA    I
C I                IN ARRAYS 'IS' AND 'IE'.                           I
C I                                                                   I
C I    LINES     = NUMBER OF LINES CONNECTING THE NODES WITHIN THE    I
C I                ELEMENT                                            I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER STRS_STRN_REL,PLANE_STRESS,PLANE_STRAIN,AXISYMMETRIC
      INTEGER MAX_ELEMENTS
      PARAMETER (PLANE_STRESS=1,PLANE_STRAIN=2,AXISYMMETRIC=3)
      PARAMETER (MAX_ELEMENTS=400)
      INTEGER ELNUM,ELEM_TYPE,I,ISTART,LINES,MATNUM,NNEL,INFOEL
      COMMON/INPUTA/INFOEL(MAX_ELEMENTS)
C
      I = INFOEL( ELNUM )
      LINES = I/67108864
      ISTART = IAND(I , 66060288)/1048576
      STRS_STRN_REL  = IAND(I , 917504)/131072
      ELEM_TYPE  = IAND(I , 130816)/256
      NNEL   = IAND(I , 248)/8
      MATNUM = IAND(I , 7)
C
      END
