changed line endings to unix style
This commit is contained in:
parent
cb82ebedef
commit
ea8ce09764
|
@ -1,4 +1,4 @@
|
||||||
|
|
||||||
!************************************
|
!************************************
|
||||||
!* Module: CONSTITUTIVE *
|
!* Module: CONSTITUTIVE *
|
||||||
!************************************
|
!************************************
|
||||||
|
@ -6,20 +6,20 @@
|
||||||
!* - constitutive equations *
|
!* - constitutive equations *
|
||||||
!* - parameters definition *
|
!* - parameters definition *
|
||||||
!************************************
|
!************************************
|
||||||
|
|
||||||
MODULE constitutive
|
MODULE constitutive
|
||||||
|
|
||||||
!*** Include other modules ***
|
!*** Include other modules ***
|
||||||
use prec
|
use prec
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
type(p_vec), dimension(:,:,:), allocatable :: constitutive_state_old, & ! pointer array to old state variables of each grain
|
type(p_vec), dimension(:,:,:), allocatable :: constitutive_state_old, & ! pointer array to old state variables of each grain
|
||||||
constitutive_state_new ! pointer array to new state variables of each grain
|
constitutive_state_new ! pointer array to new state variables of each grain
|
||||||
integer(pInt), dimension(:,:,:), allocatable :: constitutive_sizeDotState, & ! size of dotState array
|
integer(pInt), dimension(:,:,:), allocatable :: constitutive_sizeDotState, & ! size of dotState array
|
||||||
constitutive_sizeState, & ! size of state array per grain
|
constitutive_sizeState, & ! size of state array per grain
|
||||||
constitutive_sizePostResults ! size of postResults array per grain
|
constitutive_sizePostResults ! size of postResults array per grain
|
||||||
integer(pInt) constitutive_maxSizeDotState,constitutive_maxSizeState,constitutive_maxSizePostResults
|
integer(pInt) constitutive_maxSizeDotState,constitutive_maxSizeState,constitutive_maxSizePostResults
|
||||||
|
|
||||||
CONTAINS
|
CONTAINS
|
||||||
!****************************************
|
!****************************************
|
||||||
!* - constitutive_init
|
!* - constitutive_init
|
||||||
|
@ -29,8 +29,8 @@ CONTAINS
|
||||||
!* - constitutive_dotState
|
!* - constitutive_dotState
|
||||||
!* - constitutive_postResults
|
!* - constitutive_postResults
|
||||||
!****************************************
|
!****************************************
|
||||||
|
|
||||||
|
|
||||||
subroutine constitutive_init()
|
subroutine constitutive_init()
|
||||||
!**************************************
|
!**************************************
|
||||||
!* Module initialization *
|
!* Module initialization *
|
||||||
|
@ -40,26 +40,26 @@ subroutine constitutive_init()
|
||||||
use mesh, only: mesh_maxNips,mesh_NcpElems,mesh_element,FE_Nips
|
use mesh, only: mesh_maxNips,mesh_NcpElems,mesh_element,FE_Nips
|
||||||
use material
|
use material
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
|
|
||||||
integer(pInt), parameter :: fileunit = 200
|
integer(pInt), parameter :: fileunit = 200
|
||||||
integer(pInt) e,i,g,myInstance
|
integer(pInt) e,i,g,myInstance
|
||||||
|
|
||||||
if(.not. IO_open_file(fileunit,material_configFile)) call IO_error (100) ! corrupt config file
|
if(.not. IO_open_file(fileunit,material_configFile)) call IO_error (100) ! corrupt config file
|
||||||
|
|
||||||
call constitutive_phenomenological_init(fileunit) ! parse all phases of this constitution
|
call constitutive_phenomenological_init(fileunit) ! parse all phases of this constitution
|
||||||
call constitutive_j2_init(fileunit)
|
call constitutive_j2_init(fileunit)
|
||||||
call constitutive_dislobased_init(fileunit)
|
call constitutive_dislobased_init(fileunit)
|
||||||
|
|
||||||
close(fileunit)
|
close(fileunit)
|
||||||
|
|
||||||
allocate(constitutive_state_old(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
|
allocate(constitutive_state_old(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
|
||||||
allocate(constitutive_state_new(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
|
allocate(constitutive_state_new(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
|
||||||
allocate(constitutive_sizeDotState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeDotState = 0_pInt
|
allocate(constitutive_sizeDotState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeDotState = 0_pInt
|
||||||
allocate(constitutive_sizeState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeState = 0_pInt
|
allocate(constitutive_sizeState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeState = 0_pInt
|
||||||
allocate(constitutive_sizePostResults(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizePostResults = 0_pInt
|
allocate(constitutive_sizePostResults(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizePostResults = 0_pInt
|
||||||
|
|
||||||
do e = 1,mesh_NcpElems ! loop over elements
|
do e = 1,mesh_NcpElems ! loop over elements
|
||||||
do i = 1,FE_Nips(mesh_element(2,e)) ! loop over IPs
|
do i = 1,FE_Nips(mesh_element(2,e)) ! loop over IPs
|
||||||
do g = 1,homogenization_Ngrains(mesh_element(3,e)) ! loop over grains
|
do g = 1,homogenization_Ngrains(mesh_element(3,e)) ! loop over grains
|
||||||
|
@ -90,12 +90,12 @@ subroutine constitutive_init()
|
||||||
constitutive_maxSizeDotState = maxval(constitutive_sizeDotState)
|
constitutive_maxSizeDotState = maxval(constitutive_sizeDotState)
|
||||||
constitutive_maxSizeState = maxval(constitutive_sizeState)
|
constitutive_maxSizeState = maxval(constitutive_sizeState)
|
||||||
constitutive_maxSizePostResults = maxval(constitutive_sizePostResults)
|
constitutive_maxSizePostResults = maxval(constitutive_sizePostResults)
|
||||||
|
|
||||||
return
|
return
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
function constitutive_homogenizedC(ipc,ip,el)
|
function constitutive_homogenizedC(ipc,ip,el)
|
||||||
!*********************************************************************
|
!*********************************************************************
|
||||||
!* This function returns the homogenized elacticity matrix *
|
!* This function returns the homogenized elacticity matrix *
|
||||||
|
@ -108,28 +108,28 @@ function constitutive_homogenizedC(ipc,ip,el)
|
||||||
use prec, only: pReal,pInt
|
use prec, only: pReal,pInt
|
||||||
use material, only: phase_constitution,material_phase
|
use material, only: phase_constitution,material_phase
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
!* Definition of variables
|
!* Definition of variables
|
||||||
integer(pInt) ipc,ip,el
|
integer(pInt) ipc,ip,el
|
||||||
real(pReal), dimension(6,6) :: constitutive_homogenizedC
|
real(pReal), dimension(6,6) :: constitutive_homogenizedC
|
||||||
|
|
||||||
select case (phase_constitution(material_phase(ipc,ip,el)))
|
select case (phase_constitution(material_phase(ipc,ip,el)))
|
||||||
case (constitutive_phenomenological_label)
|
case (constitutive_phenomenological_label)
|
||||||
constitutive_homogenizedC = constitutive_phenomenological_homogenizedC(constitutive_state_new,ipc,ip,el)
|
constitutive_homogenizedC = constitutive_phenomenological_homogenizedC(constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
constitutive_homogenizedC = constitutive_j2_homogenizedC(constitutive_state_new,ipc,ip,el)
|
constitutive_homogenizedC = constitutive_j2_homogenizedC(constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_dislobased_label)
|
case (constitutive_dislobased_label)
|
||||||
constitutive_homogenizedC = constitutive_dislobased_homogenizedC(constitutive_state_new,ipc,ip,el)
|
constitutive_homogenizedC = constitutive_dislobased_homogenizedC(constitutive_state_new,ipc,ip,el)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
return
|
return
|
||||||
end function
|
end function
|
||||||
|
|
||||||
|
|
||||||
subroutine constitutive_microstructure(Temperature,ipc,ip,el)
|
subroutine constitutive_microstructure(Temperature,ipc,ip,el)
|
||||||
!*********************************************************************
|
!*********************************************************************
|
||||||
!* This function calculates from state needed variables *
|
!* This function calculates from state needed variables *
|
||||||
|
@ -143,27 +143,27 @@ subroutine constitutive_microstructure(Temperature,ipc,ip,el)
|
||||||
use prec, only: pReal,pInt
|
use prec, only: pReal,pInt
|
||||||
use material, only: phase_constitution,material_phase
|
use material, only: phase_constitution,material_phase
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
!* Definition of variables
|
!* Definition of variables
|
||||||
integer(pInt) ipc,ip,el
|
integer(pInt) ipc,ip,el
|
||||||
real(pReal) Temperature
|
real(pReal) Temperature
|
||||||
|
|
||||||
select case (phase_constitution(material_phase(ipc,ip,el)))
|
select case (phase_constitution(material_phase(ipc,ip,el)))
|
||||||
case (constitutive_phenomenological_label)
|
case (constitutive_phenomenological_label)
|
||||||
call constitutive_phenomenological_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_phenomenological_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
call constitutive_j2_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_j2_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_dislobased_label)
|
case (constitutive_dislobased_label)
|
||||||
call constitutive_dislobased_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_dislobased_microstructure(Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,ip,el)
|
subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,ip,el)
|
||||||
!*********************************************************************
|
!*********************************************************************
|
||||||
!* This subroutine contains the constitutive equation for *
|
!* This subroutine contains the constitutive equation for *
|
||||||
|
@ -180,31 +180,31 @@ subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,i
|
||||||
use prec, only: pReal,pInt
|
use prec, only: pReal,pInt
|
||||||
use material, only: phase_constitution,material_phase
|
use material, only: phase_constitution,material_phase
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
!* Definition of variables
|
!* Definition of variables
|
||||||
integer(pInt) ipc,ip,el
|
integer(pInt) ipc,ip,el
|
||||||
real(pReal) Temperature
|
real(pReal) Temperature
|
||||||
real(pReal), dimension(6) :: Tstar_v
|
real(pReal), dimension(6) :: Tstar_v
|
||||||
real(pReal), dimension(3,3) :: Lp
|
real(pReal), dimension(3,3) :: Lp
|
||||||
real(pReal), dimension(9,9) :: dLp_dTstar
|
real(pReal), dimension(9,9) :: dLp_dTstar
|
||||||
|
|
||||||
select case (phase_constitution(material_phase(ipc,ip,el)))
|
select case (phase_constitution(material_phase(ipc,ip,el)))
|
||||||
case (constitutive_phenomenological_label)
|
case (constitutive_phenomenological_label)
|
||||||
call constitutive_phenomenological_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_phenomenological_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_dislobased_label)
|
case (constitutive_dislobased_label)
|
||||||
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
return
|
return
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
function constitutive_dotState(Tstar_v,Temperature,ipc,ip,el)
|
function constitutive_dotState(Tstar_v,Temperature,ipc,ip,el)
|
||||||
!*********************************************************************
|
!*********************************************************************
|
||||||
!* This subroutine contains the constitutive equation for *
|
!* This subroutine contains the constitutive equation for *
|
||||||
|
@ -221,29 +221,29 @@ function constitutive_dotState(Tstar_v,Temperature,ipc,ip,el)
|
||||||
use prec, only: pReal,pInt
|
use prec, only: pReal,pInt
|
||||||
use material, only: phase_constitution,material_phase
|
use material, only: phase_constitution,material_phase
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
!* Definition of variables
|
!* Definition of variables
|
||||||
integer(pInt) ipc,ip,el
|
integer(pInt) ipc,ip,el
|
||||||
real(pReal) Temperature
|
real(pReal) Temperature
|
||||||
real(pReal), dimension(6) :: Tstar_v
|
real(pReal), dimension(6) :: Tstar_v
|
||||||
real(pReal), dimension(constitutive_sizeDotState(ipc,ip,el)) :: constitutive_dotState
|
real(pReal), dimension(constitutive_sizeDotState(ipc,ip,el)) :: constitutive_dotState
|
||||||
|
|
||||||
select case (phase_constitution(material_phase(ipc,ip,el)))
|
select case (phase_constitution(material_phase(ipc,ip,el)))
|
||||||
case (constitutive_phenomenological_label)
|
case (constitutive_phenomenological_label)
|
||||||
constitutive_dotState = constitutive_phenomenological_dotState(Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
constitutive_dotState = constitutive_phenomenological_dotState(Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
constitutive_dotState = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
constitutive_dotState = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_dislobased_label)
|
case (constitutive_dislobased_label)
|
||||||
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
return
|
return
|
||||||
end function
|
end function
|
||||||
|
|
||||||
|
|
||||||
pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
|
pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
|
||||||
!*********************************************************************
|
!*********************************************************************
|
||||||
!* return array of constitutive results *
|
!* return array of constitutive results *
|
||||||
|
@ -257,29 +257,29 @@ pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
|
||||||
use prec, only: pReal,pInt
|
use prec, only: pReal,pInt
|
||||||
use material, only: phase_constitution,material_phase
|
use material, only: phase_constitution,material_phase
|
||||||
use constitutive_phenomenological
|
use constitutive_phenomenological
|
||||||
use constitutive_j2
|
use constitutive_j2
|
||||||
use constitutive_dislobased
|
use constitutive_dislobased
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
!* Definition of variables
|
!* Definition of variables
|
||||||
integer(pInt), intent(in) :: ipc,ip,el
|
integer(pInt), intent(in) :: ipc,ip,el
|
||||||
real(pReal), intent(in) :: dt,Temperature
|
real(pReal), intent(in) :: dt,Temperature
|
||||||
real(pReal), dimension(6), intent(in) :: Tstar_v
|
real(pReal), dimension(6), intent(in) :: Tstar_v
|
||||||
real(pReal), dimension(constitutive_sizePostResults(ipc,ip,el)) :: constitutive_postResults
|
real(pReal), dimension(constitutive_sizePostResults(ipc,ip,el)) :: constitutive_postResults
|
||||||
|
|
||||||
constitutive_postResults = 0.0_pReal
|
constitutive_postResults = 0.0_pReal
|
||||||
select case (phase_constitution(material_phase(ipc,ip,el)))
|
select case (phase_constitution(material_phase(ipc,ip,el)))
|
||||||
case (constitutive_phenomenological_label)
|
case (constitutive_phenomenological_label)
|
||||||
constitutive_postResults = constitutive_phenomenological_postResults(Tstar_v,Temperature,dt,constitutive_state_new,ipc,ip,el)
|
constitutive_postResults = constitutive_phenomenological_postResults(Tstar_v,Temperature,dt,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_j2_label)
|
case (constitutive_j2_label)
|
||||||
constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state_new,ipc,ip,el)
|
constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state_new,ipc,ip,el)
|
||||||
case (constitutive_dislobased_label)
|
case (constitutive_dislobased_label)
|
||||||
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state_new,ipc,ip,el)
|
||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
return
|
return
|
||||||
|
|
||||||
end function
|
end function
|
||||||
|
|
||||||
END MODULE
|
END MODULE
|
Loading…
Reference in New Issue