2013-03-22 23:05:05 +05:30
! Copyright 2011-13 Max-Planck-Institut für Eisenforschung GmbH
2011-04-04 19:39:54 +05:30
!
! This file is part of DAMASK,
2011-04-07 12:50:28 +05:30
! the Düsseldorf Advanced MAterial Simulation Kit.
2011-04-04 19:39:54 +05:30
!
! DAMASK is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! DAMASK is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
!
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
2013-07-01 11:40:42 +05:30
!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw
!! fitting
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2012-03-09 01:55:28 +05:30
module constitutive_phenopowerlaw
2013-07-01 11:40:42 +05:30
use prec , only : &
pReal , &
pInt
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
implicit none
2012-04-11 19:31:02 +05:30
private
2013-07-01 11:40:42 +05:30
character ( len = * ) , parameter , public :: &
CONSTITUTIVE_PHENOPOWERLAW_label = 'phenopowerlaw'
2012-04-11 19:31:02 +05:30
2013-07-01 11:40:42 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public :: &
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_sizeDotState , &
constitutive_phenopowerlaw_sizeState , &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_sizePostResults , & !< cumulative size of post results
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_structure
2012-04-11 19:31:02 +05:30
2013-07-01 11:40:42 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , target , public :: &
constitutive_phenopowerlaw_sizePostResult !< size of each post result output
character ( len = 64 ) , dimension ( : , : ) , allocatable , target , public :: &
constitutive_phenopowerlaw_output !< name of each post result output
character ( len = 32 ) , dimension ( : ) , allocatable , public :: &
constitutive_phenopowerlaw_structureName
integer ( pInt ) , dimension ( : ) , allocatable , private :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_Noutput , & !< number of outputs per instance of this constitution
constitutive_phenopowerlaw_totalNslip , & !< no. of slip system used in simulation
constitutive_phenopowerlaw_totalNtwin !< no. of twin system used in simulation
2012-03-09 01:55:28 +05:30
2013-07-01 11:40:42 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_Nslip , & !< active number of slip systems per family (input parameter, per family)
constitutive_phenopowerlaw_Ntwin !< active number of twin systems per family (input parameter, per family)
2012-03-09 01:55:28 +05:30
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( : ) , allocatable , private :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_CoverA , & !< c/a of the crystal (input parameter)
constitutive_phenopowerlaw_gdot0_slip , & !< reference shear strain rate for slip (input parameter)
constitutive_phenopowerlaw_gdot0_twin , & !< reference shear strain rate for twin (input parameter)
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_n_slip , & !< stress exponent for slip (input parameter)
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_n_twin , & !< stress exponent for twin (input parameter)
2012-03-09 01:55:28 +05:30
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_spr , & !< push-up factor for slip saturation due to twinning
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_twinB , &
constitutive_phenopowerlaw_twinC , &
constitutive_phenopowerlaw_twinD , &
constitutive_phenopowerlaw_twinE , &
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_h0_SlipSlip , & !< reference hardening slip - slip (input parameter)
constitutive_phenopowerlaw_h0_SlipTwin , & !< reference hardening slip - twin (input parameter, no effect at the moment)
constitutive_phenopowerlaw_h0_TwinSlip , & !< reference hardening twin - slip (input parameter)
constitutive_phenopowerlaw_h0_TwinTwin , & !< reference hardening twin - twin (input parameter)
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_a_slip , &
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_aTolResistance , &
constitutive_phenopowerlaw_aTolShear , &
constitutive_phenopowerlaw_aTolTwinfrac
2012-03-09 01:55:28 +05:30
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
constitutive_phenopowerlaw_tau0_slip , & !< initial critical shear stress for slip (input parameter, per family)
constitutive_phenopowerlaw_tau0_twin , & !< initial critical shear stress for twin (input parameter, per family)
constitutive_phenopowerlaw_tausat_slip , & !< maximum critical shear stress for slip (input parameter, per family)
constitutive_phenopowerlaw_nonSchmidCoeff , &
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_interaction_SlipSlip , & !< interaction factors slip - slip (input parameter)
constitutive_phenopowerlaw_interaction_SlipTwin , & !< interaction factors slip - twin (input parameter)
constitutive_phenopowerlaw_interaction_TwinSlip , & !< interaction factors twin - slip (input parameter)
constitutive_phenopowerlaw_interaction_TwinTwin !< interaction factors twin - twin (input parameter)
2012-03-09 01:55:28 +05:30
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , private :: &
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_SlipSlip , &
constitutive_phenopowerlaw_hardeningMatrix_SlipTwin , &
constitutive_phenopowerlaw_hardeningMatrix_TwinSlip , &
constitutive_phenopowerlaw_hardeningMatrix_TwinTwin , &
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_Cslip_66
2012-04-11 19:31:02 +05:30
public :: &
constitutive_phenopowerlaw_init , &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_stateInit , &
2012-04-11 19:31:02 +05:30
constitutive_phenopowerlaw_aTolState , &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_homogenizedC , &
constitutive_phenopowerlaw_microstructure , &
constitutive_phenopowerlaw_LpAndItsTangent , &
2012-04-11 19:31:02 +05:30
constitutive_phenopowerlaw_dotState , &
2012-05-16 20:13:26 +05:30
constitutive_phenopowerlaw_deltaState , &
2012-04-11 19:31:02 +05:30
constitutive_phenopowerlaw_dotTemperature , &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults
2012-04-11 19:31:02 +05:30
2012-03-09 01:55:28 +05:30
contains
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2012-02-21 21:30:00 +05:30
subroutine constitutive_phenopowerlaw_init ( myFile )
2012-10-11 20:19:12 +05:30
use , intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
2013-07-01 11:40:42 +05:30
use math , only : &
math_Mandel3333to66 , &
math_Voigt66to3333
2009-07-22 21:37:19 +05:30
use IO
use material
2013-07-01 11:40:42 +05:30
use debug , only : &
debug_level , &
debug_constitutive , &
debug_levelBasic
2013-02-08 21:25:53 +05:30
use lattice
2009-10-21 18:40:12 +05:30
2012-03-09 01:55:28 +05:30
implicit none
2012-02-21 21:30:00 +05:30
integer ( pInt ) , intent ( in ) :: myFile
2013-07-01 11:40:42 +05:30
2013-05-28 23:01:55 +05:30
integer ( pInt ) , parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt
2013-07-01 11:40:42 +05:30
integer ( pInt ) , dimension ( 1_pInt + 2_pInt * MAXNCHUNKS ) :: positions
2013-02-15 03:54:55 +05:30
integer ( pInt ) , dimension ( 6 ) :: configNchunks
2013-07-01 11:40:42 +05:30
integer ( pInt ) :: &
maxNinstance , &
i , j , k , f , o , &
Nchunks_SlipSlip , Nchunks_SlipTwin , Nchunks_TwinSlip , Nchunks_TwinTwin , &
Nchunks_SlipFamilies , Nchunks_TwinFamilies , &
myStructure , index_myFamily , index_otherFamily , &
mySize = 0_pInt , section = 0_pInt
character ( len = 65536 ) :: &
tag = '' , &
line = '' ! to start initialized
2013-01-09 03:41:59 +05:30
2013-07-01 11:40:42 +05:30
write ( 6 , '(/,a)' ) ' <<<+- constitutive_' / / trim ( CONSTITUTIVE_PHENOPOWERLAW_label ) / / ' init -+>>>'
2013-05-28 23:01:55 +05:30
write ( 6 , '(a)' ) ' $Id$'
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2012-02-01 00:48:55 +05:30
#include "compilation_info.f90"
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
maxNinstance = int ( count ( phase_plasticity == CONSTITUTIVE_PHENOPOWERLAW_label ) , pInt )
if ( maxNinstance == 0_pInt ) return
2009-10-16 01:32:52 +05:30
2013-07-01 11:40:42 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0_pInt ) &
write ( 6 , '(a16,1x,i5,/)' ) '# instances:' , maxNinstance
2013-02-15 03:54:55 +05:30
Nchunks_SlipFamilies = lattice_maxNslipFamily
Nchunks_TwinFamilies = lattice_maxNtwinFamily
2013-02-08 21:25:53 +05:30
Nchunks_SlipSlip = lattice_maxNinteraction
Nchunks_SlipTwin = lattice_maxNinteraction
Nchunks_TwinSlip = lattice_maxNinteraction
Nchunks_TwinTwin = lattice_maxNinteraction
2012-03-09 01:55:28 +05:30
allocate ( constitutive_phenopowerlaw_sizeDotState ( maxNinstance ) )
constitutive_phenopowerlaw_sizeDotState = 0_pInt
allocate ( constitutive_phenopowerlaw_sizeState ( maxNinstance ) )
constitutive_phenopowerlaw_sizeState = 0_pInt
allocate ( constitutive_phenopowerlaw_sizePostResults ( maxNinstance ) )
constitutive_phenopowerlaw_sizePostResults = 0_pInt
allocate ( constitutive_phenopowerlaw_sizePostResult ( maxval ( phase_Noutput ) , maxNinstance ) )
constitutive_phenopowerlaw_sizePostResult = 0_pInt
allocate ( constitutive_phenopowerlaw_output ( maxval ( phase_Noutput ) , maxNinstance ) )
constitutive_phenopowerlaw_output = ''
allocate ( constitutive_phenopowerlaw_Noutput ( maxNinstance ) )
constitutive_phenopowerlaw_Noutput = 0_pInt
allocate ( constitutive_phenopowerlaw_structureName ( maxNinstance ) )
constitutive_phenopowerlaw_structureName = ''
allocate ( constitutive_phenopowerlaw_structure ( maxNinstance ) )
constitutive_phenopowerlaw_structure = 0_pInt
allocate ( constitutive_phenopowerlaw_Nslip ( lattice_maxNslipFamily , maxNinstance ) )
constitutive_phenopowerlaw_Nslip = 0_pInt
allocate ( constitutive_phenopowerlaw_Ntwin ( lattice_maxNtwinFamily , maxNinstance ) )
constitutive_phenopowerlaw_Ntwin = 0_pInt
allocate ( constitutive_phenopowerlaw_totalNslip ( maxNinstance ) )
constitutive_phenopowerlaw_totalNslip = 0_pInt
allocate ( constitutive_phenopowerlaw_totalNtwin ( maxNinstance ) )
constitutive_phenopowerlaw_totalNtwin = 0_pInt
allocate ( constitutive_phenopowerlaw_CoverA ( maxNinstance ) )
constitutive_phenopowerlaw_CoverA = 0.0_pReal
allocate ( constitutive_phenopowerlaw_Cslip_66 ( 6 , 6 , maxNinstance ) )
constitutive_phenopowerlaw_Cslip_66 = 0.0_pReal
allocate ( constitutive_phenopowerlaw_gdot0_slip ( maxNinstance ) )
constitutive_phenopowerlaw_gdot0_slip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_n_slip ( maxNinstance ) )
constitutive_phenopowerlaw_n_slip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_tau0_slip ( lattice_maxNslipFamily , maxNinstance ) )
constitutive_phenopowerlaw_tau0_slip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_tausat_slip ( lattice_maxNslipFamily , maxNinstance ) )
constitutive_phenopowerlaw_tausat_slip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_gdot0_twin ( maxNinstance ) )
constitutive_phenopowerlaw_gdot0_twin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_n_twin ( maxNinstance ) )
constitutive_phenopowerlaw_n_twin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_tau0_twin ( lattice_maxNtwinFamily , maxNinstance ) )
constitutive_phenopowerlaw_tau0_twin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_spr ( maxNinstance ) )
constitutive_phenopowerlaw_spr = 0.0_pReal
allocate ( constitutive_phenopowerlaw_twinB ( maxNinstance ) )
constitutive_phenopowerlaw_twinB = 0.0_pReal
allocate ( constitutive_phenopowerlaw_twinC ( maxNinstance ) )
constitutive_phenopowerlaw_twinC = 0.0_pReal
allocate ( constitutive_phenopowerlaw_twinD ( maxNinstance ) )
constitutive_phenopowerlaw_twinD = 0.0_pReal
allocate ( constitutive_phenopowerlaw_twinE ( maxNinstance ) )
constitutive_phenopowerlaw_twinE = 0.0_pReal
2012-11-14 15:52:34 +05:30
allocate ( constitutive_phenopowerlaw_h0_SlipSlip ( maxNinstance ) )
constitutive_phenopowerlaw_h0_SlipSlip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_h0_SlipTwin ( maxNinstance ) )
constitutive_phenopowerlaw_h0_SlipTwin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_h0_TwinSlip ( maxNinstance ) )
constitutive_phenopowerlaw_h0_TwinSlip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_h0_TwinTwin ( maxNinstance ) )
constitutive_phenopowerlaw_h0_TwinTwin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_interaction_SlipSlip ( lattice_maxNinteraction , maxNinstance ) )
constitutive_phenopowerlaw_interaction_SlipSlip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_interaction_SlipTwin ( lattice_maxNinteraction , maxNinstance ) )
constitutive_phenopowerlaw_interaction_SlipTwin = 0.0_pReal
allocate ( constitutive_phenopowerlaw_interaction_TwinSlip ( lattice_maxNinteraction , maxNinstance ) )
constitutive_phenopowerlaw_interaction_TwinSlip = 0.0_pReal
allocate ( constitutive_phenopowerlaw_interaction_TwinTwin ( lattice_maxNinteraction , maxNinstance ) )
constitutive_phenopowerlaw_interaction_TwinTwin = 0.0_pReal
2011-11-23 20:18:39 +05:30
allocate ( constitutive_phenopowerlaw_a_slip ( maxNinstance ) )
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_a_slip = 0.0_pReal
2010-10-26 18:46:37 +05:30
allocate ( constitutive_phenopowerlaw_aTolResistance ( maxNinstance ) )
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_aTolResistance = 0.0_pReal
2012-10-22 20:25:07 +05:30
allocate ( constitutive_phenopowerlaw_aTolShear ( maxNinstance ) )
constitutive_phenopowerlaw_aTolShear = 0.0_pReal
allocate ( constitutive_phenopowerlaw_aTolTwinfrac ( maxNinstance ) )
constitutive_phenopowerlaw_aTolTwinfrac = 0.0_pReal
2013-01-22 04:41:16 +05:30
allocate ( constitutive_phenopowerlaw_nonSchmidCoeff ( lattice_maxNonSchmid , maxNinstance ) )
constitutive_phenopowerlaw_nonSchmidCoeff = 0.0_pReal
2009-08-27 17:40:06 +05:30
2012-02-21 21:30:00 +05:30
rewind ( myFile )
2013-07-01 11:40:42 +05:30
do while ( trim ( line ) / = '#EOF#' . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = 'phase' ) ! wind forward to <phase>
2013-06-27 00:49:00 +05:30
line = IO_read ( myFile )
2009-07-22 21:37:19 +05:30
enddo
2013-07-01 11:40:42 +05:30
do while ( trim ( line ) / = '#EOF#' ) ! read through sections of phase part
2013-06-27 00:49:00 +05:30
line = IO_read ( myFile )
2012-10-11 20:19:12 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
if ( IO_getTag ( line , '<' , '>' ) / = '' ) exit ! stop at next part
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
section = section + 1_pInt ! advance section counter
cycle ! skip to next line
2009-07-22 21:37:19 +05:30
endif
2013-07-01 11:40:42 +05:30
if ( section > 0_pInt ) then ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran
if ( phase_plasticity ( section ) == CONSTITUTIVE_PHENOPOWERLAW_label ) then ! one of my sections
2013-06-12 01:46:40 +05:30
i = phase_plasticityInstance ( section ) ! which instance of my plasticity is present phase
positions = IO_stringPos ( line , MAXNCHUNKS )
tag = IO_lc ( IO_stringValue ( line , positions , 1_pInt ) ) ! extract key
select case ( tag )
case ( 'plasticity' , 'elasticity' )
cycle
case ( '(output)' )
constitutive_phenopowerlaw_Noutput ( i ) = constitutive_phenopowerlaw_Noutput ( i ) + 1_pInt
constitutive_phenopowerlaw_output ( constitutive_phenopowerlaw_Noutput ( i ) , i ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
case ( 'lattice_structure' )
constitutive_phenopowerlaw_structureName ( i ) = IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
configNchunks = lattice_configNchunks ( constitutive_phenopowerlaw_structureName ( i ) )
Nchunks_SlipFamilies = configNchunks ( 1 )
Nchunks_TwinFamilies = configNchunks ( 2 )
Nchunks_SlipSlip = configNchunks ( 3 )
Nchunks_SlipTwin = configNchunks ( 4 )
Nchunks_TwinSlip = configNchunks ( 5 )
Nchunks_TwinTwin = configNchunks ( 6 )
case ( 'covera_ratio' )
constitutive_phenopowerlaw_CoverA ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c11' )
constitutive_phenopowerlaw_Cslip_66 ( 1 , 1 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c12' )
constitutive_phenopowerlaw_Cslip_66 ( 1 , 2 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c13' )
constitutive_phenopowerlaw_Cslip_66 ( 1 , 3 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c22' )
constitutive_phenopowerlaw_Cslip_66 ( 2 , 2 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c23' )
constitutive_phenopowerlaw_Cslip_66 ( 2 , 3 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c33' )
constitutive_phenopowerlaw_Cslip_66 ( 3 , 3 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c44' )
constitutive_phenopowerlaw_Cslip_66 ( 4 , 4 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c55' )
constitutive_phenopowerlaw_Cslip_66 ( 5 , 5 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'c66' )
constitutive_phenopowerlaw_Cslip_66 ( 6 , 6 , i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'nslip' )
do j = 1_pInt , Nchunks_SlipFamilies
constitutive_phenopowerlaw_Nslip ( j , i ) = IO_intValue ( line , positions , 1_pInt + j )
enddo
case ( 'gdot0_slip' )
constitutive_phenopowerlaw_gdot0_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'n_slip' )
constitutive_phenopowerlaw_n_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'tau0_slip' )
do j = 1_pInt , Nchunks_SlipFamilies
constitutive_phenopowerlaw_tau0_slip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'tausat_slip' )
do j = 1_pInt , Nchunks_SlipFamilies
constitutive_phenopowerlaw_tausat_slip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'a_slip' , 'w0_slip' )
constitutive_phenopowerlaw_a_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'ntwin' )
do j = 1_pInt , Nchunks_TwinFamilies
constitutive_phenopowerlaw_Ntwin ( j , i ) = IO_intValue ( line , positions , 1_pInt + j )
enddo
case ( 'gdot0_twin' )
constitutive_phenopowerlaw_gdot0_twin ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'n_twin' )
constitutive_phenopowerlaw_n_twin ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'tau0_twin' )
do j = 1_pInt , Nchunks_TwinFamilies
constitutive_phenopowerlaw_tau0_twin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 's_pr' )
constitutive_phenopowerlaw_spr ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'twin_b' )
constitutive_phenopowerlaw_twinB ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'twin_c' )
constitutive_phenopowerlaw_twinC ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'twin_d' )
constitutive_phenopowerlaw_twinD ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'twin_e' )
constitutive_phenopowerlaw_twinE ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'h0_slipslip' )
constitutive_phenopowerlaw_h0_SlipSlip ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'h0_sliptwin' )
constitutive_phenopowerlaw_h0_SlipTwin ( i ) = IO_floatValue ( line , positions , 2_pInt )
2013-07-01 11:40:42 +05:30
call IO_warning ( 42_pInt , ext_msg = trim ( tag ) / / ' (' / / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2013-06-12 01:46:40 +05:30
case ( 'h0_twinslip' )
constitutive_phenopowerlaw_h0_TwinSlip ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'h0_twintwin' )
constitutive_phenopowerlaw_h0_TwinTwin ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'atol_resistance' )
constitutive_phenopowerlaw_aTolResistance ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'atol_shear' )
constitutive_phenopowerlaw_aTolShear ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'atol_twinfrac' )
constitutive_phenopowerlaw_aTolTwinfrac ( i ) = IO_floatValue ( line , positions , 2_pInt )
case ( 'interaction_slipslip' )
do j = 1_pInt , Nchunks_SlipSlip
constitutive_phenopowerlaw_interaction_SlipSlip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_sliptwin' )
do j = 1_pInt , Nchunks_SlipTwin
constitutive_phenopowerlaw_interaction_SlipTwin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_twinslip' )
do j = 1_pInt , Nchunks_TwinSlip
constitutive_phenopowerlaw_interaction_TwinSlip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'interaction_twintwin' )
do j = 1_pInt , Nchunks_TwinTwin
constitutive_phenopowerlaw_interaction_TwinTwin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case ( 'nonschmid_coefficients' )
do j = 1_pInt , lattice_maxNonSchmid
constitutive_phenopowerlaw_nonSchmidCoeff ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
case default
2013-07-01 11:40:42 +05:30
call IO_error ( 210_pInt , ext_msg = trim ( tag ) / / ' (' / / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2013-06-12 01:46:40 +05:30
end select
endif
2009-07-22 21:37:19 +05:30
endif
enddo
2013-07-01 11:40:42 +05:30
sanityChecks : do i = 1_pInt , maxNinstance
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_structure ( i ) = lattice_initializeStructure ( constitutive_phenopowerlaw_structureName ( i ) , & ! get structure
constitutive_phenopowerlaw_CoverA ( i ) )
2011-03-24 22:50:35 +05:30
constitutive_phenopowerlaw_Nslip ( 1 : lattice_maxNslipFamily , i ) = &
2012-10-11 20:19:12 +05:30
min ( lattice_NslipSystem ( 1 : lattice_maxNslipFamily , constitutive_phenopowerlaw_structure ( i ) ) , & ! limit active slip systems per family to min of available and requested
2011-03-24 22:50:35 +05:30
constitutive_phenopowerlaw_Nslip ( 1 : lattice_maxNslipFamily , i ) )
constitutive_phenopowerlaw_Ntwin ( 1 : lattice_maxNtwinFamily , i ) = &
2012-10-11 20:19:12 +05:30
min ( lattice_NtwinSystem ( 1 : lattice_maxNtwinFamily , constitutive_phenopowerlaw_structure ( i ) ) , & ! limit active twin systems per family to min of available and requested
2011-03-24 22:50:35 +05:30
constitutive_phenopowerlaw_Ntwin ( : , i ) )
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_totalNslip ( i ) = sum ( constitutive_phenopowerlaw_Nslip ( : , i ) ) ! how many slip systems altogether
constitutive_phenopowerlaw_totalNtwin ( i ) = sum ( constitutive_phenopowerlaw_Ntwin ( : , i ) ) ! how many twin systems altogether
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
if ( constitutive_phenopowerlaw_structure ( i ) < 1 ) call IO_error ( 205_pInt , e = i )
2009-07-22 21:37:19 +05:30
if ( any ( constitutive_phenopowerlaw_tau0_slip ( : , i ) < 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_Nslip ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'tau0_slip (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
if ( constitutive_phenopowerlaw_gdot0_slip ( i ) < = 0.0_pReal ) call IO_error ( 211_pInt , e = i , ext_msg = 'gdot0_slip (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
if ( constitutive_phenopowerlaw_n_slip ( i ) < = 0.0_pReal ) call IO_error ( 211_pInt , e = i , ext_msg = 'n_slip (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2009-07-22 21:37:19 +05:30
if ( any ( constitutive_phenopowerlaw_tausat_slip ( : , i ) < = 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_Nslip ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'tausat_slip (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2011-11-23 20:18:39 +05:30
if ( any ( constitutive_phenopowerlaw_a_slip ( i ) == 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_Nslip ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'a_slip (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2009-07-22 21:37:19 +05:30
if ( any ( constitutive_phenopowerlaw_tau0_twin ( : , i ) < 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_Ntwin ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'tau0_twin (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2009-09-18 21:07:14 +05:30
if ( constitutive_phenopowerlaw_gdot0_twin ( i ) < = 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
any ( constitutive_phenopowerlaw_Ntwin ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'gdot0_twin (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2009-08-13 19:02:17 +05:30
if ( constitutive_phenopowerlaw_n_twin ( i ) < = 0.0_pReal . and . &
2013-07-01 11:40:42 +05:30
any ( constitutive_phenopowerlaw_Ntwin ( : , i ) > 0 ) ) call IO_error ( 211_pInt , e = i , ext_msg = 'n_twin (' &
/ / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2010-10-26 18:46:37 +05:30
if ( constitutive_phenopowerlaw_aTolResistance ( i ) < = 0.0_pReal ) &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolResistance ( i ) = 1.0_pReal ! default absolute tolerance 1 Pa
2012-10-22 20:25:07 +05:30
if ( constitutive_phenopowerlaw_aTolShear ( i ) < = 0.0_pReal ) &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolShear ( i ) = 1.0e-6_pReal ! default absolute tolerance 1e-6
2012-10-22 20:25:07 +05:30
if ( constitutive_phenopowerlaw_aTolTwinfrac ( i ) < = 0.0_pReal ) &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolTwinfrac ( i ) = 1.0e-6_pReal ! default absolute tolerance 1e-6
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
enddo sanityChecks
2009-10-22 14:28:14 +05:30
2012-11-14 15:52:34 +05:30
allocate ( constitutive_phenopowerlaw_hardeningMatrix_SlipSlip ( maxval ( constitutive_phenopowerlaw_totalNslip ) , & ! slip resistance from slip activity
2009-07-22 21:37:19 +05:30
maxval ( constitutive_phenopowerlaw_totalNslip ) , &
maxNinstance ) )
2012-11-14 15:52:34 +05:30
allocate ( constitutive_phenopowerlaw_hardeningMatrix_SlipTwin ( maxval ( constitutive_phenopowerlaw_totalNslip ) , & ! slip resistance from twin activity
2011-03-24 22:50:35 +05:30
maxval ( constitutive_phenopowerlaw_totalNtwin ) , &
maxNinstance ) )
2012-11-14 15:52:34 +05:30
allocate ( constitutive_phenopowerlaw_hardeningMatrix_TwinSlip ( maxval ( constitutive_phenopowerlaw_totalNtwin ) , & ! twin resistance from slip activity
maxval ( constitutive_phenopowerlaw_totalNslip ) , &
maxNinstance ) )
allocate ( constitutive_phenopowerlaw_hardeningMatrix_TwinTwin ( maxval ( constitutive_phenopowerlaw_totalNtwin ) , & ! twin resistance from twin activity
2009-07-22 21:37:19 +05:30
maxval ( constitutive_phenopowerlaw_totalNtwin ) , &
maxNinstance ) )
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_SlipSlip = 0.0_pReal
constitutive_phenopowerlaw_hardeningMatrix_SlipTwin = 0.0_pReal
constitutive_phenopowerlaw_hardeningMatrix_TwinSlip = 0.0_pReal
constitutive_phenopowerlaw_hardeningMatrix_TwinTwin = 0.0_pReal
2009-10-16 01:32:52 +05:30
2013-07-01 11:40:42 +05:30
instancesLoop : do i = 1_pInt , maxNinstance
outputsLoop : do o = 1_pInt , constitutive_phenopowerlaw_Noutput ( i )
select case ( constitutive_phenopowerlaw_output ( o , i ) )
2009-10-16 01:32:52 +05:30
case ( 'resistance_slip' , &
'shearrate_slip' , &
2013-02-06 23:39:11 +05:30
'accumulatedshear_slip' , &
2009-10-16 01:32:52 +05:30
'resolvedstress_slip' &
)
mySize = constitutive_phenopowerlaw_totalNslip ( i )
case ( 'resistance_twin' , &
'shearrate_twin' , &
2013-02-06 23:39:11 +05:30
'accumulatedshear_twin' , &
2009-10-16 01:32:52 +05:30
'resolvedstress_twin' &
)
mySize = constitutive_phenopowerlaw_totalNtwin ( i )
case ( 'totalshear' , &
'totalvolfrac' &
)
mySize = 1_pInt
case default
2013-07-01 11:40:42 +05:30
call IO_error ( 212_pInt , ext_msg = constitutive_phenopowerlaw_output ( o , i ) / / ' (' / / CONSTITUTIVE_PHENOPOWERLAW_label / / ')' )
2009-10-16 01:32:52 +05:30
end select
2012-10-11 20:19:12 +05:30
if ( mySize > 0_pInt ) then ! any meaningful output found
2012-07-17 23:06:24 +05:30
constitutive_phenopowerlaw_sizePostResult ( o , i ) = mySize
2009-10-16 01:32:52 +05:30
constitutive_phenopowerlaw_sizePostResults ( i ) = &
constitutive_phenopowerlaw_sizePostResults ( i ) + mySize
endif
2013-07-01 11:40:42 +05:30
enddo outputsLoop
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_sizeDotState ( i ) = constitutive_phenopowerlaw_totalNslip ( i ) + &
2013-02-06 23:39:11 +05:30
constitutive_phenopowerlaw_totalNtwin ( i ) + &
2_pInt + &
constitutive_phenopowerlaw_totalNslip ( i ) + &
constitutive_phenopowerlaw_totalNtwin ( i ) ! s_slip, s_twin, sum(gamma), sum(f), accshear_slip, accshear_twin
constitutive_phenopowerlaw_sizeState ( i ) = constitutive_phenopowerlaw_sizeDotState ( i )
2009-07-22 21:37:19 +05:30
2010-11-03 20:28:11 +05:30
myStructure = constitutive_phenopowerlaw_structure ( i )
2013-01-22 03:27:26 +05:30
constitutive_phenopowerlaw_Cslip_66 ( : , : , i ) = lattice_symmetrizeC66 ( constitutive_phenopowerlaw_structureName ( i ) , &
2013-01-22 21:18:47 +05:30
constitutive_phenopowerlaw_Cslip_66 ( : , : , i ) )
2013-01-22 03:27:26 +05:30
! assign elasticity tensor
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_Cslip_66 ( : , : , i ) = &
math_Mandel3333to66 ( math_Voigt66to3333 ( constitutive_phenopowerlaw_Cslip_66 ( : , : , i ) ) )
2012-10-22 20:25:07 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! >>> interaction slip -- X
2012-02-13 19:48:07 +05:30
index_myFamily = sum ( constitutive_phenopowerlaw_Nslip ( 1 : f - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do j = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , i ) ! loop over (active) systems in my family (slip)
2012-02-13 19:48:07 +05:30
do o = 1_pInt , lattice_maxNslipFamily
index_otherFamily = sum ( constitutive_phenopowerlaw_Nslip ( 1 : o - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do k = 1_pInt , constitutive_phenopowerlaw_Nslip ( o , i ) ! loop over (active) systems in other family (slip)
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_SlipSlip ( index_myFamily + j , index_otherFamily + k , i ) = &
constitutive_phenopowerlaw_interaction_SlipSlip ( lattice_interactionSlipSlip ( &
sum ( lattice_NslipSystem ( 1 : f - 1 , myStructure ) ) + j , &
sum ( lattice_NslipSystem ( 1 : o - 1 , myStructure ) ) + k , &
myStructure ) , i )
2009-10-21 18:40:12 +05:30
enddo ; enddo
2012-02-13 19:48:07 +05:30
do o = 1_pInt , lattice_maxNtwinFamily
index_otherFamily = sum ( constitutive_phenopowerlaw_Ntwin ( 1 : o - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do k = 1_pInt , constitutive_phenopowerlaw_Ntwin ( o , i ) ! loop over (active) systems in other family (twin)
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_SlipTwin ( index_myFamily + j , index_otherFamily + k , i ) = &
constitutive_phenopowerlaw_interaction_SlipTwin ( lattice_interactionSlipTwin ( &
sum ( lattice_NslipSystem ( 1 : f - 1_pInt , myStructure ) ) + j , &
sum ( lattice_NtwinSystem ( 1 : o - 1_pInt , myStructure ) ) + k , &
myStructure ) , i )
2009-10-21 18:40:12 +05:30
enddo ; enddo
enddo ; enddo
2012-10-22 20:25:07 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! >>> interaction twin -- X
2012-02-13 19:48:07 +05:30
index_myFamily = sum ( constitutive_phenopowerlaw_Ntwin ( 1 : f - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do j = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , i ) ! loop over (active) systems in my family (twin)
2009-10-21 18:40:12 +05:30
2012-02-13 19:48:07 +05:30
do o = 1_pInt , lattice_maxNslipFamily
index_otherFamily = sum ( constitutive_phenopowerlaw_Nslip ( 1 : o - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do k = 1_pInt , constitutive_phenopowerlaw_Nslip ( o , i ) ! loop over (active) systems in other family (slip)
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_TwinSlip ( index_myFamily + j , index_otherFamily + k , i ) = &
constitutive_phenopowerlaw_interaction_TwinSlip ( lattice_interactionTwinSlip ( &
sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , myStructure ) ) + j , &
sum ( lattice_NslipSystem ( 1 : o - 1_pInt , myStructure ) ) + k , &
myStructure ) , i )
2009-10-21 18:40:12 +05:30
enddo ; enddo
2012-02-13 19:48:07 +05:30
do o = 1_pInt , lattice_maxNtwinFamily
index_otherFamily = sum ( constitutive_phenopowerlaw_Ntwin ( 1 : o - 1_pInt , i ) )
2012-10-11 20:19:12 +05:30
do k = 1_pInt , constitutive_phenopowerlaw_Ntwin ( o , i ) ! loop over (active) systems in other family (twin)
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_hardeningMatrix_TwinTwin ( index_myFamily + j , index_otherFamily + k , i ) = &
constitutive_phenopowerlaw_interaction_TwinTwin ( lattice_interactionTwinTwin ( &
sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , myStructure ) ) + j , &
sum ( lattice_NtwinSystem ( 1 : o - 1_pInt , myStructure ) ) + k , &
myStructure ) , i )
2009-10-21 18:40:12 +05:30
enddo ; enddo
enddo ; enddo
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
enddo instancesLoop
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end subroutine constitutive_phenopowerlaw_init
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief sets the initial microstructural state for a given instance of this plasticity
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
pure function constitutive_phenopowerlaw_stateInit ( myInstance )
use lattice , only : &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily
2012-03-09 01:55:28 +05:30
2009-07-22 21:37:19 +05:30
implicit none
2013-07-01 11:40:42 +05:30
integer ( pInt ) , intent ( in ) :: &
myInstance !< number specifying the instance of the plasticity
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( myInstance ) ) :: &
constitutive_phenopowerlaw_stateInit
integer ( pInt ) :: &
i
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_stateInit = 0.0_pReal
2012-02-21 21:30:00 +05:30
do i = 1_pInt , lattice_maxNslipFamily
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_stateInit ( 1 + &
sum ( constitutive_phenopowerlaw_Nslip ( 1 : i - 1 , myInstance ) ) : &
sum ( constitutive_phenopowerlaw_Nslip ( 1 : i , myInstance ) ) ) = &
constitutive_phenopowerlaw_tau0_slip ( i , myInstance )
enddo
2012-02-21 21:30:00 +05:30
do i = 1_pInt , lattice_maxNtwinFamily
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_stateInit ( 1 + sum ( constitutive_phenopowerlaw_Nslip ( : , myInstance ) ) + &
sum ( constitutive_phenopowerlaw_Ntwin ( 1 : i - 1 , myInstance ) ) : &
sum ( constitutive_phenopowerlaw_Nslip ( : , myInstance ) ) + &
sum ( constitutive_phenopowerlaw_Ntwin ( 1 : i , myInstance ) ) ) = &
constitutive_phenopowerlaw_tau0_twin ( i , myInstance )
enddo
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_stateInit
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief sets the relevant state values for a given instance of this plasticity
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2010-10-26 18:46:37 +05:30
pure function constitutive_phenopowerlaw_aTolState ( myInstance )
2013-07-01 11:40:42 +05:30
2012-10-11 20:19:12 +05:30
implicit none
2013-07-01 11:40:42 +05:30
integer ( pInt ) , intent ( in ) :: myInstance !< number specifying the instance of the plasticity
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeState ( myInstance ) ) :: &
constitutive_phenopowerlaw_aTolState
2012-10-22 20:25:07 +05:30
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolState ( 1 : constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolResistance ( myInstance )
constitutive_phenopowerlaw_aTolState ( 1 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolShear ( myInstance )
constitutive_phenopowerlaw_aTolState ( 2 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolTwinFrac ( myInstance )
constitutive_phenopowerlaw_aTolState ( 3 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
2013-02-06 23:39:11 +05:30
constitutive_phenopowerlaw_totalNtwin ( myInstance ) : &
2 + 2 * ( constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) ) = &
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_aTolShear ( myInstance )
2009-09-18 21:07:14 +05:30
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_aTolState
2009-09-18 21:07:14 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief returns the homogenized elasticity matrix
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2012-11-07 21:13:29 +05:30
pure function constitutive_phenopowerlaw_homogenizedC ( state , ipc , ip , el )
2013-07-01 11:40:42 +05:30
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
2012-03-09 01:55:28 +05:30
2009-07-22 21:37:19 +05:30
implicit none
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( 6 , 6 ) :: &
constitutive_phenopowerlaw_homogenizedC
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: &
2013-07-01 11:40:42 +05:30
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
2012-10-11 20:19:12 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
2013-07-01 11:40:42 +05:30
state !< microstructure state
constitutive_phenopowerlaw_homogenizedC = constitutive_phenopowerlaw_Cslip_66 ( 1 : 6 , 1 : 6 , &
phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) )
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_homogenizedC
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief calculates derived quantities from state
!> @details dummy subroutine, does nothing
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
pure subroutine constitutive_phenopowerlaw_microstructure ( temperature , state , ipc , ip , el )
2013-02-11 16:26:10 +05:30
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
2013-07-01 11:40:42 +05:30
homogenization_maxNgrains
2012-03-09 01:55:28 +05:30
2009-07-22 21:37:19 +05:30
implicit none
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: &
2013-07-01 11:40:42 +05:30
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
real ( pReal ) , intent ( in ) :: &
temperature !< temperature at IP
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state !< microstructure state
2010-11-03 20:28:11 +05:30
2012-03-09 01:55:28 +05:30
end subroutine constitutive_phenopowerlaw_microstructure
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief calculates plastic velocity gradient and its tangent
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
pure subroutine constitutive_phenopowerlaw_LpAndItsTangent ( Lp , dLp_dTstar_99 , Tstar_v , &
temperature , state , ipc , ip , el )
use prec , only : &
p_vec
use math , only : &
math_Plain3333to99 , &
math_Mandel6to33
use lattice , only : &
lattice_Sslip , &
lattice_Sslip_v , &
lattice_Stwin , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , &
NnonSchmid
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
2009-07-22 21:37:19 +05:30
implicit none
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( out ) :: &
Lp !< plastic velocity gradient
real ( pReal ) , dimension ( 9 , 9 ) , intent ( out ) :: &
dLp_dTstar_99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real ( pReal ) , intent ( in ) :: &
temperature !< temperature at IP
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state !< microstructure state
integer ( pInt ) :: &
matID , &
nSlip , &
nTwin , structID , index_Gamma , index_F , index_myFamily , &
f , i , j , k , l , m , n
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) :: &
dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor
real ( pReal ) , dimension ( 3 , 3 , 2 ) :: &
nonSchmid_tensor
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_totalNslip ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2013-01-22 04:41:16 +05:30
gdot_slip_pos , gdot_slip_neg , dgdot_dtauslip_pos , dgdot_dtauslip_neg , tau_slip_pos , tau_slip_neg
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_totalNtwin ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2009-07-22 21:37:19 +05:30
gdot_twin , dgdot_dtautwin , tau_twin
2012-03-12 19:39:37 +05:30
matID = phase_plasticityInstance ( material_phase ( ipc , ip , el ) )
2009-07-22 21:37:19 +05:30
structID = constitutive_phenopowerlaw_structure ( matID )
nSlip = constitutive_phenopowerlaw_totalNslip ( matID )
nTwin = constitutive_phenopowerlaw_totalNtwin ( matID )
2012-02-21 21:30:00 +05:30
index_Gamma = nSlip + nTwin + 1_pInt
index_F = nSlip + nTwin + 2_pInt
2009-07-22 21:37:19 +05:30
Lp = 0.0_pReal
dLp_dTstar3333 = 0.0_pReal
2013-07-01 11:40:42 +05:30
dLp_dTstar_99 = 0.0_pReal
2009-10-21 18:40:12 +05:30
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
slipFamiliesLoop : do f = 1_pInt , lattice_maxNslipFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , matID ) ! process each (active) slip system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of Lp
2013-01-22 04:41:16 +05:30
tau_slip_pos ( j ) = dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
tau_slip_neg ( j ) = tau_slip_pos ( j )
nonSchmid_tensor ( 1 : 3 , 1 : 3 , 1 ) = math_Mandel6to33 ( lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
nonSchmid_tensor ( 1 : 3 , 1 : 3 , 2 ) = nonSchmid_tensor ( 1 : 3 , 1 : 3 , 1 )
do k = 1 , NnonSchmid ( structID )
tau_slip_pos ( j ) = tau_slip_pos ( j ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k , index_myFamily + i , structID ) )
tau_slip_neg ( j ) = tau_slip_neg ( j ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k + 1 , index_myFamily + i , structID ) )
nonSchmid_tensor ( 1 : 3 , 1 : 3 , 1 ) = nonSchmid_tensor ( 1 : 3 , 1 : 3 , 1 ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
math_Mandel6to33 ( lattice_Sslip_v ( 1 : 6 , 2 * k , index_myFamily + i , structID ) )
nonSchmid_tensor ( 1 : 3 , 1 : 3 , 2 ) = nonSchmid_tensor ( 1 : 3 , 1 : 3 , 2 ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
math_Mandel6to33 ( lattice_Sslip_v ( 1 : 6 , 2 * k + 1 , index_myFamily + i , structID ) )
enddo
gdot_slip_pos ( j ) = 0.5_pReal * constitutive_phenopowerlaw_gdot0_slip ( matID ) * &
2013-01-22 18:32:23 +05:30
( ( abs ( tau_slip_pos ( j ) ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) ) * &
sign ( 1.0_pReal , tau_slip_pos ( j ) )
2013-01-22 04:41:16 +05:30
gdot_slip_neg ( j ) = 0.5_pReal * constitutive_phenopowerlaw_gdot0_slip ( matID ) * &
2013-01-22 18:32:23 +05:30
( ( abs ( tau_slip_neg ( j ) ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) ) * &
sign ( 1.0_pReal , tau_slip_neg ( j ) )
2013-01-22 04:41:16 +05:30
Lp = Lp + ( 1.0_pReal - state ( ipc , ip , el ) % p ( index_F ) ) * & ! 1-F
( gdot_slip_pos ( j ) + gdot_slip_neg ( j ) ) * lattice_Sslip ( 1 : 3 , 1 : 3 , index_myFamily + i , structID )
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp
2013-01-22 04:41:16 +05:30
if ( gdot_slip_pos ( j ) / = 0.0_pReal ) then
dgdot_dtauslip_pos ( j ) = gdot_slip_pos ( j ) * constitutive_phenopowerlaw_n_slip ( matID ) / tau_slip_pos ( j )
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
dLp_dTstar3333 ( k , l , m , n ) = dLp_dTstar3333 ( k , l , m , n ) + &
dgdot_dtauslip_pos ( j ) * lattice_Sslip ( k , l , index_myFamily + i , structID ) * &
nonSchmid_tensor ( m , n , 1 )
endif
if ( gdot_slip_neg ( j ) / = 0.0_pReal ) then
dgdot_dtauslip_neg ( j ) = gdot_slip_neg ( j ) * constitutive_phenopowerlaw_n_slip ( matID ) / tau_slip_neg ( j )
2012-02-21 21:30:00 +05:30
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
2009-10-21 18:40:12 +05:30
dLp_dTstar3333 ( k , l , m , n ) = dLp_dTstar3333 ( k , l , m , n ) + &
2013-01-22 04:41:16 +05:30
dgdot_dtauslip_neg ( j ) * lattice_Sslip ( k , l , index_myFamily + i , structID ) * &
nonSchmid_tensor ( m , n , 2 )
2009-10-21 18:40:12 +05:30
endif
2009-07-22 21:37:19 +05:30
enddo
2013-07-01 11:40:42 +05:30
enddo slipFamiliesLoop
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
twinFamiliesLoop : do f = 1_pInt , lattice_maxNtwinFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , matID ) ! process each (active) twin system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of Lp
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
tau_twin ( j ) = dot_product ( Tstar_v , lattice_Stwin_v ( 1 : 6 , index_myFamily + i , structID ) )
2012-10-11 20:19:12 +05:30
gdot_twin ( j ) = ( 1.0_pReal - state ( ipc , ip , el ) % p ( index_F ) ) * & ! 1-F
2009-10-22 14:28:14 +05:30
constitutive_phenopowerlaw_gdot0_twin ( matID ) * &
2009-07-22 21:37:19 +05:30
( abs ( tau_twin ( j ) ) / state ( ipc , ip , el ) % p ( nSlip + j ) ) ** &
constitutive_phenopowerlaw_n_twin ( matID ) * max ( 0.0_pReal , sign ( 1.0_pReal , tau_twin ( j ) ) )
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
Lp = Lp + gdot_twin ( j ) * lattice_Stwin ( 1 : 3 , 1 : 3 , index_myFamily + i , structID )
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp
2009-10-21 18:40:12 +05:30
if ( gdot_twin ( j ) / = 0.0_pReal ) then
dgdot_dtautwin ( j ) = gdot_twin ( j ) * constitutive_phenopowerlaw_n_twin ( matID ) / tau_twin ( j )
2012-02-21 21:30:00 +05:30
forall ( k = 1_pInt : 3_pInt , l = 1_pInt : 3_pInt , m = 1_pInt : 3_pInt , n = 1_pInt : 3_pInt ) &
2009-10-21 18:40:12 +05:30
dLp_dTstar3333 ( k , l , m , n ) = dLp_dTstar3333 ( k , l , m , n ) + &
dgdot_dtautwin ( j ) * lattice_Stwin ( k , l , index_myFamily + i , structID ) * &
lattice_Stwin ( m , n , index_myFamily + i , structID )
endif
2009-07-22 21:37:19 +05:30
enddo
2013-07-01 11:40:42 +05:30
enddo twinFamiliesLoop
2009-07-22 21:37:19 +05:30
2013-07-01 11:40:42 +05:30
dLp_dTstar_99 = math_Plain3333to99 ( dLp_dTstar3333 )
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end subroutine constitutive_phenopowerlaw_LpAndItsTangent
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief calculates the rate of change of microstructure
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
function constitutive_phenopowerlaw_dotState ( Tstar_v , temperature , state , ipc , ip , el )
use prec , only : &
p_vec
use lattice , only : &
lattice_Sslip_v , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , &
lattice_shearTwin , &
NnonSchmid
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
2012-03-09 01:55:28 +05:30
2009-07-22 21:37:19 +05:30
implicit none
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real ( pReal ) , intent ( in ) :: &
temperature !< temperature at integration point
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state !< microstructure state
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
constitutive_phenopowerlaw_dotState
integer ( pInt ) :: matID , nSlip , nTwin , f , i , j , k , structID , &
2013-02-08 19:03:25 +05:30
index_Gamma , index_F , offset_accshear_slip , offset_accshear_twin , index_myFamily
2013-07-01 11:40:42 +05:30
real ( pReal ) :: c_SlipSlip , c_SlipTwin , c_TwinSlip , c_TwinTwin , ssat_offset
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_totalNslip ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2013-01-22 04:41:16 +05:30
gdot_slip , tau_slip_pos , tau_slip_neg , left_SlipSlip , left_SlipTwin , right_SlipSlip , right_TwinSlip
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_totalNtwin ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2012-11-14 15:52:34 +05:30
gdot_twin , tau_twin , left_TwinSlip , left_TwinTwin , right_SlipTwin , right_TwinTwin
2013-07-01 11:40:42 +05:30
2009-07-22 21:37:19 +05:30
2012-03-12 19:39:37 +05:30
matID = phase_plasticityInstance ( material_phase ( ipc , ip , el ) )
2009-07-22 21:37:19 +05:30
structID = constitutive_phenopowerlaw_structure ( matID )
nSlip = constitutive_phenopowerlaw_totalNslip ( matID )
nTwin = constitutive_phenopowerlaw_totalNtwin ( matID )
2012-02-21 21:30:00 +05:30
index_Gamma = nSlip + nTwin + 1_pInt
index_F = nSlip + nTwin + 2_pInt
2013-02-08 19:03:25 +05:30
offset_accshear_slip = nSlip + nTwin + 2_pInt
offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_dotState = 0.0_pReal
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2012-10-22 20:25:07 +05:30
! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices
2012-11-14 15:52:34 +05:30
c_SlipSlip = constitutive_phenopowerlaw_h0_SlipSlip ( matID ) * &
2013-07-01 11:40:42 +05:30
( 1.0_pReal + constitutive_phenopowerlaw_twinC ( matID ) * state ( ipc , ip , el ) % p ( index_F ) ** &
constitutive_phenopowerlaw_twinB ( matID ) )
2012-11-14 15:52:34 +05:30
c_SlipTwin = 0.0_pReal
c_TwinSlip = constitutive_phenopowerlaw_h0_TwinSlip ( matID ) * &
2009-07-22 21:37:19 +05:30
state ( ipc , ip , el ) % p ( index_Gamma ) ** constitutive_phenopowerlaw_twinE ( matID )
2012-11-14 15:52:34 +05:30
c_TwinTwin = constitutive_phenopowerlaw_h0_TwinTwin ( matID ) * &
2009-07-22 21:37:19 +05:30
state ( ipc , ip , el ) % p ( index_F ) ** constitutive_phenopowerlaw_twinD ( matID )
2012-10-22 20:25:07 +05:30
2013-07-01 11:40:42 +05:30
!--------------------------------------------------------------------------------------------------
! calculate left and right vectors and calculate dot gammas
2011-02-25 14:55:53 +05:30
ssat_offset = constitutive_phenopowerlaw_spr ( matID ) * sqrt ( state ( ipc , ip , el ) % p ( index_F ) )
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
slipFamiliesLoop1 : do f = 1_pInt , lattice_maxNslipFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , matID ) ! process each (active) slip system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2013-07-01 11:40:42 +05:30
left_SlipSlip ( j ) = 1.0_pReal ! no system-dependent left part
left_SlipTwin ( j ) = 1.0_pReal ! no system-dependent left part
2013-02-01 21:14:50 +05:30
right_SlipSlip ( j ) = abs ( 1.0_pReal - state ( ipc , ip , el ) % p ( j ) / &
2012-10-22 20:25:07 +05:30
( constitutive_phenopowerlaw_tausat_slip ( f , matID ) + ssat_offset ) ) &
2013-02-01 21:14:50 +05:30
** constitutive_phenopowerlaw_a_slip ( matID ) &
* sign ( 1.0_pReal , 1.0_pReal - state ( ipc , ip , el ) % p ( j ) / &
( constitutive_phenopowerlaw_tausat_slip ( f , matID ) + ssat_offset ) )
2013-07-01 11:40:42 +05:30
right_TwinSlip ( j ) = 1.0_pReal ! no system-dependent part
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of dot gamma
2013-01-22 04:41:16 +05:30
tau_slip_pos ( j ) = dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
tau_slip_neg ( j ) = tau_slip_pos ( j )
do k = 1 , NnonSchmid ( structID )
tau_slip_pos ( j ) = tau_slip_pos ( j ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k , index_myFamily + i , structID ) )
tau_slip_neg ( j ) = tau_slip_neg ( j ) + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k + 1 , index_myFamily + i , structID ) )
enddo
gdot_slip ( j ) = constitutive_phenopowerlaw_gdot0_slip ( matID ) * 0.5_pReal * &
2013-07-01 11:40:42 +05:30
( ( abs ( tau_slip_pos ( j ) ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) &
+ ( abs ( tau_slip_neg ( j ) ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) ) &
* sign ( 1.0_pReal , tau_slip_pos ( j ) )
enddo
enddo slipFamiliesLoop1
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
twinFamiliesLoop1 : do f = 1_pInt , lattice_maxNtwinFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , matID ) ! process each (active) twin system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2012-11-14 15:52:34 +05:30
left_TwinSlip ( j ) = 1.0_pReal ! no system-dependent right part
left_TwinTwin ( j ) = 1.0_pReal ! no system-dependent right part
right_SlipTwin ( j ) = 1.0_pReal ! no system-dependent right part
right_TwinTwin ( j ) = 1.0_pReal ! no system-dependent right part
2012-10-22 20:25:07 +05:30
2013-07-01 11:40:42 +05:30
!--------------------------------------------------------------------------------------------------
! Calculation of dot vol frac
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
tau_twin ( j ) = dot_product ( Tstar_v , lattice_Stwin_v ( 1 : 6 , index_myFamily + i , structID ) )
2012-10-22 20:25:07 +05:30
gdot_twin ( j ) = ( 1.0_pReal - state ( ipc , ip , el ) % p ( index_F ) ) * & ! 1-F
2009-10-22 14:28:14 +05:30
constitutive_phenopowerlaw_gdot0_twin ( matID ) * &
2009-07-22 21:37:19 +05:30
( abs ( tau_twin ( j ) ) / state ( ipc , ip , el ) % p ( nSlip + j ) ) ** &
constitutive_phenopowerlaw_n_twin ( matID ) * max ( 0.0_pReal , sign ( 1.0_pReal , tau_twin ( j ) ) )
enddo
2013-07-01 11:40:42 +05:30
enddo twinFamiliesLoop1
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
! calculate the overall hardening based on above
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
slipFamiliesLoop2 : do f = 1_pInt , lattice_maxNslipFamily
2012-10-11 20:19:12 +05:30
do i = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , matID ) ! process each (active) slip system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_dotState ( j ) = & ! evolution of slip resistance j
2012-11-14 15:52:34 +05:30
c_SlipSlip * left_SlipSlip ( j ) * &
dot_product ( constitutive_phenopowerlaw_hardeningMatrix_SlipSlip ( j , 1 : nSlip , matID ) , &
right_SlipSlip * abs ( gdot_slip ) ) + & ! dot gamma_slip modulated by right-side slip factor
c_SlipTwin * left_SlipTwin ( j ) * &
dot_product ( constitutive_phenopowerlaw_hardeningMatrix_SlipTwin ( j , 1 : nTwin , matID ) , &
right_SlipTwin * gdot_twin ) ! dot gamma_twin modulated by right-side twin factor
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_dotState ( index_Gamma ) = constitutive_phenopowerlaw_dotState ( index_Gamma ) + &
abs ( gdot_slip ( j ) )
2013-02-08 19:03:25 +05:30
constitutive_phenopowerlaw_dotState ( offset_accshear_slip + j ) = abs ( gdot_slip ( j ) )
2009-07-22 21:37:19 +05:30
enddo
2013-07-01 11:40:42 +05:30
enddo slipFamiliesLoop2
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
twinFamiliesLoop2 : do f = 1_pInt , lattice_maxNtwinFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , matID ) ! process each (active) twin system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_dotState ( j + nSlip ) = & ! evolution of twin resistance j
2012-11-14 15:52:34 +05:30
c_TwinSlip * left_TwinSlip ( j ) * &
dot_product ( constitutive_phenopowerlaw_hardeningMatrix_TwinSlip ( j , 1 : nSlip , matID ) , &
right_TwinSlip * abs ( gdot_slip ) ) + & ! dot gamma_slip modulated by right-side slip factor
c_TwinTwin * left_TwinTwin ( j ) * &
dot_product ( constitutive_phenopowerlaw_hardeningMatrix_TwinTwin ( j , 1 : nTwin , matID ) , &
right_TwinTwin * gdot_twin ) ! dot gamma_twin modulated by right-side twin factor
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_dotState ( index_F ) = constitutive_phenopowerlaw_dotState ( index_F ) + &
gdot_twin ( j ) / lattice_shearTwin ( index_myFamily + i , structID )
2013-02-08 19:03:25 +05:30
constitutive_phenopowerlaw_dotState ( offset_accshear_twin + j ) = abs ( gdot_twin ( j ) )
2009-07-22 21:37:19 +05:30
enddo
2013-07-01 11:40:42 +05:30
enddo twinFamiliesLoop2
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_dotState
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief (instantaneous) incremental change of microstructure
2013-07-01 11:40:42 +05:30
!> @details dummy function, returns 0.0
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
function constitutive_phenopowerlaw_deltaState ( Tstar_v , temperature , state , ipc , ip , el )
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
2012-05-16 20:13:26 +05:30
2013-07-01 11:40:42 +05:30
implicit none
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real ( pReal ) , intent ( in ) :: &
Temperature !< temperature at integration point
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state !< microstructure state
2012-05-16 20:13:26 +05:30
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
constitutive_phenopowerlaw_deltaState
2012-05-16 20:13:26 +05:30
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_deltaState = 0.0_pReal
2012-05-16 20:13:26 +05:30
2012-10-11 20:19:12 +05:30
end function constitutive_phenopowerlaw_deltaState
2012-05-16 20:13:26 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
!> @brief calculates the rate of change of temperature
!> @details dummy function, returns 0.0
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
real ( pReal ) pure function constitutive_phenopowerlaw_dotTemperature ( Tstar_v , temperature , state , ipc , ip , el )
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains
implicit none
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real ( pReal ) , intent ( in ) :: &
temperature !< temperature at integration point
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state
constitutive_phenopowerlaw_dotTemperature = 0.0_pReal
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_dotTemperature
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief return array of constitutive results
!--------------------------------------------------------------------------------------------------
2013-07-01 11:40:42 +05:30
pure function constitutive_phenopowerlaw_postResults ( Tstar_v , temperature , dt , state , ipc , ip , el )
use prec , only : &
p_vec
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance , &
phase_Noutput
use lattice , only : &
lattice_Sslip_v , &
lattice_Stwin_v , &
lattice_maxNslipFamily , &
lattice_maxNtwinFamily , &
lattice_NslipSystem , &
lattice_NtwinSystem , NnonSchmid
use mesh , only : &
mesh_NcpElems , &
mesh_maxNips
2009-07-22 21:37:19 +05:30
implicit none
2013-07-01 11:40:42 +05:30
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation
real ( pReal ) , intent ( in ) :: &
temperature , & !< temperature at integration point
dt
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID of integration point
ip , & !< integration point
el !< element
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
state !< microstructure state
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizePostResults ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_postResults
2013-07-01 11:40:42 +05:30
integer ( pInt ) :: &
matID , structID , &
nSlip , nTwin , &
o , f , i , c , j , k , &
index_Gamma , index_F , index_accshear_slip , index_accshear_twin , index_myFamily
real ( pReal ) :: &
tau_slip_pos , tau_slip_neg , tau
2012-03-12 19:39:37 +05:30
matID = phase_plasticityInstance ( material_phase ( ipc , ip , el ) )
2009-07-22 21:37:19 +05:30
structID = constitutive_phenopowerlaw_structure ( matID )
nSlip = constitutive_phenopowerlaw_totalNslip ( matID )
nTwin = constitutive_phenopowerlaw_totalNtwin ( matID )
2012-02-21 21:30:00 +05:30
index_Gamma = nSlip + nTwin + 1_pInt
index_F = nSlip + nTwin + 2_pInt
2013-02-06 23:39:11 +05:30
index_accshear_slip = nSlip + nTwin + 3_pInt
index_accshear_twin = nSlip + nTwin + 3_pInt + nSlip
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_postResults = 0.0_pReal
c = 0_pInt
2013-07-01 11:40:42 +05:30
outputsLoop : do o = 1_pInt , phase_Noutput ( material_phase ( ipc , ip , el ) )
2009-07-22 21:37:19 +05:30
select case ( constitutive_phenopowerlaw_output ( o , matID ) )
case ( 'resistance_slip' )
2012-02-21 21:30:00 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt : c + nSlip ) = state ( ipc , ip , el ) % p ( 1 : nSlip )
2009-07-22 21:37:19 +05:30
c = c + nSlip
2013-02-06 23:39:11 +05:30
case ( 'accumulatedshear_slip' )
constitutive_phenopowerlaw_postResults ( c + 1_pInt : c + nSlip ) = state ( ipc , ip , el ) % p ( index_accshear_slip : &
index_accshear_slip + nSlip )
c = c + nSlip
2009-07-22 21:37:19 +05:30
case ( 'shearrate_slip' )
j = 0_pInt
2013-07-01 11:40:42 +05:30
slipFamiliesLoop1 : do f = 1_pInt , lattice_maxNslipFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , matID ) ! process each (active) slip system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2013-01-22 04:41:16 +05:30
tau_slip_pos = dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
tau_slip_neg = tau_slip_pos
do k = 1 , NnonSchmid ( structID )
tau_slip_pos = tau_slip_pos + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k , index_myFamily + i , structID ) )
tau_slip_neg = tau_slip_neg + constitutive_phenopowerlaw_nonSchmidCoeff ( k , matID ) * &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 2 * k + 1 , index_myFamily + i , structID ) )
enddo
constitutive_phenopowerlaw_postResults ( c + j ) = constitutive_phenopowerlaw_gdot0_slip ( matID ) * 0.5_pReal * &
( ( abs ( tau_slip_pos ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) &
+ ( abs ( tau_slip_neg ) / state ( ipc , ip , el ) % p ( j ) ) ** constitutive_phenopowerlaw_n_slip ( matID ) ) &
* sign ( 1.0_pReal , tau_slip_pos )
2013-07-01 11:40:42 +05:30
enddo
enddo slipFamiliesLoop1
2009-07-22 21:37:19 +05:30
c = c + nSlip
case ( 'resolvedstress_slip' )
j = 0_pInt
2013-07-01 11:40:42 +05:30
slipFamiliesLoop2 : do f = 1_pInt , lattice_maxNslipFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NslipSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Nslip ( f , matID ) ! process each (active) slip system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults ( c + j ) = &
dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
enddo
enddo slipFamiliesLoop2
2009-07-22 21:37:19 +05:30
c = c + nSlip
case ( 'totalshear' )
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt ) = &
state ( ipc , ip , el ) % p ( index_Gamma )
2012-02-21 21:30:00 +05:30
c = c + 1_pInt
2009-07-22 21:37:19 +05:30
case ( 'resistance_twin' )
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt : c + nTwin ) = &
state ( ipc , ip , el ) % p ( 1_pInt + nSlip : nTwin + nSlip )
2009-07-22 21:37:19 +05:30
c = c + nTwin
2009-10-21 18:40:12 +05:30
2013-02-06 23:39:11 +05:30
case ( 'accumulatedshear_twin' )
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt : c + nTwin ) = &
state ( ipc , ip , el ) % p ( index_accshear_twin : index_accshear_twin + nTwin )
2013-02-06 23:39:11 +05:30
c = c + nTwin
2009-10-21 18:40:12 +05:30
case ( 'shearrate_twin' )
2009-07-22 21:37:19 +05:30
j = 0_pInt
2013-07-01 11:40:42 +05:30
twinFamiliesLoop1 : do f = 1_pInt , lattice_maxNtwinFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , matID ) ! process each (active) twin system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
tau = dot_product ( Tstar_v , lattice_Stwin_v ( 1 : 6 , index_myFamily + i , structID ) )
2009-10-22 14:28:14 +05:30
constitutive_phenopowerlaw_postResults ( c + j ) = ( 1.0_pReal - state ( ipc , ip , el ) % p ( index_F ) ) * & ! 1-F
constitutive_phenopowerlaw_gdot0_twin ( matID ) * &
2009-07-22 21:37:19 +05:30
( abs ( tau ) / state ( ipc , ip , el ) % p ( j + nSlip ) ) ** &
constitutive_phenopowerlaw_n_twin ( matID ) * max ( 0.0_pReal , sign ( 1.0_pReal , tau ) )
2013-07-01 11:40:42 +05:30
enddo
enddo twinFamiliesLoop1
2009-07-22 21:37:19 +05:30
c = c + nTwin
case ( 'resolvedstress_twin' )
j = 0_pInt
2013-07-01 11:40:42 +05:30
twinFamiliesLoop2 : do f = 1_pInt , lattice_maxNtwinFamily
2012-10-11 20:19:12 +05:30
index_myFamily = sum ( lattice_NtwinSystem ( 1 : f - 1_pInt , structID ) ) ! at which index starts my family
do i = 1_pInt , constitutive_phenopowerlaw_Ntwin ( f , matID ) ! process each (active) twin system in family
2009-07-22 21:37:19 +05:30
j = j + 1_pInt
2013-07-01 11:40:42 +05:30
constitutive_phenopowerlaw_postResults ( c + j ) = &
dot_product ( Tstar_v , lattice_Stwin_v ( 1 : 6 , index_myFamily + i , structID ) )
enddo
enddo twinFamiliesLoop2
2009-07-22 21:37:19 +05:30
c = c + nTwin
case ( 'totalvolfrac' )
2012-02-21 21:30:00 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt ) = state ( ipc , ip , el ) % p ( index_F )
c = c + 1_pInt
2009-07-22 21:37:19 +05:30
end select
2013-07-01 11:40:42 +05:30
enddo outputsLoop
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end function constitutive_phenopowerlaw_postResults
2009-07-22 21:37:19 +05:30
2012-03-09 01:55:28 +05:30
end module constitutive_phenopowerlaw
