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
!> @brief phenomenological crystal plasticity formulation using a powerlaw fitting
!--------------------------------------------------------------------------------------------------
2012-03-09 01:55:28 +05:30
module constitutive_phenopowerlaw
2009-07-22 21:37:19 +05:30
use prec , only : pReal , pInt
2012-03-09 01:55:28 +05:30
implicit none
2012-04-11 19:31:02 +05:30
private
character ( len = * ) , parameter , public :: &
2013-05-28 23:01:55 +05:30
constitutive_phenopowerlaw_LABEL = 'phenopowerlaw'
2012-04-11 19:31:02 +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
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
2009-07-22 21:37:19 +05:30
2012-04-11 19:31:02 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , target , public :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_sizePostResult !< size of each post result output
2012-03-09 01:55:28 +05:30
2012-04-11 19:31:02 +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
2012-04-11 19:31:02 +05:30
character ( len = 64 ) , dimension ( : , : ) , allocatable , target , public :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_output !< name of each post result output
2012-03-09 01:55:28 +05:30
2013-01-22 03:27:26 +05:30
character ( len = 32 ) , dimension ( : ) , allocatable , public :: &
2012-03-09 01:55:28 +05:30
constitutive_phenopowerlaw_structureName
2012-04-11 19:31:02 +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)
constitutive_phenopowerlaw_n_twin !< stress exponent for twin (input parameter)
2012-03-09 01:55:28 +05:30
2012-04-11 19:31:02 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
2012-10-11 20:19:12 +05:30
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)
2012-03-09 01:55:28 +05:30
2012-04-11 19:31:02 +05:30
real ( pReal ) , dimension ( : ) , allocatable , private :: &
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
2012-04-11 19:31:02 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
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
2012-04-11 19:31:02 +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
2013-01-22 04:41:16 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , private :: &
constitutive_phenopowerlaw_nonSchmidCoeff
2012-04-11 19:31:02 +05:30
public :: &
constitutive_phenopowerlaw_init , &
constitutive_phenopowerlaw_homogenizedC , &
constitutive_phenopowerlaw_aTolState , &
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 , &
constitutive_phenopowerlaw_microstructure , &
constitutive_phenopowerlaw_LpAndItsTangent , &
constitutive_phenopowerlaw_postResults , &
constitutive_phenopowerlaw_stateInit
2012-03-09 01:55:28 +05:30
contains
2009-07-22 21:37:19 +05:30
2012-10-11 20:19:12 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief reading in parameters from material config and doing consistency checks
!--------------------------------------------------------------------------------------------------
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)
2012-03-09 01:55:28 +05:30
use math , only : math_Mandel3333to66 , &
math_Voigt66to3333
2009-07-22 21:37:19 +05:30
use IO
use material
2012-07-05 15:24:50 +05:30
use debug , only : debug_level , &
2012-03-09 01:55:28 +05:30
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-05-28 23:01:55 +05:30
integer ( pInt ) , parameter :: MAXNCHUNKS = lattice_maxNinteraction + 1_pInt
integer ( pInt ) , dimension ( 1 + 2 * MAXNCHUNKS ) :: positions
2013-02-15 03:54:55 +05:30
integer ( pInt ) , dimension ( 6 ) :: configNchunks
2013-02-11 16:13:45 +05:30
integer ( pInt ) :: section , maxNinstance , i , j , k , f , o , &
Nchunks_SlipSlip , Nchunks_SlipTwin , Nchunks_TwinSlip , Nchunks_TwinTwin , &
Nchunks_SlipFamilies , Nchunks_TwinFamilies , &
mySize = 0_pInt , myStructure , index_myFamily , index_otherFamily
2012-03-09 01:55:28 +05:30
character ( len = 64 ) :: tag
2013-01-09 03:41:59 +05:30
character ( len = 1024 ) :: line = '' ! to start initialized
2013-05-28 23:01:55 +05:30
write ( 6 , '(/,a)' ) ' <<<+- constitutive_' / / trim ( constitutive_phenopowerlaw_LABEL ) / / ' init -+>>>'
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
2012-03-12 19:39:37 +05:30
maxNinstance = int ( count ( phase_plasticity == constitutive_phenopowerlaw_label ) , pInt )
2009-07-22 21:37:19 +05:30
if ( maxNinstance == 0 ) return
2009-10-16 01:32:52 +05:30
2013-02-15 03:54:55 +05:30
if ( iand ( debug_level ( debug_constitutive ) , debug_levelBasic ) / = 0_pInt ) then
write ( 6 , '(a16,1x,i5)' ) '# instances:' , maxNinstance
write ( 6 , * )
endif
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 )
section = 0_pInt
2009-10-16 01:32:52 +05:30
2012-10-11 20:19:12 +05:30
do while ( IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = 'phase' ) ! wind forward to <phase>
2012-02-21 21:30:00 +05:30
read ( myFile , '(a1024)' , END = 100 ) line
2009-07-22 21:37:19 +05:30
enddo
2012-10-11 20:19:12 +05:30
do ! read thru sections of phase part
2012-02-21 21:30:00 +05:30
read ( myFile , '(a1024)' , END = 100 ) line
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
2012-10-11 20:19:12 +05:30
if ( section > 0_pInt . and . phase_plasticity ( section ) == constitutive_phenopowerlaw_label ) then ! one of my sections
i = phase_plasticityInstance ( section ) ! which instance of my plasticity is present phase
2013-05-28 23:01:55 +05:30
positions = IO_stringPos ( line , MAXNCHUNKS )
2012-10-11 20:19:12 +05:30
tag = IO_lc ( IO_stringValue ( line , positions , 1_pInt ) ) ! extract key
2009-07-22 21:37:19 +05:30
select case ( tag )
2012-03-15 14:52:24 +05:30
case ( 'plasticity' , 'elasticity' )
2012-02-14 14:52:37 +05:30
cycle
2009-07-22 21:37:19 +05:30
case ( '(output)' )
2012-02-14 20:49:59 +05:30
constitutive_phenopowerlaw_Noutput ( i ) = constitutive_phenopowerlaw_Noutput ( i ) + 1_pInt
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_output ( constitutive_phenopowerlaw_Noutput ( i ) , i ) = &
IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2009-07-22 21:37:19 +05:30
case ( 'lattice_structure' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_structureName ( i ) = IO_lc ( IO_stringValue ( line , positions , 2_pInt ) )
2013-02-15 03:54:55 +05:30
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 )
2009-07-22 21:37:19 +05:30
case ( 'covera_ratio' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_CoverA ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'c11' )
2013-01-22 03:27:26 +05:30
constitutive_phenopowerlaw_Cslip_66 ( 1 , 1 , i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'c12' )
2013-01-22 03:27:26 +05:30
constitutive_phenopowerlaw_Cslip_66 ( 1 , 2 , i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'c13' )
2013-01-22 03:27:26 +05:30
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 )
2009-07-22 21:37:19 +05:30
case ( 'c33' )
2013-01-22 03:27:26 +05:30
constitutive_phenopowerlaw_Cslip_66 ( 3 , 3 , i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'c44' )
2013-01-22 03:27:26 +05:30
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 )
2009-07-22 21:37:19 +05:30
case ( 'nslip' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_SlipFamilies
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_Nslip ( j , i ) = IO_intValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2009-07-22 21:37:19 +05:30
case ( 'gdot0_slip' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_gdot0_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'n_slip' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_n_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'tau0_slip' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_SlipFamilies
2013-02-06 22:15:34 +05:30
constitutive_phenopowerlaw_tau0_slip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
2009-07-22 21:37:19 +05:30
case ( 'tausat_slip' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_SlipFamilies
2013-02-06 22:15:34 +05:30
constitutive_phenopowerlaw_tausat_slip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
2011-11-23 20:18:39 +05:30
case ( 'a_slip' , 'w0_slip' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_a_slip ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'ntwin' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_TwinFamilies
2013-02-06 22:15:34 +05:30
constitutive_phenopowerlaw_Ntwin ( j , i ) = IO_intValue ( line , positions , 1_pInt + j )
enddo
2009-07-22 21:37:19 +05:30
case ( 'gdot0_twin' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_gdot0_twin ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'n_twin' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_n_twin ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'tau0_twin' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_TwinFamilies
2013-02-06 22:15:34 +05:30
constitutive_phenopowerlaw_tau0_twin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
enddo
2009-07-22 21:37:19 +05:30
case ( 's_pr' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_spr ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'twin_b' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_twinB ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'twin_c' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_twinC ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'twin_d' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_twinD ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'twin_e' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_twinE ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'h0_slipslip' )
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_h0_SlipSlip ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'h0_sliptwin' )
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_h0_SlipTwin ( i ) = IO_floatValue ( line , positions , 2_pInt )
2012-10-11 20:19:12 +05:30
call IO_warning ( 42_pInt , ext_msg = trim ( tag ) / / ' (' / / constitutive_phenopowerlaw_label / / ')' )
2009-07-22 21:37:19 +05:30
case ( 'h0_twinslip' )
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_h0_TwinSlip ( i ) = IO_floatValue ( line , positions , 2_pInt )
2009-07-22 21:37:19 +05:30
case ( 'h0_twintwin' )
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_h0_TwinTwin ( i ) = IO_floatValue ( line , positions , 2_pInt )
2010-10-26 18:46:37 +05:30
case ( 'atol_resistance' )
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_aTolResistance ( i ) = IO_floatValue ( line , positions , 2_pInt )
2012-10-22 20:25:07 +05:30
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 )
2009-07-22 21:37:19 +05:30
case ( 'interaction_slipslip' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_SlipSlip
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_interaction_SlipSlip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2009-07-22 21:37:19 +05:30
case ( 'interaction_sliptwin' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_SlipTwin
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_interaction_SlipTwin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2009-07-22 21:37:19 +05:30
case ( 'interaction_twinslip' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_TwinSlip
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_interaction_TwinSlip ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2009-07-22 21:37:19 +05:30
case ( 'interaction_twintwin' )
2013-02-08 21:25:53 +05:30
do j = 1_pInt , Nchunks_TwinTwin
2012-11-14 15:52:34 +05:30
constitutive_phenopowerlaw_interaction_TwinTwin ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2013-01-22 04:41:16 +05:30
case ( 'nonschmid_coefficients' )
2013-02-06 22:15:34 +05:30
do j = 1_pInt , lattice_maxNonSchmid
2013-01-22 04:41:16 +05:30
constitutive_phenopowerlaw_nonSchmidCoeff ( j , i ) = IO_floatValue ( line , positions , 1_pInt + j )
2013-02-06 22:15:34 +05:30
enddo
2012-02-14 14:52:37 +05:30
case default
2012-10-11 20:19:12 +05:30
call IO_error ( 210_pInt , ext_msg = tag / / ' (' / / constitutive_phenopowerlaw_label / / ')' )
2009-07-22 21:37:19 +05:30
end select
endif
enddo
2012-02-13 19:48:07 +05:30
100 do i = 1_pInt , maxNinstance
2009-10-16 01:32:52 +05:30
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 ) )
2012-10-22 20:25:07 +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
2012-02-13 23:11:27 +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 . &
2012-07-17 23:06:24 +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 . &
2012-07-17 23:06:24 +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 . &
2012-07-17 23:06:24 +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 . &
2012-07-17 23:06:24 +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 . &
2012-07-17 23:06:24 +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 . &
2012-07-17 23:06:24 +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 ) &
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_aTolResistance ( i ) = 1.0_pReal ! default absolute tolerance 1 Pa
if ( constitutive_phenopowerlaw_aTolShear ( i ) < = 0.0_pReal ) &
constitutive_phenopowerlaw_aTolShear ( i ) = 1.0e-6_pReal ! default absolute tolerance 1e-6
if ( constitutive_phenopowerlaw_aTolTwinfrac ( i ) < = 0.0_pReal ) &
constitutive_phenopowerlaw_aTolTwinfrac ( i ) = 1.0e-6_pReal ! default absolute tolerance 1e-6
2009-07-22 21:37:19 +05:30
enddo
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
2012-02-13 19:48:07 +05:30
do i = 1_pInt , maxNinstance
2012-07-17 23:06:24 +05:30
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
2012-07-17 23:06:24 +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-02-08 19:03:25 +05:30
enddo ! outputs
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
2010-11-03 20:28:11 +05:30
! report to out file...
2012-10-22 20:25:07 +05:30
2009-07-22 21:37:19 +05:30
enddo
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
!--------------------------------------------------------------------------------------------------
!> @brief initial microstructural state
!--------------------------------------------------------------------------------------------------
2009-07-22 21:37:19 +05:30
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
integer ( pInt ) , intent ( in ) :: myInstance
2012-03-09 01:55:28 +05:30
integer ( pInt ) :: i
2009-07-23 19:03:53 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( myInstance ) ) :: constitutive_phenopowerlaw_stateInit
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
!--------------------------------------------------------------------------------------------------
!> @brief absolute state tolerance
!--------------------------------------------------------------------------------------------------
2010-10-26 18:46:37 +05:30
pure function constitutive_phenopowerlaw_aTolState ( myInstance )
2012-10-11 20:19:12 +05:30
implicit none
integer ( pInt ) , intent ( in ) :: myInstance ! number specifying the current instance of the plasticity
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeState ( myInstance ) ) :: &
constitutive_phenopowerlaw_aTolState ! relevant state values for the current instance of this plasticity
2009-09-18 21:07:14 +05:30
2012-10-22 20:25:07 +05:30
constitutive_phenopowerlaw_aTolState ( 1 : constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
constitutive_phenopowerlaw_aTolResistance ( myInstance )
constitutive_phenopowerlaw_aTolState ( 1 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
constitutive_phenopowerlaw_aTolShear ( myInstance )
constitutive_phenopowerlaw_aTolState ( 2 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) = &
constitutive_phenopowerlaw_aTolTwinFrac ( myInstance )
2013-02-06 23:39:11 +05:30
constitutive_phenopowerlaw_aTolState ( 3 + constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) : &
2 + 2 * ( constitutive_phenopowerlaw_totalNslip ( myInstance ) + &
constitutive_phenopowerlaw_totalNtwin ( myInstance ) ) ) = &
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
!--------------------------------------------------------------------------------------------------
!> @brief homogenized elacticity matrix
!--------------------------------------------------------------------------------------------------
2012-11-07 21:13:29 +05:30
pure function constitutive_phenopowerlaw_homogenizedC ( state , ipc , ip , el )
2012-03-09 01:55:28 +05:30
use prec , only : p_vec
2009-07-22 21:37:19 +05:30
use mesh , only : mesh_NcpElems , mesh_maxNips
2012-03-12 19:39:37 +05:30
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
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: &
ipc , & !component-ID of current integration point
ip , & !current integration point
el !current element
2009-07-22 21:37:19 +05:30
integer ( pInt ) matID
real ( pReal ) , dimension ( 6 , 6 ) :: constitutive_phenopowerlaw_homogenizedC
2012-10-11 20:19:12 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
2012-10-22 20:25:07 +05:30
state ! state variables
2009-07-22 21:37:19 +05:30
2012-03-12 19:39:37 +05:30
matID = phase_plasticityInstance ( material_phase ( ipc , ip , el ) )
2013-01-09 20:13:27 +05:30
constitutive_phenopowerlaw_homogenizedC = constitutive_phenopowerlaw_Cslip_66 ( 1 : 6 , 1 : 6 , matID )
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
!--------------------------------------------------------------------------------------------------
!> @brief calculate derived quantities from state (dummy subroutine, not used here)
!--------------------------------------------------------------------------------------------------
2013-02-11 16:13:45 +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 : &
homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
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 ) :: &
ipc , & !component-ID of current integration point
ip , & !current integration point
el !current element
integer ( pInt ) :: matID
real ( pReal ) , intent ( in ) :: Temperature ! temperature
2013-02-11 16:26:10 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: state
2009-07-22 21:37:19 +05:30
2012-03-12 19:39:37 +05:30
matID = phase_plasticityInstance ( material_phase ( ipc , ip , el ) )
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
!--------------------------------------------------------------------------------------------------
!> @brief plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
2009-07-22 21:37:19 +05:30
subroutine constitutive_phenopowerlaw_LpAndItsTangent ( Lp , dLp_dTstar , Tstar_v , Temperature , state , ipc , ip , el )
2012-03-09 01:55:28 +05:30
use prec , only : p_vec
2013-01-22 04:41:16 +05:30
use math , only : math_Plain3333to99 , math_Mandel6to33
2009-07-22 21:37:19 +05:30
use lattice , only : lattice_Sslip , lattice_Sslip_v , lattice_Stwin , lattice_Stwin_v , lattice_maxNslipFamily , lattice_maxNtwinFamily , &
2013-01-22 04:41:16 +05:30
lattice_NslipSystem , lattice_NtwinSystem , NnonSchmid
2009-07-22 21:37:19 +05:30
use mesh , only : mesh_NcpElems , mesh_maxNips
2012-03-12 19:39:37 +05:30
use material , only : homogenization_maxNgrains , material_phase , phase_plasticityInstance
2009-07-22 21:37:19 +05:30
implicit none
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: &
ipc , & ! component-ID at current integration point
ip , & ! current integration point
el ! current element
2009-07-22 21:37:19 +05:30
integer ( pInt ) matID , nSlip , nTwin , f , i , j , k , l , m , n , structID , index_Gamma , index_F , index_myFamily
real ( pReal ) Temperature
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) :: state
2012-10-22 20:25:07 +05:30
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v ! 2nd Piola Kirchhoff stress tensor (Mandel)
2012-10-11 20:19:12 +05:30
real ( pReal ) , dimension ( 3 , 3 ) , intent ( out ) :: Lp ! plastic velocity gradient
2012-10-22 20:25:07 +05:30
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) :: dLp_dTstar3333 ! derivative of Lp (4th-rank tensor)
real ( pReal ) , dimension ( 9 , 9 ) , intent ( out ) :: dLp_dTstar
2013-01-22 04:41:16 +05:30
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
dLp_dTstar = 0.0_pReal
2009-10-21 18:40:12 +05:30
2009-07-22 21:37:19 +05:30
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
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
enddo
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
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
enddo
dLp_dTstar = math_Plain3333to99 ( dLp_dTstar3333 )
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
!--------------------------------------------------------------------------------------------------
!> @brief of change of microstructure, evolution of state variable
!--------------------------------------------------------------------------------------------------
2009-07-22 21:37:19 +05:30
function constitutive_phenopowerlaw_dotState ( Tstar_v , Temperature , state , ipc , ip , el )
2012-03-09 01:55:28 +05:30
use prec , only : p_vec
2012-02-21 21:30:00 +05:30
use lattice , only : lattice_Sslip_v , lattice_Stwin_v , lattice_maxNslipFamily , lattice_maxNtwinFamily , &
2013-01-22 04:41:16 +05:30
lattice_NslipSystem , lattice_NtwinSystem , lattice_shearTwin , NnonSchmid
2009-07-22 21:37:19 +05:30
use mesh , only : mesh_NcpElems , mesh_maxNips
2012-03-12 19:39:37 +05:30
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
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: &
ipc , & !< component-ID at current integration point
ip , & !< current integration point
el !< current element
2013-02-06 23:39:11 +05:30
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
2012-11-14 15:52:34 +05:30
real ( pReal ) Temperature , c_SlipSlip , c_SlipTwin , c_TwinSlip , c_TwinTwin , ssat_offset
2012-10-11 20:19:12 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: state
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel)
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
2012-03-12 19:39:37 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( phase_plasticityInstance ( material_phase ( ipc , ip , el ) ) ) ) :: &
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_dotState
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 ) * &
2009-07-22 21:37:19 +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
!-- 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
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
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-11-14 15:52:34 +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 ) )
2012-11-14 15:52:34 +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 * &
( ( 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 ) )
2009-07-22 21:37:19 +05:30
enddo
enddo
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
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
!* 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
enddo
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
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
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
enddo
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
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
enddo
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
!--------------------------------------------------------------------------------------------------
2012-05-16 20:13:26 +05:30
function constitutive_phenopowerlaw_deltaState ( Tstar_v , Temperature , state , g , ip , el )
use prec , only : pReal , &
pInt , &
p_vec
use mesh , only : mesh_NcpElems , &
mesh_maxNips
use material , only : homogenization_maxNgrains , &
material_phase , &
phase_plasticityInstance
implicit none
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: g , & ! current grain number
ip , & ! current integration point
el ! current element number
real ( pReal ) , intent ( in ) :: Temperature ! temperature
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v ! current 2nd Piola-Kirchhoff stress in Mandel notation
2012-05-16 20:13:26 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: &
2012-10-11 20:19:12 +05:30
state ! current microstructural state
2012-05-16 20:13:26 +05:30
real ( pReal ) , dimension ( constitutive_phenopowerlaw_sizeDotState ( phase_plasticityInstance ( material_phase ( g , ip , el ) ) ) ) :: &
2012-10-11 20:19:12 +05:30
constitutive_phenopowerlaw_deltaState ! change of state variables / microstructure
2012-05-16 20:13:26 +05:30
constitutive_phenopowerlaw_deltaState = 0.0_pReal
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
!--------------------------------------------------------------------------------------------------
!> @brief calculates the rate of change of temperature (dummy function)
!--------------------------------------------------------------------------------------------------
2009-07-22 21:37:19 +05:30
pure function constitutive_phenopowerlaw_dotTemperature ( Tstar_v , Temperature , state , ipc , ip , el )
use prec , only : pReal , pInt , p_vec
2012-02-21 21:30:00 +05:30
use mesh , only : mesh_NcpElems , mesh_maxNips
use material , only : 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
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v ! 2nd Piola Kirchhoff stress tensor in Mandel notation
2009-07-22 21:37:19 +05:30
real ( pReal ) , intent ( in ) :: Temperature
2012-10-11 20:19:12 +05:30
integer ( pInt ) , intent ( in ) :: ipc , & ! grain number
ip , & ! integration point number
el ! element number
2009-07-22 21:37:19 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: state ! state of the current microstructure
2012-10-11 20:19:12 +05:30
real ( pReal ) constitutive_phenopowerlaw_dotTemperature ! rate of change of temparature
2009-07-22 21:37:19 +05:30
constitutive_phenopowerlaw_dotTemperature = 0.0_pReal
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
!--------------------------------------------------------------------------------------------------
2009-07-22 21:37:19 +05:30
pure function constitutive_phenopowerlaw_postResults ( Tstar_v , Temperature , dt , state , ipc , ip , el )
use prec , only : pReal , pInt , p_vec
use lattice , only : lattice_Sslip_v , lattice_Stwin_v , lattice_maxNslipFamily , lattice_maxNtwinFamily , &
2013-01-22 04:41:16 +05:30
lattice_NslipSystem , lattice_NtwinSystem , NnonSchmid
2009-07-22 21:37:19 +05:30
use mesh , only : mesh_NcpElems , mesh_maxNips
2012-03-12 19:39:37 +05:30
use material , only : homogenization_maxNgrains , material_phase , phase_plasticityInstance , phase_Noutput
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 ) :: &
ipc , & !component-ID at current integration point
ip , & !current integration point
el !current element
real ( pReal ) , intent ( in ) :: &
dt , & !current time increment
Temperature
real ( pReal ) , dimension ( 6 ) , intent ( in ) :: Tstar_v ! 2nd Piola Kirchhoff stress tensor (Mandel)
2009-07-22 21:37:19 +05:30
type ( p_vec ) , dimension ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , intent ( in ) :: state
2013-02-06 23:39:11 +05:30
integer ( pInt ) matID , o , f , i , c , nSlip , nTwin , j , k , structID , &
index_Gamma , index_F , index_accshear_slip , index_accshear_twin , index_myFamily
2013-01-22 04:41:16 +05:30
real ( pReal ) tau_slip_pos , tau_slip_neg , tau
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
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
2012-02-21 21:30:00 +05:30
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
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
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 )
2009-07-22 21:37:19 +05:30
enddo ; enddo
c = c + nSlip
case ( 'resolvedstress_slip' )
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNslipFamily ! loop over all slip families
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
constitutive_phenopowerlaw_postResults ( c + j ) = dot_product ( Tstar_v , lattice_Sslip_v ( 1 : 6 , 1 , index_myFamily + i , structID ) )
2009-10-21 18:40:12 +05:30
enddo ; enddo
2009-07-22 21:37:19 +05:30
c = c + nSlip
case ( 'totalshear' )
2012-02-21 21:30:00 +05:30
constitutive_phenopowerlaw_postResults ( c + 1_pInt ) = state ( ipc , ip , el ) % p ( index_Gamma )
c = c + 1_pInt
2009-07-22 21:37:19 +05:30
case ( 'resistance_twin' )
2012-02-21 21:30:00 +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' )
constitutive_phenopowerlaw_postResults ( c + 1_pInt : c + nTwin ) = state ( ipc , ip , el ) % p ( index_accshear_twin : &
index_accshear_twin + nTwin )
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
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
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 ) )
enddo ; enddo
c = c + nTwin
case ( 'resolvedstress_twin' )
j = 0_pInt
2012-10-11 20:19:12 +05:30
do f = 1_pInt , lattice_maxNtwinFamily ! loop over all twin families
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
constitutive_phenopowerlaw_postResults ( c + j ) = dot_product ( Tstar_v , lattice_Stwin_v ( 1 : 6 , index_myFamily + i , structID ) )
2009-10-21 18:40:12 +05:30
enddo ; enddo
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
enddo
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
