! copyright 2005,  J. E. Akin, all rights reserved.
! Begin: thermal_lib.f

SUBROUTINE POISSON_ISOTROPIC_E_MATRIX (E)
!b SUBROUTINE POISSON_ISOTROPIC_E_MATRIX (K, E)
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!     ISOTROPIC POISSON CONSTITUTIVE MATRIX DEFINITION
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Use System_Constants   ! for N_R_B
Use Sys_Properties_Data ! for GET_REAL_LP
 IMPLICIT NONE
 !b REAL(DP), INTENT(IN)  :: K    ! CONDUCTIVITY
 REAL(DP), INTENT(OUT) :: E (N_R_B, N_R_B)
 INTEGER :: J ! LOOPS

! E     = CONSTITUTIVE MATRIX
! N_R_B = NUMBER OF ROWS IN B AND E MATRICES

  E = 0.d0
  DO J = 1, N_R_B
    E (J, J) = GET_REAL_LP (1)
  END DO
END SUBROUTINE POISSON_ISOTROPIC_E_MATRIX 

SUBROUTINE POISSON_ORTHOTROPIC_E_MATRIX (E)
!b SUBROUTINE POISSON_ORTHOTROPIC_E_MATRIX (K, E)
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!     ORTHOTROPIC POISSON CONSTITUTIVE MATRIX DEFINITION
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Use System_Constants   ! for N_R_B
Use Sys_Properties_Data ! for GET_REAL_LP
 IMPLICIT NONE
 !b REAL(DP), INTENT(IN)  :: K (N_R_B)       ! CONDUCTIVITY
 REAL(DP), INTENT(OUT) :: E (N_R_B, N_R_B)
 INTEGER :: J ! LOOPS

! E     = CONSTITUTIVE MATRIX
! N_R_B = NUMBER OF ROWS IN B AND E MATRICES

  E = 0.d0
  DO J = 1, N_R_B
    E (J, J) = GET_REAL_LP (J)
    !b E (J, J) = K (J)
  END DO
END SUBROUTINE POISSON_ORTHOTROPIC_E_MATRIX 

SUBROUTINE POISSON_ANISOTROPIC_2D_E_MATRIX (K_XX, K_YY, K_XY, E)
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! 2-D ANISOTROPIC POISSON CONSTITUTIVE MATRIX DEFINITION
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Use System_Constants   ! for N_R_B
 IMPLICIT NONE
 REAL(DP), INTENT(IN)  :: K_XX, K_YY, K_XY   ! CONDUCTIVITY
 REAL(DP), INTENT(OUT) :: E (N_R_B, N_R_B)

! E     = CONSTITUTIVE MATRIX
! N_R_B = NUMBER OF ROWS IN B AND E MATRICES

  IF ( N_R_B /= 2 ) STOP &
       'POISSON_ANISOTROPIC_2D_E_MATRIX, INVALID SIZE FOR b_rows'
  E (1, 1) = K_XX  ; E (1, 2) = K_XY
  E (2, 1) = K_XY  ; E (2, 2) = K_YY
END SUBROUTINE POISSON_ANISOTROPIC_2D_E_MATRIX

SUBROUTINE POISSON_ANISOTROPIC_E_MATRIX (E) ! in progress
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!  ANISOTROPIC POISSON CONSTITUTIVE MATRIX DEFINITION
!  Conductivites must be first data for element: 1D-K, 
! 2D-K_xx, K_yy, K_xy, 3D-K_xx, K_yy, K_zz, K_xy, K_xz, K_yz
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Use System_Constants    ! for N_R_B
Use Sys_Properties_Data ! for GET_REAL_LP
 IMPLICIT NONE
 REAL(DP), INTENT(OUT) :: E (N_R_B, N_R_B)

! E     = CONSTITUTIVE MATRIX
! N_R_B = NUMBER OF ROWS IN B AND E MATRICES

  SELECT CASE (N_R_B)
    CASE (1) ; E = GET_REAL_LP (1) ! 1-D problem, K_xx, Q, Thickness
    CASE (2) ! 2-D problem, K_xx, K_yy, K_xy, Q, Thickness
      E = RESHAPE((/ GET_REAL_LP(1), GET_REAL_LP(3),    &
                     GET_REAL_LP(3), GET_REAL_LP(2) /), &
                     (/ 2, 2 /)) ! K_xx, K_yy, K_xy
    CASE (3) ! 3-D problem, K_xx, K_yy, K_zz, K_xy, K_xz, K_yz, Q
      E = RESHAPE((/ GET_REAL_LP(1), GET_REAL_LP(4), &
                     GET_REAL_LP(5), GET_REAL_LP(4), &
                     GET_REAL_LP(2), GET_REAL_LP(6), &
                     GET_REAL_LP(5), GET_REAL_LP(6), &
                     GET_REAL_LP(3) /), (/ 3, 3 /)) 
    CASE DEFAULT ; PRINT *,'INVALID NUMBER OF ROWS IN b_rows'
             STOP 'DIED IN POISSON_ANISOTROPIC_E_MATRIX'
  END SELECT ! for array size
END SUBROUTINE POISSON_ANISOTROPIC_E_MATRIX

! End: thermal_lib.f
! copyright 1999, 2002,  J. E. Akin, all rights reserved.