C
C The following is a set of subroutines that handle several 
C tensor operations useful in Solid Mechanics. 
C NOTE: ALL TENSORS ARE ASSUMED TO HAVE AN INDEX RANGE OF 1,2,3
C       ALL MATRICIES ARE SQUARE OF SIZE (3X3) OR (6X6 if full)
C
C
C*DAi_minus_Bi  Computes Ci=Ai-Bi  [REAL*8]
C=**********************************************************************
C                                                                      *
C                   D A i __ m i n u s __ B i                          *
C                                                                      *
C=**********************************************************************
C+
C
C       DAi_minus_Bi(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the difference of two first order   
C         tensors term for term.
C         i.e. it performs the operation Ci=Ai-Bi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         tensC    - the output first order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAi_minus_Bi(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),TENSC(3)
C
      DO I=1,3
        TENSC(I)=TENSA(I)-TENSB(I)
      END DO
C
      END
C
C
C*Ai_minus_Bi  Computes Ci=Ai-Bi  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     A i __ m i n u s __ B i                          *
C                                                                      *
C=**********************************************************************
C+
C
C       Ai_minus_Bi(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the difference of two first order   
C         tensors term for term.
C         i.e. it performs the operation Ci=Ai-Bi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         tensC    - the output first order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Ai_minus_Bi(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3),TENSB(3),TENSC(3)
C
      DO I=1,3
        TENSC(I)=TENSA(I)-TENSB(I)
      END DO
C
      END
C
C
C*DAi_plus_Bi  Computes Ci=Ai+Bi  [REAL*8]
C=**********************************************************************
C                                                                      *
C                   D A i __ p l u s __ B i                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAi_plus_Bi(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the sum of two first order   
C         tensors term for term.
C         i.e. it performs the operation Ci=Ai+Bi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         tensC    - the output first order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAi_plus_Bi(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),TENSC(3)
C
      DO I=1,3
        TENSC(I)=TENSA(I)+TENSB(I)
      END DO
C
      END
C
C
C*Ai_plus_Bi  Computes Ci=Ai+Bi  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     A i __ p l u s __ B i                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Ai_plus_Bi(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the sum of two first order   
C         tensors term for term.
C         i.e. it performs the operation Ci=Ai+Bi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         tensC    - the output first order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Ai_plus_Bi(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3),TENSB(3),TENSC(3)
C
      DO I=1,3
        TENSC(I)=TENSA(I)+TENSB(I)
      END DO
C
      END
C
C
C*DAij_minus_Bij  Computes Cij=Aij-Bij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                   D A i j __ m i n u s __ B i j                      *
C                                                                      *
C=**********************************************************************
C+
C
C       DAij_minus_Bij(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the difference of two second order   
C         tensors term for term.
C         i.e. it performs the operation Cij=Aij-Bij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the input second order tensor B. an array of floating
C                     point values.
C         tensC    - the output second order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAij_minus_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I,J)-TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C*Aij_minus_Bij  Computes Cij=Aij-Bij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     A i j __ m i n u s __ B i j                      *
C                                                                      *
C=**********************************************************************
C+
C
C       Aij_minus_Bij(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the difference of two second order   
C         tensors term for term.
C         i.e. it performs the operation Cij=Aij-Bij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the input second order tensor B. an array of floating
C                     point values.
C         tensC    - the output second order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aij_minus_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I,J)-TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C*DAij_plus_Bij  Computes Cij=Aij+Bij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                   D A i j __ p l u s __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAij_plus_Bij(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the sum of two second order   
C         tensors term for term.
C         i.e. it performs the operation Cij=Aij+Bij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the input second order tensor B. an array of floating
C                     point values.
C         tensC    - the output second order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAij_plus_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I,J)+TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C*Aij_plus_Bij  Computes Cij=Aij+Bij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     A i j __ p l u s __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aij_plus_Bij(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the sum of two second order   
C         tensors term for term.
C         i.e. it performs the operation Cij=Aij+Bij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the input second order tensor B. an array of floating
C                     point values.
C         tensC    - the output second order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aij_plus_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I,J)+TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C*DAi_Bi  Computes Ci=AiBi  [REAL*8]
C=**********************************************************************
C                                                                      *
C                              D A i __ B i                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAi_Bi(tensA,tensB,scalarC) [REAL*8]
C         subroutine to multiply a first order tensor with another   
C         first order tensor to yield a scalar.
C         i.e. it performs the operation C=AiBi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         scalarC  - the output scalar quanity C.
C
C
C--
      SUBROUTINE DAi_Bi(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),SCALARC
      DATA ZERO /0.0D0/
C
      SCALARC=ZERO
      DO I=1,3
        SCALARC=SCALARC+TENSA(I)*TENSB(I)
      END DO
C
      END
C
C*Ai_Bi  Computes Ci=AiBi  [REAL*4]
C=**********************************************************************
C                                                                      *
C                                A i __ B i                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Ai_Bi(tensA,tensB,scalarC) [REAL*4]
C         subroutine to multiply a first order tensor with another   
C         first order tensor to yield a scalar.
C         i.e. it performs the operation C=AiBi
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the input first order tensor B. an array of floating
C                     point values.
C         scalarC  - the output scalar quanity C.
C
C
C--
      SUBROUTINE Ai_Bi(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3),TENSB(3),SCALARC
      DATA ZERO /0.000/
C
      SCALARC=ZERO
      DO I=1,3
        SCALARC=SCALARC+TENSA(I)*TENSB(I)
      END DO
C
      END
C
C
C*DAi_Bj  Computes Cij=AiBj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                             D A i __ B j                             *
C                                                                      *
C=**********************************************************************
C+
C
C       DAi_Bj(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two first order tensors to yield a  
C         second order tensor.
C         i.e. it performs the operation Cij=AiBj
C
C         tensA   - the input first order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAi_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C*Ai_Bj  Computes Cij=AiBj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                               A i __ B j                             *
C                                                                      *
C=**********************************************************************
C+
C
C       Ai_Bj(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two first order tensors to yield a  
C         second order tensor.
C         i.e. it performs the operation Cij=AiBj
C
C         tensA   - the input first order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Ai_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3),TENSB(3),TENSC(3,3)
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=TENSA(I)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C*DAij_Bij  Computes C=AijBij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j __ B i j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAij_Bij(tensA,tensB,scalarC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a 
C         scalar.
C         i.e. it performs the operation C=AijBij
C
C         tensA     - the input second order tensor A. an array of floating
C                     point values.
C         tensB     - the input second order tensor B. an array of floating
C                     point values.
C         scalarC   - the output scalar C.
C
C
C--
      SUBROUTINE DAij_Bij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),SCALARC
      DATA ZERO /0.0D0/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          SCALARC=SCALARC+TENSA(I,J)*TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C*Aij_Bij  Computes C=AijBij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j __ B i j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aij_Bij(tensA,tensB,scalarC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a 
C         scalar.
C         i.e. it performs the operation C=AijBij
C
C         tensA     - the input second order tensor A. an array of floating
C                     point values.
C         tensB     - the input second order tensor B. an array of floating
C                     point values.
C         scalarC   - the output scalar C.
C
C
C--
      SUBROUTINE Aij_Bij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),SCALARC
      DATA ZERO /0.000/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          SCALARC=SCALARC+TENSA(I,J)*TENSB(I,J)
        END DO
      END DO
C
      END
C
C
C
C*DAik_Bkj  Computes Cij=AikBkj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i k __ B k j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAik_Bkj(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AikBkj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAik_Bkj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(I,K)*TENSB(K,J)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aik_Bkj  Computes Cij=AikBkj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i k __ B k j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aik_Bkj(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AikBkj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aik_Bkj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(I,K)*TENSB(K,J)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAij_Bkl  Computes Cijkl=AijBkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j __ B k l                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAij_Bkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Cijkl=AijBkl
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAij_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J)*TENSB(K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aij_Bkl  Computes Cijkl=AijBkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j __ B k l                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aij_Bkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Cijkl=AijBkl
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aij_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J)*TENSB(K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C
C*DAik_Bjl  Computes Cikjl=AikBjl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i k __ B j l                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAik_Bjl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Cikjl=AikBjl
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAik_Bjl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,K,J,L)=TENSA(I,K)*TENSB(J,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aik_Bjl  Computes Cikjl=AikBjl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i k __ B j l                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aik_Bjl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Cikjl=AikBjl
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aik_Bjl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,K,J,L)=TENSA(I,K)*TENSB(J,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAil_Bjk  Computes Ciljk=AilBjk  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i l __ B j k                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAil_Bjk(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Ciljk=AilBjk
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAil_Bjk(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,L,J,K)=TENSA(I,L)*TENSB(J,K)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Ail_Bjk  Computes Ciljk=AilBjk  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i l __ B j k                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Ail_Bjk(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a 
C         fourth order tensor. 
C         i.e. it performs the operation Ciljk=AilBjk
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Ail_Bjk(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,L,J,K)=TENSA(I,L)*TENSB(J,K)
            END DO
          END DO
        END DO
      END DO
C
      END
C

C
C*DAij_Bj  Computes Ci=AijBj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j __ B j                              *
C                                                                      *
C=**********************************************************************
C+
C
C       DAij_Bj(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a first order tensor and a second 
C         order tensor to yield a first order tensor. 
C         i.e. it performs the operation Ci=AijBj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output first order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE DAij_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3),TENSC(3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        TENSC(I)=ZERO
        DO J=1,3
          TENSC(I)=TENSC(I)+TENSA(I,J)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C
C*Aij_Bj  Computes Ci=AijBj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j __ B j                              *
C                                                                      *
C=**********************************************************************
C+
C
C       Aij_Bj(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a first order tensor and a second 
C         order tensor to yield a first order tensor. 
C         i.e. it performs the operation Ci=AijBj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output first order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE Aij_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3),TENSC(3)
      DATA ZERO /0.000/
C
      DO I=1,3
        TENSC(I)=ZERO
        DO J=1,3
          TENSC(I)=TENSC(I)+TENSA(I,J)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bklmn  Computes Cijmn=AijklBklmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B k l m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bklmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two fourth order tensors to yield a  
C         fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklBklmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijkl_Bklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bklmn  Computes Cijmn=AijklBklmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B k l m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bklmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two fourth order tensors to yield a  
C         fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklBklmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijkl_Bklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bijkl  Computes C=AijklBijkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B i j k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bijkl(tensA,tensB,scalarC) [REAL*8]
C         subroutine to multiply two fourth order tensors
C         to yield a scalar. 
C         i.e. it performs the operation C=AijklBijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                    point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                    point values.
C         scalarC  - the output scalar quanity C. 
C
C
C--
      SUBROUTINE DAijkl_Bijkl(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
      DATA ZERO /0.0D0/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              SCALARC=SCALARC+TENSA(I,J,K,L)*TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bijkl  Computes C=AijklBijkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B i j k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bijkl(tensA,tensB,scalarC) [REAL*4]
C         subroutine to multiply two fourth order tensors
C         to yield a scalar. 
C         i.e. it performs the operation C=AijklBijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                    point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                    point values.
C         scalarC  - the output scalar quanity C. 
C
C
C--
      SUBROUTINE Aijkl_Bijkl(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
      DATA ZERO /0.000/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              SCALARC=SCALARC+TENSA(I,J,K,L)*TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bklij  Computes C=AijklBklij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B k l i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bklij(tensA,tensB,scalarC) [REAL*8]
C         subroutine to multiply two fourth order tensors
C         to yield a scalar. 
C         i.e. it performs the operation C=AijklBklij
C
C         tensA    - the input fourth order tensor A. an array of floating
C                    point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                    point values.
C         scalarC  - the output scalar quanity C. 
C
C
C--
      SUBROUTINE DAijkl_Bklij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
      DATA ZERO /0.0D0/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              SCALARC=SCALARC+TENSA(I,J,K,L)*TENSB(K,L,I,J)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bklij  Computes C=AijklBklij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B k l i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bklij(tensA,tensB,scalarC) [REAL*4]
C         subroutine to multiply two fourth order tensors
C         to yield a scalar. 
C         i.e. it performs the operation C=AijklBklij
C
C         tensA    - the input fourth order tensor A. an array of floating
C                    point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                    point values.
C         scalarC  - the output scalar quanity C. 
C
C
C--
      SUBROUTINE Aijkl_Bklij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
      DATA ZERO /0.000/
C
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              SCALARC=SCALARC+TENSA(I,J,K,L)*TENSB(K,L,I,J)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bijmn  Computes Cklmn=AijklBijmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B i j m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bijmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two fourth order tensors 
C         to yield a fourth order tensor. 
C         i.e. it performs the operation Cklmn=AijklBijmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijkl_Bijmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              TENSC(K,L,M,N)=ZERO
              DO I=1,3
                DO J=1,3
                  TENSC(K,L,M,N)=TENSC(K,L,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(I,J,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bijmn  Computes Cklmn=AijklBijmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B i j m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bijmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two fourth order tensors 
C         to yield a fourth order tensor. 
C         i.e. it performs the operation Cklmn=AijklBijmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijkl_Bijmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              TENSC(K,L,M,N)=ZERO
              DO I=1,3
                DO J=1,3
                  TENSC(K,L,M,N)=TENSC(K,L,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(I,J,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bmnkl  Computes Cijmn=AijklBmnkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l __ B m n k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bmnkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two fourth order tensors
C         to yield a fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklBmnkl
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijkl_Bmnkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(M,N,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bmnkl  Computes Cijmn=AijklBmnkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l __ B m n k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bmnkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two fourth order tensors
C         to yield a fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklBmnkl
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijkl_Bmnkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L)*
     .                           TENSB(M,N,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C*DAijkl_Bkl  Computes Cij=AijklBkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklBkl
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE DAijkl_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            DO L=1,3
              TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L)*TENSB(K,L)
            END DO
          END DO
        END DO
      END DO
C
      END

C
C
C*Aijkl_Bkl  Computes Cij=AijklBkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklBkl
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE Aijkl_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            DO L=1,3
              TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L)*TENSB(K,L)
            END DO
          END DO
        END DO
      END DO
C
      END

C
C
C
C*DAijkl_Bmn  Computes Cijklmn=AijklBmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B m n                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklmn=AijklBmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijkl_Bmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L)*TENSB(M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bmn  Computes Cijklmn=AijklBmm  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B m n                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklmn=AijklBmn
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijkl_Bmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L)*TENSB(M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_Bij  Computes Ckl=AijklBij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j k l __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_Bij(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklBij
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE DAijkl_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L)*TENSB(I,J)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_Bij  Computes Ckl=AijklBij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i j k l __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_Bij(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a fourth order tensor and a second  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklBij
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE Aijkl_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.000/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L)*TENSB(I,J)
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bmn  Computes Cijkl=aijklmnBmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B m n                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor. 
C         i.e. it performs the operation Cijkl=AijklmnBmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=ZERO
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L)=TENSC(I,J,K,L)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bmn  Computes Cijkl=AijklmnBmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B m n                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor. 
C         i.e. it performs the operation Cijkl=AijklmnBmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=ZERO
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L)=TENSC(I,J,K,L)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bkl  Computes Cijmn=AijklmnBkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklmnBkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bkl  Computes Cijmn=AijklmnBkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B k l                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor. 
C         i.e. it performs the operation Cijmn=AijklmnBkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              TENSC(I,J,M,N)=ZERO
              DO K=1,3
                DO L=1,3
                  TENSC(I,J,M,N)=TENSC(I,J,M,N)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bij  Computes Cklmn=AijklmnBij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bij(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor.
C         i.e. it performs the operation Cklmn=AijklmnBij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              TENSC(K,L,M,N)=ZERO
              DO I=1,3
                DO J=1,3
                  TENSC(K,L,M,N)=TENSC(K,L,M,N)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bij  Computes Cklmn=AijklmnBij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B i j                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bij(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a second  
C         order tensor to yield a fourth order tensor.
C         i.e. it performs the operation Cklmn=AijklmnBij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output fourth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3),TENSC(3,3,3,3)
      DATA ZERO /0.000/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              TENSC(K,L,M,N)=ZERO
              DO I=1,3
                DO J=1,3
                  TENSC(K,L,M,N)=TENSC(K,L,M,N)+TENSA(I,J,K,L,M,N)*
     .                           TENSB(I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C           
C
C
C*Diarray Initialize array to zero  [REAL*8]
C=**********************************************************************
C                                                                      *
C                             D i a r r a y                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Diarray(ARRAY,D1,D2,D3,D4,D5,D6,D7) [REAL*8]
C         Subroutine to initialize ARRAY(D1,D2,D3,D4,D5,D6,D7) with
C         zeros. The actual size of the array is set to the product
C         of the nonzero values of D1,D2,D3,D4,D5,D6,D7.
C         Note: all non-existing dimensions must be specified as 0
C               e.g. A(3,3)==>call diarray(a,3,3,0,0,0,0,0)
C
C
C--
      SUBROUTINE Diarray(ARRAY,D1,D2,D3,D4,D5,D6,D7)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 ARRAY(*)
      INTEGER D1,D2,D3,D4,D5,D6,D7,TOTALSIZE
      DATA ZERO/0.0D0/
C
      TOTALSIZE=1
      IF(D1.GE.1)TOTALSIZE=TOTALSIZE*D1
      IF(D2.GE.1)TOTALSIZE=TOTALSIZE*D2
      IF(D3.GE.1)TOTALSIZE=TOTALSIZE*D3
      IF(D4.GE.1)TOTALSIZE=TOTALSIZE*D4
      IF(D5.GE.1)TOTALSIZE=TOTALSIZE*D5
      IF(D6.GE.1)TOTALSIZE=TOTALSIZE*D6
      IF(D7.GE.1)TOTALSIZE=TOTALSIZE*D7
      DO I=1,TOTALSIZE
        ARRAY(I)=ZERO
      END DO
C
      END


C           
C
C
C*iarray  Initialize array to zero [REAL*4]
C=**********************************************************************
C                                                                      *
C                              i a r r a y                             *
C                                                                      *
C=**********************************************************************
C+
C
C       iarray(ARRAY,D1,D2,D3,D4,D5,D6,D7) [REAL*4]
C         Subroutine to initialize ARRAY(D1,D2,D3,D4,D5,D6,D7) with
C         zeros. The actual size of the array is set to the product
C         of the nonzero values of D1,D2,D3,D4,D5,D6,D7.
C         Note: all non-existing dimensions must be specified as 0
C               e.g. A(3,3)==>call iarray(a,3,3,0,0,0,0,0)
C
C
C--
      SUBROUTINE iarray(ARRAY,D1,D2,D3,D4,D5,D6,D7)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 ARRAY(*)
      INTEGER D1,D2,D3,D4,D5,D6,D7,TOTALSIZE
      DATA ZERO/0.000/
C
      TOTALSIZE=1
      IF(D1.GE.1)TOTALSIZE=TOTALSIZE*D1
      IF(D2.GE.1)TOTALSIZE=TOTALSIZE*D2
      IF(D3.GE.1)TOTALSIZE=TOTALSIZE*D3
      IF(D4.GE.1)TOTALSIZE=TOTALSIZE*D4
      IF(D5.GE.1)TOTALSIZE=TOTALSIZE*D5
      IF(D6.GE.1)TOTALSIZE=TOTALSIZE*D6
      IF(D7.GE.1)TOTALSIZE=TOTALSIZE*D7
      DO I=1,TOTALSIZE
        ARRAY(I)=ZERO
      END DO
C
      END

C           
C
C
C*Dtensor_to_matrix  Transform fourth order tensor to matrix [REAL*8]
C=**********************************************************************
C                                                                      *
C                  D t e n s o r __ t o __  m a t r i x                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_to_matrix(TENSOR,MATRIX) [REAL*8]
C         Subroutine to transform a fourth order tensor into a   
C         second order matrix.
C         TENSOR - input, fourth order tensor to transform. array of
C                  floating point values.
C         MATRIX - output, second order matrix(3X3) of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dtensor_to_matrix(TENSOR,MATRIX)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSOR(3,3,3,3),MATRIX(3,3)
C
      CALL Diarray(MATRIX,3,3,0,0,0,0,0)
      MATRIX(1,1)=TENSOR(1,1,1,1)
      MATRIX(1,2)=TENSOR(1,1,2,2)
      MATRIX(1,3)=TENSOR(1,1,1,2)
      MATRIX(2,1)=TENSOR(2,2,1,1)
      MATRIX(2,2)=TENSOR(2,2,2,2)
      MATRIX(2,3)=TENSOR(2,2,1,2)
      MATRIX(3,1)=TENSOR(1,2,1,1)
      MATRIX(3,2)=TENSOR(1,2,2,2)
      MATRIX(3,3)=TENSOR(1,2,1,2)
C
C      CST1=TENSOR(3,3,1,1)/TENSOR(3,3,3,3)
C      CST2=TENSOR(3,3,2,2)/TENSOR(3,3,3,3)
C      CST3=(TENSOR(3,3,1,2)+TENSOR(3,3,2,1))/TENSOR(3,3,3,3)/2.
C      MATRIX(1,1)=MATRIX(1,1)-CST1*TENSOR(1,1,3,3)
C      MATRIX(1,2)=MATRIX(1,2)-CST2*TENSOR(1,1,3,3)
C      MATRIX(1,3)=MATRIX(1,3)-CST3*TENSOR(1,1,3,3)
C      MATRIX(2,1)=MATRIX(2,1)-CST1*TENSOR(2,2,3,3)
C      MATRIX(2,2)=MATRIX(2,2)-CST2*TENSOR(2,2,3,3)
C      MATRIX(2,3)=MATRIX(2,3)-CST3*TENSOR(2,2,3,3)
C      MATRIX(3,1)=MATRIX(3,1)-CST1*TENSOR(1,2,3,3)
C      MATRIX(3,2)=MATRIX(3,2)-CST2*TENSOR(1,2,3,3)
C      MATRIX(3,3)=MATRIX(3,3)-CST3*TENSOR(1,2,3,3)
C
      END

C           
C
C
C*tensor_to_matrix  Transform fourth order tensor to matrix [REAL*4]
C=**********************************************************************
C                                                                      *
C                    t e n s o r __ t o __  m a t r i x                *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_to_matrix(TENSOR,MATRIX) [REAL*4]
C         Subroutine to transform a fourth order tensor into a   
C         second order matrix.
C         TENSOR - input, fourth order tensor to transform. array of
C                  floating point values.
C         MATRIX - output, second order matrix(3X3) of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE tensor_to_matrix(TENSOR,MATRIX)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSOR(3,3,3,3),MATRIX(3,3)
C
      CALL iarray(MATRIX,3,3,0,0,0,0,0)
      MATRIX(1,1)=TENSOR(1,1,1,1)
      MATRIX(1,2)=TENSOR(1,1,2,2)
      MATRIX(1,3)=TENSOR(1,1,1,2)
      MATRIX(2,1)=TENSOR(2,2,1,1)
      MATRIX(2,2)=TENSOR(2,2,2,2)
      MATRIX(2,3)=TENSOR(2,2,1,2)
      MATRIX(3,1)=TENSOR(1,2,1,1)
      MATRIX(3,2)=TENSOR(1,2,2,2)
      MATRIX(3,3)=TENSOR(1,2,1,2)
C
C      CST1=TENSOR(3,3,1,1)/TENSOR(3,3,3,3)
C      CST2=TENSOR(3,3,2,2)/TENSOR(3,3,3,3)
C      CST3=(TENSOR(3,3,1,2)+TENSOR(3,3,2,1))/TENSOR(3,3,3,3)/2.
C      MATRIX(1,1)=MATRIX(1,1)-CST1*TENSOR(1,1,3,3)
C      MATRIX(1,2)=MATRIX(1,2)-CST2*TENSOR(1,1,3,3)
C      MATRIX(1,3)=MATRIX(1,3)-CST3*TENSOR(1,1,3,3)
C      MATRIX(2,1)=MATRIX(2,1)-CST1*TENSOR(2,2,3,3)
C      MATRIX(2,2)=MATRIX(2,2)-CST2*TENSOR(2,2,3,3)
C      MATRIX(2,3)=MATRIX(2,3)-CST3*TENSOR(2,2,3,3)
C      MATRIX(3,1)=MATRIX(3,1)-CST1*TENSOR(1,2,3,3)
C      MATRIX(3,2)=MATRIX(3,2)-CST2*TENSOR(1,2,3,3)
C      MATRIX(3,3)=MATRIX(3,3)-CST3*TENSOR(1,2,3,3)
C
      END
C           
C
C
C*Dvector_to_tensor  Convert vector to second order tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C                  D v e c t o r __ t o __  t e n s o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dvector_to_tensor(VECTOR,TENSOR) [REAL*8]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dvector_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(3),TENSOR(3,3)
C
      CALL Diarray(TENSOR,3,3,0,0,0,0,0)
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(1,2) = VECTOR(3)
      TENSOR(2,1) = TENSOR(1,2)
C
      END
C           
C
C
C*vector_to_tensor  Convert vector to second order tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C                    v e c t o r __ t o __  t e n s o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       vector_to_tensor(VECTOR,TENSOR) [REAL*4]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE vector_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(3),TENSOR(3,3)
C
      CALL iarray(TENSOR,3,3,0,0,0,0,0)
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(1,2) = VECTOR(3)
      TENSOR(2,1) = TENSOR(1,2)
C
      END
C           
C
C
C*Dtensor_to_vector  Convert second order tensor to a vector [REAL*8]
C=**********************************************************************
C                                                                      *
C                  D t e n s o r __ t o __  v e c t o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_to_vector(TENSOR,VECTOR) [REAL*8]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dtensor_to_vector(TENSOR,VECTOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(3),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(1,2)
C
      END
C           
C
C
C*tensor_to_vector  Convert second order tensor to a vector [REAL*4]
C=**********************************************************************
C                                                                      *
C                    t e n s o r __ t o __  v e c t o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_to_vector(TENSOR,VECTOR) [REAL*4]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE tensor_to_vector(TENSOR,VECTOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(3),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(1,2)
C
      END
C           
C
C
C*Dvector_6_to_tensor  Convert vector to second order tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C             D v e c t o r __ 6 __ t o __  t e n s o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dvector_6_to_tensor(VECTOR,TENSOR) [REAL*8]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dvector_6_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(6),TENSOR(3,3)
C
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(3,3) = VECTOR(3)
      TENSOR(2,3) = VECTOR(4)
      TENSOR(1,3) = VECTOR(5)
      TENSOR(1,2) = VECTOR(6)
      TENSOR(3,2) = VECTOR(4)
      TENSOR(3,1) = VECTOR(5)
      TENSOR(2,1) = VECTOR(6)
C
      END
C           
C
C
C*vector_6_to_tensor  Convert vector to second order tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C             v e c t o r __ 6 __ t o __  t e n s o r                  *
C                                                                      *
C=**********************************************************************
C+
C
C       vector_6_to_tensor(VECTOR,TENSOR) [REAL*4]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE vector_6_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(6),TENSOR(3,3)
C
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(3,3) = VECTOR(3)
      TENSOR(2,3) = VECTOR(4)
      TENSOR(1,3) = VECTOR(5)
      TENSOR(1,2) = VECTOR(6)
      TENSOR(3,2) = VECTOR(4)
      TENSOR(3,1) = VECTOR(5)
      TENSOR(2,1) = VECTOR(6)
C
      END
C           
C
C
C*Dtensor_to_vector_6  Convert second order tensor to a vector [REAL*8]
C=**********************************************************************
C                                                                      *
C             D t e n s o r __ t o __  v e c t o r __ 6                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_to_vector_6(TENSOR,VECTOR) [REAL*8]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dtensor_to_vector_6(TENSOR,VECTOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(6),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(3,3)
      VECTOR(4) = TENSOR(2,3)
      VECTOR(5) = TENSOR(1,3)
      VECTOR(6) = TENSOR(1,2)
C
      END
C           
C
C
C*tensor_to_vector_6  Convert second order tensor to a vector [REAL*4]
C=**********************************************************************
C                                                                      *
C             t e n s o r __ t o __  v e c t o r __ 6                  *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_to_vector_6(TENSOR,VECTOR) [REAL*4]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE tensor_to_vector_6(TENSOR,VECTOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(6),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(3,3)
      VECTOR(4) = TENSOR(2,3)
      VECTOR(5) = TENSOR(1,3)
      VECTOR(6) = TENSOR(1,2)
C
      END
C           
C
C
C*Dvector_9_to_tensor  Convert vector to second order tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C             D v e c t o r __ 9 __ t o __  t e n s o r                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dvector_9_to_tensor(VECTOR,TENSOR) [REAL*8]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dvector_9_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(9),TENSOR(3,3)
C
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(3,3) = VECTOR(3)
      TENSOR(2,3) = VECTOR(4)
      TENSOR(1,3) = VECTOR(5)
      TENSOR(1,2) = VECTOR(6)
      TENSOR(3,2) = VECTOR(7)
      TENSOR(3,1) = VECTOR(8)
      TENSOR(2,1) = VECTOR(9)
C
      END
C           
C
C
C*vector_9_to_tensor  Convert vector to second order tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C             v e c t o r __ 9 __ t o __  t e n s o r                  *
C                                                                      *
C=**********************************************************************
C+
C
C       vector_9_to_tensor(VECTOR,TENSOR) [REAL*4]
C         Subroutine to transform a tensor of order one into a  
C         second order tensor.
C         VECTOR - input, first order tensor to transform. array of
C                  floating point values.
C         TENSOR - output, second order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE vector_9_to_tensor(VECTOR,TENSOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(9),TENSOR(3,3)
C
      TENSOR(1,1) = VECTOR(1)
      TENSOR(2,2) = VECTOR(2)
      TENSOR(3,3) = VECTOR(3)
      TENSOR(2,3) = VECTOR(4)
      TENSOR(1,3) = VECTOR(5)
      TENSOR(1,2) = VECTOR(6)
      TENSOR(3,2) = VECTOR(7)
      TENSOR(3,1) = VECTOR(8)
      TENSOR(2,1) = VECTOR(9)
C
      END
C           
C
C
C*Dtensor_to_vector_9  Convert second order tensor to a vector [REAL*8]
C=**********************************************************************
C                                                                      *
C             D t e n s o r __ t o __  v e c t o r __ 9                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_to_vector_9(TENSOR,VECTOR) [REAL*8]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE Dtensor_to_vector_9(TENSOR,VECTOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 VECTOR(9),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(3,3)
      VECTOR(4) = TENSOR(2,3)
      VECTOR(5) = TENSOR(1,3)
      VECTOR(6) = TENSOR(1,2)
      VECTOR(7) = TENSOR(3,2)
      VECTOR(8) = TENSOR(3,1)
      VECTOR(9) = TENSOR(2,1)
C
      END
C           
C
C
C*tensor_to_vector_9  Convert second order tensor to a vector [REAL*4]
C=**********************************************************************
C                                                                      *
C             t e n s o r __ t o __  v e c t o r __ 9                  *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_to_vector_9(TENSOR,VECTOR) [REAL*4]
C         Subroutine to transform a tensor of order two into a  
C         first order tensor.
C         TENSOR - input, second order tensor to transform. array of
C                  floating point values.
C         VECTOR - output, first order tensor of transformed values.
C                  array of floating point values.
C
C
C--
      SUBROUTINE tensor_to_vector_9(TENSOR,VECTOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 VECTOR(9),TENSOR(3,3)
C
      VECTOR(1) = TENSOR(1,1)
      VECTOR(2) = TENSOR(2,2)
      VECTOR(3) = TENSOR(3,3)
      VECTOR(4) = TENSOR(2,3)
      VECTOR(5) = TENSOR(1,3)
      VECTOR(6) = TENSOR(1,2)
      VECTOR(7) = TENSOR(3,2)
      VECTOR(8) = TENSOR(3,1)
      VECTOR(9) = TENSOR(2,1)
C
      END
C           
C
C
C*Dsymmetrize  Convert any fourth order tensor into a symmetric tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C                         D s y m m e t r i z e                        *
C                                                                      *
C=**********************************************************************
C+
C
C       Dsymmetrize(TENSOR) [REAL*8]
C         Subroutine to transform a fourth order tensor into a  
C         symmetric fourth order tensor.
C         NOTE:  the original values in "TENSOR" are overwritten with
C                the symmetric values upon exit from subroutine.
C
C
C--
      SUBROUTINE Dsymmetrize(TENSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSOR(3,3,3,3)
      DATA EIGHTH,QUARTER,HALF/0.125D0,0.25D0,0.5D0/
C
      TENSOR(1,1,1,1)=TENSOR(1,1,1,1)
      TENSOR(2,2,2,2)=TENSOR(2,2,2,2)
      TENSOR(3,3,3,3)=TENSOR(3,3,3,3)
C
      TENSOR(1,1,2,2)=(TENSOR(1,1,2,2)+TENSOR(2,2,1,1))*HALF
      TENSOR(2,2,1,1)=TENSOR(1,1,2,2)
C
      TENSOR(1,1,3,3)=(TENSOR(1,1,3,3)+TENSOR(3,3,1,1))*HALF
      TENSOR(3,3,1,1)=TENSOR(1,1,3,3)
C
      TENSOR(2,2,3,3)=(TENSOR(2,2,3,3)+TENSOR(3,3,2,2))*HALF
      TENSOR(3,3,2,2)=TENSOR(2,2,3,3)
C
      TENSOR(1,2,1,2)=(TENSOR(1,2,1,2)+TENSOR(1,2,2,1)+TENSOR(2,1,1,2)+
     .                 TENSOR(2,1,2,1))*QUARTER
      TENSOR(1,2,2,1)=TENSOR(1,2,1,2)
      TENSOR(2,1,1,2)=TENSOR(1,2,1,2)
      TENSOR(2,1,2,1)=TENSOR(1,2,1,2)
C
      TENSOR(1,3,1,3)=(TENSOR(1,3,1,3)+TENSOR(1,3,3,1)+TENSOR(3,1,1,3)+
     .                 TENSOR(3,1,3,1))*QUARTER
      TENSOR(1,3,3,1)=TENSOR(1,3,1,3)
      TENSOR(3,1,1,3)=TENSOR(1,3,1,3)
      TENSOR(3,1,3,1)=TENSOR(1,3,1,3)
C
      TENSOR(2,3,2,3)=(TENSOR(2,3,2,3)+TENSOR(2,3,3,2)+TENSOR(3,2,2,3)+
     .                 TENSOR(3,2,3,2))*QUARTER
      TENSOR(2,3,3,2)=TENSOR(2,3,2,3)
      TENSOR(3,2,2,3)=TENSOR(2,3,2,3)
      TENSOR(3,2,3,2)=TENSOR(2,3,2,3)
C
      TENSOR(1,1,1,2)=(TENSOR(1,1,1,2)+TENSOR(1,1,2,1)+TENSOR(1,2,1,1)+
     .                 TENSOR(2,1,1,1))*QUARTER
      TENSOR(1,1,2,1)=TENSOR(1,1,1,2)
      TENSOR(1,2,1,1)=TENSOR(1,1,1,2)
      TENSOR(2,1,1,1)=TENSOR(1,1,1,2)
C
      TENSOR(1,1,1,3)=(TENSOR(1,1,1,3)+TENSOR(1,1,3,1)+TENSOR(1,3,1,1)+
     .                 TENSOR(3,1,1,1))*QUARTER
      TENSOR(1,1,3,1)=TENSOR(1,1,1,3)
      TENSOR(1,3,1,1)=TENSOR(1,1,1,3)
      TENSOR(3,1,1,1)=TENSOR(1,1,1,3)
C
      TENSOR(1,1,2,3)=(TENSOR(1,1,2,3)+TENSOR(1,1,3,2)+TENSOR(2,3,1,1)+
     .                 TENSOR(3,2,1,1))*QUARTER
      TENSOR(1,1,3,2)=TENSOR(1,1,2,3)
      TENSOR(2,3,1,1)=TENSOR(1,1,2,3)
      TENSOR(3,2,1,1)=TENSOR(1,1,2,3)
C
      TENSOR(2,2,1,2)=(TENSOR(2,2,1,2)+TENSOR(2,2,2,1)+TENSOR(1,2,2,2)+
     .                 TENSOR(2,1,2,2))*QUARTER
      TENSOR(2,2,2,1)=TENSOR(2,2,1,2)
      TENSOR(1,2,2,2)=TENSOR(2,2,1,2)
      TENSOR(2,1,2,2)=TENSOR(2,2,1,2)
C
      TENSOR(2,2,1,3)=(TENSOR(2,2,1,3)+TENSOR(2,2,3,1)+TENSOR(1,3,2,2)+
     .                 TENSOR(3,1,2,2))*QUARTER
      TENSOR(2,2,3,1)=TENSOR(2,2,1,3)
      TENSOR(1,3,2,2)=TENSOR(2,2,1,3)
      TENSOR(3,1,2,2)=TENSOR(2,2,1,3)
C
      TENSOR(2,2,2,3)=(TENSOR(2,2,2,3)+TENSOR(2,2,3,2)+TENSOR(2,3,2,2)+
     .                 TENSOR(3,2,2,2))*QUARTER
      TENSOR(2,2,3,2)=TENSOR(2,2,2,3)
      TENSOR(2,3,2,2)=TENSOR(2,2,2,3)
      TENSOR(3,2,2,2)=TENSOR(2,2,2,3)
C
      TENSOR(3,3,1,2)=(TENSOR(3,3,1,2)+TENSOR(3,3,2,1)+TENSOR(1,2,3,3)+
     .                 TENSOR(2,1,3,3))*QUARTER
      TENSOR(3,3,2,1)=TENSOR(3,3,1,2)
      TENSOR(1,2,3,3)=TENSOR(3,3,1,2)
      TENSOR(2,1,3,3)=TENSOR(3,3,1,2)
C
      TENSOR(3,3,1,3)=(TENSOR(3,3,1,3)+TENSOR(3,3,3,1)+TENSOR(1,3,3,3)+
     .                 TENSOR(3,1,3,3))*QUARTER
      TENSOR(3,3,3,1)=TENSOR(3,3,1,3)
      TENSOR(1,3,3,3)=TENSOR(3,3,1,3)
      TENSOR(3,1,3,3)=TENSOR(3,3,1,3)
C
      TENSOR(3,3,2,3)=(TENSOR(3,3,2,3)+TENSOR(3,3,3,2)+TENSOR(3,2,3,3)+
     .                 TENSOR(2,3,3,3))*QUARTER
      TENSOR(3,3,3,2)=TENSOR(3,3,2,3)
      TENSOR(3,2,3,3)=TENSOR(3,3,2,3)
      TENSOR(2,3,3,3)=TENSOR(3,3,2,3)
C
      TENSOR(1,2,1,3)=(TENSOR(1,2,1,3)+TENSOR(1,2,3,1)+TENSOR(2,1,1,3)+
     .                 TENSOR(2,1,3,1)+TENSOR(1,3,1,2)+TENSOR(1,3,2,1)+
     .                 TENSOR(3,1,1,2)+TENSOR(3,1,2,1))*EIGHTH
      TENSOR(1,2,3,1)=TENSOR(1,2,1,3)
      TENSOR(2,1,1,3)=TENSOR(1,2,1,3)
      TENSOR(2,1,3,1)=TENSOR(1,2,1,3)
      TENSOR(1,3,1,2)=TENSOR(1,2,1,3)
      TENSOR(1,3,2,1)=TENSOR(1,2,1,3)
      TENSOR(3,1,1,2)=TENSOR(1,2,1,3)
      TENSOR(3,1,2,1)=TENSOR(1,2,1,3)
C
      TENSOR(1,2,2,3)=(TENSOR(1,2,2,3)+TENSOR(1,2,3,2)+TENSOR(2,1,2,3)+
     .                 TENSOR(2,1,3,2)+TENSOR(2,3,1,2)+TENSOR(2,3,2,1)+
     .                 TENSOR(3,2,1,2)+TENSOR(3,2,2,1))*EIGHTH
      TENSOR(1,2,3,2)=TENSOR(1,2,2,3)
      TENSOR(2,1,2,3)=TENSOR(1,2,2,3)
      TENSOR(2,1,3,2)=TENSOR(1,2,2,3)
      TENSOR(2,3,1,2)=TENSOR(1,2,2,3)
      TENSOR(2,3,2,1)=TENSOR(1,2,2,3)
      TENSOR(3,2,1,2)=TENSOR(1,2,2,3)
      TENSOR(3,2,2,1)=TENSOR(1,2,2,3)
C
      TENSOR(1,3,2,3)=(TENSOR(1,3,2,3)+TENSOR(1,3,3,2)+TENSOR(3,1,2,3)+
     .                 TENSOR(3,1,3,2)+TENSOR(2,3,1,3)+TENSOR(2,3,3,1)+
     .                 TENSOR(3,2,1,3)+TENSOR(3,2,3,1))*EIGHTH
      TENSOR(1,3,3,2)=TENSOR(1,3,2,3)
      TENSOR(3,1,2,3)=TENSOR(1,3,2,3)
      TENSOR(3,1,3,2)=TENSOR(1,3,2,3)
      TENSOR(2,3,1,3)=TENSOR(1,3,2,3)
      TENSOR(2,3,3,1)=TENSOR(1,3,2,3)
      TENSOR(3,2,1,3)=TENSOR(1,3,2,3)
      TENSOR(3,2,3,1)=TENSOR(1,3,2,3)
C
      END
C           
C
C
C*symmetrize  Convert any fourth order tensor into a symmetric tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C                           s y m m e t r i z e                        *
C                                                                      *
C=**********************************************************************
C+
C
C       symmetrize(TENSOR) [REAL*4]
C         Subroutine to transform a fourth order tensor into a  
C         symmetric fourth order tensor.
C         NOTE:  the original values in "TENSOR" are overwritten with
C                the symmetric values upon exit from subroutine.
C
C
C--
      SUBROUTINE symmetrize(TENSOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSOR(3,3,3,3)
      DATA EIGHTH,QUARTER,HALF/0.12500,0.2500,0.500/
C
      TENSOR(1,1,1,1)=TENSOR(1,1,1,1)
      TENSOR(2,2,2,2)=TENSOR(2,2,2,2)
      TENSOR(3,3,3,3)=TENSOR(3,3,3,3)
C
      TENSOR(1,1,2,2)=(TENSOR(1,1,2,2)+TENSOR(2,2,1,1))*HALF
      TENSOR(2,2,1,1)=TENSOR(1,1,2,2)
C
      TENSOR(1,1,3,3)=(TENSOR(1,1,3,3)+TENSOR(3,3,1,1))*HALF
      TENSOR(3,3,1,1)=TENSOR(1,1,3,3)
C
      TENSOR(2,2,3,3)=(TENSOR(2,2,3,3)+TENSOR(3,3,2,2))*HALF
      TENSOR(3,3,2,2)=TENSOR(2,2,3,3)
C
      TENSOR(1,2,1,2)=(TENSOR(1,2,1,2)+TENSOR(1,2,2,1)+TENSOR(2,1,1,2)+
     .                 TENSOR(2,1,2,1))*QUARTER
      TENSOR(1,2,2,1)=TENSOR(1,2,1,2)
      TENSOR(2,1,1,2)=TENSOR(1,2,1,2)
      TENSOR(2,1,2,1)=TENSOR(1,2,1,2)
C
      TENSOR(1,3,1,3)=(TENSOR(1,3,1,3)+TENSOR(1,3,3,1)+TENSOR(3,1,1,3)+
     .                 TENSOR(3,1,3,1))*QUARTER
      TENSOR(1,3,3,1)=TENSOR(1,3,1,3)
      TENSOR(3,1,1,3)=TENSOR(1,3,1,3)
      TENSOR(3,1,3,1)=TENSOR(1,3,1,3)
C
      TENSOR(2,3,2,3)=(TENSOR(2,3,2,3)+TENSOR(2,3,3,2)+TENSOR(3,2,2,3)+
     .                 TENSOR(3,2,3,2))*QUARTER
      TENSOR(2,3,3,2)=TENSOR(2,3,2,3)
      TENSOR(3,2,2,3)=TENSOR(2,3,2,3)
      TENSOR(3,2,3,2)=TENSOR(2,3,2,3)
C
      TENSOR(1,1,1,2)=(TENSOR(1,1,1,2)+TENSOR(1,1,2,1)+TENSOR(1,2,1,1)+
     .                 TENSOR(2,1,1,1))*QUARTER
      TENSOR(1,1,2,1)=TENSOR(1,1,1,2)
      TENSOR(1,2,1,1)=TENSOR(1,1,1,2)
      TENSOR(2,1,1,1)=TENSOR(1,1,1,2)
C
      TENSOR(1,1,1,3)=(TENSOR(1,1,1,3)+TENSOR(1,1,3,1)+TENSOR(1,3,1,1)+
     .                 TENSOR(3,1,1,1))*QUARTER
      TENSOR(1,1,3,1)=TENSOR(1,1,1,3)
      TENSOR(1,3,1,1)=TENSOR(1,1,1,3)
      TENSOR(3,1,1,1)=TENSOR(1,1,1,3)
C
      TENSOR(1,1,2,3)=(TENSOR(1,1,2,3)+TENSOR(1,1,3,2)+TENSOR(2,3,1,1)+
     .                 TENSOR(3,2,1,1))*QUARTER
      TENSOR(1,1,3,2)=TENSOR(1,1,2,3)
      TENSOR(2,3,1,1)=TENSOR(1,1,2,3)
      TENSOR(3,2,1,1)=TENSOR(1,1,2,3)
C
      TENSOR(2,2,1,2)=(TENSOR(2,2,1,2)+TENSOR(2,2,2,1)+TENSOR(1,2,2,2)+
     .                 TENSOR(2,1,2,2))*QUARTER
      TENSOR(2,2,2,1)=TENSOR(2,2,1,2)
      TENSOR(1,2,2,2)=TENSOR(2,2,1,2)
      TENSOR(2,1,2,2)=TENSOR(2,2,1,2)
C
      TENSOR(2,2,1,3)=(TENSOR(2,2,1,3)+TENSOR(2,2,3,1)+TENSOR(1,3,2,2)+
     .                 TENSOR(3,1,2,2))*QUARTER
      TENSOR(2,2,3,1)=TENSOR(2,2,1,3)
      TENSOR(1,3,2,2)=TENSOR(2,2,1,3)
      TENSOR(3,1,2,2)=TENSOR(2,2,1,3)
C
      TENSOR(2,2,2,3)=(TENSOR(2,2,2,3)+TENSOR(2,2,3,2)+TENSOR(2,3,2,2)+
     .                 TENSOR(3,2,2,2))*QUARTER
      TENSOR(2,2,3,2)=TENSOR(2,2,2,3)
      TENSOR(2,3,2,2)=TENSOR(2,2,2,3)
      TENSOR(3,2,2,2)=TENSOR(2,2,2,3)
C
      TENSOR(3,3,1,2)=(TENSOR(3,3,1,2)+TENSOR(3,3,2,1)+TENSOR(1,2,3,3)+
     .                 TENSOR(2,1,3,3))*QUARTER
      TENSOR(3,3,2,1)=TENSOR(3,3,1,2)
      TENSOR(1,2,3,3)=TENSOR(3,3,1,2)
      TENSOR(2,1,3,3)=TENSOR(3,3,1,2)
C
      TENSOR(3,3,1,3)=(TENSOR(3,3,1,3)+TENSOR(3,3,3,1)+TENSOR(1,3,3,3)+
     .                 TENSOR(3,1,3,3))*QUARTER
      TENSOR(3,3,3,1)=TENSOR(3,3,1,3)
      TENSOR(1,3,3,3)=TENSOR(3,3,1,3)
      TENSOR(3,1,3,3)=TENSOR(3,3,1,3)
C
      TENSOR(3,3,2,3)=(TENSOR(3,3,2,3)+TENSOR(3,3,3,2)+TENSOR(3,2,3,3)+
     .                 TENSOR(2,3,3,3))*QUARTER
      TENSOR(3,3,3,2)=TENSOR(3,3,2,3)
      TENSOR(3,2,3,3)=TENSOR(3,3,2,3)
      TENSOR(2,3,3,3)=TENSOR(3,3,2,3)
C
      TENSOR(1,2,1,3)=(TENSOR(1,2,1,3)+TENSOR(1,2,3,1)+TENSOR(2,1,1,3)+
     .                 TENSOR(2,1,3,1)+TENSOR(1,3,1,2)+TENSOR(1,3,2,1)+
     .                 TENSOR(3,1,1,2)+TENSOR(3,1,2,1))*EIGHTH
      TENSOR(1,2,3,1)=TENSOR(1,2,1,3)
      TENSOR(2,1,1,3)=TENSOR(1,2,1,3)
      TENSOR(2,1,3,1)=TENSOR(1,2,1,3)
      TENSOR(1,3,1,2)=TENSOR(1,2,1,3)
      TENSOR(1,3,2,1)=TENSOR(1,2,1,3)
      TENSOR(3,1,1,2)=TENSOR(1,2,1,3)
      TENSOR(3,1,2,1)=TENSOR(1,2,1,3)
C
      TENSOR(1,2,2,3)=(TENSOR(1,2,2,3)+TENSOR(1,2,3,2)+TENSOR(2,1,2,3)+
     .                 TENSOR(2,1,3,2)+TENSOR(2,3,1,2)+TENSOR(2,3,2,1)+
     .                 TENSOR(3,2,1,2)+TENSOR(3,2,2,1))*EIGHTH
      TENSOR(1,2,3,2)=TENSOR(1,2,2,3)
      TENSOR(2,1,2,3)=TENSOR(1,2,2,3)
      TENSOR(2,1,3,2)=TENSOR(1,2,2,3)
      TENSOR(2,3,1,2)=TENSOR(1,2,2,3)
      TENSOR(2,3,2,1)=TENSOR(1,2,2,3)
      TENSOR(3,2,1,2)=TENSOR(1,2,2,3)
      TENSOR(3,2,2,1)=TENSOR(1,2,2,3)
C
      TENSOR(1,3,2,3)=(TENSOR(1,3,2,3)+TENSOR(1,3,3,2)+TENSOR(3,1,2,3)+
     .                 TENSOR(3,1,3,2)+TENSOR(2,3,1,3)+TENSOR(2,3,3,1)+
     .                 TENSOR(3,2,1,3)+TENSOR(3,2,3,1))*EIGHTH
      TENSOR(1,3,3,2)=TENSOR(1,3,2,3)
      TENSOR(3,1,2,3)=TENSOR(1,3,2,3)
      TENSOR(3,1,3,2)=TENSOR(1,3,2,3)
      TENSOR(2,3,1,3)=TENSOR(1,3,2,3)
      TENSOR(2,3,3,1)=TENSOR(1,3,2,3)
      TENSOR(3,2,1,3)=TENSOR(1,3,2,3)
      TENSOR(3,2,3,1)=TENSOR(1,3,2,3)
C
      END
C           
C
C
C*Dtensor_to_matrix_full  Convert fourth order tensor into 6x6 matrix [REAL*8]
C=**********************************************************************
C                                                                      *
C          D t e n s o r  __  t o  __  m a t r i x  __  f u l l        *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_to_matrix_full(TENSOR,MATRIX) [REAL*8]
C         Subroutine to transform a fourth order tensor into a  
C         second order matrix.
C         TENSOR - input, fourth order tensor to be transformed.
C                  an array of floating point values.
C         MATRIX - output, second order matrix(6X6) of transformed values.
C                  an array of floating point values.
C
C
C--
      SUBROUTINE Dtensor_to_matrix_full(TENSOR,MATRIX)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSOR(3,3,3,3),MATRIX(6,6)
C
      CALL Diarray(MATRIX,6,6,0,0,0,0,0)
      MATRIX(1,1)=TENSOR(1,1,1,1)
      MATRIX(1,2)=TENSOR(1,1,2,2)
      MATRIX(1,3)=TENSOR(1,1,3,3)
      MATRIX(1,4)=TENSOR(1,1,1,2)
      MATRIX(1,5)=TENSOR(1,1,2,3)
      MATRIX(1,6)=TENSOR(1,1,1,3)
C
      MATRIX(2,1)=TENSOR(2,2,1,1)
      MATRIX(2,2)=TENSOR(2,2,2,2)
      MATRIX(2,3)=TENSOR(2,2,3,3)
      MATRIX(2,4)=TENSOR(2,2,1,2)
      MATRIX(2,5)=TENSOR(2,2,2,3)
      MATRIX(2,6)=TENSOR(2,2,1,3)
C
      MATRIX(3,1)=TENSOR(3,3,1,1)
      MATRIX(3,2)=TENSOR(3,3,2,2)
      MATRIX(3,3)=TENSOR(3,3,3,3)
      MATRIX(3,4)=TENSOR(3,3,1,2)
      MATRIX(3,5)=TENSOR(3,3,2,3)
      MATRIX(3,6)=TENSOR(3,3,1,3)
C
      MATRIX(4,1)=TENSOR(1,2,1,1)
      MATRIX(4,2)=TENSOR(1,2,2,2)
      MATRIX(4,3)=TENSOR(1,2,3,3)
      MATRIX(4,4)=TENSOR(1,2,1,2)
      MATRIX(4,5)=TENSOR(1,2,2,3)
      MATRIX(4,6)=TENSOR(1,2,1,3)
C
      MATRIX(5,1)=TENSOR(2,3,1,1)
      MATRIX(5,2)=TENSOR(2,3,2,2)
      MATRIX(5,3)=TENSOR(2,3,3,3)
      MATRIX(5,4)=TENSOR(2,3,1,2)
      MATRIX(5,5)=TENSOR(2,3,2,3)
      MATRIX(5,6)=TENSOR(2,3,1,3)
C
      MATRIX(6,1)=TENSOR(1,3,1,1)
      MATRIX(6,2)=TENSOR(1,3,2,2)
      MATRIX(6,3)=TENSOR(1,3,3,3)
      MATRIX(6,4)=TENSOR(1,3,1,2)
      MATRIX(6,5)=TENSOR(1,3,2,3)
      MATRIX(6,6)=TENSOR(1,3,1,3)
C
      END
C           
C
C
C*tensor_to_matrix_full  Convert fourth order tensor into 6x6 matrix [REAL*4]
C=**********************************************************************
C                                                                      *
C            t e n s o r  __  t o  __  m a t r i x  __  f u l l        *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_to_matrix_full(TENSOR,MATRIX) [REAL*4]
C         Subroutine to transform a fourth order tensor into a  
C         second order matrix.
C         TENSOR - input, fourth order tensor to be transformed.
C                  an array of floating point values.
C         MATRIX - output, second order matrix(6X6) of transformed values.
C                  an array of floating point values.
C
C
C--
      SUBROUTINE tensor_to_matrix_full(TENSOR,MATRIX)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSOR(3,3,3,3),MATRIX(6,6)
C
      CALL iarray(MATRIX,6,6,0,0,0,0,0)
      MATRIX(1,1)=TENSOR(1,1,1,1)
      MATRIX(1,2)=TENSOR(1,1,2,2)
      MATRIX(1,3)=TENSOR(1,1,3,3)
      MATRIX(1,4)=TENSOR(1,1,1,2)
      MATRIX(1,5)=TENSOR(1,1,2,3)
      MATRIX(1,6)=TENSOR(1,1,1,3)
C
      MATRIX(2,1)=TENSOR(2,2,1,1)
      MATRIX(2,2)=TENSOR(2,2,2,2)
      MATRIX(2,3)=TENSOR(2,2,3,3)
      MATRIX(2,4)=TENSOR(2,2,1,2)
      MATRIX(2,5)=TENSOR(2,2,2,3)
      MATRIX(2,6)=TENSOR(2,2,1,3)
C
      MATRIX(3,1)=TENSOR(3,3,1,1)
      MATRIX(3,2)=TENSOR(3,3,2,2)
      MATRIX(3,3)=TENSOR(3,3,3,3)
      MATRIX(3,4)=TENSOR(3,3,1,2)
      MATRIX(3,5)=TENSOR(3,3,2,3)
      MATRIX(3,6)=TENSOR(3,3,1,3)
C
      MATRIX(4,1)=TENSOR(1,2,1,1)
      MATRIX(4,2)=TENSOR(1,2,2,2)
      MATRIX(4,3)=TENSOR(1,2,3,3)
      MATRIX(4,4)=TENSOR(1,2,1,2)
      MATRIX(4,5)=TENSOR(1,2,2,3)
      MATRIX(4,6)=TENSOR(1,2,1,3)
C
      MATRIX(5,1)=TENSOR(2,3,1,1)
      MATRIX(5,2)=TENSOR(2,3,2,2)
      MATRIX(5,3)=TENSOR(2,3,3,3)
      MATRIX(5,4)=TENSOR(2,3,1,2)
      MATRIX(5,5)=TENSOR(2,3,2,3)
      MATRIX(5,6)=TENSOR(2,3,1,3)
C
      MATRIX(6,1)=TENSOR(1,3,1,1)
      MATRIX(6,2)=TENSOR(1,3,2,2)
      MATRIX(6,3)=TENSOR(1,3,3,3)
      MATRIX(6,4)=TENSOR(1,3,1,2)
      MATRIX(6,5)=TENSOR(1,3,2,3)
      MATRIX(6,6)=TENSOR(1,3,1,3)
C
      END
C           
C
C
C*Dmatrix_full_to_tensor  Converts 6x6 matrix into a fourth order tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C          D m a t r i x  __  f u l l  __  t o  __  t e n s o r        *
C                                                                      *
C=**********************************************************************
C+
C
C       Dmatrix_full_to_tensor(MATRIX,TENSOR) [REAL*8]
C         Subroutine to transform a second order matrix into a  
C         fourth order tensor.
C         MATRIX - input, second order matrix(6X6) to be transformed.
C                  an array of floating point values.
C         TENSOR - output, fourth order tensor of transformed values.
C                  an array of floating point values.
C
C
C--
      SUBROUTINE Dmatrix_full_to_tensor(MATRIX,TENSOR)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 MATRIX(6,6),TENSOR(3,3,3,3)
      DATA QUARTER,HALF/0.25D0,0.5D0/
C
      CALL Diarray(TENSOR,3,3,3,3,0,0,0)
      TENSOR(1,1,1,1)=MATRIX(1,1)
      TENSOR(1,1,2,2)=MATRIX(1,2)
      TENSOR(1,1,3,3)=MATRIX(1,3)
      TENSOR(1,1,1,2)=MATRIX(1,4)*HALF
      TENSOR(1,1,2,1)=MATRIX(1,4)*HALF
      TENSOR(1,1,2,3)=MATRIX(1,5)*HALF
      TENSOR(1,1,3,2)=MATRIX(1,5)*HALF
      TENSOR(1,1,1,3)=MATRIX(1,6)*HALF
      TENSOR(1,1,3,1)=MATRIX(1,6)*HALF
C
      TENSOR(2,2,1,1)=MATRIX(2,1)
      TENSOR(2,2,2,2)=MATRIX(2,2)
      TENSOR(2,2,3,3)=MATRIX(2,3)
      TENSOR(2,2,1,2)=MATRIX(2,4)*HALF
      TENSOR(2,2,2,1)=MATRIX(2,4)*HALF
      TENSOR(2,2,2,3)=MATRIX(2,5)*HALF
      TENSOR(2,2,3,2)=MATRIX(2,5)*HALF
      TENSOR(2,2,1,3)=MATRIX(2,6)*HALF
      TENSOR(2,2,3,1)=MATRIX(2,6)*HALF
C
      TENSOR(3,3,1,1)=MATRIX(3,1)
      TENSOR(3,3,2,2)=MATRIX(3,2)
      TENSOR(3,3,3,3)=MATRIX(3,3)
      TENSOR(3,3,1,2)=MATRIX(3,4)*HALF
      TENSOR(3,3,2,1)=MATRIX(3,4)*HALF
      TENSOR(3,3,2,3)=MATRIX(3,5)*HALF
      TENSOR(3,3,3,2)=MATRIX(3,5)*HALF
      TENSOR(3,3,1,3)=MATRIX(3,6)*HALF
      TENSOR(3,3,3,1)=MATRIX(3,6)*HALF
C
      TENSOR(1,2,1,1)=MATRIX(4,1)*HALF
      TENSOR(1,2,2,2)=MATRIX(4,2)*HALF
      TENSOR(1,2,3,3)=MATRIX(4,3)*HALF
      TENSOR(1,2,1,2)=MATRIX(4,4)*QUARTER
      TENSOR(1,2,2,1)=MATRIX(4,4)*QUARTER
      TENSOR(1,2,2,3)=MATRIX(4,5)*QUARTER
      TENSOR(1,2,3,2)=MATRIX(4,5)*QUARTER
      TENSOR(1,2,1,3)=MATRIX(4,6)*QUARTER
      TENSOR(1,2,3,1)=MATRIX(4,6)*QUARTER
C
      TENSOR(2,1,1,1)=MATRIX(4,1)*HALF
      TENSOR(2,1,2,2)=MATRIX(4,2)*HALF
      TENSOR(2,1,3,3)=MATRIX(4,3)*HALF
      TENSOR(2,1,1,2)=MATRIX(4,4)*QUARTER
      TENSOR(2,1,2,1)=MATRIX(4,4)*QUARTER
      TENSOR(2,1,2,3)=MATRIX(4,5)*QUARTER
      TENSOR(2,1,3,2)=MATRIX(4,5)*QUARTER
      TENSOR(2,1,1,3)=MATRIX(4,6)*QUARTER
      TENSOR(2,1,3,1)=MATRIX(4,6)*QUARTER
C
      TENSOR(2,3,1,1)=MATRIX(5,1)*HALF
      TENSOR(2,3,2,2)=MATRIX(5,2)*HALF
      TENSOR(2,3,3,3)=MATRIX(5,3)*HALF
      TENSOR(2,3,1,2)=MATRIX(5,4)*QUARTER
      TENSOR(2,3,2,1)=MATRIX(5,4)*QUARTER
      TENSOR(2,3,2,3)=MATRIX(5,5)*QUARTER
      TENSOR(2,3,3,2)=MATRIX(5,5)*QUARTER
      TENSOR(2,3,1,3)=MATRIX(5,6)*QUARTER
      TENSOR(2,3,3,1)=MATRIX(5,6)*QUARTER
C
      TENSOR(3,2,1,1)=MATRIX(5,1)*HALF
      TENSOR(3,2,2,2)=MATRIX(5,2)*HALF
      TENSOR(3,2,3,3)=MATRIX(5,3)*HALF
      TENSOR(3,2,1,2)=MATRIX(5,4)*QUARTER
      TENSOR(3,2,2,1)=MATRIX(5,4)*QUARTER
      TENSOR(3,2,2,3)=MATRIX(5,5)*QUARTER
      TENSOR(3,2,3,2)=MATRIX(5,5)*QUARTER
      TENSOR(3,2,1,3)=MATRIX(5,6)*QUARTER
      TENSOR(3,2,3,1)=MATRIX(5,6)*QUARTER
C
      TENSOR(1,3,1,1)=MATRIX(6,1)*HALF
      TENSOR(1,3,2,2)=MATRIX(6,2)*HALF
      TENSOR(1,3,3,3)=MATRIX(6,3)*HALF
      TENSOR(1,3,1,2)=MATRIX(6,4)*QUARTER
      TENSOR(1,3,2,1)=MATRIX(6,4)*QUARTER
      TENSOR(1,3,2,3)=MATRIX(6,5)*QUARTER
      TENSOR(1,3,3,2)=MATRIX(6,5)*QUARTER
      TENSOR(1,3,1,3)=MATRIX(6,6)*QUARTER
      TENSOR(1,3,3,1)=MATRIX(6,6)*QUARTER
C
      TENSOR(3,1,1,1)=MATRIX(6,1)*HALF
      TENSOR(3,1,2,2)=MATRIX(6,2)*HALF
      TENSOR(3,1,3,3)=MATRIX(6,3)*HALF
      TENSOR(3,1,1,2)=MATRIX(6,4)*QUARTER
      TENSOR(3,1,2,1)=MATRIX(6,4)*QUARTER
      TENSOR(3,1,2,3)=MATRIX(6,5)*QUARTER
      TENSOR(3,1,3,2)=MATRIX(6,5)*QUARTER
      TENSOR(3,1,1,3)=MATRIX(6,6)*QUARTER
      TENSOR(3,1,3,1)=MATRIX(6,6)*QUARTER
C
      END
C           
C
C
C*matrix_full_to_tensor  Converts 6x6 matrix into a fourth order tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C            m a t r i x  __  f u l l  __  t o  __  t e n s o r        *
C                                                                      *
C=**********************************************************************
C+
C
C       matrix_full_to_tensor(MATRIX,TENSOR) [REAL*4]
C         Subroutine to transform a second order matrix into a  
C         fourth order tensor.
C         MATRIX - input, second order matrix(6X6) to be transformed.
C                  an array of floating point values.
C         TENSOR - output, fourth order tensor of transformed values.
C                  an array of floating point values.
C
C
C--
      SUBROUTINE matrix_full_to_tensor(MATRIX,TENSOR)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 MATRIX(6,6),TENSOR(3,3,3,3)
      DATA QUARTER,HALF/0.2500,0.500/
C
      CALL iarray(TENSOR,3,3,3,3,0,0,0)
      TENSOR(1,1,1,1)=MATRIX(1,1)
      TENSOR(1,1,2,2)=MATRIX(1,2)
      TENSOR(1,1,3,3)=MATRIX(1,3)
      TENSOR(1,1,1,2)=MATRIX(1,4)*HALF
      TENSOR(1,1,2,1)=MATRIX(1,4)*HALF
      TENSOR(1,1,2,3)=MATRIX(1,5)*HALF
      TENSOR(1,1,3,2)=MATRIX(1,5)*HALF
      TENSOR(1,1,1,3)=MATRIX(1,6)*HALF
      TENSOR(1,1,3,1)=MATRIX(1,6)*HALF
C
      TENSOR(2,2,1,1)=MATRIX(2,1)
      TENSOR(2,2,2,2)=MATRIX(2,2)
      TENSOR(2,2,3,3)=MATRIX(2,3)
      TENSOR(2,2,1,2)=MATRIX(2,4)*HALF
      TENSOR(2,2,2,1)=MATRIX(2,4)*HALF
      TENSOR(2,2,2,3)=MATRIX(2,5)*HALF
      TENSOR(2,2,3,2)=MATRIX(2,5)*HALF
      TENSOR(2,2,1,3)=MATRIX(2,6)*HALF
      TENSOR(2,2,3,1)=MATRIX(2,6)*HALF
C
      TENSOR(3,3,1,1)=MATRIX(3,1)
      TENSOR(3,3,2,2)=MATRIX(3,2)
      TENSOR(3,3,3,3)=MATRIX(3,3)
      TENSOR(3,3,1,2)=MATRIX(3,4)*HALF
      TENSOR(3,3,2,1)=MATRIX(3,4)*HALF
      TENSOR(3,3,2,3)=MATRIX(3,5)*HALF
      TENSOR(3,3,3,2)=MATRIX(3,5)*HALF
      TENSOR(3,3,1,3)=MATRIX(3,6)*HALF
      TENSOR(3,3,3,1)=MATRIX(3,6)*HALF
C
      TENSOR(1,2,1,1)=MATRIX(4,1)*HALF
      TENSOR(1,2,2,2)=MATRIX(4,2)*HALF
      TENSOR(1,2,3,3)=MATRIX(4,3)*HALF
      TENSOR(1,2,1,2)=MATRIX(4,4)*QUARTER
      TENSOR(1,2,2,1)=MATRIX(4,4)*QUARTER
      TENSOR(1,2,2,3)=MATRIX(4,5)*QUARTER
      TENSOR(1,2,3,2)=MATRIX(4,5)*QUARTER
      TENSOR(1,2,1,3)=MATRIX(4,6)*QUARTER
      TENSOR(1,2,3,1)=MATRIX(4,6)*QUARTER
C
      TENSOR(2,1,1,1)=MATRIX(4,1)*HALF
      TENSOR(2,1,2,2)=MATRIX(4,2)*HALF
      TENSOR(2,1,3,3)=MATRIX(4,3)*HALF
      TENSOR(2,1,1,2)=MATRIX(4,4)*QUARTER
      TENSOR(2,1,2,1)=MATRIX(4,4)*QUARTER
      TENSOR(2,1,2,3)=MATRIX(4,5)*QUARTER
      TENSOR(2,1,3,2)=MATRIX(4,5)*QUARTER
      TENSOR(2,1,1,3)=MATRIX(4,6)*QUARTER
      TENSOR(2,1,3,1)=MATRIX(4,6)*QUARTER
C
      TENSOR(2,3,1,1)=MATRIX(5,1)*HALF
      TENSOR(2,3,2,2)=MATRIX(5,2)*HALF
      TENSOR(2,3,3,3)=MATRIX(5,3)*HALF
      TENSOR(2,3,1,2)=MATRIX(5,4)*QUARTER
      TENSOR(2,3,2,1)=MATRIX(5,4)*QUARTER
      TENSOR(2,3,2,3)=MATRIX(5,5)*QUARTER
      TENSOR(2,3,3,2)=MATRIX(5,5)*QUARTER
      TENSOR(2,3,1,3)=MATRIX(5,6)*QUARTER
      TENSOR(2,3,3,1)=MATRIX(5,6)*QUARTER
C
      TENSOR(3,2,1,1)=MATRIX(5,1)*HALF
      TENSOR(3,2,2,2)=MATRIX(5,2)*HALF
      TENSOR(3,2,3,3)=MATRIX(5,3)*HALF
      TENSOR(3,2,1,2)=MATRIX(5,4)*QUARTER
      TENSOR(3,2,2,1)=MATRIX(5,4)*QUARTER
      TENSOR(3,2,2,3)=MATRIX(5,5)*QUARTER
      TENSOR(3,2,3,2)=MATRIX(5,5)*QUARTER
      TENSOR(3,2,1,3)=MATRIX(5,6)*QUARTER
      TENSOR(3,2,3,1)=MATRIX(5,6)*QUARTER
C
      TENSOR(1,3,1,1)=MATRIX(6,1)*HALF
      TENSOR(1,3,2,2)=MATRIX(6,2)*HALF
      TENSOR(1,3,3,3)=MATRIX(6,3)*HALF
      TENSOR(1,3,1,2)=MATRIX(6,4)*QUARTER
      TENSOR(1,3,2,1)=MATRIX(6,4)*QUARTER
      TENSOR(1,3,2,3)=MATRIX(6,5)*QUARTER
      TENSOR(1,3,3,2)=MATRIX(6,5)*QUARTER
      TENSOR(1,3,1,3)=MATRIX(6,6)*QUARTER
      TENSOR(1,3,3,1)=MATRIX(6,6)*QUARTER
C
      TENSOR(3,1,1,1)=MATRIX(6,1)*HALF
      TENSOR(3,1,2,2)=MATRIX(6,2)*HALF
      TENSOR(3,1,3,3)=MATRIX(6,3)*HALF
      TENSOR(3,1,1,2)=MATRIX(6,4)*QUARTER
      TENSOR(3,1,2,1)=MATRIX(6,4)*QUARTER
      TENSOR(3,1,2,3)=MATRIX(6,5)*QUARTER
      TENSOR(3,1,3,2)=MATRIX(6,5)*QUARTER
      TENSOR(3,1,1,3)=MATRIX(6,6)*QUARTER
      TENSOR(3,1,3,1)=MATRIX(6,6)*QUARTER
C
      END
C                   
C
C
C*Darray_copy Makes duplicate copy of an array  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D a r r a y __ c o p y                      *
C                                                                      *
C=**********************************************************************
C+
C
C       Darray_copy(array1,array2,D1,D2,D3,D4,D5,D6,D7) [REAL*8]
C         Subroutine to make a duplicate copy of an array with 7 or
C         less dimensions.
C         array1 - array of floating point values to be copied
C         array2 - array of floating point containing the copy
C                  of array1.
C         D#     - integer value representing the upper bound of
C                  corresponding array dimension.
C
C         The actual size of the array is set to the product
C         of the nonzero values of D1,D2,D3,D4,D5,D6,D7.
C         Note: all non-existing dimensions must be specified as 0
C               e.g. to copy A(3,3) to B(3,3)
C                    ==>call darray_copy(a,b,3,3,0,0,0,0,0)
C
C
C--
      SUBROUTINE Darray_copy(ARRAY1,ARRAY2,D1,D2,D3,D4,D5,D6,D7)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 ARRAY1(*),ARRAY2(*)
      INTEGER D1,D2,D3,D4,D5,D6,D7,TOTALSIZE
C
      TOTALSIZE=1
      IF(D1.GE.1)TOTALSIZE=TOTALSIZE*D1
      IF(D2.GE.1)TOTALSIZE=TOTALSIZE*D2
      IF(D3.GE.1)TOTALSIZE=TOTALSIZE*D3
      IF(D4.GE.1)TOTALSIZE=TOTALSIZE*D4
      IF(D5.GE.1)TOTALSIZE=TOTALSIZE*D5
      IF(D6.GE.1)TOTALSIZE=TOTALSIZE*D6
      IF(D7.GE.1)TOTALSIZE=TOTALSIZE*D7
      DO I=1,TOTALSIZE
        ARRAY2(I)=ARRAY1(I)
      END DO
C
      END
C           
C
C
C*array_copy Makes duplicate copy of an array  [REAL*4]
C=**********************************************************************
C                                                                      *
C                          a r r a y __ c o p y                        *
C                                                                      *
C=**********************************************************************
C+
C
C       array_copy(array1,array2,D1,D2,D3,D4,D5,D6,D7) [REAL*4]
C         Subroutine to make a duplicate copy of an array with 7 or
C         less dimensions.
C         array1 - array of floating point values to be copied
C         array2 - array of floating point containing the copy
C                  of array1.
C         D#     - integer value representing the upper bound of
C                  corresponding array dimension.
C
C         The actual size of the array is set to the product
C         of the nonzero values of D1,D2,D3,D4,D5,D6,D7.
C         Note: all non-existing dimensions must be specified as 0
C               e.g. to copy A(3,3) to B(3,3)
C                    ==>call array_copy(a,b,3,3,0,0,0,0,0)
C
C
C--
      SUBROUTINE array_copy(ARRAY1,ARRAY2,D1,D2,D3,D4,D5,D6,D7)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 ARRAY1(*),ARRAY2(*)
      INTEGER D1,D2,D3,D4,D5,D6,D7,TOTALSIZE
C
      TOTALSIZE=1
      IF(D1.GE.1)TOTALSIZE=TOTALSIZE*D1
      IF(D2.GE.1)TOTALSIZE=TOTALSIZE*D2
      IF(D3.GE.1)TOTALSIZE=TOTALSIZE*D3
      IF(D4.GE.1)TOTALSIZE=TOTALSIZE*D4
      IF(D5.GE.1)TOTALSIZE=TOTALSIZE*D5
      IF(D6.GE.1)TOTALSIZE=TOTALSIZE*D6
      IF(D7.GE.1)TOTALSIZE=TOTALSIZE*D7
      DO I=1,TOTALSIZE
        ARRAY2(I)=ARRAY1(I)
      END DO
C
      END
C           
C
C
C*Dtensor_inverse  Compute the inverse of a fourth order tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C                  D t e n s o r  __  i n v e r s e                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Dtensor_inverse(TENSOR,TENSOR_INV,PTYPE,OK) [REAL*8]
C         Subroutine to invert a fourth order tensor using LU decomposition.
C         TENSOR     - input, fourth order tensor to be inverted.
C                      an array of floating point values.
C         TENSOR_INV - output, fourth order tensor of inverted values.
C                      an array of floating point values.
C         PTYPE      - character variable representing the type of pivoting
C                      to use in the LU decomposition:
C                      maximal -> pivoting based on maximal column pivoting
C                      scaled  -> pivoting based on scaled column pivoting
C                      total   -> pivoting based on maximal column and 
C                                 row pivoting.
C                      note: only the first character of each keyword is
C                            is significant. if incorrectly specified
C                            maximal pivoting will be used.
C         OK         - logical indicating the status of the inversion.
C                      true  ==> inversion was successful
C                      false ==> inversion was unsuccessful
C         NOTE       : "TENSOR" and "TENSOR_INV" may be the same
C
C
C--
      SUBROUTINE Dtensor_inverse(TENSOR,TENSOR_INV,PIVOT_TYPE,OK)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 MATRIX(6,6),MATRIX1(6,6),MAT3(6,6)
      REAL*8 TENSOR(3,3,3,3),TENSOR_INV(3,3,3,3)
      INTEGER PIVOT(6),PIVOTT(3,6)
      CHARACTER PIVOT_TYPE*(*)
      LOGICAL OK
C
      CALL Dsymmetrize(TENSOR)
      CALL Dtensor_to_matrix_full(TENSOR,MATRIX)
      CALL DMATRIX_INVERSE(MATRIX,MATRIX1,MAT3,PIVOT,PIVOTT,6,
     .                     PIVOT_TYPE,OK)
      IF(.NOT.OK)RETURN
      CALL Dmatrix_full_to_tensor(MATRIX1,TENSOR_INV)
C
      END
      
C           
C
C
C*tensor_inverse  Compute the inverse of a fourth order tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C                    t e n s o r  __  i n v e r s e                    *
C                                                                      *
C=**********************************************************************
C+
C
C       tensor_inverse(TENSOR,TENSOR_INV,PTYPE,OK) [REAL*4]
C         Subroutine to invert a fourth order tensor using LU decomposition.
C         TENSOR     - input, fourth order tensor to be inverted.
C                      an array of floating point values.
C         TENSOR_INV - output, fourth order tensor of inverted values.
C                      an array of floating point values.
C         PTYPE      - character variable representing the type of pivoting
C                      to use in the LU decomposition:
C                      maximal -> pivoting based on maximal column pivoting
C                      scaled  -> pivoting based on scaled column pivoting
C                      total   -> pivoting based on maximal column and 
C                                 row pivoting.
C                      note: only the first character of each keyword is
C                            is significant. if incorrectly specified
C                            maximal pivoting will be used.
C         OK         - logical indicating the status of the inversion.
C                      true  ==> inversion was successful
C                      false ==> inversion was unsuccessful
C         NOTE       : "TENSOR" and "TENSOR_INV" may be the same
C
C
C--
      SUBROUTINE tensor_inverse(TENSOR,TENSOR_INV,PIVOT_TYPE,OK)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 MATRIX(6,6),MATRIX1(6,6),MAT3(6,6)
      REAL*4 TENSOR(3,3,3,3),TENSOR_INV(3,3,3,3)
      INTEGER PIVOT(6),PIVOTT(3,6)
      CHARACTER PIVOT_TYPE*(*)
      LOGICAL OK
C
      CALL symmetrize(TENSOR)
      CALL tensor_to_matrix_full(TENSOR,MATRIX)
      CALL MATRIX_INVERSE(MATRIX,MATRIX1,MAT3,PIVOT,PIVOTT,6,
     .                    PIVOT_TYPE,OK)
      IF(.NOT.OK)RETURN
      CALL matrix_full_to_tensor(MATRIX1,TENSOR_INV)
C
      END
      
C
C*DAijkl_minus_Bijkl  Computes Cijkl=Aijkl-Bijkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                 D A i j k l __ m i n u s __ B i j k l                *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_minus_Bijkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the difference of two fourth order   
C         tensors term for term.
C         i.e. it performs the operation Cijkl=Aijkl-Bijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                     point values.
C         tensC    - the output fourth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijkl_minus_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J,K,L)-TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_minus_Bijkl  Computes Cijkl=Aijkl-Bijkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                  A i j k l __ m i n u s __ B i j k l                 *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_minus_Bijkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the difference of two fourth order   
C         tensors term for term.
C         i.e. it performs the operation Cijkl=Aijkl-Bijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                     point values.
C         tensC    - the output fourth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijkl_minus_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J,K,L)-TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijkl_plus_Bijkl  Computes Cijkl=Aijkl+Bijkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                 D A i j k l __ p l u s __ B i j k l                  *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijkl_plus_Bijkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the sum of two fourth order   
C         tensors term for term.
C         i.e. it performs the operation Cijkl=Aijkl+Bijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                     point values.
C         tensC    - the output fourth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijkl_plus_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J,K,L)+TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijkl_plus_Bijkl  Computes Cijkl=Aijkl+Bijkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                  A i j k l __ p l u s __ B i j k l                   *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijkl_plus_Bijkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the sum of two fourth order   
C         tensors term for term.
C         i.e. it performs the operation Cijkl=Aijkl+Bijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the input fourth order tensor B. an array of floating
C                     point values.
C         tensC    - the output fourth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijkl_plus_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSC(I,J,K,L)=TENSA(I,J,K,L)+TENSB(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijklmn_minus_Bijklmn  Computes Cijklmn=Aijklmn-Bijklmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D A i j k l m n __ m i n u s __ B i j k l m n            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_minus_Bijklmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the difference of two sixth order   
C         tensors term for term.
C         i.e. it performs the operation Cijklmn=Aijklmn-Bijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the input sixth order tensor B. an array of floating
C                     point values.
C         tensC    - the output sixth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijklmn_minus_Bijklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L,M,N)-
     $                               TENSB(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijklmn_minus_Bijklmn  Computes Cijklmn=Aijklmn-Bijklmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C               A i j k l m n __ m i n u s __ B i j k l m n            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_minus_Bijklmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the difference of two sixth order   
C         tensors term for term.
C         i.e. it performs the operation Cijklmn=Aijklmn-Bijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the input sixth order tensor B. an array of floating
C                     point values.
C         tensC    - the output sixth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijklmn_minus_Bijklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L,M,N)-
     $                               TENSB(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAijklmn_plus_Bijklmn  Computes Cijklmn=Aijklmn+Bijklmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D A i j k l m n __ p l u s __ B i j k l m n              *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_plus_Bijklmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to compute the sum of two sixth order   
C         tensors term for term.
C         i.e. it performs the operation Cijklmn=Aijklmn+Bijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the input sixth order tensor B. an array of floating
C                     point values.
C         tensC    - the output sixth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAijklmn_plus_Bijklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L,M,N)+
     $                               TENSB(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aijklmn_plus_Bijklmn  Computes Cijklmn=Aijklmn+Bijklmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C               A i j k l m n __ p l u s __ B i j k l m n              *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_plus_Bijklmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to compute the sum of two sixth order   
C         tensors term for term.
C         i.e. it performs the operation Cijklmn=Aijklmn+Bijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the input sixth order tensor B. an array of floating
C                     point values.
C         tensC    - the output sixth order tensor C.
C         NOTE:   "tensC" may be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aijklmn_plus_Bijklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),TENSC(3,3,3,3,3,3)
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J,K,L,M,N)=TENSA(I,J,K,L,M,N)+
     $                               TENSB(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Dscalar_multiply_Ai  Computes Ci=AiB  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D s c a l a r __ m u l t i p l y __ A i                  *
C                                                                      *
C=**********************************************************************
C+
C
C       Dscalar_multiply_Ai(tensA,tensB,scalarC) [REAL*8]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a vector (first order tensor) term for term.
C         i.e. it performs the operation Bi=C*Ai
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the output first order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE Dscalar_multiply_Ai(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),SCALARC
C
      DO I=1,3
        TENSB(I)=SCALARC*TENSA(I)
      END DO
C
      END
C
C
C
C*scalar_multiply_Ai  Computes Ci=AiB  [REAL*4]
C=**********************************************************************
C                                                                      *
C               s c a l a r __ m u l t i p l y __ A i                  *
C                                                                      *
C=**********************************************************************
C+
C
C       scalar_multiply_Ai(tensA,tensB,scalarC) [REAL*4]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a vector (first order tensor) term for term.
C         i.e. it performs the operation Bi=C*Ai
C
C         tensA    - the input first order tensor A. an array of floating
C                     point values.
C         tensB    - the output first order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE scalar_multiply_Ai(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3),TENSB(3),SCALARC
C
      DO I=1,3
        TENSB(I)=SCALARC*TENSA(I)
      END DO
C
      END
C
C
C
C*Dscalar_multiply_Aij  Computes Cij=AijB  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D s c a l a r __ m u l t i p l y __ A i j                *
C                                                                      *
C=**********************************************************************
C+
C
C       Dscalar_multiply_Aij(tensA,tensB,scalarC) [REAL*8]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a second order tensor term for term.
C         i.e. it performs the operation Bij=C*Aij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the output second order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE Dscalar_multiply_Aij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=SCALARC*TENSA(I,J)
        END DO
      END DO
C
      END
C
C
C
C*scalar_multiply_Aij  Computes Cij=AijB  [REAL*4]
C=**********************************************************************
C                                                                      *
C               s c a l a r __ m u l t i p l y __ A i j                *
C                                                                      *
C=**********************************************************************
C+
C
C       scalar_multiply_Aij(tensA,tensB,scalarC) [REAL*4]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a second order tensor term for term.
C         i.e. it performs the operation Bij=C*Aij
C
C         tensA    - the input second order tensor A. an array of floating
C                     point values.
C         tensB    - the output second order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE scalar_multiply_Aij(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=SCALARC*TENSA(I,J)
        END DO
      END DO
C
      END
C
C
C
C*Dscalar_multiply_Aijkl  Computes Cijkl=AijklB  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D s c a l a r __ m u l t i p l y __ A i j k l            *
C                                                                      *
C=**********************************************************************
C+
C
C       Dscalar_multiply_Aijkl(tensA,tensB,scalarC) [REAL*8]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a fourth order tensor term for term.
C         i.e. it performs the operation Bijkl=C*Aijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the output fourth order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE Dscalar_multiply_Aijkl(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSB(I,J,K,L)=SCALARC*TENSA(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*scalar_multiply_Aijkl  Computes Cijkl=AijklB  [REAL*4]
C=**********************************************************************
C                                                                      *
C               s c a l a r __ m u l t i p l y __ A i j k l            *
C                                                                      *
C=**********************************************************************
C+
C
C       scalar_multiply_Aijkl(tensA,tensB,scalarC) [REAL*4]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a fourth order tensor term for term.
C         i.e. it performs the operation Bijkl=C*Aijkl
C
C         tensA    - the input fourth order tensor A. an array of floating
C                     point values.
C         tensB    - the output fourth order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE scalar_multiply_Aijkl(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSB(I,J,K,L)=SCALARC*TENSA(I,J,K,L)
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Dscalar_multiply_Aijklmn  Computes Cijklmn=AijklmnB  [REAL*8]
C=**********************************************************************
C                                                                      *
C             D s c a l a r __ m u l t i p l y __ A i j k l m n        *
C                                                                      *
C=**********************************************************************
C+
C
C       Dscalar_multiply_Aijklmn(tensA,tensB,scalarC) [REAL*8]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a sixth order tensor term for term.
C         i.e. it performs the operation Bijklmn=C*Aijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the output sixth order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE Dscalar_multiply_Aijklmn(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSB(I,J,K,L,M,N)=SCALARC*TENSA(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*scalar_multiply_Aijklmn  Computes Cijklmn=AijklmnB  [REAL*4]
C=**********************************************************************
C                                                                      *
C               s c a l a r __ m u l t i p l y __ A i j k l m n        *
C                                                                      *
C=**********************************************************************
C+
C
C       scalar_multiply_Aijklmn(tensA,tensB,scalarC) [REAL*4]
C         subroutine to compute the scalar multiplication of a scalar   
C         and a sixth order tensor term for term.
C         i.e. it performs the operation Bijklmn=C*Aijklmn
C
C         tensA    - the input sixth order tensor A. an array of floating
C                     point values.
C         tensB    - the output sixth order tensor B.
C         scalarC  - the input scalar C.
C         NOTE:   "tensB" may be the same as "tensA"
C
C
C--
      SUBROUTINE scalar_multiply_Aijklmn(TENSA,TENSB,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3,3,3),SCALARC
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSB(I,J,K,L,M,N)=SCALARC*TENSA(I,J,K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAik_Bjk  Computes Cij=AikBjk  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i k __ B j k                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAik_Bjk(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AikBjk
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAik_Bjk(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(I,K)*TENSB(J,K)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aik_Bjk  Computes Cij=AikBjk  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A i k __ B j k                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aik_Bjk(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AikBjk
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aik_Bjk(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(I,K)*TENSB(J,K)
          END DO
        END DO
      END DO
C
      END
C
C
C
C
C
C*DAki_Bkj  Computes Cij=AkiBkj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A k i __ B k j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       DAki_Bkj(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AkiBkj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE DAki_Bkj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(K,I)*TENSB(K,J)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Aki_Bkj  Computes Cij=AkiBkj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A k i __ B k j                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Aki_Bkj(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply two second order tensors to yield a
C         second order tensor.
C         i.e. it performs the operation Cij=AkiBkj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input second order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensA" or "tensB"
C
C
C--
      SUBROUTINE Aki_Bkj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3),TENSC(3,3)
      DATA ZERO /0.000/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            TENSC(I,J)=TENSC(I,J)+TENSA(K,I)*TENSB(K,J)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAji_Bj  Computes Ci=AjiBj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A j i __ B j                              *
C                                                                      *
C=**********************************************************************
C+
C
C       DAji_Bj(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a first order tensor and a second 
C         order tensor to yield a first order tensor. 
C         i.e. it performs the operation Ci=AjiBj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output first order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE DAji_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3),TENSC(3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        TENSC(I)=ZERO
        DO J=1,3
          TENSC(I)=TENSC(I)+TENSA(J,I)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C
C*Aji_Bj  Computes Ci=AjiBj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                            A j i __ B j                              *
C                                                                      *
C=**********************************************************************
C+
C
C       Aji_Bj(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a first order tensor and a second 
C         order tensor to yield a first order tensor. 
C         i.e. it performs the operation Ci=AjiBj
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the input first order tensor B. an array of floating
C                   point values.
C         tensC   - the output first order tensor C. an array of floating
C                   point values.
C         note   : "tensC" may not be the same as "tensB"
C
C
C--
      SUBROUTINE Aji_Bj(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3),TENSC(3)
      DATA ZERO /0.000/
C
      DO I=1,3
        TENSC(I)=ZERO
        DO J=1,3
          TENSC(I)=TENSC(I)+TENSA(J,I)*TENSB(J)
        END DO
      END DO
C
      END
C
C
C
C*DAijklmn_Bijkl  Computes Cmn=AijklmnBijkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B i j k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bijkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cmn=AijklmnBijkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO M=1,3
        DO N=1,3
          TENSC(M,N)=ZERO
          DO I=1,3
            DO J=1,3
              DO K=1,3
                DO L=1,3
                  TENSC(M,N)=TENSC(M,N)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(I,J,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bijkl  Computes Cmn=AijklmnBijkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B i j k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bijkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cmn=AijklmnBijkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bijkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO M=1,3
        DO N=1,3
          TENSC(M,N)=ZERO
          DO I=1,3
            DO J=1,3
              DO K=1,3
                DO L=1,3
                  TENSC(M,N)=TENSC(M,N)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(I,J,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bijmn  Computes Ckl=AijklmnBijmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B i j m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bijmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklmnBijmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bijmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(I,J,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bijmn  Computes Ckl=AijklmnBijmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B i j m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bijmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklmnBijmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bijmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.00/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(I,J,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bklmn  Computes Cij=AijklmnBklmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B k l m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bklmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklmnBklmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(K,L)=ZERO
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bklmn  Computes Cij=AijklmnBklmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B k l m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bklmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklmnBklmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bklmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(K,L,M,N)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bklij  Computes Cmn=AijklmnBklij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B k l i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bklij(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cmn=AijklmnBklij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bklij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO M=1,3
        DO N=1,3
          TENSC(M,N)=ZERO
          DO I=1,3
            DO J=1,3
              DO K=1,3
                DO L=1,3
                  TENSC(M,N)=TENSC(M,N)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(K,L,I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bklij  Computes Cmn=AijklmnBklij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B k l i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bklij(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cmn=AijklmnBklij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bklij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.00/
C
      DO M=1,3
        DO N=1,3
          TENSC(M,N)=ZERO
          DO I=1,3
            DO J=1,3
              DO K=1,3
                DO L=1,3
                  TENSC(M,N)=TENSC(M,N)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(K,L,I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bmnij  Computes Ckl=Aijklmnbmnij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B m n i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bmnij(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklmnBmnij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bmnij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(M,N,I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bmnij  Computes Ckl=AijklmnBmnij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B m n i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bmnij(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Ckl=AijklmnBmnij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bmnij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.00/
C
      DO K=1,3
        DO L=1,3
          TENSC(K,L)=ZERO
          DO I=1,3
            DO J=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(K,L)=TENSC(K,L)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(M,N,I,J)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bmnkl  Computes Cij=AijklmnBmnkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B m n k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bmnkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklmnBmnkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bmnkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          TENSC(K,L)=ZERO
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(M,N,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bmnkl  Computes Cij=AijklmnBmnkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        A i j k l m n __ B m n k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bmnkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a second order tensor. 
C         i.e. it performs the operation Cij=AijklmnBmnkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output second order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bmnkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          TENSC(I,J)=ZERO
          DO K=1,3
            DO L=1,3
              DO M=1,3
                DO N=1,3
                  TENSC(I,J)=TENSC(I,J)+TENSA(I,J,K,L,M,N)*
     $                       TENSB(M,N,K,L)
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Didentity_2  Computes second order identity tensor  [REAL*8]
C=**********************************************************************
C                                                                      *
C                       D i d e n t i t y __ 2                         *
C                                                                      *
C=**********************************************************************
C+
C
C       Didentity_2(delta) [REAL*8]
C         subroutine to compute the second order identity tensor  
C         (known as the Kroneker delta).
C
C         delta   - the output second order identity tensor.  
C                   an array of floating point values.
C
C
C--
      SUBROUTINE DIDENTITY_2(DELTA)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 DELTA(3,3)
      DATA ZERO,ONE /0.0D0,1.0D0/
C         
      DELTA(1,1)=ONE
      DELTA(2,2)=ONE
      DELTA(3,3)=ONE
      DELTA(1,2)=ZERO
      DELTA(1,3)=ZERO
      DELTA(2,1)=ZERO
      DELTA(2,3)=ZERO
      DELTA(3,1)=ZERO
      DELTA(3,2)=ZERO
C
      END
C
C
C
C*identity_2  Computes second order identity tensor  [REAL*4]
C=**********************************************************************
C                                                                      *
C                        i d e n t i t y __ 2                          *
C                                                                      *
C=**********************************************************************
C+
C
C       identity_2(delta) [REAL*4]
C         subroutine to compute the second order identity tensor  
C         (known as the Kroneker delta).
C
C         delta   - the output second order identity tensor.  
C                   an array of floating point values.
C
C
C--
      SUBROUTINE IDENTITY_2(DELTA)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 DELTA(3,3)
      DATA ZERO,ONE /0.00,1.00/
C         
      DELTA(1,1)=ONE
      DELTA(2,2)=ONE
      DELTA(3,3)=ONE
      DELTA(1,2)=ZERO
      DELTA(1,3)=ZERO
      DELTA(2,1)=ZERO
      DELTA(2,3)=ZERO
      DELTA(3,1)=ZERO
      DELTA(3,2)=ZERO
C
      END
C
C
C
C*Didentity_4  Computes fourth order identity tensor  [REAL*8]
C=**********************************************************************
C                                                                      *
C                    D i d e n t i t y __ 4                            *
C                                                                      *
C=**********************************************************************
C+
C
C       Didentity_4(DELTA_FOURTH) [REAL*8]
C         subroutine to compute the fourth order identity tensor.
C
C         DELTA_FOURTH   - the output fourth order identity tensor.
C
C
C--
      SUBROUTINE DIDENTITY_4(DELTA_FOURTH)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 DELTA_FOURTH(3,3,3,3)
      REAL*8 DELTA(3,3)
      DATA TWO/2.0D0/
C         
      CALL DIDENTITY_2(DELTA)
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DELTA_FOURTH(I,J,K,L)=(DELTA(I,K)*DELTA(J,L)
     $                        +DELTA(I,L)*DELTA(J,K))/TWO 
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*identity_4  Computes fourth order identity tensor  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     i d e n t i t y __ 4                             *
C                                                                      *
C=**********************************************************************
C+
C
C       identity_4(DELTA_FOURTH) [REAL*4]
C         subroutine to compute the fourth order identity tensor.
C
C         DELTA_FOURTH   - the output fourth order identity tensor.
C
C
C--
      SUBROUTINE IDENTITY_4(DELTA_FOURTH)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 DELTA_FOURTH(3,3,3,3)
      REAL*4 DELTA(3,3)
      DATA TWO/2.00/
C         
      CALL IDENTITY_2(DELTA)
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DELTA_FOURTH(I,J,K,L)=(DELTA(I,K)*DELTA(J,L)
     $                        +DELTA(I,L)*DELTA(J,K))/TWO 
            END DO
          END DO
        END DO
      END DO
C
      END
C
C
C
C*DAmmij  Computes Cij=Ammij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A m m i j                                 *
C                                                                      *
C=**********************************************************************
C+
C
C       DAmmij(tensA,tensB) [REAL*8]
C         subroutine to compute the contraction of a fourth 
C         order tensor into a second order tensor.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the output second order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE DAmmij(TENSA,TENSB)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3)
      DATA ZERO/0.0D0/
C         
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=ZERO  
          DO M=1,3
            TENSB(I,J)=TENSB(I,J)+TENSA(M,M,I,J)
          END DO
        END DO
      END DO
C
      END
C           
C
C
C*Ammij  Computes Cij=Ammij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                           A m m i j                                  *
C                                                                      *
C=**********************************************************************
C+
C
C       Ammij(tensA,tensB) [REAL*4]
C         subroutine to compute the contraction of a fourth 
C         order tensor into a second order tensor.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the output second order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE Ammij(TENSA,TENSB)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3)
      DATA ZERO/0.00/
C         
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=ZERO  
          DO M=1,3
            TENSB(I,J)=TENSB(I,J)+TENSA(M,M,I,J)
          END DO
        END DO
      END DO
C
      END
C
C
C
C*Dsdeviator  Computes deviatoric part of second order tensor  [REAL*8]
C=**********************************************************************
C                                                                      *
C                    D s d e v i a t o r                               *
C                                                                      *
C=**********************************************************************
C+
C
C       Dsdeviator(tensA,tensB) [REAL*8]
C         subroutine to compute the deviatoric part of a second 
C         order tensor.
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the output second order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE Dsdeviator(TENSA,TENSB)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),TENSB(3,3)
      REAL*8 SCALARC,DELTA(3,3)
      DATA THREE/3.0D0/
C         
      CALL Didentity_2(DELTA)
      CALL DAii(TENSA,SCALARC)
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=TENSA(I,J)-DELTA(I,J)*SCALARC/THREE 
        END DO
      END DO
C
      END
C           
C
C
C*sdeviator  Computes deviatoric part of second order tensor  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     S d e v i a t o r                                *
C                                                                      *
C=**********************************************************************
C+
C
C       sdeviator(tensA,tensB) [REAL*4]
C         subroutine to compute the deviatoric part of a second 
C         order tensor.
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         tensB   - the output second order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE sdeviator(TENSA,TENSB)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),TENSB(3,3)
      REAL*4 SCALARC,DELTA(3,3)
      DATA THREE/3.00/
C         
      CALL identity_2(DELTA)
      CALL Aii(TENSA,SCALARC)
      DO I=1,3
        DO J=1,3
          TENSB(I,J)=TENSA(I,J)-DELTA(I,J)*SCALARC/THREE 
        END DO
      END DO
C
      END
C
C
C
C*Dsdeviator_4  Computes deviatoric part of fourth order tensor  [REAL*8]
C=**********************************************************************
C                                                                      *
C                    D s d e v i a t o r __ 4                          *
C                                                                      *
C=**********************************************************************
C+
C
C       Dsdeviator_4(tensA,tensB) [REAL*8]
C         subroutine to compute the "deviatoric" part of a fourth 
C         order tensor.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the output fourth order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE Dsdeviator_4(TENSA,TENSB)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),TENSB(3,3,3,3)
      REAL*8 TENSC(3,3),DELTA(3,3)
      DATA THREE/3.0D0/
C         
      CALL Didentity_2(DELTA)
      CALL DAmmij(TENSA,TENSC)
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSB(I,J,K,L)=TENSA(I,J,K,L)-DELTA(I,J)*TENSC(K,L)/THREE 
            END DO
          END DO
        END DO
      END DO
C
      END

C           
C
C
C*sdeviator_4  Computes deviatoric part of fourth order tensor  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     s d e v i a t o r __ 4                           *
C                                                                      *
C=**********************************************************************
C+
C
C       sdeviator_4(tensA,tensB) [REAL*4]
C         subroutine to compute the "deviatoric" part of a fourth 
C         order tensor.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         tensB   - the output fourth order tensor B containing the 
C                   "deviatoric" components of tensor A. an array of 
C                   floating point values.
C         note   : "tensB" may not be the same as "tensA" 
C
C
C--
      SUBROUTINE sdeviator_4(TENSA,TENSB)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),TENSB(3,3,3,3)
      REAL*4 TENSC(3,3),DELTA(3,3)
      DATA THREE/3.00/
C         
      CALL identity_2(DELTA)
      CALL Ammij(TENSA,TENSC)
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              TENSB(I,J,K,L)=TENSA(I,J,K,L)-DELTA(I,J)*TENSC(K,L)/THREE 
            END DO
          END DO    
        END DO  
      END DO  
C
      END

C           
C
C
C*DAijij  Computes C=Aijij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i j i j                                 *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijij(tensA,scalarC) [REAL*8]
C         subroutine to compute the contraction Aijij of a fourth 
C         order tensor into a scalar.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE DAijij(TENSA,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),SCALARC
      DATA ZERO/0.0D0/
C         
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
           SCALARC=SCALARC+TENSA(I,J,I,J)
        END DO
      END DO
C
      END
C           
C
C
C*Aijij  Computes C=Aijij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                           A i j i j                                  *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijij(tensA,scalarC) [REAL*4]
C         subroutine to compute the contraction Aijij of a fourth 
C         order tensor into a scalar.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE Aijij(TENSA,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),SCALARC
      DATA ZERO/0.00/

C         
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
           SCALARC=SCALARC+TENSA(I,J,I,J)
        END DO
      END DO
C
      END
C           
C
C
C*DAiijj  Computes C=Aiijj  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i i j j                                 *
C                                                                      *
C=**********************************************************************
C+
C
C       DAiijj(tensA,scalarC) [REAL*8]
C         subroutine to compute the contraction Aiijj of a fourth 
C         order tensor into a scalar.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE DAiijj(TENSA,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3),SCALARC
      DATA ZERO/0.0D0/
C         
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
           SCALARC=SCALARC+TENSA(I,I,J,J)
        END DO
      END DO
C
      END
C           
C
C
C*Aiijj  Computes C=Aiijj  [REAL*4]
C=**********************************************************************
C                                                                      *
C                           A i i j j                                  *
C                                                                      *
C=**********************************************************************
C+
C
C       Aiijj(tensA,scalarC) [REAL*4]
C         subroutine to compute the contraction Aiijj of a fourth 
C         order tensor into a scalar.
C
C         tensA   - the input fourth order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE Aiijj(TENSA,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3),SCALARC
      DATA ZERO/0.00/
C         
      SCALARC=ZERO
      DO I=1,3
        DO J=1,3
           SCALARC=SCALARC+TENSA(I,I,J,J)
        END DO
      END DO
C
      END
C           
C
C
C*DAii  Computes C=Aii  [REAL*8]
C=**********************************************************************
C                                                                      *
C                          D A i i                                     *
C                                                                      *
C=**********************************************************************
C+
C
C       DAii(tensA,scalarC) [REAL*8]
C         subroutine to compute the contraction Aii of a second 
C         order tensor into a scalar.
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE DAii(TENSA,SCALARC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3),SCALARC
      DATA ZERO/0.0D0/
C         
      SCALARC=ZERO
      DO I=1,3
        SCALARC=SCALARC+TENSA(I,I)
      END DO
C
      END
C           
C
C
C*Aii  Computes C=Aii  [REAL*4]
C=**********************************************************************
C                                                                      *
C                              A i i                                   *
C                                                                      *
C=**********************************************************************
C+
C
C       Aii(tensA,scalarC) [REAL*4]
C         subroutine to compute the contraction Aii of a second 
C         order tensor into a scalar.
C
C         tensA   - the input second order tensor A. an array of floating
C                   point values.
C         scalarC - the output scalar C. 
C
C
C--
      SUBROUTINE Aii(TENSA,SCALARC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3),SCALARC
      DATA ZERO/0.00/
C         
      SCALARC=ZERO
      DO I=1,3
        SCALARC=SCALARC+TENSA(I,I)
      END DO
C
      END
C           
C
C
C*DAijklmn_Bijpq  Computes Cklmmpq=AijklmnBijpq  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B i j p q                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bijpq(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cklmnpq=AijklmnBijpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bijpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(K,L,M,N,IP,IQ)=ZERO
                  DO I=1,3
                    DO J=1,3
                      TENSC(K,L,M,N,IP,IQ)=TENSC(K,L,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(I,J,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bijpq  Computes Cklmnpq=AijklmnBijpq  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B i j p q                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bijpq(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cklmnpq=AijklmnBijpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bijpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(K,L,M,N,IP,IQ)=ZERO
                  DO I=1,3
                    DO J=1,3
                      TENSC(K,L,M,N,IP,IQ)=TENSC(K,L,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(I,J,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bpqij  Computes Cklmnpq=AijklmnBpqij  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B p q i j                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bpqij(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cklmnpq=AijklmnBpqij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bpqij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(K,L,M,N,IP,IQ)=ZERO
                  DO I=1,3
                    DO J=1,3
                      TENSC(K,L,M,N,IP,IQ)=TENSC(K,L,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,I,J)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bpqij  Computes Cklmnpq=AijklmnBpqij  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B p q i j                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bpqij(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cklmnpq=AijklmnBpqij
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bpqij(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO K=1,3
        DO L=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(K,L,M,N,IP,IQ)=ZERO
                  DO I=1,3
                    DO J=1,3
                      TENSC(K,L,M,N,IP,IQ)=TENSC(K,L,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,I,J)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bklpq  Computes Cijmnpq=AijklmnBklpq  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B k l p q                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bklpq(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijmnpq=AijklmnBklpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bklpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,M,N,IP,IQ)=ZERO
                  DO K=1,3
                    DO L=1,3
                      TENSC(I,J,M,N,IP,IQ)=TENSC(I,J,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(K,L,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bklpq  Computes Cijmnpq=Aijklmnbklpq  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B k l p q                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bklpq(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijmnpq=AijklmnBklpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bklpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,M,N,IP,IQ)=ZERO
                  DO K=1,3
                    DO L=1,3
                      TENSC(I,J,M,N,IP,IQ)=TENSC(I,J,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(K,L,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bpqkl  Computes Cijmnpq=AijklmnBpqkl  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B p q k l                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bpqkl(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijmnpq=AijklmnBpqkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bpqkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,M,N,IP,IQ)=ZERO
                  DO K=1,3
                    DO L=1,3
                      TENSC(I,J,M,N,IP,IQ)=TENSC(I,J,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,K,L)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bpqkl  Computes Cijmnpq=AijklmnBpqkl  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B p q k l                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bpqkl(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijmnpq=AijklmnBpqkl
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bpqkl(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          DO M=1,3
            DO N=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,M,N,IP,IQ)=ZERO
                  DO K=1,3
                    DO L=1,3
                      TENSC(I,J,M,N,IP,IQ)=TENSC(I,J,M,N,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,K,L)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bmnpq  Computes Cijklpq=AijklmnBmnpq  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B m n p q                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bmnpq(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklpq=AijklmnBmnpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bmnpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,K,L,IP,IQ)=ZERO
                  DO M=1,3
                    DO N=1,3
                      TENSC(I,J,K,L,IP,IQ)=TENSC(I,J,K,L,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(M,N,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bmnpq  Computes Cijklpq=AijklmnBmnpq  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B m n p q                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bmnpq(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklpq=AijklmnBmnpq
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bmnpq(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,K,L,IP,IQ)=ZERO
                  DO M=1,3
                    DO N=1,3
                      TENSC(I,J,K,L,IP,IQ)=TENSC(I,J,K,L,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(M,N,IP,IQ)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*DAijklmn_Bpqmn  Computes Cijklpq=AijklmnBpqmn  [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D A i j k l m n __ B p q m n                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DAijklmn_Bpqmn(tensA,tensB,tensC) [REAL*8]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklpq=AijklmnBpqmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE DAijklmn_Bpqmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.0D0/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,K,L,IP,IQ)=ZERO
                  DO M=1,3
                    DO N=1,3
                      TENSC(I,J,K,L,IP,IQ)=TENSC(I,J,K,L,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,M,N)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Aijklmn_Bpqmn  Computes Cijklpq=AijklmnBpqmn  [REAL*4]
C=**********************************************************************
C                                                                      *
C                       A i j k l m n __ B p q m n                     *
C                                                                      *
C=**********************************************************************
C+
C
C       Aijklmn_Bpqmn(tensA,tensB,tensC) [REAL*4]
C         subroutine to multiply a sixth order tensor and a fourth  
C         order tensor to yield a sixth order tensor. 
C         i.e. it performs the operation Cijklpq=AijklmnBpqmn
C
C         tensA   - the input sixth order tensor A. an array of floating
C                   point values.
C         tensB   - the input fourth order tensor B. an array of floating
C                   point values.
C         tensC   - the output sixth order tensor C. an array of floating
C                   point values.
C
C
C--
      SUBROUTINE Aijklmn_Bpqmn(TENSA,TENSB,TENSC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 TENSA(3,3,3,3,3,3),TENSB(3,3,3,3),TENSC(3,3,3,3,3,3)
      DATA ZERO /0.00/
C
      DO I=1,3
        DO J=1,3
          DO K=1,3
            DO L=1,3
              DO IP=1,3
                DO IQ=1,3  
                  TENSC(I,J,K,L,IP,IQ)=ZERO
                  DO M=1,3
                    DO N=1,3
                      TENSC(I,J,K,L,IP,IQ)=TENSC(I,J,K,L,IP,IQ)
     $                     +TENSA(I,J,K,L,M,N)*TENSB(IP,IQ,M,N)
                    END DO
                  END DO
                END DO
              END DO
            END DO
          END DO
        END DO
      END DO
C
      END
C                                
C
C
C*Dpermute  Computes an entry of the permutation tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C                              D p e r m u t e                         *
C                                                                      *
C=**********************************************************************
C+
C
C       Dpermute(i,j,k)  [REAL*8]
C         function to compute an entry in the permutation tensor    
C         epsilon(i,j,k) given i,j,k.
C         i,j,k   - integer representing the indices of the permutation 
C                   tensor whose value is to be computed.
C
C
C--
C
      REAL*8 FUNCTION DPERMUTE(I,J,K)
      IMPLICIT REAL*8 (A-H,O-Z)
      DATA ZERO,ONE/0.0D0,1.0D0/
C
      IDIFF=I-J-K
      IF(I.EQ.J.OR.I.EQ.K.OR.J.EQ.K)THEN
        DPERMUTE=ZERO
      ELSEIF((IDIFF.EQ.-4.AND.I.EQ.1).OR.(IDIFF.EQ.-2.AND.I.EQ.2).OR.
     .       (IDIFF.EQ.0.AND.I.EQ.3))THEN
        DPERMUTE=ONE
      ELSE
        DPERMUTE=-ONE
      ENDIF
C
      END
C                                
C
C
C*permute  Computes an entry of the permutation tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C                               p e r m u t e                          *
C                                                                      *
C=**********************************************************************
C+
C
C       permute(i,j,k)  [REAL*4]
C         function to compute an entry in the permutation tensor    
C         epsilon(i,j,k) given i,j,k.
C         i,j,k   - integer representing the indices of the permutation 
C                   tensor whose value is to be computed.
C
C
C--
C
      REAL*4 FUNCTION PERMUTE(I,J,K)
      IMPLICIT REAL*4 (A-H,O-Z)
      DATA ZERO,ONE/0.00,1.00/
C
      IDIFF=I-J-K
      IF(I.EQ.J.OR.I.EQ.K.OR.J.EQ.K)THEN
        PERMUTE=ZERO
      ELSEIF((IDIFF.EQ.-4.AND.I.EQ.1).OR.(IDIFF.EQ.-2.AND.I.EQ.2).OR.
     .       (IDIFF.EQ.0.AND.I.EQ.3))THEN
        PERMUTE=ONE
      ELSE
        PERMUTE=-ONE
      ENDIF
C
      END
C
C
C*Matrix_Transpose  Computes Transpose of Matrix  [REAL*4]
C=**********************************************************************
C                                                                      *
C                     M a t r i x __ T r a n s p o s e                 *
C                                                                      *
C=**********************************************************************
C+
C
C       Matrix_Transpose(matA,matB) [REAL*4]
C         subroutine to compute the transpose of matA
C         outputs the matB as the transpose matrix
C
C         matA    - the input 3x3 matrix A. an array of floating
C                     point values.
C         matB    - the output 3x3 matrix B. an array of floating
C
C--
      SUBROUTINE Matrix_Transpose(matA,matB)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 matA(3,3),matB(3,3)
C
      DO I=1,3
        DO J=1,3
          matB(I,J)=matA(J,I)
        END DO
      END DO
C
      END
C
C
C*DMatrix_Transpose  Computes Transpose of Matrix  [REAL*8]
C=**********************************************************************
C                                                                      *
C                  D M a t r i x __ T r a n s p o s e                  *
C                                                                      *
C=**********************************************************************
C+
C
C      DMatrix_Transpose(matA,matB) [REAL*8]
C         subroutine to compute the transpose of matA
C         outputs the matB as the transpose matrix
C
C         matA    - the input 3x3 matrix A. an array of floating
C                     point values.
C         matB    - the output 3x3 matrix B. an array of floating
C                     point values.
C
C--
      SUBROUTINE DMatrix_Transpose(matA,matB)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 matA(3,3),matB(3,3)
C
      DO I=1,3
        DO J=1,3
          matB(I,J)=matA(J,I)
        END DO
      END DO
C
      END
C
C*DVector_full_to_Tensor Transforms a 1X6 vector into a tensor [REAL*8]
C=**********************************************************************
C                                                                      *
C           D V e c t o r __ f u l l __ t o __ T e n s o r             *
C                                                                      *
C=**********************************************************************
C+
C
C      DVector_full_to_Tensor(vector,tensor) [REAL*8]
C         subroutine to transform a 1X6 vector into a 2nd order tensor
C
C         tensor  - output, 3X3 array of floating point values.
C         vector  - input, 1X6 array of floating point values.
C
C--
C
      SUBROUTINE DVECTOR_FULL_TO_TENSOR(VECTOR,TENSOR)
      IMPLICIT NONE
      REAL*8 VECTOR(6),TENSOR(3,3)
C
      TENSOR(1,1)=VECTOR(1)
      TENSOR(2,2)=VECTOR(2)
      TENSOR(3,3)=VECTOR(3)
      TENSOR(1,2)=VECTOR(4)
      TENSOR(2,3)=VECTOR(5)
      TENSOR(1,3)=VECTOR(6)
      TENSOR(2,1)=TENSOR(1,2)
      TENSOR(3,2)=TENSOR(2,3)
      TENSOR(3,1)=TENSOR(1,3)
C
      END
C
C*Vector_full_to_Tensor Transforms a 1X6 vector into a tensor [REAL*4]
C=**********************************************************************
C                                                                      *
C            V e c t o r __ f u l l __ t o __ T e n s o r              *
C                                                                      *
C=**********************************************************************
C+
C
C      Vector_full_to_Tensor(vector,tensor) [REAL*4]
C         subroutine to transform a 1X6 vector into a 2nd order tensor
C
C         tensor  - output, 3X3 array of floating point values.
C         vector  - input, 1X6 array of floating point values.
C
C--
C
      SUBROUTINE VECTOR_FULL_TO_TENSOR(VECTOR,TENSOR)
      IMPLICIT NONE
      REAL*4 VECTOR(6),TENSOR(3,3)
C
      TENSOR(1,1)=VECTOR(1)
      TENSOR(2,2)=VECTOR(2)
      TENSOR(3,3)=VECTOR(3)
      TENSOR(1,2)=VECTOR(4)
      TENSOR(2,3)=VECTOR(5)
      TENSOR(1,3)=VECTOR(6)
      TENSOR(2,1)=TENSOR(1,2)
      TENSOR(3,2)=TENSOR(2,3)
      TENSOR(3,1)=TENSOR(1,3)
C
      END
C
C*DTensor_to_Vector_full Transforms a tensor into a 1X6 vector [REAL*8]
C=**********************************************************************
C                                                                      *
C           D T e n s o r __ t o __ V e c t o r __ f u l l             *
C                                                                      *
C=**********************************************************************
C+
C
C      DTensor_to_Vector_full(tensor,vector) [REAL*8]
C         subroutine to transform a 2nd order tensor into a 1X6 vector
C
C         tensor  - input, 3X3 array of floating point values.
C         vector  - output, 1X6 array of floating point values.
C
C--
C
      SUBROUTINE DTENSOR_TO_VECTOR_FULL(TENSOR,VECTOR)
      IMPLICIT NONE
      REAL*8 VECTOR(6),TENSOR(3,3)
C
      VECTOR(1)=TENSOR(1,1)
      VECTOR(2)=TENSOR(2,2)
      VECTOR(3)=TENSOR(3,3)
      VECTOR(4)=TENSOR(1,2)
      VECTOR(5)=TENSOR(2,3)
      VECTOR(6)=TENSOR(1,3)
C
      END
C
C*Tensor_to_Vector_full Transforms a tensor into a 1X6 vector [REAL*4]
C=**********************************************************************
C                                                                      *
C            T e n s o r __ t o __ V e c t o r __ f u l l              *
C                                                                      *
C=**********************************************************************
C+
C
C      Tensor_to_Vector_full(tensor,vector) [REAL*4]
C         subroutine to transform a 2nd order tensor into a 1X6 vector
C
C         tensor  - input, 3X3 array of floating point values.
C         vector  - output, 1X6 array of floating point values.
C
C--
C
      SUBROUTINE TENSOR_TO_VECTOR_FULL(TENSOR,VECTOR)
      IMPLICIT NONE
      REAL*4 VECTOR(6),TENSOR(3,3)
C
      VECTOR(1)=TENSOR(1,1)
      VECTOR(2)=TENSOR(2,2)
      VECTOR(3)=TENSOR(3,3)
      VECTOR(4)=TENSOR(1,2)
      VECTOR(5)=TENSOR(2,3)
      VECTOR(6)=TENSOR(1,3)
C
      END
