2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
! $Id$
!--------------------------------------------------------------------------------------------------
2015-10-14 00:22:01 +05:30
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
2013-02-22 04:38:36 +05:30
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
2015-10-14 00:22:01 +05:30
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @author Chen Zhang, Michigan State University
2013-02-22 04:38:36 +05:30
!> @brief crystallite state integration functions and reporting of results
!--------------------------------------------------------------------------------------------------
2010-10-01 17:48:49 +05:30
2012-08-31 01:56:28 +05:30
module crystallite
2013-04-29 16:47:30 +05:30
use prec , only : &
pReal , &
pInt
2012-08-31 01:56:28 +05:30
implicit none
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
private
2013-12-12 22:39:59 +05:30
character ( len = 64 ) , dimension ( : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_output !< name of each post result output
2013-12-12 22:39:59 +05:30
integer ( pInt ) , public , protected :: &
2013-05-17 23:22:46 +05:30
crystallite_maxSizePostResults !< description not available
2013-12-12 22:39:59 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
2013-05-17 23:22:46 +05:30
crystallite_sizePostResults !< description not available
2013-12-12 22:39:59 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private :: &
2013-05-17 23:22:46 +05:30
crystallite_sizePostResult !< description not available
2014-08-26 20:14:32 +05:30
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , public :: &
2013-10-16 18:34:59 +05:30
crystallite_dt !< requested time increment of each grain
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_subdt , & !< substepped time increment of each grain
crystallite_subFrac , & !< already calculated fraction of increment
2013-10-16 18:34:59 +05:30
crystallite_subStep !< size of next integration step
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable , public :: &
2013-02-22 04:38:36 +05:30
crystallite_Tstar_v , & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step)
crystallite_Tstar0_v , & !< 2nd Piola-Kirchhoff stress vector at start of FE inc
crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_subTstar0_v , & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc
crystallite_orientation , & !< orientation as quaternion
crystallite_orientation0 , & !< initial orientation as quaternion
2014-08-26 20:14:32 +05:30
crystallite_rotation !< grain rotation away from initial orientation as axis-angle (in degrees) in crystal reference frame
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : , : ) , allocatable , public :: &
2013-02-22 04:38:36 +05:30
crystallite_Fp , & !< current plastic def grad (end of converged time step)
crystallite_Fp0 , & !< plastic def grad at start of FE inc
crystallite_partionedFp0 , & !< plastic def grad at start of homog inc
2015-03-06 18:39:00 +05:30
crystallite_Fi , & !< current intermediate def grad (end of converged time step)
crystallite_Fi0 , & !< intermediate def grad at start of FE inc
crystallite_partionedFi0 , & !< intermediate def grad at start of homog inc
2013-02-22 04:38:36 +05:30
crystallite_F0 , & !< def grad at start of FE inc
crystallite_partionedF , & !< def grad to be reached at end of homog inc
crystallite_partionedF0 , & !< def grad at start of homog inc
crystallite_Lp , & !< current plastic velocitiy grad (end of converged time step)
crystallite_Lp0 , & !< plastic velocitiy grad at start of FE inc
crystallite_partionedLp0 , & !< plastic velocity grad at start of homog inc
2015-03-06 18:39:00 +05:30
crystallite_Li , & !< current intermediate velocitiy grad (end of converged time step)
crystallite_Li0 , & !< intermediate velocitiy grad at start of FE inc
crystallite_partionedLi0 , & !< intermediate velocity grad at start of homog inc
2015-05-28 22:32:23 +05:30
crystallite_Fe , & !< current "elastic" def grad (end of converged time step)
2013-02-22 04:38:36 +05:30
crystallite_P !< 1st Piola-Kirchhoff stress per grain
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_subFe0 , & !< "elastic" def grad at start of crystallite inc
crystallite_invFp , & !< inverse of current plastic def grad (end of converged time step)
crystallite_subFp0 , & !< plastic def grad at start of crystallite inc
2015-03-06 18:39:00 +05:30
crystallite_invFi , & !< inverse of current intermediate def grad (end of converged time step)
crystallite_subFi0 , & !< intermediate def grad at start of crystallite inc
2013-02-22 04:38:36 +05:30
crystallite_subF , & !< def grad to be reached at end of crystallite inc
crystallite_subF0 , & !< def grad at start of crystallite inc
crystallite_subLp0 , & !< plastic velocity grad at start of crystallite inc
2015-03-06 18:39:00 +05:30
crystallite_subLi0 , & !< intermediate velocity grad at start of crystallite inc
2013-02-22 04:38:36 +05:30
crystallite_disorientation !< disorientation between two neighboring ips (only calculated for single grain IPs)
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : , : , : , : ) , allocatable , public :: &
2013-02-22 04:38:36 +05:30
crystallite_dPdF , & !< current individual dPdF per grain (end of converged time step)
crystallite_dPdF0 , & !< individual dPdF per grain at start of FE inc
crystallite_partioneddPdF0 !< individual dPdF per grain at start of homog inc
2013-12-12 22:39:59 +05:30
real ( pReal ) , dimension ( : , : , : , : , : , : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_fallbackdPdF !< dPdF fallback for non-converged grains (elastic prediction)
2013-12-12 22:39:59 +05:30
logical , dimension ( : , : , : ) , allocatable , public :: &
2013-02-22 04:38:36 +05:30
crystallite_requested !< flag to request crystallite calculation
2013-12-12 22:39:59 +05:30
logical , dimension ( : , : , : ) , allocatable , public , protected :: &
2013-03-01 17:18:29 +05:30
crystallite_converged , & !< convergence flag
crystallite_localPlasticity !< indicates this grain to have purely local constitutive law
2013-12-12 22:39:59 +05:30
logical , dimension ( : , : , : ) , allocatable , private :: &
2013-02-22 04:38:36 +05:30
crystallite_todo !< flag to indicate need for further computation
2013-12-12 22:39:59 +05:30
logical , dimension ( : , : ) , allocatable , private :: &
2013-05-17 23:22:46 +05:30
crystallite_clearToWindForward , & !< description not available
crystallite_clearToCutback , & !< description not available
crystallite_syncSubFrac , & !< description not available
crystallite_syncSubFracCompleted , & !< description not available
crystallite_neighborEnforcedCutback !< description not available
2013-02-22 04:38:36 +05:30
2014-08-26 20:14:32 +05:30
enum , bind ( c )
2013-12-12 22:39:59 +05:30
enumerator :: undefined_ID , &
phase_ID , &
texture_ID , &
volume_ID , &
grainrotationx_ID , &
grainrotationy_ID , &
grainrotationz_ID , &
orientation_ID , &
grainrotation_ID , &
eulerangles_ID , &
defgrad_ID , &
fe_ID , &
fp_ID , &
2015-03-06 18:39:00 +05:30
fi_ID , &
2013-12-12 22:39:59 +05:30
lp_ID , &
2015-03-06 18:39:00 +05:30
li_ID , &
2013-12-12 22:39:59 +05:30
e_ID , &
ee_ID , &
p_ID , &
s_ID , &
elasmatrix_ID , &
neighboringip_ID , &
neighboringelement_ID
end enum
2014-08-26 20:14:32 +05:30
integer ( kind ( undefined_ID ) ) , dimension ( : , : ) , allocatable , private :: &
2013-12-12 22:39:59 +05:30
crystallite_outputID !< ID of each post result output
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
public :: &
crystallite_init , &
crystallite_stressAndItsTangent , &
crystallite_orientations , &
2014-09-10 14:07:12 +05:30
crystallite_push33ToRef , &
2013-02-22 04:38:36 +05:30
crystallite_postResults
private :: &
2014-08-26 20:14:32 +05:30
crystallite_integrateStateFPI , &
2013-02-22 04:38:36 +05:30
crystallite_integrateStateEuler , &
crystallite_integrateStateAdaptiveEuler , &
crystallite_integrateStateRK4 , &
crystallite_integrateStateRKCK45 , &
crystallite_integrateStress , &
crystallite_stateJump
2014-08-26 20:14:32 +05:30
2012-08-31 01:56:28 +05:30
contains
2009-05-07 21:57:36 +05:30
2011-03-29 12:57:19 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief allocates and initialize per grain variables
!--------------------------------------------------------------------------------------------------
2014-10-10 17:58:57 +05:30
subroutine crystallite_init
2013-02-22 04:38:36 +05:30
use , intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
2013-04-29 16:47:30 +05:30
use debug , only : &
debug_info , &
debug_reset , &
debug_level , &
debug_crystallite , &
debug_levelBasic
2013-04-16 22:37:27 +05:30
use numerics , only : &
2014-10-10 01:53:06 +05:30
worldrank , &
2014-08-26 20:14:32 +05:30
usePingPong
2013-05-17 23:22:46 +05:30
use math , only : &
2013-04-29 16:47:30 +05:30
math_I3 , &
math_EulerToR , &
math_inv33 , &
math_transpose33 , &
math_mul33xx33 , &
math_mul33x33
use FEsolving , only : &
FEsolving_execElem , &
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems , &
mesh_maxNips , &
mesh_maxNipNeighbors
use IO , only : &
2013-06-27 00:49:00 +05:30
IO_read , &
2013-04-29 16:47:30 +05:30
IO_timeStamp , &
IO_open_jobFile_stat , &
IO_open_file , &
IO_lc , &
IO_getTag , &
IO_isBlank , &
IO_stringPos , &
IO_stringValue , &
IO_write_jobFile , &
2013-12-12 22:39:59 +05:30
IO_error , &
IO_EOF
2012-08-31 01:56:28 +05:30
use material
2013-04-29 16:47:30 +05:30
use constitutive , only : &
2015-07-24 20:17:18 +05:30
constitutive_initialFi , &
2014-09-03 01:16:52 +05:30
constitutive_microstructure ! derived (shortcut) quantities of given state
2014-08-26 20:14:32 +05:30
2012-08-31 01:56:28 +05:30
implicit none
2013-10-16 18:34:59 +05:30
integer ( pInt ) , parameter :: &
2015-08-28 13:08:48 +05:30
FILEUNIT = 200_pInt
2014-08-26 20:14:32 +05:30
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-04-29 16:47:30 +05:30
integer ( pInt ) :: &
2016-01-17 23:26:24 +05:30
c , & !< counter in integration point component loop
i , & !< counter in integration point loop
e , & !< counter in element loop
o , & !< counter in output loop
r , & !< counter in crystallite loop
cMax , & !< maximum number of integration point components
2013-04-29 16:47:30 +05:30
iMax , & !< maximum number of integration points
eMax , & !< maximum number of elements
nMax , & !< maximum number of ip neighbors
2016-01-17 23:26:24 +05:30
myNcomponents , & !< number of components at current IP
2013-12-12 22:39:59 +05:30
section = 0_pInt , &
2013-04-29 16:47:30 +05:30
j , &
p , &
2014-03-09 02:20:31 +05:30
mySize
2013-10-19 00:27:28 +05:30
character ( len = 65536 ) :: &
2013-12-12 22:39:59 +05:30
tag = '' , &
line = ''
2014-08-26 20:14:32 +05:30
2015-10-14 00:22:01 +05:30
mainProcess : if ( worldrank == 0 ) then
2014-10-10 21:51:10 +05:30
write ( 6 , '(/,a)' ) ' <<<+- crystallite 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"
2014-10-10 21:51:10 +05:30
endif mainProcess
2014-08-26 20:14:32 +05:30
2016-01-17 20:20:33 +05:30
cMax = homogenization_maxNgrains
2012-08-31 01:56:28 +05:30
iMax = mesh_maxNips
eMax = mesh_NcpElems
nMax = mesh_maxNipNeighbors
2014-05-27 20:16:03 +05:30
2014-08-26 20:14:32 +05:30
2016-01-17 20:20:33 +05:30
allocate ( crystallite_Tstar0_v ( 6 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedTstar0_v ( 6 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subTstar0_v ( 6 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Tstar_v ( 6 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_P ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_F0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedF0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedF ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subF0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subF ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Fp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedFp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subFp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Fp ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_invFp ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Fi0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedFi0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subFi0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Fi ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_invFi ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Fe ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subFe0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Lp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedLp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subLp0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Lp ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Li0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partionedLi0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subLi0 ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_Li ( 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_dPdF ( 3 , 3 , 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_dPdF0 ( 3 , 3 , 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_partioneddPdF0 ( 3 , 3 , 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_fallbackdPdF ( 3 , 3 , 3 , 3 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_dt ( cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subdt ( cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subFrac ( cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_subStep ( cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_orientation ( 4 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_orientation0 ( 4 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_rotation ( 4 , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_disorientation ( 4 , nMax , cMax , iMax , eMax ) , source = 0.0_pReal )
allocate ( crystallite_localPlasticity ( cMax , iMax , eMax ) , source = . true . )
allocate ( crystallite_requested ( cMax , iMax , eMax ) , source = . false . )
allocate ( crystallite_todo ( cMax , iMax , eMax ) , source = . false . )
allocate ( crystallite_converged ( cMax , iMax , eMax ) , source = . true . )
2013-12-12 22:39:59 +05:30
allocate ( crystallite_clearToWindForward ( iMax , eMax ) , source = . true . )
allocate ( crystallite_syncSubFrac ( iMax , eMax ) , source = . false . )
allocate ( crystallite_syncSubFracCompleted ( iMax , eMax ) , source = . false . )
allocate ( crystallite_clearToCutback ( iMax , eMax ) , source = . true . )
allocate ( crystallite_neighborEnforcedCutback ( iMax , eMax ) , source = . false . )
2012-08-31 01:56:28 +05:30
allocate ( crystallite_output ( maxval ( crystallite_Noutput ) , &
2013-12-12 22:39:59 +05:30
material_Ncrystallite ) ) ; crystallite_output = ''
allocate ( crystallite_outputID ( maxval ( crystallite_Noutput ) , &
material_Ncrystallite ) , source = undefined_ID )
allocate ( crystallite_sizePostResults ( material_Ncrystallite ) , source = 0_pInt )
2012-08-31 01:56:28 +05:30
allocate ( crystallite_sizePostResult ( maxval ( crystallite_Noutput ) , &
2013-12-12 22:39:59 +05:30
material_Ncrystallite ) , source = 0_pInt )
2014-08-26 20:14:32 +05:30
2013-12-12 22:39:59 +05:30
if ( . not . IO_open_jobFile_stat ( FILEUNIT , material_localFileExt ) ) & ! no local material configuration present...
call IO_open_file ( FILEUNIT , material_configFile ) ! ...open material.config file
2016-01-17 23:26:24 +05:30
2013-12-12 22:39:59 +05:30
do while ( trim ( line ) / = IO_EOF . and . IO_lc ( IO_getTag ( line , '<' , '>' ) ) / = material_partCrystallite ) ! wind forward to <crystallite>
line = IO_read ( FILEUNIT )
2012-08-31 01:56:28 +05:30
enddo
2014-08-26 20:14:32 +05:30
2013-12-12 22:39:59 +05:30
do while ( trim ( line ) / = IO_EOF ) ! read through sections of crystallite part
line = IO_read ( FILEUNIT )
2013-02-22 04:38:36 +05:30
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2013-12-12 22:39:59 +05:30
if ( IO_getTag ( line , '<' , '>' ) / = '' ) then ! stop at next part
line = IO_read ( FILEUNIT , . true . ) ! reset IO_read
2014-08-26 20:14:32 +05:30
exit
2013-12-12 22:39:59 +05:30
endif
2013-02-22 04:38:36 +05:30
if ( IO_getTag ( line , '[' , ']' ) / = '' ) then ! next section
2012-08-31 01:56:28 +05:30
section = section + 1_pInt
2016-01-17 23:26:24 +05:30
o = 0_pInt ! reset output counter
2013-12-20 16:43:12 +05:30
cycle ! skip to next line
2012-08-31 01:56:28 +05:30
endif
if ( section > 0_pInt ) then
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
tag = IO_lc ( IO_stringValue ( line , chunkPos , 1_pInt ) ) ! extract key
2012-08-31 01:56:28 +05:30
select case ( tag )
case ( '(output)' )
2016-01-17 23:26:24 +05:30
o = o + 1_pInt
crystallite_output ( o , section ) = IO_lc ( IO_stringValue ( line , chunkPos , 2_pInt ) )
outputName : select case ( crystallite_output ( o , section ) )
case ( 'phase' ) outputName
crystallite_outputID ( o , section ) = phase_ID
case ( 'texture' ) outputName
crystallite_outputID ( o , section ) = texture_ID
case ( 'volume' ) outputName
crystallite_outputID ( o , section ) = volume_ID
case ( 'grainrotationx' ) outputName
crystallite_outputID ( o , section ) = grainrotationx_ID
case ( 'grainrotationy' ) outputName
crystallite_outputID ( o , section ) = grainrotationy_ID
case ( 'grainrotationz' ) outputName
crystallite_outputID ( o , section ) = grainrotationx_ID
case ( 'orientation' ) outputName
crystallite_outputID ( o , section ) = orientation_ID
case ( 'grainrotation' ) outputName
crystallite_outputID ( o , section ) = grainrotation_ID
case ( 'eulerangles' ) outputName
crystallite_outputID ( o , section ) = eulerangles_ID
case ( 'defgrad' , 'f' ) outputName
crystallite_outputID ( o , section ) = defgrad_ID
case ( 'fe' ) outputName
crystallite_outputID ( o , section ) = fe_ID
case ( 'fp' ) outputName
crystallite_outputID ( o , section ) = fp_ID
case ( 'fi' ) outputName
crystallite_outputID ( o , section ) = fi_ID
case ( 'lp' ) outputName
crystallite_outputID ( o , section ) = lp_ID
case ( 'li' ) outputName
crystallite_outputID ( o , section ) = li_ID
case ( 'e' ) outputName
crystallite_outputID ( o , section ) = e_ID
case ( 'ee' ) outputName
crystallite_outputID ( o , section ) = ee_ID
case ( 'p' , 'firstpiola' , '1stpiola' ) outputName
crystallite_outputID ( o , section ) = p_ID
case ( 's' , 'tstar' , 'secondpiola' , '2ndpiola' ) outputName
crystallite_outputID ( o , section ) = s_ID
case ( 'elasmatrix' ) outputName
crystallite_outputID ( o , section ) = elasmatrix_ID
case ( 'neighboringip' ) outputName
crystallite_outputID ( o , section ) = neighboringip_ID
case ( 'neighboringelement' ) outputName
crystallite_outputID ( o , section ) = neighboringelement_ID
case default outputName
2015-08-28 13:08:48 +05:30
call IO_error ( 105_pInt , ext_msg = IO_stringValue ( line , chunkPos , 2_pInt ) / / ' (Crystallite)' )
2016-01-17 23:26:24 +05:30
end select outputName
2012-08-31 01:56:28 +05:30
end select
endif
enddo
2014-08-26 20:14:32 +05:30
2013-12-12 22:39:59 +05:30
close ( FILEUNIT )
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
do r = 1_pInt , material_Ncrystallite
do o = 1_pInt , crystallite_Noutput ( r )
select case ( crystallite_outputID ( o , r ) )
2014-10-10 17:58:57 +05:30
case ( phase_ID , texture_ID , volume_ID , grainrotationx_ID , grainrotationy_ID , grainrotationz_ID )
2012-08-31 01:56:28 +05:30
mySize = 1_pInt
2016-01-17 23:26:24 +05:30
case ( orientation_ID , grainrotation_ID )
2012-08-31 01:56:28 +05:30
mySize = 4_pInt
2013-12-12 22:39:59 +05:30
case ( eulerangles_ID )
2012-08-31 01:56:28 +05:30
mySize = 3_pInt
2015-03-06 18:39:00 +05:30
case ( defgrad_ID , fe_ID , fp_ID , fi_ID , lp_ID , li_ID , e_ID , ee_ID , p_ID , s_ID )
2012-08-31 01:56:28 +05:30
mySize = 9_pInt
2013-12-12 22:39:59 +05:30
case ( elasmatrix_ID )
2014-08-26 20:14:32 +05:30
mySize = 36_pInt
2013-12-12 22:39:59 +05:30
case ( neighboringip_ID , neighboringelement_ID )
2013-05-08 17:32:30 +05:30
mySize = mesh_maxNipNeighbors
2012-08-31 01:56:28 +05:30
case default
2014-08-26 20:14:32 +05:30
mySize = 0_pInt
2012-08-31 01:56:28 +05:30
end select
2016-01-17 23:26:24 +05:30
crystallite_sizePostResult ( o , r ) = mySize
crystallite_sizePostResults ( r ) = crystallite_sizePostResults ( r ) + mySize
2012-08-31 01:56:28 +05:30
enddo
enddo
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
crystallite_maxSizePostResults = &
maxval ( crystallite_sizePostResults ( microstructure_crystallite ) , microstructure_active )
2009-06-16 14:33:30 +05:30
2013-04-29 16:47:30 +05:30
!--------------------------------------------------------------------------------------------------
2010-02-25 23:09:11 +05:30
! write description file for crystallite output
2015-03-25 21:32:30 +05:30
if ( worldrank == 0_pInt ) then
call IO_write_jobFile ( FILEUNIT , 'outputCrystallite' )
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
do r = 1_pInt , material_Ncrystallite
if ( any ( microstructure_crystallite ( mesh_element ( 4 , : ) ) == r ) ) then
write ( FILEUNIT , '(/,a,/)' ) '[' / / trim ( crystallite_name ( r ) ) / / ']'
do o = 1_pInt , crystallite_Noutput ( r )
write ( FILEUNIT , '(a,i4)' ) trim ( crystallite_output ( o , r ) ) / / char ( 9 ) , crystallite_sizePostResult ( o , r )
2015-04-21 17:53:00 +05:30
enddo
endif
2012-08-31 01:56:28 +05:30
enddo
2014-08-26 20:14:32 +05:30
2015-03-25 21:32:30 +05:30
close ( FILEUNIT )
2015-10-14 00:22:01 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
!--------------------------------------------------------------------------------------------------
! initialize
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO PRIVATE(myNcomponents)
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1_pInt : myNcomponents )
crystallite_Fp0 ( 1 : 3 , 1 : 3 , c , i , e ) = math_EulerToR ( material_EulerAngles ( 1 : 3 , c , i , e ) ) ! plastic def gradient reflects init orientation
crystallite_Fi0 ( 1 : 3 , 1 : 3 , c , i , e ) = constitutive_initialFi ( c , i , e )
crystallite_F0 ( 1 : 3 , 1 : 3 , c , i , e ) = math_I3
crystallite_localPlasticity ( c , i , e ) = phase_localPlasticity ( material_phase ( c , i , e ) )
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) = math_inv33 ( math_mul33x33 ( crystallite_Fi0 ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_Fp0 ( 1 : 3 , 1 : 3 , c , i , e ) ) ) ! assuming that euler angles are given in internal strain free configuration
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fp0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fi0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_requested ( c , i , e ) = . true .
2014-05-27 20:16:03 +05:30
endforall
enddo
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
if ( any ( . not . crystallite_localPlasticity ) . and . . not . usePingPong ) call IO_error ( 601_pInt ) ! exit if nonlocal but no ping-pong
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
crystallite_partionedFp0 = crystallite_Fp0
2015-03-06 18:39:00 +05:30
crystallite_partionedFi0 = crystallite_Fi0
2016-01-17 23:26:24 +05:30
crystallite_partionedF0 = crystallite_F0
crystallite_partionedF = crystallite_F0
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
call crystallite_orientations ( )
crystallite_orientation0 = crystallite_orientation ! store initial orientations for calculation of grain rotations
2009-12-22 17:58:02 +05:30
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO PRIVATE(myNcomponents)
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-04-29 16:47:30 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2016-01-17 23:26:24 +05:30
do c = 1_pInt , myNcomponents
call constitutive_microstructure ( crystallite_orientation , & ! pass orientation to constitutive module
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) , &
c , i , e ) ! update dependent state variables to be consistent with basic states
2014-06-25 04:51:25 +05:30
enddo
2013-04-29 16:47:30 +05:30
enddo
enddo
!$OMP END PARALLEL DO
2014-06-17 00:49:38 +05:30
2014-08-08 02:38:34 +05:30
call crystallite_stressAndItsTangent ( . true . ) ! request elastic answers
2013-04-29 16:47:30 +05:30
crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
!--------------------------------------------------------------------------------------------------
! debug output
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Fe: ' , shape ( crystallite_Fe )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Fp: ' , shape ( crystallite_Fp )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Fi: ' , shape ( crystallite_Fi )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Lp: ' , shape ( crystallite_Lp )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Li: ' , shape ( crystallite_Li )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_F0: ' , shape ( crystallite_F0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Fp0: ' , shape ( crystallite_Fp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Fi0: ' , shape ( crystallite_Fi0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Lp0: ' , shape ( crystallite_Lp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Li0: ' , shape ( crystallite_Li0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedF: ' , shape ( crystallite_partionedF )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedF0: ' , shape ( crystallite_partionedF0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedFp0: ' , shape ( crystallite_partionedFp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedFi0: ' , shape ( crystallite_partionedFi0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedLp0: ' , shape ( crystallite_partionedLp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedLi0: ' , shape ( crystallite_partionedLi0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subF: ' , shape ( crystallite_subF )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subF0: ' , shape ( crystallite_subF0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subFe0: ' , shape ( crystallite_subFe0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subFp0: ' , shape ( crystallite_subFp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subFi0: ' , shape ( crystallite_subFi0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subLp0: ' , shape ( crystallite_subLp0 )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subLi0: ' , shape ( crystallite_subLi0 )
2013-04-29 16:47:30 +05:30
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_P: ' , shape ( crystallite_P )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Tstar_v: ' , shape ( crystallite_Tstar_v )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_Tstar0_v: ' , shape ( crystallite_Tstar0_v )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partionedTstar0_v: ' , shape ( crystallite_partionedTstar0_v )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subTstar0_v: ' , shape ( crystallite_subTstar0_v )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_dPdF: ' , shape ( crystallite_dPdF )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_dPdF0: ' , shape ( crystallite_dPdF0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_partioneddPdF0: ' , shape ( crystallite_partioneddPdF0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_fallbackdPdF: ' , shape ( crystallite_fallbackdPdF )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_orientation: ' , shape ( crystallite_orientation )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_orientation0: ' , shape ( crystallite_orientation0 )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_rotation: ' , shape ( crystallite_rotation )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_disorientation: ' , shape ( crystallite_disorientation )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_dt: ' , shape ( crystallite_dt )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subdt: ' , shape ( crystallite_subdt )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subFrac: ' , shape ( crystallite_subFrac )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_subStep: ' , shape ( crystallite_subStep )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_localPlasticity: ' , shape ( crystallite_localPlasticity )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_requested: ' , shape ( crystallite_requested )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_todo: ' , shape ( crystallite_todo )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_converged: ' , shape ( crystallite_converged )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_sizePostResults: ' , shape ( crystallite_sizePostResults )
write ( 6 , '(a35,1x,7(i8,1x))' ) 'crystallite_sizePostResult: ' , shape ( crystallite_sizePostResult )
2013-05-17 23:22:46 +05:30
write ( 6 , '(/,a35,1x,i10)' ) 'Number of nonlocal grains: ' , count ( . not . crystallite_localPlasticity )
2013-04-29 16:47:30 +05:30
flush ( 6 )
endif
2010-11-03 22:52:48 +05:30
2012-08-31 01:56:28 +05:30
call debug_info
call debug_reset
2010-11-03 22:52:48 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_init
2009-05-07 21:57:36 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculate stress (P) and tangent (dPdF) for crystallites
!--------------------------------------------------------------------------------------------------
2014-08-08 02:38:34 +05:30
subroutine crystallite_stressAndItsTangent ( updateJaco )
2015-04-21 17:53:00 +05:30
use prec , only : &
tol_math_check
2013-04-29 16:47:30 +05:30
use numerics , only : &
subStepMinCryst , &
subStepSizeCryst , &
stepIncreaseCryst , &
pert_Fg , &
pert_method , &
nCryst , &
numerics_integrator , &
numerics_integrationMode , &
numerics_timeSyncing , &
analyticJaco
use debug , only : &
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
debug_e , &
debug_i , &
debug_g , &
debug_CrystalliteLoopDistribution
use IO , only : &
2014-08-08 02:46:37 +05:30
IO_warning , &
IO_error
2013-04-29 16:47:30 +05:30
use math , only : &
math_inv33 , &
math_identity2nd , &
math_transpose33 , &
math_mul33x33 , &
math_mul66x6 , &
math_Mandel6to33 , &
math_Mandel33to6 , &
2015-03-06 18:39:00 +05:30
math_Plain3333to99 , &
math_Plain99to3333 , &
2013-04-29 16:47:30 +05:30
math_I3 , &
2013-10-19 00:27:28 +05:30
math_mul3333xx3333 , &
2014-08-08 02:38:34 +05:30
math_mul33xx33 , &
2014-11-01 00:33:08 +05:30
math_invert , &
math_det33
2013-04-29 16:47:30 +05:30
use FEsolving , only : &
2014-08-26 20:14:32 +05:30
FEsolving_execElem , &
2013-04-29 16:47:30 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems , &
mesh_maxNips , &
mesh_ipNeighborhood , &
FE_NipNeighbors , &
FE_geomtype , &
FE_cellType
use material , only : &
homogenization_Ngrains , &
2014-05-12 18:30:37 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
phase_Nsources , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt , &
2013-04-29 16:47:30 +05:30
homogenization_maxNgrains
use constitutive , only : &
2014-08-08 02:38:34 +05:30
constitutive_TandItsTangent , &
2014-11-01 00:33:08 +05:30
constitutive_LpAndItsTangent , &
2015-03-06 18:39:00 +05:30
constitutive_LiAndItsTangent
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
implicit none
2013-05-17 23:22:46 +05:30
logical , intent ( in ) :: &
2014-08-08 02:38:34 +05:30
updateJaco !< whether to update the Jacobian (stiffness) or not
2013-05-17 23:22:46 +05:30
real ( pReal ) :: &
myPert , & ! perturbation with correct sign
formerSubStep , &
subFracIntermediate
real ( pReal ) , dimension ( 3 , 3 ) :: &
invFp , & ! inverse of the plastic deformation gradient
Fe_guess , & ! guess for elastic deformation gradient
Tstar ! 2nd Piola-Kirchhoff stress tensor
2015-08-28 16:25:38 +05:30
real ( pReal ) , allocatable , dimension ( : , : , : , : , : , : , : ) :: &
2013-05-17 23:22:46 +05:30
dPdF_perturbation1 , &
dPdF_perturbation2
2015-08-28 16:25:38 +05:30
real ( pReal ) , allocatable , dimension ( : , : , : , : , : ) :: &
2013-05-17 23:22:46 +05:30
F_backup , &
Fp_backup , &
InvFp_backup , &
2015-03-06 18:39:00 +05:30
Fi_backup , &
InvFi_backup , &
2013-05-17 23:22:46 +05:30
Fe_backup , &
Lp_backup , &
2015-03-06 18:39:00 +05:30
Li_backup , &
2013-05-17 23:22:46 +05:30
P_backup
2015-08-28 16:25:38 +05:30
real ( pReal ) , allocatable , dimension ( : , : , : , : ) :: &
2013-05-17 23:22:46 +05:30
Tstar_v_backup
2015-08-28 16:25:38 +05:30
logical , allocatable , dimension ( : , : , : ) :: &
convergenceFlag_backup
2013-05-17 23:22:46 +05:30
integer ( pInt ) :: &
NiterationCrystallite , & ! number of iterations in crystallite loop
2016-01-17 23:26:24 +05:30
c , & !< counter in integration point component loop
i , & !< counter in integration point loop
e , & !< counter in element loop
2013-05-17 23:22:46 +05:30
k , &
l , &
n , startIP , endIP , &
neighboring_e , &
neighboring_i , &
o , &
p , &
perturbation , & ! loop counter for forward,backward perturbation mode
2016-01-17 23:26:24 +05:30
myNcomponents , &
2015-05-28 22:32:23 +05:30
mySource
2013-04-29 16:47:30 +05:30
! local variables used for calculating analytic Jacobian
2015-03-06 18:39:00 +05:30
real ( pReal ) , dimension ( 3 , 3 ) :: temp_33
2013-04-29 16:47:30 +05:30
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) :: dSdFe , &
dSdF , &
2015-03-06 18:39:00 +05:30
dSdFi , &
2014-11-01 00:33:08 +05:30
dLidS , &
2015-03-06 18:39:00 +05:30
dLidFi , &
2014-11-01 00:33:08 +05:30
dLpdS , &
2015-03-06 18:39:00 +05:30
dLpdFi , &
dFidS , &
2014-11-01 00:33:08 +05:30
dFpinvdF , &
rhs_3333 , &
lhs_3333 , &
temp_3333
2014-11-03 16:13:36 +05:30
real ( pReal ) , dimension ( 9 , 9 ) :: temp_99
2014-08-08 02:38:34 +05:30
logical :: error
2014-08-26 20:14:32 +05:30
2014-05-19 22:13:32 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt &
. and . FEsolving_execElem ( 1 ) < = debug_e &
. and . debug_e < = FEsolving_execElem ( 2 ) ) then
2016-01-17 23:26:24 +05:30
write ( 6 , '(/,a,i8,1x,a,i8,a,1x,i2,1x,i3)' ) '<< CRYST >> boundary values at el ip ipc ' , &
2014-08-27 21:24:11 +05:30
debug_e , '(' , mesh_element ( 1 , debug_e ) , ')' , debug_i , debug_g
2015-10-15 00:06:19 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> F ' , &
math_transpose33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
2014-05-27 20:16:03 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> F0 ' , &
math_transpose33 ( crystallite_partionedF0 ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Fp0' , &
math_transpose33 ( crystallite_partionedFp0 ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Fi0' , &
math_transpose33 ( crystallite_partionedFi0 ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
2014-05-27 20:16:03 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Lp0' , &
math_transpose33 ( crystallite_partionedLp0 ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Li0' , &
math_transpose33 ( crystallite_partionedLi0 ( 1 : 3 , 1 : 3 , debug_g , debug_i , debug_e ) )
2013-04-29 16:47:30 +05:30
endif
!--------------------------------------------------------------------------------------------------
! initialize to starting condition
crystallite_subStep = 0.0_pReal
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO PRIVATE(myNcomponents)
2014-05-27 20:16:03 +05:30
elementLooping1 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ; do c = 1_pInt , myNcomponents
if ( crystallite_requested ( c , i , e ) ) then
plasticState ( phaseAt ( c , i , e ) ) % subState0 ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % partionedState0 ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % subState0 ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % partionedState0 ( : , phasememberAt ( c , i , e ) )
2015-05-28 22:32:23 +05:30
enddo
2016-01-17 23:26:24 +05:30
crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partionedFp0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic def grad
crystallite_subLp0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partionedLp0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic velocity grad
crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partionedFi0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate def grad
crystallite_subLi0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partionedLi0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate velocity grad
crystallite_dPdF0 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partioneddPdF0 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) ! ...stiffness
crystallite_subF0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_partionedF0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...def grad
crystallite_subTstar0_v ( 1 : 6 , c , i , e ) = crystallite_partionedTstar0_v ( 1 : 6 , c , i , e ) !...2nd PK stress
crystallite_subFe0 ( 1 : 3 , 1 : 3 , c , i , e ) = math_mul33x33 ( math_mul33x33 ( crystallite_subF0 ( 1 : 3 , 1 : 3 , c , i , e ) , &
math_inv33 ( crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) ) ) , &
math_inv33 ( crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) ) ) ! only needed later on for stiffness calculation
crystallite_subFrac ( c , i , e ) = 0.0_pReal
crystallite_subStep ( c , i , e ) = 1.0_pReal / subStepSizeCryst
crystallite_todo ( c , i , e ) = . true .
crystallite_converged ( c , i , e ) = . false . ! pretend failed step of twice the required size
2015-05-28 22:32:23 +05:30
endif
enddo ; enddo
2014-05-27 20:16:03 +05:30
enddo elementLooping1
!$OMP END PARALLEL DO
singleRun : if ( FEsolving_execELem ( 1 ) == FEsolving_execElem ( 2 ) . and . &
2013-05-17 23:22:46 +05:30
FEsolving_execIP ( 1 , FEsolving_execELem ( 1 ) ) == FEsolving_execIP ( 2 , FEsolving_execELem ( 1 ) ) ) then
startIP = FEsolving_execIP ( 1 , FEsolving_execELem ( 1 ) )
endIP = startIP
2014-05-27 20:16:03 +05:30
else singleRun
2013-05-17 23:22:46 +05:30
startIP = 1_pInt
endIP = mesh_maxNips
2014-05-27 20:16:03 +05:30
endif singleRun
2009-12-22 17:58:02 +05:30
2013-04-29 16:47:30 +05:30
NiterationCrystallite = 0_pInt
numerics_integrationMode = 1_pInt
2013-05-17 23:22:46 +05:30
cutbackLooping : do while ( any ( crystallite_todo ( : , startIP : endIP , FEsolving_execELem ( 1 ) : FEsolving_execElem ( 2 ) ) ) )
2015-08-05 02:56:22 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
write ( 6 , '(a,i6)' ) '<< CRYST >> crystallite iteration ' , NiterationCrystallite
2013-05-17 23:22:46 +05:30
timeSyncing1 : if ( any ( . not . crystallite_localPlasticity ) . and . numerics_timeSyncing ) then
2014-06-17 00:49:38 +05:30
2012-11-28 00:06:55 +05:30
! Time synchronization can only be used for nonlocal calculations, and only there it makes sense.
2014-08-26 20:14:32 +05:30
! The idea is that in nonlocal calculations often the vast majority of the ips
! converges in one iteration whereas a small fraction of ips has to do a lot of cutbacks.
2012-11-28 00:06:55 +05:30
! Hence, we try to minimize the computational effort by just doing a lot of cutbacks
! in the vicinity of the "bad" ips and leave the easily converged volume more or less as it is.
2014-08-26 20:14:32 +05:30
! However, some synchronization of the time step has to be done at the border between "bad" ips
! and the ones that immediately converged.
2012-11-28 00:06:55 +05:30
2014-08-26 20:14:32 +05:30
if ( any ( crystallite_syncSubFrac ) ) then
2013-04-29 16:47:30 +05:30
! Just did a time synchronization.
2014-08-26 20:14:32 +05:30
! If all synchronizers converged, then do nothing else than winding them forward.
! If any of the synchronizers did not converge, something went completely wrong
2013-04-29 16:47:30 +05:30
! and its not clear how to fix this, so all nonlocals become terminally ill.
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
if ( any ( crystallite_syncSubFrac . and . . not . crystallite_converged ( 1 , : , : ) ) ) then
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) then
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2014-05-27 20:16:03 +05:30
if ( crystallite_syncSubFrac ( i , e ) . and . . not . crystallite_converged ( 1 , i , e ) ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i8,1x,i2)' ) '<< CRYST >> time synchronization: failed at el,ip ' , e , i
enddo
enddo
endif
crystallite_syncSubFrac = . false .
where ( . not . crystallite_localPlasticity )
crystallite_substep = 0.0_pReal
crystallite_todo = . false .
endwhere
else
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
crystallite_clearToWindForward ( i , e ) = crystallite_localPlasticity ( 1 , i , e ) . or . crystallite_syncSubFrac ( i , e )
crystallite_clearToCutback ( i , e ) = crystallite_localPlasticity ( 1 , i , e )
enddo
enddo
!$OMP END PARALLEL DO
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> time synchronization: wind forward'
endif
2012-11-28 00:06:55 +05:30
2014-08-26 20:14:32 +05:30
elseif ( any ( crystallite_syncSubFracCompleted ) ) then
2013-04-29 16:47:30 +05:30
! Just completed a time synchronization.
2014-08-26 20:14:32 +05:30
! Make sure that the ips that synchronized their time step start non-converged
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( crystallite_syncSubFracCompleted ( i , e ) ) crystallite_converged ( 1 , i , e ) = . false .
crystallite_syncSubFracCompleted ( i , e ) = . false .
crystallite_clearToWindForward ( i , e ) = crystallite_localPlasticity ( 1 , i , e )
crystallite_clearToCutback ( i , e ) = crystallite_localPlasticity ( 1 , i , e ) . or . . not . crystallite_converged ( 1 , i , e )
enddo
enddo
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> time synchronization: done, proceed with cutback'
else
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! Normal calculation.
! If all converged and are at the end of the time increment, then just do a final wind forward.
! If all converged, but not all reached the end of the time increment, then we only wind
! those forward that are still on their way, all others have to wait.
2014-08-26 20:14:32 +05:30
! If some did not converge and all are still at the start of the time increment,
2013-04-29 16:47:30 +05:30
! then all non-convergers force their converged neighbors to also do a cutback.
2014-08-26 20:14:32 +05:30
! In case that some ips have already wound forward to an intermediate time (subfrac),
2013-04-29 16:47:30 +05:30
! then all those ips that converged in the first iteration, but now have a non-converged neighbor
! have to synchronize their time step to the same intermediate time. If such a synchronization
2014-08-26 20:14:32 +05:30
! takes place, all other ips have to wait and only the synchronizers do a cutback. In the next
! iteration those will do a wind forward while all others still wait.
2013-04-29 16:47:30 +05:30
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
crystallite_clearToWindForward ( i , e ) = crystallite_localPlasticity ( 1 , i , e )
crystallite_clearToCutback ( i , e ) = crystallite_localPlasticity ( 1 , i , e )
enddo
enddo
!$OMP END PARALLEL DO
if ( all ( crystallite_localPlasticity . or . crystallite_converged ) ) then
if ( all ( crystallite_localPlasticity . or . crystallite_subStep + crystallite_subFrac > = 1.0_pReal ) ) then
crystallite_clearToWindForward = . true . ! final wind forward
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> final wind forward'
else
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
crystallite_clearToWindForward ( i , e ) = crystallite_localPlasticity ( 1 , i , e ) . or . crystallite_subStep ( 1 , i , e ) < 1.0_pReal
enddo
enddo
!$OMP END PARALLEL DO
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> wind forward'
endif
else
subFracIntermediate = maxval ( crystallite_subFrac , mask = . not . crystallite_localPlasticity )
2015-09-10 18:31:33 +05:30
if ( abs ( subFracIntermediate ) > tiny ( 0.0_pReal ) ) then
2013-04-29 16:47:30 +05:30
crystallite_neighborEnforcedCutback = . false . ! look for ips that require a cutback because of a nonconverged neighbor
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2013-04-29 16:47:30 +05:30
!$OMP DO PRIVATE(neighboring_e,neighboring_i)
2014-08-26 20:14:32 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2013-04-29 16:47:30 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( . not . crystallite_localPlasticity ( 1 , i , e ) . and . crystallite_converged ( 1 , i , e ) ) then
do n = 1_pInt , FE_NipNeighbors ( FE_celltype ( FE_geomtype ( mesh_element ( 2 , e ) ) ) )
neighboring_e = mesh_ipNeighborhood ( 1 , n , i , e )
neighboring_i = mesh_ipNeighborhood ( 2 , n , i , e )
if ( neighboring_e > 0_pInt . and . neighboring_i > 0_pInt ) then
if ( . not . crystallite_localPlasticity ( 1 , neighboring_i , neighboring_e ) &
2014-08-26 20:14:32 +05:30
. and . . not . crystallite_converged ( 1 , neighboring_i , neighboring_e ) ) then
2013-04-29 16:47:30 +05:30
crystallite_neighborEnforcedCutback ( i , e ) = . true .
2012-11-28 00:06:55 +05:30
#ifndef _OPENMP
2013-04-29 16:47:30 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
write ( 6 , '(a12,i5,1x,i2,a,i5,1x,i2)' ) '<< CRYST >> ' , neighboring_e , neighboring_i , &
2012-11-28 00:06:55 +05:30
' enforced cutback at ' , e , i
#endif
2013-04-29 16:47:30 +05:30
exit
endif
endif
enddo
endif
enddo
enddo
!$OMP END DO
2016-01-17 23:26:24 +05:30
!$OMP DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( crystallite_neighborEnforcedCutback ( i , e ) ) crystallite_converged ( 1 , i , e ) = . false .
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
else
crystallite_syncSubFrac = . false . ! look for ips that have to do a time synchronization because of a nonconverged neighbor
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2013-04-29 16:47:30 +05:30
!$OMP DO PRIVATE(neighboring_e,neighboring_i)
2014-08-26 20:14:32 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2013-11-21 16:28:41 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2015-09-10 18:31:33 +05:30
if ( . not . crystallite_localPlasticity ( 1 , i , e ) . and . abs ( crystallite_subFrac ( 1 , i , e ) ) > tiny ( 0.0_pReal ) ) then
2013-11-21 16:28:41 +05:30
do n = 1_pInt , FE_NipNeighbors ( FE_celltype ( FE_geomtype ( mesh_element ( 2 , e ) ) ) )
neighboring_e = mesh_ipNeighborhood ( 1 , n , i , e )
neighboring_i = mesh_ipNeighborhood ( 2 , n , i , e )
if ( neighboring_e > 0_pInt . and . neighboring_i > 0_pInt ) then
if ( . not . crystallite_localPlasticity ( 1 , neighboring_i , neighboring_e ) &
2014-08-26 20:14:32 +05:30
. and . . not . crystallite_converged ( 1 , neighboring_i , neighboring_e ) ) then
2013-11-21 16:28:41 +05:30
crystallite_syncSubFrac ( i , e ) = . true .
2012-11-28 00:06:55 +05:30
#ifndef _OPENMP
2013-11-21 16:28:41 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
write ( 6 , '(a12,i5,1x,i2,a,i5,1x,i2)' ) '<< CRYST >> ' , neighboring_e , neighboring_i , &
' enforced time synchronization at ' , e , i
2012-11-28 00:06:55 +05:30
#endif
2013-11-21 16:28:41 +05:30
exit
2013-04-29 16:47:30 +05:30
endif
2013-11-21 16:28:41 +05:30
endif
enddo
endif
2013-04-29 16:47:30 +05:30
enddo
2013-11-21 16:28:41 +05:30
enddo
2013-04-29 16:47:30 +05:30
!$OMP END DO
2016-01-17 23:26:24 +05:30
!$OMP DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( crystallite_syncSubFrac ( i , e ) ) crystallite_converged ( 1 , i , e ) = . false .
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
endif
where ( . not . crystallite_localPlasticity . and . crystallite_subStep < 1.0_pReal ) &
crystallite_converged = . false .
if ( any ( crystallite_syncSubFrac ) ) then ! have to do syncing now, so all wait except for the synchronizers which do a cutback
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
crystallite_clearToWindForward ( i , e ) = crystallite_localPlasticity ( 1 , i , e )
crystallite_clearToCutback ( i , e ) = crystallite_localPlasticity ( 1 , i , e ) . or . crystallite_syncSubFrac ( i , e )
enddo
enddo
!$OMP END PARALLEL DO
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> time synchronization: cutback'
else
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-04-29 16:47:30 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( . not . crystallite_converged ( 1 , i , e ) ) crystallite_clearToCutback ( i , e ) = . true .
enddo
enddo
!$OMP END PARALLEL DO
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i6)' ) '<< CRYST >> cutback'
endif
endif
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! Make sure that all cutbackers start with the same substep
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
where ( . not . crystallite_localPlasticity . and . . not . crystallite_converged ) &
crystallite_subStep = minval ( crystallite_subStep , mask = . not . crystallite_localPlasticity &
. and . . not . crystallite_converged )
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! Those that do neither wind forward nor cutback are not to do
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO
2013-10-19 00:27:28 +05:30
elementLooping2 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2013-04-29 16:47:30 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
if ( . not . crystallite_clearToWindForward ( i , e ) . and . . not . crystallite_clearToCutback ( i , e ) ) &
crystallite_todo ( 1 , i , e ) = . false .
enddo
2013-10-19 00:27:28 +05:30
enddo elementLooping2
2013-04-29 16:47:30 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
endif timeSyncing1
2015-08-05 02:56:22 +05:30
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO PRIVATE(myNcomponents,formerSubStep)
2013-10-19 00:27:28 +05:30
elementLooping3 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-04-29 16:47:30 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ! iterate over IPs of this element to be processed
2016-01-17 23:26:24 +05:30
do c = 1 , myNcomponents
2013-04-29 16:47:30 +05:30
! --- wind forward ---
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
if ( crystallite_converged ( c , i , e ) . and . crystallite_clearToWindForward ( i , e ) ) then
formerSubStep = crystallite_subStep ( c , i , e )
crystallite_subFrac ( c , i , e ) = crystallite_subFrac ( c , i , e ) + crystallite_subStep ( c , i , e )
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_subFrac)
2016-01-17 23:26:24 +05:30
crystallite_subStep ( c , i , e ) = min ( 1.0_pReal - crystallite_subFrac ( c , i , e ) , &
stepIncreaseCryst * crystallite_subStep ( c , i , e ) )
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_subStep)
2016-01-17 23:26:24 +05:30
if ( crystallite_subStep ( c , i , e ) > 0.0_pReal ) then
crystallite_subF0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) ! ...def grad
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_subF0)
2016-01-17 23:26:24 +05:30
crystallite_subLp0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic velocity gradient
crystallite_subLi0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate velocity gradient
crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic def grad
crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate def grad
crystallite_subFe0 ( 1 : 3 , 1 : 3 , c , i , e ) = math_mul33x33 ( math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) , &
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) ) ! only needed later on for stiffness calculation
2014-05-27 20:16:03 +05:30
!if abbrevation, make c and p private in omp
2016-01-17 23:26:24 +05:30
plasticState ( phaseAt ( c , i , e ) ) % subState0 ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % subState0 ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) )
2015-05-28 22:32:23 +05:30
enddo
2016-01-17 23:26:24 +05:30
crystallite_subTstar0_v ( 1 : 6 , c , i , e ) = crystallite_Tstar_v ( 1 : 6 , c , i , e ) ! ...2nd PK stress
2013-04-29 16:47:30 +05:30
if ( crystallite_syncSubFrac ( i , e ) ) then ! if we just did a synchronization of states, then we wind forward without any further time integration
crystallite_syncSubFracCompleted ( i , e ) = . true .
crystallite_syncSubFrac ( i , e ) = . false .
2016-01-17 23:26:24 +05:30
crystallite_todo ( c , i , e ) = . false .
2013-04-29 16:47:30 +05:30
else
2016-01-17 23:26:24 +05:30
crystallite_todo ( c , i , e ) = . true .
2013-04-29 16:47:30 +05:30
endif
!$OMP FLUSH(crystallite_todo)
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-04-29 16:47:30 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt &
2016-01-17 23:26:24 +05:30
. and . ( ( e == debug_e . and . i == debug_i . and . c == debug_g ) &
2013-10-19 00:27:28 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) &
write ( 6 , '(a,f12.8,a,f12.8,a,i8,1x,i2,1x,i3,/)' ) '<< CRYST >> winding forward from ' , &
2016-01-17 23:26:24 +05:30
crystallite_subFrac ( c , i , e ) - formerSubStep , ' to current crystallite_subfrac ' , &
crystallite_subFrac ( c , i , e ) , ' in crystallite_stressAndItsTangent at el ip ipc ' , e , i , c
2011-03-29 12:57:19 +05:30
#endif
2013-08-02 13:29:55 +05:30
else ! this crystallite just converged for the entire timestep
2016-01-17 23:26:24 +05:30
crystallite_todo ( c , i , e ) = . false . ! so done here
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_todo)
2013-08-02 11:48:41 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt &
. and . formerSubStep > 0.0_pReal ) then
2013-04-29 16:47:30 +05:30
!$OMP CRITICAL (distributionCrystallite)
debug_CrystalliteLoopDistribution ( min ( nCryst + 1_pInt , NiterationCrystallite ) ) = &
debug_CrystalliteLoopDistribution ( min ( nCryst + 1_pInt , NiterationCrystallite ) ) + 1_pInt
!$OMP END CRITICAL (distributionCrystallite)
endif
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! --- cutback ---
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
elseif ( . not . crystallite_converged ( c , i , e ) . and . crystallite_clearToCutback ( i , e ) ) then
2013-04-29 16:47:30 +05:30
if ( crystallite_syncSubFrac ( i , e ) ) then ! synchronize time
2016-01-17 23:26:24 +05:30
crystallite_subStep ( c , i , e ) = subFracIntermediate
2013-04-29 16:47:30 +05:30
else
2016-01-17 23:26:24 +05:30
crystallite_subStep ( c , i , e ) = subStepSizeCryst * crystallite_subStep ( c , i , e ) ! cut step in half and restore...
2013-04-29 16:47:30 +05:30
endif
!$OMP FLUSH(crystallite_subStep)
2016-01-17 23:26:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic def grad
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_Fp)
2016-01-17 23:26:24 +05:30
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) = math_inv33 ( crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) )
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_invFp)
2016-01-17 23:26:24 +05:30
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate def grad
2015-03-06 18:39:00 +05:30
!$OMP FLUSH(crystallite_Fi)
2016-01-17 23:26:24 +05:30
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) = math_inv33 ( crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) )
2015-03-06 18:39:00 +05:30
!$OMP FLUSH(crystallite_invFi)
2016-01-17 23:26:24 +05:30
crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subLp0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...plastic velocity grad
crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subLi0 ( 1 : 3 , 1 : 3 , c , i , e ) ! ...intermediate velocity grad
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % subState0 ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % subState0 ( : , phasememberAt ( c , i , e ) )
2015-05-28 22:32:23 +05:30
enddo
2016-01-17 23:26:24 +05:30
crystallite_Tstar_v ( 1 : 6 , c , i , e ) = crystallite_subTstar0_v ( 1 : 6 , c , i , e ) ! ...2nd PK stress
2014-05-27 20:16:03 +05:30
2013-04-29 16:47:30 +05:30
! cant restore dotState here, since not yet calculated in first cutback after initialization
2016-01-17 23:26:24 +05:30
crystallite_todo ( c , i , e ) = crystallite_subStep ( c , i , e ) > subStepMinCryst ! still on track or already done (beyond repair)
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_todo)
2012-11-22 15:28:36 +05:30
#ifndef _OPENMP
2014-08-26 20:14:32 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2016-01-17 23:26:24 +05:30
if ( crystallite_todo ( c , i , e ) ) then
2014-07-10 14:17:00 +05:30
write ( 6 , '(a,f12.8,a,i8,1x,i2,1x,i3,/)' ) ' < < CRYST > > cutback step in crystallite_stressAndItsTangent &
2013-04-29 16:47:30 +05:30
& with new crystallite_subStep : ' , &
2016-01-17 23:26:24 +05:30
crystallite_subStep ( c , i , e ) , ' at el ip ipc ' , e , i , c
2013-04-29 16:47:30 +05:30
else
2014-07-10 14:17:00 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3,/)' ) ' < < CRYST > > reached minimum step size &
2016-01-17 23:26:24 +05:30
& in crystallite_stressAndItsTangent at el ip ipc ' , e , i , c
2013-04-29 16:47:30 +05:30
endif
endif
2012-11-22 15:28:36 +05:30
#endif
2013-04-29 16:47:30 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! --- prepare for integration ---
2014-08-26 20:14:32 +05:30
2016-01-17 23:26:24 +05:30
if ( crystallite_todo ( c , i , e ) . and . ( crystallite_clearToWindForward ( i , e ) . or . crystallite_clearToCutback ( i , e ) ) ) then
crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subF0 ( 1 : 3 , 1 : 3 , c , i , e ) &
+ crystallite_subStep ( c , i , e ) &
* ( crystallite_partionedF ( 1 : 3 , 1 : 3 , c , i , e ) &
- crystallite_partionedF0 ( 1 : 3 , 1 : 3 , c , i , e ) )
2013-04-29 16:47:30 +05:30
!$OMP FLUSH(crystallite_subF)
2016-01-17 23:26:24 +05:30
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) = math_mul33x33 ( math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) , &
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) )
crystallite_subdt ( c , i , e ) = crystallite_subStep ( c , i , e ) * crystallite_dt ( c , i , e )
crystallite_converged ( c , i , e ) = . false . ! start out non-converged
2013-04-29 16:47:30 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
enddo ! grains
enddo ! IPs
2013-10-19 00:27:28 +05:30
enddo elementLooping3
2013-04-29 16:47:30 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
timeSyncing2 : if ( numerics_timeSyncing ) then
2013-04-29 16:47:30 +05:30
if ( any ( . not . crystallite_localPlasticity . and . . not . crystallite_todo . and . . not . crystallite_converged &
. and . crystallite_subStep < = subStepMinCryst ) ) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ...
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) then
2013-10-19 00:27:28 +05:30
elementLooping4 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-04-29 16:47:30 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2016-01-17 23:26:24 +05:30
do c = 1 , myNcomponents
if ( . not . crystallite_localPlasticity ( c , i , e ) . and . . not . crystallite_todo ( c , i , e ) &
. and . . not . crystallite_converged ( c , i , e ) . and . crystallite_subStep ( c , i , e ) < = subStepMinCryst ) &
write ( 6 , '(a,i8,1x,i2,1x,i3)' ) '<< CRYST >> nonlocal violated minimum subStep at el ip ipc ' , e , i , c
2013-04-29 16:47:30 +05:30
enddo
enddo
2013-10-19 00:27:28 +05:30
enddo elementLooping4
2013-04-29 16:47:30 +05:30
endif
where ( . not . crystallite_localPlasticity )
crystallite_todo = . false . ! ... so let all nonlocal ips die peacefully
crystallite_subStep = 0.0_pReal
endwhere
endif
2014-08-26 20:14:32 +05:30
endif timeSyncing2
2013-04-29 16:47:30 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) then
write ( 6 , '(/,a,e12.5)' ) '<< CRYST >> min(subStep) ' , minval ( crystallite_subStep )
write ( 6 , '(a,e12.5)' ) '<< CRYST >> max(subStep) ' , maxval ( crystallite_subStep )
write ( 6 , '(a,e12.5)' ) '<< CRYST >> min(subFrac) ' , minval ( crystallite_subFrac )
write ( 6 , '(a,e12.5,/)' ) '<< CRYST >> max(subFrac) ' , maxval ( crystallite_subFrac )
2014-05-27 20:16:03 +05:30
flush ( 6 )
2013-04-29 16:47:30 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
! --- integrate --- requires fully defined state array (basic + dependent state)
2014-05-27 20:16:03 +05:30
2013-04-29 16:47:30 +05:30
if ( any ( crystallite_todo ) ) then
select case ( numerics_integrator ( numerics_integrationMode ) )
case ( 1_pInt )
call crystallite_integrateStateFPI ( )
case ( 2_pInt )
call crystallite_integrateStateEuler ( )
case ( 3_pInt )
call crystallite_integrateStateAdaptiveEuler ( )
case ( 4_pInt )
call crystallite_integrateStateRK4 ( )
case ( 5_pInt )
call crystallite_integrateStateRKCK45 ( )
end select
endif
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
where ( . not . crystallite_converged . and . crystallite_subStep > subStepMinCryst ) & ! do not try non-converged & fully cutbacked any further
crystallite_todo = . true .
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
NiterationCrystallite = NiterationCrystallite + 1_pInt
2014-08-26 20:14:32 +05:30
2013-04-29 16:47:30 +05:30
enddo cutbackLooping
2010-11-03 22:52:48 +05:30
! --+>> CHECK FOR NON-CONVERGED CRYSTALLITES <<+--
2013-11-21 16:28:41 +05:30
2013-10-19 00:27:28 +05:30
elementLooping5 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-05-17 23:22:46 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ! iterate over IPs of this element to be processed
2016-01-17 23:26:24 +05:30
do c = 1 , myNcomponents
if ( . not . crystallite_converged ( c , i , e ) ) then ! respond fully elastically (might be not required due to becoming terminally ill anyway)
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) &
2016-01-17 23:26:24 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3,/)' ) '<< CRYST >> no convergence: respond fully elastic at el (elFE) ip ipc ' , &
e , '(' , mesh_element ( 1 , e ) , ')' , i , c
invFp = math_inv33 ( crystallite_partionedFp0 ( 1 : 3 , 1 : 3 , c , i , e ) )
Fe_guess = math_mul33x33 ( math_mul33x33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , c , i , e ) , invFp ) , &
math_inv33 ( crystallite_partionedFi0 ( 1 : 3 , 1 : 3 , c , i , e ) ) )
call constitutive_TandItsTangent ( Tstar , dSdFe , dSdFi , Fe_guess , crystallite_partionedFi0 ( 1 : 3 , 1 : 3 , c , i , e ) , c , i , e )
crystallite_P ( 1 : 3 , 1 : 3 , c , i , e ) = math_mul33x33 ( math_mul33x33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , c , i , e ) , invFp ) , &
2015-10-14 00:22:01 +05:30
math_mul33x33 ( Tstar , transpose ( invFp ) ) )
2013-05-17 23:22:46 +05:30
endif
2014-08-26 20:14:32 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 23:26:24 +05:30
. and . ( ( e == debug_e . and . i == debug_i . and . c == debug_g ) &
2012-11-07 21:13:29 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-17 23:26:24 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3)' ) '<< CRYST >> central solution of cryst_StressAndTangent at el ip ipc ' , e , i , c
2013-05-17 23:22:46 +05:30
write ( 6 , '(/,a,/,3(12x,3(f12.4,1x)/))' ) '<< CRYST >> P / MPa' , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_P ( 1 : 3 , 1 : 3 , c , i , e ) ) * 1.0e-6_pReal
2013-05-17 23:22:46 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Fp' , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/))' ) '<< CRYST >> Fi' , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) )
2013-05-17 23:22:46 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/),/)' ) '<< CRYST >> Lp' , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a,/,3(12x,3(f14.9,1x)/),/)' ) '<< CRYST >> Li' , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) )
2014-05-27 20:16:03 +05:30
flush ( 6 )
2013-05-17 23:22:46 +05:30
endif
enddo
enddo
2013-10-19 00:27:28 +05:30
enddo elementLooping5
2010-11-03 22:52:48 +05:30
2014-09-03 01:16:52 +05:30
2010-11-03 22:52:48 +05:30
! --+>> STIFFNESS CALCULATION <<+--
2009-06-16 14:33:30 +05:30
2013-10-19 00:27:28 +05:30
computeJacobian : if ( updateJaco ) then
jacobianMethod : if ( analyticJaco ) then
2009-12-15 13:50:31 +05:30
2013-11-21 16:28:41 +05:30
! --- ANALYTIC JACOBIAN ---
2015-03-06 18:39:00 +05:30
!$OMP PARALLEL DO PRIVATE(dSdF,dSdFe,dSdFi,dLpdS,dLpdFi,dFpinvdF,dLidS,dLidFi,dFidS,&
2016-01-17 23:26:24 +05:30
!$OMP rhs_3333,lhs_3333,temp_99,temp_33,temp_3333,myNcomponents,error)
2013-11-21 16:28:41 +05:30
elementLooping6 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-11-21 16:28:41 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ! iterate over IPs of this element to be processed
2016-01-17 23:26:24 +05:30
do c = 1_pInt , myNcomponents
call constitutive_TandItsTangent ( temp_33 , dSdFe , dSdFi , crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) , c , i , e ) ! call constitutive law to calculate elastic stress tangent
2015-03-06 18:39:00 +05:30
2016-01-17 23:26:24 +05:30
call constitutive_LiAndItsTangent ( temp_33 , dLidS , dLidFi , crystallite_Tstar_v ( 1 : 6 , c , i , e ) , &
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) , &
c , i , e ) ! call constitutive law to calculate Li tangent in lattice configuration
2015-04-21 17:53:00 +05:30
if ( sum ( abs ( dLidS ) ) < tol_math_check ) then
2015-03-06 18:39:00 +05:30
dFidS = 0.0_pReal
2015-10-14 00:22:01 +05:30
else
2016-01-17 23:26:24 +05:30
temp_33 = math_inv33 ( crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) )
2015-03-20 13:11:11 +05:30
lhs_3333 = 0.0_pReal ; rhs_3333 = 0.0_pReal
do o = 1_pInt , 3_pInt ; do p = 1_pInt , 3_pInt
lhs_3333 ( 1 : 3 , 1 : 3 , o , p ) = lhs_3333 ( 1 : 3 , 1 : 3 , o , p ) + &
2016-01-17 23:26:24 +05:30
crystallite_subdt ( c , i , e ) * math_mul33x33 ( temp_33 , dLidFi ( 1 : 3 , 1 : 3 , o , p ) )
2015-03-20 13:11:11 +05:30
lhs_3333 ( 1 : 3 , o , 1 : 3 , p ) = lhs_3333 ( 1 : 3 , o , 1 : 3 , p ) + &
2016-01-17 23:26:24 +05:30
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) * crystallite_invFi ( p , o , c , i , e )
2015-03-20 13:11:11 +05:30
rhs_3333 ( 1 : 3 , 1 : 3 , o , p ) = rhs_3333 ( 1 : 3 , 1 : 3 , o , p ) - &
2016-01-17 23:26:24 +05:30
crystallite_subdt ( c , i , e ) * math_mul33x33 ( temp_33 , dLidS ( 1 : 3 , 1 : 3 , o , p ) )
2015-03-20 13:11:11 +05:30
enddo ; enddo
call math_invert ( 9_pInt , math_Plain3333to99 ( lhs_3333 ) , temp_99 , error )
if ( error ) then
2016-01-17 23:26:24 +05:30
call IO_warning ( warning_ID = 600_pInt , el = e , ip = i , g = c , &
2015-03-20 13:11:11 +05:30
ext_msg = 'inversion error in analytic tangent calculation' )
dFidS = 0.0_pReal
else
dFidS = math_mul3333xx3333 ( math_Plain99to3333 ( temp_99 ) , rhs_3333 )
endif
dLidS = math_mul3333xx3333 ( dLidFi , dFidS ) + dLidS
2015-10-14 00:22:01 +05:30
endif
2015-03-06 18:39:00 +05:30
2016-01-17 23:26:24 +05:30
call constitutive_LpAndItsTangent ( temp_33 , dLpdS , dLpdFi , crystallite_Tstar_v ( 1 : 6 , c , i , e ) , &
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) , c , i , e ) ! call constitutive law to calculate Lp tangent in lattice configuration
2015-03-06 18:39:00 +05:30
dLpdS = math_mul3333xx3333 ( dLpdFi , dFidS ) + dLpdS
2016-01-17 23:26:24 +05:30
temp_33 = math_transpose33 ( math_mul33x33 ( crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2014-08-08 02:38:34 +05:30
rhs_3333 = 0.0_pReal
2013-11-21 16:28:41 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2014-11-03 16:13:36 +05:30
rhs_3333 ( p , o , 1 : 3 , 1 : 3 ) = math_mul33x33 ( dSdFe ( p , o , 1 : 3 , 1 : 3 ) , temp_33 )
2015-10-14 00:22:01 +05:30
2014-08-08 02:38:34 +05:30
temp_3333 = 0.0_pReal
2016-01-17 23:26:24 +05:30
temp_33 = math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
math_inv33 ( crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2013-11-21 16:28:41 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2015-03-06 18:39:00 +05:30
temp_3333 ( 1 : 3 , 1 : 3 , p , o ) = math_mul33x33 ( math_mul33x33 ( temp_33 , dLpdS ( 1 : 3 , 1 : 3 , p , o ) ) , &
2016-01-17 23:26:24 +05:30
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) )
2015-10-14 00:22:01 +05:30
2016-01-17 23:26:24 +05:30
temp_33 = math_mul33x33 ( math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) , &
math_inv33 ( crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2014-11-01 00:33:08 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2014-11-03 16:13:36 +05:30
temp_3333 ( 1 : 3 , 1 : 3 , p , o ) = temp_3333 ( 1 : 3 , 1 : 3 , p , o ) + math_mul33x33 ( temp_33 , dLidS ( 1 : 3 , 1 : 3 , p , o ) )
2015-10-14 00:22:01 +05:30
2016-01-17 23:26:24 +05:30
lhs_3333 = crystallite_subdt ( c , i , e ) * math_mul3333xx3333 ( dSdFe , temp_3333 ) + &
2015-03-06 18:39:00 +05:30
math_mul3333xx3333 ( dSdFi , dFidS )
2015-01-29 19:28:25 +05:30
2015-03-06 18:39:00 +05:30
call math_invert ( 9_pInt , math_identity2nd ( 9_pInt ) + math_Plain3333to99 ( lhs_3333 ) , temp_99 , error )
2015-01-30 19:30:32 +05:30
if ( error ) then
2016-01-17 23:26:24 +05:30
call IO_warning ( warning_ID = 600_pInt , el = e , ip = i , g = c , &
2015-01-30 19:30:32 +05:30
ext_msg = 'inversion error in analytic tangent calculation' )
dSdF = rhs_3333
else
2015-03-06 18:39:00 +05:30
dSdF = math_mul3333xx3333 ( math_Plain99to3333 ( temp_99 ) , rhs_3333 )
2015-10-14 00:22:01 +05:30
endif
2014-08-08 02:38:34 +05:30
dFpinvdF = 0.0_pReal
2014-11-01 00:33:08 +05:30
temp_3333 = math_mul3333xx3333 ( dLpdS , dSdF )
2014-01-22 21:04:10 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2016-01-17 23:26:24 +05:30
dFpinvdF ( 1 : 3 , 1 : 3 , p , o ) = - crystallite_subdt ( c , i , e ) * &
math_mul33x33 ( math_inv33 ( crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e ) ) , &
2015-03-06 18:39:00 +05:30
math_mul33x33 ( temp_3333 ( 1 : 3 , 1 : 3 , p , o ) , &
2016-01-17 23:26:24 +05:30
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2015-10-14 00:22:01 +05:30
2016-01-17 23:26:24 +05:30
crystallite_dPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = 0.0_pReal
temp_33 = math_mul33x33 ( crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) , &
math_mul33x33 ( math_Mandel6to33 ( crystallite_Tstar_v ( 1 : 6 , c , i , e ) ) , &
math_transpose33 ( crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) ) )
2014-11-01 00:33:08 +05:30
forall ( p = 1_pInt : 3_pInt ) &
2016-01-17 23:26:24 +05:30
crystallite_dPdF ( p , 1 : 3 , p , 1 : 3 , c , i , e ) = math_transpose33 ( temp_33 )
2014-11-01 00:33:08 +05:30
2016-01-17 23:26:24 +05:30
temp_33 = math_mul33x33 ( math_Mandel6to33 ( crystallite_Tstar_v ( 1 : 6 , c , i , e ) ) , &
math_transpose33 ( crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2014-01-22 21:04:10 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2016-01-17 23:26:24 +05:30
crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) = crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) + &
math_mul33x33 ( math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , dFpinvdF ( 1 : 3 , 1 : 3 , p , o ) ) , temp_33 )
2014-11-01 00:33:08 +05:30
2016-01-17 23:26:24 +05:30
temp_33 = math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) )
2014-01-22 21:04:10 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2016-01-17 23:26:24 +05:30
crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) = crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) + &
2014-11-03 16:13:36 +05:30
math_mul33x33 ( math_mul33x33 ( temp_33 , dSdF ( 1 : 3 , 1 : 3 , p , o ) ) , &
2016-01-17 23:26:24 +05:30
math_transpose33 ( crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) )
2014-01-22 21:04:10 +05:30
2016-01-17 23:26:24 +05:30
temp_33 = math_mul33x33 ( math_mul33x33 ( crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) , &
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) ) , &
math_Mandel6to33 ( crystallite_Tstar_v ( 1 : 6 , c , i , e ) ) )
2014-08-08 02:38:34 +05:30
forall ( p = 1_pInt : 3_pInt , o = 1_pInt : 3_pInt ) &
2016-01-17 23:26:24 +05:30
crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) = crystallite_dPdF ( 1 : 3 , 1 : 3 , p , o , c , i , e ) + &
2014-11-03 16:13:36 +05:30
math_mul33x33 ( temp_33 , math_transpose33 ( dFpinvdF ( 1 : 3 , 1 : 3 , p , o ) ) )
2014-11-01 00:33:08 +05:30
2014-08-08 02:38:34 +05:30
enddo ; enddo
enddo elementLooping6
!$OMP END PARALLEL DO
2013-11-21 16:28:41 +05:30
else jacobianMethod
2014-08-26 20:14:32 +05:30
2013-11-21 16:28:41 +05:30
! --- STANDARD (PERTURBATION METHOD) FOR JACOBIAN ---
numerics_integrationMode = 2_pInt
2014-08-26 20:14:32 +05:30
2013-11-21 16:28:41 +05:30
! --- BACKUP ---
2015-08-28 16:25:38 +05:30
allocate ( dPdF_perturbation1 ( 3 , 3 , 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( dPdF_perturbation2 ( 3 , 3 , 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( F_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Fp_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( InvFp_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Fi_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( InvFi_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Fe_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Lp_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Li_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( P_backup ( 3 , 3 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( Tstar_v_backup ( 6 , homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
allocate ( convergenceFlag_backup ( homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) , source = . false . )
2016-01-17 23:26:24 +05:30
!$OMP PARALLEL DO PRIVATE(myNcomponents)
2014-05-27 20:16:03 +05:30
elementLooping7 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ; do c = 1 , myNcomponents
plasticState ( phaseAt ( c , i , e ) ) % state_backup ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state_backup ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
2016-01-17 23:26:24 +05:30
plasticState ( phaseAt ( c , i , e ) ) % dotState_backup ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % dotState ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState_backup ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2014-07-02 17:57:39 +05:30
2016-01-17 23:26:24 +05:30
F_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) ! ... and kinematics
Fp_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e )
InvFp_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e )
Fi_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e )
InvFi_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e )
Fe_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e )
Lp_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e )
Li_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e )
Tstar_v_backup ( 1 : 6 , c , i , e ) = crystallite_Tstar_v ( 1 : 6 , c , i , e )
P_backup ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_P ( 1 : 3 , 1 : 3 , c , i , e )
convergenceFlag_backup ( c , i , e ) = crystallite_converged ( c , i , e )
2015-05-28 22:32:23 +05:30
enddo ; enddo
2014-05-27 20:16:03 +05:30
enddo elementLooping7
2014-08-26 20:14:32 +05:30
!$END PARALLEL DO
2013-11-21 16:28:41 +05:30
! --- CALCULATE STATE AND STRESS FOR PERTURBATION ---
dPdF_perturbation1 = crystallite_dPdF0 ! initialize stiffness with known good values from last increment
dPdF_perturbation2 = crystallite_dPdF0 ! initialize stiffness with known good values from last increment
2014-05-27 20:16:03 +05:30
pertubationLoop : do perturbation = 1 , 2 ! forward and backward perturbation
2013-11-21 16:28:41 +05:30
if ( iand ( pert_method , perturbation ) > 0_pInt ) then ! mask for desired direction
myPert = - pert_Fg * ( - 1.0_pReal ) ** perturbation ! set perturbation step
do k = 1 , 3 ; do l = 1 , 3 ! ...alter individual components
2014-08-26 20:14:32 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 23:26:24 +05:30
. and . ( ( e == debug_e . and . i == debug_i . and . c == debug_g ) &
2014-08-26 20:14:32 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) &
2013-11-21 16:28:41 +05:30
write ( 6 , '(a,2(1x,i1),1x,a,/)' ) '<< CRYST >> [[[[[[ Stiffness perturbation' , k , l , ']]]]]]'
2014-08-26 20:14:32 +05:30
! --- INITIALIZE UNPERTURBED STATE ---
2013-11-21 16:28:41 +05:30
select case ( numerics_integrator ( numerics_integrationMode ) )
2014-05-27 20:16:03 +05:30
case ( 1_pInt )
!why not OMP? ! Fix-point method: restore to last converged state at end of subinc, since this is probably closest to perturbed state
2013-11-21 16:28:41 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ; do c = 1 , myNcomponents
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % state_backup ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state_backup ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
2016-01-17 23:26:24 +05:30
plasticState ( phaseAt ( c , i , e ) ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2014-09-03 01:16:52 +05:30
2016-01-17 23:26:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) = Fp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) = InvFp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) = Fi_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) = InvFi_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) = Fe_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) = Lp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) = Li_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Tstar_v ( 1 : 6 , c , i , e ) = Tstar_v_backup ( 1 : 6 , c , i , e )
2015-05-28 22:32:23 +05:30
enddo ; enddo
2013-11-21 16:28:41 +05:30
enddo
2014-05-12 18:30:37 +05:30
case ( 2_pInt , 3_pInt ) ! explicit Euler methods: nothing to restore (except for F), since we are only doing a stress integration step
2014-08-26 20:14:32 +05:30
case ( 4_pInt , 5_pInt )
2014-05-27 20:16:03 +05:30
!why not OMP? ! explicit Runge-Kutta methods: restore to start of subinc, since we are doing a full integration of state and stress
2013-11-21 16:28:41 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ; do c = 1 , myNcomponents
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % subState0 ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % subState0 ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
2016-01-17 23:26:24 +05:30
plasticState ( phaseAt ( c , i , e ) ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2014-09-03 01:16:52 +05:30
2016-01-17 23:26:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subFp0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subFi0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subFe0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subLp0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) = crystallite_subLi0 ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Tstar_v ( 1 : 6 , c , i , e ) = crystallite_subTstar0_v ( 1 : 6 , c , i , e )
2015-05-28 22:32:23 +05:30
enddo ; enddo
2013-11-21 16:28:41 +05:30
enddo
end select
! --- PERTURB EITHER FORWARD OR BACKWARD ---
2014-05-27 20:16:03 +05:30
!why not OMP?
2014-01-21 21:39:00 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2014-01-21 21:39:00 +05:30
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2016-01-17 23:26:24 +05:30
do c = 1 , myNcomponents
crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) = F_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_subF ( k , l , c , i , e ) = crystallite_subF ( k , l , c , i , e ) + myPert
crystallite_todo ( c , i , e ) = crystallite_requested ( c , i , e ) &
. and . convergenceFlag_backup ( c , i , e )
if ( crystallite_todo ( c , i , e ) ) crystallite_converged ( c , i , e ) = . false . ! start out non-converged
2014-01-21 21:39:00 +05:30
enddo ; enddo ; enddo
2013-11-21 16:28:41 +05:30
2014-05-27 20:16:03 +05:30
2013-11-21 16:28:41 +05:30
select case ( numerics_integrator ( numerics_integrationMode ) )
case ( 1_pInt )
call crystallite_integrateStateFPI ( )
case ( 2_pInt )
call crystallite_integrateStateEuler ( )
case ( 3_pInt )
call crystallite_integrateStateAdaptiveEuler ( )
case ( 4_pInt )
call crystallite_integrateStateRK4 ( )
case ( 5_pInt )
call crystallite_integrateStateRKCK45 ( )
end select
2014-05-27 20:16:03 +05:30
!why not OMP?
2013-11-21 16:28:41 +05:30
elementLooping8 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-11-21 16:28:41 +05:30
select case ( perturbation )
case ( 1_pInt )
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . crystallite_converged ( c , i , e ) ) & ! converged state warrants stiffness update
dPdF_perturbation1 ( 1 : 3 , 1 : 3 , k , l , c , i , e ) = &
( crystallite_P ( 1 : 3 , 1 : 3 , c , i , e ) - P_backup ( 1 : 3 , 1 : 3 , c , i , e ) ) / myPert ! tangent dP_ij/dFg_kl
2013-11-21 16:28:41 +05:30
case ( 2_pInt )
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . crystallite_converged ( c , i , e ) ) & ! converged state warrants stiffness update
dPdF_perturbation2 ( 1 : 3 , 1 : 3 , k , l , c , i , e ) = &
( crystallite_P ( 1 : 3 , 1 : 3 , c , i , e ) - P_backup ( 1 : 3 , 1 : 3 , c , i , e ) ) / myPert ! tangent dP_ij/dFg_kl
2013-11-21 16:28:41 +05:30
end select
enddo elementLooping8
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
enddo ; enddo ! k,l component perturbation loop
2013-11-21 16:28:41 +05:30
endif
2014-05-27 20:16:03 +05:30
enddo pertubationLoop
2013-11-21 16:28:41 +05:30
! --- STIFFNESS ACCORDING TO PERTURBATION METHOD AND CONVERGENCE ---
elementLooping9 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
2013-11-21 16:28:41 +05:30
select case ( pert_method )
case ( 1_pInt )
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . convergenceFlag_backup ( c , i , e ) ) & ! perturbation mode 1: central solution converged
crystallite_dPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = dPdF_perturbation1 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e )
2013-11-21 16:28:41 +05:30
case ( 2_pInt )
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . convergenceFlag_backup ( c , i , e ) ) & ! perturbation mode 2: central solution converged
crystallite_dPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = dPdF_perturbation2 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e )
2013-11-21 16:28:41 +05:30
case ( 3_pInt )
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . convergenceFlag_backup ( c , i , e ) ) & ! perturbation mode 3: central solution converged
crystallite_dPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = 0.5_pReal * ( dPdF_perturbation1 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) &
+ dPdF_perturbation2 ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) )
2013-11-21 16:28:41 +05:30
end select
2016-01-17 23:26:24 +05:30
forall ( i = FEsolving_execIP ( 1 , e ) : FEsolving_execIP ( 2 , e ) , c = 1 : myNcomponents , &
crystallite_requested ( c , i , e ) . and . . not . convergenceFlag_backup ( c , i , e ) ) & ! for any pertubation mode: if central solution did not converge...
crystallite_dPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) = crystallite_fallbackdPdF ( 1 : 3 , 1 : 3 , 1 : 3 , 1 : 3 , c , i , e ) ! ...use (elastic) fallback
2013-11-21 16:28:41 +05:30
enddo elementLooping9
! --- RESTORE ---
2014-05-27 20:16:03 +05:30
!why not OMP?
2013-11-21 16:28:41 +05:30
elementLooping10 : do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
2016-01-17 23:26:24 +05:30
myNcomponents = homogenization_Ngrains ( mesh_element ( 3 , e ) )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e ) ; do c = 1 , myNcomponents
plasticState ( phaseAt ( c , i , e ) ) % state ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % state_backup ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % state_backup ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
2016-01-17 23:26:24 +05:30
plasticState ( phaseAt ( c , i , e ) ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
plasticState ( phaseAt ( c , i , e ) ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
do mySource = 1_pInt , phase_Nsources ( phaseAt ( c , i , e ) )
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState ( : , phasememberAt ( c , i , e ) ) = &
sourceState ( phaseAt ( c , i , e ) ) % p ( mySource ) % dotState_backup ( : , phasememberAt ( c , i , e ) )
2015-10-14 00:22:01 +05:30
enddo
2014-09-03 01:16:52 +05:30
2016-01-17 23:26:24 +05:30
crystallite_subF ( 1 : 3 , 1 : 3 , c , i , e ) = F_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fp ( 1 : 3 , 1 : 3 , c , i , e ) = Fp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_invFp ( 1 : 3 , 1 : 3 , c , i , e ) = InvFp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fi ( 1 : 3 , 1 : 3 , c , i , e ) = Fi_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_invFi ( 1 : 3 , 1 : 3 , c , i , e ) = InvFi_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) = Fe_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Lp ( 1 : 3 , 1 : 3 , c , i , e ) = Lp_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Li ( 1 : 3 , 1 : 3 , c , i , e ) = Li_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_Tstar_v ( 1 : 6 , c , i , e ) = Tstar_v_backup ( 1 : 6 , c , i , e )
crystallite_P ( 1 : 3 , 1 : 3 , c , i , e ) = P_backup ( 1 : 3 , 1 : 3 , c , i , e )
crystallite_converged ( c , i , e ) = convergenceFlag_backup ( c , i , e )
2015-05-28 22:32:23 +05:30
enddo ; enddo
2013-11-21 16:28:41 +05:30
enddo elementLooping10
2015-10-14 00:22:01 +05:30
2015-08-28 16:25:38 +05:30
deallocate ( dPdF_perturbation1 )
deallocate ( dPdF_perturbation2 )
deallocate ( F_backup )
deallocate ( Fp_backup )
deallocate ( InvFp_backup )
deallocate ( Fi_backup )
deallocate ( InvFi_backup )
deallocate ( Fe_backup )
deallocate ( Lp_backup )
deallocate ( Li_backup )
deallocate ( P_backup )
deallocate ( Tstar_v_backup )
deallocate ( convergenceFlag_backup )
2013-11-21 16:28:41 +05:30
2014-01-22 21:04:10 +05:30
endif jacobianMethod
2013-10-19 00:27:28 +05:30
endif computeJacobian
2014-05-27 20:16:03 +05:30
!why not OMP?
2013-10-19 00:27:28 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_stressAndItsTangent
2009-05-07 21:57:36 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2014-08-26 20:14:32 +05:30
!> @brief integrate stress, state with 4th order explicit Runge Kutta method
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-26 18:53:36 +05:30
subroutine crystallite_integrateStateRK4 ( )
2015-04-13 15:32:52 +05:30
use prec , only : &
prec_isNaN
2013-10-19 00:27:28 +05:30
use numerics , only : &
numerics_integrationMode
use debug , only : &
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-10-19 00:27:28 +05:30
debug_StateLoopDistribution
use FEsolving , only : &
2014-08-26 20:14:32 +05:30
FEsolving_execElem , &
2013-10-19 00:27:28 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
2015-04-21 17:53:00 +05:30
mesh_NcpElems
2013-10-19 00:27:28 +05:30
use material , only : &
homogenization_Ngrains , &
2014-05-12 18:30:37 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
phase_Nsources , &
material_Nphase , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt
2013-10-19 00:27:28 +05:30
use constitutive , only : &
2014-05-27 20:16:03 +05:30
constitutive_collectDotState , &
2014-06-23 00:28:29 +05:30
constitutive_microstructure
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-10-19 00:27:28 +05:30
real ( pReal ) , dimension ( 4 ) , parameter :: &
2014-05-27 20:16:03 +05:30
TIMESTEPFRACTION = [ 0.5_pReal , 0.5_pReal , 1.0_pReal , 1.0_pReal ] ! factor giving the fraction of the original timestep used for Runge Kutta Integration
2013-10-19 00:27:28 +05:30
real ( pReal ) , dimension ( 4 ) , parameter :: &
2014-09-03 01:16:52 +05:30
WEIGHT = [ 1.0_pReal , 2.0_pReal , 2.0_pReal , 1.0_pReal / 6.0_pReal ] ! weight of slope used for Runge Kutta integration (final weight divided by 6)
2013-04-26 18:53:36 +05:30
2014-05-27 20:16:03 +05:30
integer ( pInt ) :: e , & ! element index in element loop
2013-02-22 04:38:36 +05:30
i , & ! integration point index in ip loop
g , & ! grain index in grain loop
2014-05-27 20:16:03 +05:30
p , & ! phase loop
c , &
2013-02-22 04:38:36 +05:30
n , &
2015-05-28 22:32:23 +05:30
mySource , &
2014-06-25 04:51:25 +05:30
mySizePlasticDotState , &
2015-05-28 22:32:23 +05:30
mySizeSourceDotState
2013-02-22 04:38:36 +05:30
integer ( pInt ) , dimension ( 2 ) :: eIter ! bounds for element iteration
integer ( pInt ) , dimension ( 2 , mesh_NcpElems ) :: iIter , & ! bounds for ip iteration
gIter ! bounds for grain iteration
2015-09-10 03:22:00 +05:30
logical :: NaN , &
2015-05-28 22:32:23 +05:30
singleRun ! flag indicating computation for single (g,i,e) triple
2014-08-26 20:14:32 +05:30
2013-04-26 18:53:36 +05:30
eIter = FEsolving_execElem ( 1 : 2 )
do e = eIter ( 1 ) , eIter ( 2 )
iIter ( 1 : 2 , e ) = FEsolving_execIP ( 1 : 2 , e )
gIter ( 1 : 2 , e ) = [ 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) ) ]
enddo
2014-08-26 20:14:32 +05:30
2013-04-30 17:44:07 +05:30
singleRun = ( eIter ( 1 ) == eIter ( 2 ) . and . iIter ( 1 , eIter ( 1 ) ) == iIter ( 2 , eIter ( 2 ) ) )
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
!--------------------------------------------------------------------------------------------------
! initialize dotState
if ( . not . singleRun ) then
2015-10-14 00:22:01 +05:30
do p = 1_pInt , material_Nphase
2015-05-28 22:32:23 +05:30
plasticState ( p ) % RK4dotState = 0.0_pReal
2015-10-14 00:22:01 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-05-28 22:32:23 +05:30
sourceState ( p ) % p ( mySource ) % RK4dotState = 0.0_pReal
enddo
enddo
2014-05-27 20:16:03 +05:30
else
e = eIter ( 1 )
i = iIter ( 1 , e )
2016-01-17 23:26:24 +05:30
do g = gIter ( 1 , e ) , gIter ( 2 , e )
plasticState ( phaseAt ( g , i , e ) ) % RK4dotState ( : , phasememberAt ( g , i , e ) ) = 0.0_pReal
2016-01-15 05:49:44 +05:30
do mySource = 1_pInt , phase_Nsources ( phaseAt ( g , i , e ) )
sourceState ( phaseAt ( g , i , e ) ) % p ( mySource ) % RK4dotState ( : , phasememberAt ( g , i , e ) ) = 0.0_pReal
2015-10-14 00:22:01 +05:30
enddo
2014-05-27 20:16:03 +05:30
enddo
endif
!--------------------------------------------------------------------------------------------------
! first Runge-Kutta step
!$OMP PARALLEL
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2014-05-27 20:16:03 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
c = phasememberAt ( g , i , e )
p = phaseAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2015-05-28 22:32:23 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
2013-02-22 04:38:36 +05:30
!$OMP CRITICAL (checkTodo)
2015-05-28 22:32:23 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
2013-02-22 04:38:36 +05:30
!$OMP END CRITICAL (checkTodo)
2015-05-28 22:32:23 +05:30
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
2013-02-22 04:38:36 +05:30
endif
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
!$OMP END PARALLEL
2014-05-27 20:16:03 +05:30
!--------------------------------------------------------------------------------------------------
2014-08-26 20:14:32 +05:30
! --- SECOND TO FOURTH RUNGE KUTTA STEP PLUS FINAL INTEGRATION ---
2014-05-27 20:16:03 +05:30
2013-02-22 04:38:36 +05:30
do n = 1_pInt , 4_pInt
! --- state update ---
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2014-05-27 20:16:03 +05:30
!$OMP DO PRIVATE(p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-09-03 01:16:52 +05:30
plasticState ( p ) % RK4dotState ( : , c ) = plasticState ( p ) % RK4dotState ( : , c ) &
2015-10-14 00:22:01 +05:30
+ weight ( n ) * plasticState ( p ) % dotState ( : , c )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
sourceState ( p ) % p ( mySource ) % RK4dotState ( : , c ) = sourceState ( p ) % p ( mySource ) % RK4dotState ( : , c ) &
2015-10-14 00:22:01 +05:30
+ weight ( n ) * sourceState ( p ) % p ( mySource ) % dotState ( : , c )
2015-05-28 22:32:23 +05:30
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2014-07-02 17:57:39 +05:30
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) = &
plasticState ( p ) % subState0 ( 1 : mySizePlasticDotState , c ) &
+ plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c ) &
* crystallite_subdt ( g , i , e ) * timeStepFraction ( n )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) = &
sourceState ( p ) % p ( mySource ) % subState0 ( 1 : mySizeSourceDotState , c ) &
+ sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , c ) &
* crystallite_subdt ( g , i , e ) * timeStepFraction ( n )
enddo
2014-09-03 01:16:52 +05:30
2012-06-06 20:41:30 +05:30
#ifndef _OPENMP
2014-09-03 01:16:52 +05:30
if ( n == 4 &
. and . iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
. and . ( ( e == debug_e . and . i == debug_i . and . g == debug_g ) &
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then ! final integration step
2014-07-02 17:57:39 +05:30
2014-09-03 01:16:52 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3,/)' ) '<< CRYST >> updateState at el ip g ' , e , i , g
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> dotState' , plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c )
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , plasticState ( p ) % state ( 1 : mySizePlasticDotState , c )
2013-02-22 04:38:36 +05:30
endif
2014-09-03 01:16:52 +05:30
#endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
!$OMP ENDDO
2013-02-22 04:38:36 +05:30
! --- state jump ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- update dependent states ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientation information
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-05-28 22:32:23 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- stress integration ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e , timeStepFraction ( n ) ) ! fraction of original times step
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
!$OMP ENDDO
2013-02-22 04:38:36 +05:30
! --- dot state and RK dot state---
2015-10-14 00:22:01 +05:30
2014-09-03 01:16:52 +05:30
first3steps : if ( n < 4 ) then
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
timeStepFraction ( n ) * crystallite_subdt ( g , i , e ) , & ! fraction of original timestep
2013-02-22 04:38:36 +05:30
crystallite_subFrac , g , i , e )
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2014-07-02 17:57:39 +05:30
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-09-03 01:16:52 +05:30
endif first3steps
2014-05-27 20:16:03 +05:30
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
enddo
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- SET CONVERGENCE FLAG ---
2014-08-26 20:14:32 +05:30
2015-09-10 03:22:00 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
if ( crystallite_todo ( g , i , e ) ) then
2015-09-10 03:22:00 +05:30
crystallite_converged ( g , i , e ) = . true . ! if still "to do" then converged per definitionem
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( 4 , numerics_integrationMode ) = &
debug_StateLoopDistribution ( 4 , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- CHECK NONLOCAL CONVERGENCE ---
2014-08-26 20:14:32 +05:30
if ( . not . singleRun ) then ! if not requesting Integration of just a single IP
2013-02-22 04:38:36 +05:30
if ( any ( . not . crystallite_converged . and . . not . crystallite_localPlasticity ) ) then ! any non-local not yet converged (or broken)...
crystallite_converged = crystallite_converged . and . crystallite_localPlasticity ! ...restart all non-local as not converged
endif
endif
2014-08-26 20:14:32 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_integrateStateRK4
2010-10-01 17:48:49 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2014-08-26 20:14:32 +05:30
!> @brief integrate stress, state with 5th order Runge-Kutta Cash-Karp method with
2013-02-22 04:38:36 +05:30
!> adaptive step size (use 5th order solution to advance = "local extrapolation")
!--------------------------------------------------------------------------------------------------
2013-04-26 18:53:36 +05:30
subroutine crystallite_integrateStateRKCK45 ( )
2015-04-13 15:32:52 +05:30
use prec , only : &
prec_isNaN
2013-11-21 16:28:41 +05:30
use debug , only : &
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-11-21 16:28:41 +05:30
debug_StateLoopDistribution
use numerics , only : &
rTol_crystalliteState , &
numerics_integrationMode
use FEsolving , only : &
2014-08-26 20:14:32 +05:30
FEsolving_execElem , &
2013-11-21 16:28:41 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_Ngrains , &
2014-05-27 20:16:03 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
phase_Nsources , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt , &
2013-11-21 16:28:41 +05:30
homogenization_maxNgrains
use constitutive , only : &
2014-05-27 20:16:03 +05:30
constitutive_collectDotState , &
2015-05-28 22:32:23 +05:30
constitutive_plasticity_maxSizeDotState , &
constitutive_source_maxSizeDotState , &
2013-11-21 16:28:41 +05:30
constitutive_microstructure
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
real ( pReal ) , dimension ( 5 , 5 ) , parameter :: &
A = reshape ( [ &
. 2_pReal , . 075_pReal , . 3_pReal , - 1 1.0_pReal / 5 4.0_pReal , 163 1.0_pReal / 5529 6.0_pReal , &
. 0_pReal , . 225_pReal , - . 9_pReal , 2.5_pReal , 17 5.0_pReal / 51 2.0_pReal , &
. 0_pReal , . 0_pReal , 1.2_pReal , - 7 0.0_pReal / 2 7.0_pReal , 57 5.0_pReal / 1382 4.0_pReal , &
. 0_pReal , . 0_pReal , . 0_pReal , 3 5.0_pReal / 2 7.0_pReal , 4427 5.0_pReal / 11059 2.0_pReal , &
. 0_pReal , . 0_pReal , . 0_pReal , . 0_pReal , 25 3.0_pReal / 409 6.0_pReal ] , &
2014-08-26 20:14:32 +05:30
[ 5 , 5 ] , order = [ 2 , 1 ] ) !< coefficients in Butcher tableau (used for preliminary integration in stages 2 to 6)
2013-11-21 16:28:41 +05:30
real ( pReal ) , dimension ( 6 ) , parameter :: &
2014-08-26 20:14:32 +05:30
B = &
2013-11-21 16:28:41 +05:30
[ 3 7.0_pReal / 37 8.0_pReal , . 0_pReal , 25 0.0_pReal / 62 1.0_pReal , &
12 5.0_pReal / 59 4.0_pReal , . 0_pReal , 51 2.0_pReal / 177 1.0_pReal ] , & !< coefficients in Butcher tableau (used for final integration and error estimate)
DB = B - &
2014-05-27 20:16:03 +05:30
[ 282 5.0_pReal / 2764 8.0_pReal , . 0_pReal , 1857 5.0_pReal / 4838 4.0_pReal , &
1352 5.0_pReal / 5529 6.0_pReal , 27 7.0_pReal / 1433 6.0_pReal , 0.25_pReal ] !< coefficients in Butcher tableau (used for final integration and error estimate)
2013-11-21 16:28:41 +05:30
real ( pReal ) , dimension ( 5 ) , parameter :: &
C = [ 0.2_pReal , 0.3_pReal , 0.6_pReal , 1.0_pReal , 0.875_pReal ] !< coefficients in Butcher tableau (fractions of original time step in stages 2 to 6)
2013-04-29 16:47:30 +05:30
integer ( pInt ) :: &
e , & ! element index in element loop
i , & ! integration point index in ip loop
g , & ! grain index in grain loop
2014-09-03 01:41:57 +05:30
stage , & ! stage index in integration stage loop
2014-06-25 04:51:25 +05:30
s , & ! state index
2014-09-03 01:41:57 +05:30
n , &
2014-06-25 04:51:25 +05:30
p , &
cc , &
2015-05-28 22:32:23 +05:30
mySource , &
2014-09-03 01:16:52 +05:30
mySizePlasticDotState , & ! size of dot States
2015-05-28 22:32:23 +05:30
mySizeSourceDotState
2013-11-21 16:28:41 +05:30
integer ( pInt ) , dimension ( 2 ) :: &
eIter ! bounds for element iteration
integer ( pInt ) , dimension ( 2 , mesh_NcpElems ) :: &
iIter , & ! bounds for ip iteration
gIter ! bounds for grain iteration
2014-08-26 20:14:32 +05:30
2015-05-28 22:32:23 +05:30
real ( pReal ) , dimension ( constitutive_plasticity_maxSizeDotState , &
homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) :: &
plasticStateResiduum , & ! residuum from evolution in microstructure
relPlasticStateResiduum ! relative residuum from evolution in microstructure
real ( pReal ) , dimension ( constitutive_source_maxSizeDotState , &
maxval ( phase_Nsources ) , &
homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) :: &
sourceStateResiduum , & ! residuum from evolution in microstructure
relSourceStateResiduum ! relative residuum from evolution in microstructure
2013-11-21 16:28:41 +05:30
logical :: &
2015-09-10 03:22:00 +05:30
NaN , &
2013-11-21 16:28:41 +05:30
singleRun ! flag indicating computation for single (g,i,e) triple
2014-08-26 20:14:32 +05:30
2013-04-26 18:53:36 +05:30
eIter = FEsolving_execElem ( 1 : 2 )
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2014-08-26 20:14:32 +05:30
write ( 6 , '(a,1x,i1)' ) '<< CRYST >> Runge--Kutta step' , 1
2014-05-27 20:16:03 +05:30
! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP ---
2013-04-26 18:53:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 )
iIter ( 1 : 2 , e ) = FEsolving_execIP ( 1 : 2 , e )
gIter ( 1 : 2 , e ) = [ 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) ) ]
enddo
2014-08-26 20:14:32 +05:30
2013-04-30 17:44:07 +05:30
singleRun = ( eIter ( 1 ) == eIter ( 2 ) . and . iIter ( 1 , eIter ( 1 ) ) == iIter ( 2 , eIter ( 2 ) ) )
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- FIRST RUNGE KUTTA STEP ---
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
!$OMP PARALLEL
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,cc,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
cc = phasememberAt ( g , i , e )
p = phaseAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , cc ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
2013-02-22 04:38:36 +05:30
endif
2011-03-29 12:57:19 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- SECOND TO SIXTH RUNGE KUTTA STEP ---
2014-05-27 20:16:03 +05:30
2014-09-03 01:41:57 +05:30
do stage = 1_pInt , 5_pInt
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- state update ---
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2014-06-25 04:51:25 +05:30
!$OMP DO PRIVATE(p,cc)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-09-03 01:41:57 +05:30
plasticState ( p ) % RKCK45dotState ( stage , : , cc ) = plasticState ( p ) % dotState ( : , cc ) ! store Runge-Kutta dotState
2015-10-14 00:22:01 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-05-28 22:32:23 +05:30
sourceState ( p ) % p ( mySource ) % RKCK45dotState ( stage , : , cc ) = sourceState ( p ) % p ( mySource ) % dotState ( : , cc )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-09-03 01:41:57 +05:30
!$OMP DO PRIVATE(p,cc,n)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-07-02 17:57:39 +05:30
2014-09-03 01:41:57 +05:30
plasticState ( p ) % dotState ( : , cc ) = A ( 1 , stage ) * plasticState ( p ) % RKCK45dotState ( 1 , : , cc )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) = A ( 1 , stage ) * sourceState ( p ) % p ( mySource ) % RKCK45dotState ( 1 , : , cc )
enddo
2014-09-03 01:41:57 +05:30
do n = 2_pInt , stage
plasticState ( p ) % dotState ( : , cc ) = &
plasticState ( p ) % dotState ( : , cc ) + A ( n , stage ) * plasticState ( p ) % RKCK45dotState ( n , : , cc )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) = &
sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) + A ( n , stage ) * sourceState ( p ) % p ( mySource ) % RKCK45dotState ( n , : , cc )
enddo
2014-09-03 01:41:57 +05:30
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-09-03 01:41:57 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , cc ) = &
plasticState ( p ) % subState0 ( 1 : mySizePlasticDotState , cc ) &
+ plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , cc ) &
* crystallite_subdt ( g , i , e )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , cc ) = &
sourceState ( p ) % p ( mySource ) % subState0 ( 1 : mySizeSourceDotState , cc ) &
+ sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , cc ) &
* crystallite_subdt ( g , i , e )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- state jump ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
2015-09-10 03:22:00 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
!$OMP FLUSH(crystallite_todo)
2015-09-10 03:22:00 +05:30
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
2013-02-22 04:38:36 +05:30
!$OMP CRITICAL (checkTodo)
2015-09-10 03:22:00 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
2013-02-22 04:38:36 +05:30
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- update dependent states ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientations to constitutive_microstructure
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-05-28 22:32:23 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- stress integration ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2014-09-03 01:41:57 +05:30
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e , C ( stage ) ) ! fraction of original time step
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
!$OMP ENDDO
2013-02-22 04:38:36 +05:30
! --- dot state and RK dot state---
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2014-09-03 01:41:57 +05:30
write ( 6 , '(a,1x,i1)' ) '<< CRYST >> Runge--Kutta step' , stage + 1_pInt
2011-03-29 12:57:19 +05:30
#endif
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2014-09-03 01:41:57 +05:30
C ( stage ) * crystallite_subdt ( g , i , e ) , & ! fraction of original timestep
2013-02-22 04:38:36 +05:30
crystallite_subFrac , g , i , e )
enddo ; enddo ; enddo
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,cc,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2014-07-02 17:57:39 +05:30
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , cc ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2013-02-22 04:38:36 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
enddo
2013-05-17 23:22:46 +05:30
!--------------------------------------------------------------------------------------------------
2014-06-25 04:51:25 +05:30
! --- STATE UPDATE WITH ERROR ESTIMATE FOR STATE ---
2014-08-26 20:14:32 +05:30
2015-05-28 22:32:23 +05:30
relPlasticStateResiduum = 0.0_pReal
relSourceStateResiduum = 0.0_pReal
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2014-06-25 04:51:25 +05:30
!$OMP DO PRIVATE(p,cc)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2015-05-28 22:32:23 +05:30
plasticState ( p ) % RKCK45dotState ( 6 , : , cc ) = plasticState ( p ) % dotState ( : , cc ) ! store Runge-Kutta dotState
do mySource = 1_pInt , phase_Nsources ( p )
sourceState ( p ) % p ( mySource ) % RKCK45dotState ( 6 , : , cc ) = sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) ! store Runge-Kutta dotState
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
! --- absolute residuum in state ---
2015-05-28 22:32:23 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) = &
matmul ( transpose ( plasticState ( p ) % RKCK45dotState ( 1 : 6 , 1 : mySizePlasticDotState , cc ) ) , DB ) &
* crystallite_subdt ( g , i , e )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) = &
matmul ( transpose ( sourceState ( p ) % p ( mySource ) % RKCK45dotState ( 1 : 6 , 1 : mySizeSourceDotState , cc ) ) , DB ) &
* crystallite_subdt ( g , i , e )
2015-10-14 00:22:01 +05:30
enddo
2014-05-27 20:16:03 +05:30
! --- dot state ---
2015-05-28 22:32:23 +05:30
plasticState ( p ) % dotState ( : , cc ) = &
matmul ( transpose ( plasticState ( p ) % RKCK45dotState ( 1 : 6 , 1 : mySizePlasticDotState , cc ) ) , B )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % dotState ( : , cc ) = &
2015-10-14 00:22:01 +05:30
matmul ( transpose ( sourceState ( p ) % p ( mySource ) % RKCK45dotState ( 1 : 6 , 1 : mySizeSourceDotState , cc ) ) , B )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2015-10-14 00:22:01 +05:30
! --- state and update ---
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2014-07-02 17:57:39 +05:30
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , cc ) = &
plasticState ( p ) % subState0 ( 1 : mySizePlasticDotState , cc ) &
+ plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , cc ) &
* crystallite_subdt ( g , i , e )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , cc ) = &
sourceState ( p ) % p ( mySource ) % subState0 ( 1 : mySizeSourceDotState , cc ) &
+ sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , cc ) &
* crystallite_subdt ( g , i , e )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2015-10-14 00:22:01 +05:30
! --- relative residui and state convergence ---
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,cc,s)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
cc = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
forall ( s = 1_pInt : mySizePlasticDotState , abs ( plasticState ( p ) % state ( s , cc ) ) > 0.0_pReal ) &
relPlasticStateResiduum ( s , g , i , e ) = &
plasticStateResiduum ( s , g , i , e ) / plasticState ( p ) % state ( s , cc )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
forall ( s = 1_pInt : mySizeSourceDotState , abs ( sourceState ( p ) % p ( mySource ) % state ( s , cc ) ) > 0.0_pReal ) &
relSourceStateResiduum ( s , mySource , g , i , e ) = &
sourceStateResiduum ( s , mySource , g , i , e ) / sourceState ( p ) % p ( mySource ) % state ( s , cc )
enddo
!$OMP FLUSH(relPlasticStateResiduum)
!$OMP FLUSH(relSourceStateResiduum)
2014-09-03 01:16:52 +05:30
! @Martin: do we need flushing? why..?
2015-05-28 22:32:23 +05:30
crystallite_todo ( g , i , e ) = all ( abs ( relPlasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) ) < &
rTol_crystalliteState . or . &
abs ( plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) ) < &
plasticState ( p ) % aTolState ( 1 : mySizePlasticDotState ) )
2015-10-14 00:22:01 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-05-28 22:32:23 +05:30
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
crystallite_todo ( g , i , e ) = crystallite_todo ( g , i , e ) . and . &
all ( abs ( relSourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) ) < &
rTol_crystalliteState . or . &
abs ( sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) ) < &
sourceState ( p ) % p ( mySource ) % aTolState ( 1 : mySizeSourceDotState ) )
enddo
2014-07-02 17:57:39 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
. and . ( ( e == debug_e . and . i == debug_i . and . g == debug_g ) &
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-17 23:26:24 +05:30
write ( 6 , '(a,i8,1x,i3,1x,i3,/)' ) '<< CRYST >> updateState at el ip ipc ' , e , i , g
2014-07-02 17:57:39 +05:30
write ( 6 , '(a,/,(12x,12(f12.1,1x)),/)' ) '<< CRYST >> absolute residuum tolerance' , &
2015-05-28 22:32:23 +05:30
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) / plasticState ( p ) % aTolState ( 1 : mySizePlasticDotState )
2014-07-02 17:57:39 +05:30
write ( 6 , '(a,/,(12x,12(f12.1,1x)),/)' ) '<< CRYST >> relative residuum tolerance' , &
2015-05-28 22:32:23 +05:30
relPlasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) / rTol_crystalliteState
2014-07-02 17:57:39 +05:30
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> dotState' , &
plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , cc )
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , &
plasticState ( p ) % state ( 1 : mySizePlasticDotState , cc )
endif
2011-03-29 12:57:19 +05:30
#endif
2013-02-22 04:38:36 +05:30
endif
2011-11-04 18:14:50 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- STATE JUMP ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
2011-11-04 18:14:50 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
!--------------------------------------------------------------------------------------------------
! --- UPDATE DEPENDENT STATES IF RESIDUUM BELOW TOLERANCE ---
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientations to constitutive_microstructure
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-05-28 22:32:23 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2010-10-01 17:48:49 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
!--------------------------------------------------------------------------------------------------
! --- FINAL STRESS INTEGRATION STEP IF RESIDUUM BELOW TOLERANCE ---
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e )
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-05-17 23:22:46 +05:30
!--------------------------------------------------------------------------------------------------
! --- SET CONVERGENCE FLAG ---
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2014-06-11 22:02:09 +05:30
crystallite_converged ( g , i , e ) = . true . ! if still "to do" then converged per definition
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( 6 , numerics_integrationMode ) = &
debug_StateLoopDistribution ( 6 , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- nonlocal convergence check ---
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2015-10-14 00:22:01 +05:30
write ( 6 , '(a,i8,a,i2,/)' ) '<< CRYST >> ' , count ( crystallite_converged ( : , : , : ) ) , ' grains converged' ! if not requesting Integration of just a single IP
2014-05-27 20:16:03 +05:30
if ( ( . not . singleRun ) . and . any ( . not . crystallite_converged . and . . not . crystallite_localPlasticity ) ) & ! any non-local not yet converged (or broken)...
2014-09-03 01:16:52 +05:30
crystallite_converged = crystallite_converged . and . crystallite_localPlasticity ! ...restart all non-local as not converged
2015-10-14 00:22:01 +05:30
2013-02-22 04:38:36 +05:30
end subroutine crystallite_integrateStateRKCK45
2010-10-01 17:48:49 +05:30
2012-05-17 20:55:21 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-10-16 18:34:59 +05:30
!> @brief integrate stress, state with 1st order Euler method with adaptive step size
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-26 18:53:36 +05:30
subroutine crystallite_integrateStateAdaptiveEuler ( )
2015-04-13 15:32:52 +05:30
use prec , only : &
prec_isNaN
2013-11-21 16:28:41 +05:30
use debug , only : &
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-11-21 16:28:41 +05:30
debug_StateLoopDistribution
use numerics , only : &
rTol_crystalliteState , &
numerics_integrationMode
2014-08-26 20:14:32 +05:30
use FEsolving , only : &
FEsolving_execElem , &
2013-11-21 16:28:41 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems , &
mesh_maxNips
use material , only : &
homogenization_Ngrains , &
2014-05-27 20:16:03 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt , &
2015-05-28 22:32:23 +05:30
phase_Nsources , &
2013-11-21 16:28:41 +05:30
homogenization_maxNgrains
use constitutive , only : &
2014-05-27 20:16:03 +05:30
constitutive_collectDotState , &
constitutive_microstructure , &
2015-05-28 22:32:23 +05:30
constitutive_plasticity_maxSizeDotState , &
constitutive_source_maxSizeDotState
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
integer ( pInt ) :: &
e , & ! element index in element loop
i , & ! integration point index in ip loop
g , & ! grain index in grain loop
2014-06-25 04:51:25 +05:30
s , & ! state index
p , &
c , &
2015-05-28 22:32:23 +05:30
mySource , &
2014-09-03 01:16:52 +05:30
mySizePlasticDotState , & ! size of dot states
2015-05-28 22:32:23 +05:30
mySizeSourceDotState
2013-11-21 16:28:41 +05:30
integer ( pInt ) , dimension ( 2 ) :: &
eIter ! bounds for element iteration
integer ( pInt ) , dimension ( 2 , mesh_NcpElems ) :: &
iIter , & ! bounds for ip iteration
gIter ! bounds for grain iteration
2015-05-28 22:32:23 +05:30
real ( pReal ) , dimension ( constitutive_plasticity_maxSizeDotState , &
homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) :: &
plasticStateResiduum , & ! residuum from evolution in micrstructure
relPlasticStateResiduum ! relative residuum from evolution in microstructure
real ( pReal ) , dimension ( constitutive_source_maxSizeDotState , &
maxval ( phase_Nsources ) , &
homogenization_maxNgrains , mesh_maxNips , mesh_NcpElems ) :: &
sourceStateResiduum , & ! residuum from evolution in micrstructure
relSourceStateResiduum ! relative residuum from evolution in microstructure
2014-05-27 20:16:03 +05:30
2013-11-21 16:28:41 +05:30
logical :: &
2015-05-28 22:32:23 +05:30
converged , &
2015-09-10 03:22:00 +05:30
NaN , &
2013-11-21 16:28:41 +05:30
singleRun ! flag indicating computation for single (g,i,e) triple
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP ---
2013-04-26 18:53:36 +05:30
eIter = FEsolving_execElem ( 1 : 2 )
do e = eIter ( 1 ) , eIter ( 2 )
iIter ( 1 : 2 , e ) = FEsolving_execIP ( 1 : 2 , e )
gIter ( 1 : 2 , e ) = [ 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) ) ]
enddo
2014-08-26 20:14:32 +05:30
2013-04-30 17:44:07 +05:30
singleRun = ( eIter ( 1 ) == eIter ( 2 ) . and . iIter ( 1 , eIter ( 1 ) ) == iIter ( 2 , eIter ( 2 ) ) )
2014-08-26 20:14:32 +05:30
2015-05-28 22:32:23 +05:30
plasticStateResiduum = 0.0_pReal
relPlasticStateResiduum = 0.0_pReal
sourceStateResiduum = 0.0_pReal
relSourceStateResiduum = 0.0_pReal
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
integrationMode : if ( numerics_integrationMode == 1_pInt ) then
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2013-10-16 18:34:59 +05:30
! --- DOT STATE (EULER INTEGRATION) ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2012-05-17 20:55:21 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
2014-05-27 20:16:03 +05:30
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
2013-02-22 04:38:36 +05:30
endif
2014-05-27 20:16:03 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- STATE UPDATE (EULER INTEGRATION) ---
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) = &
- 0.5_pReal &
* plasticState ( p ) % dotstate ( 1 : mySizePlasticDotState , c ) &
* crystallite_subdt ( g , i , e ) ! contribution to absolute residuum in state
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) = &
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) &
+ plasticState ( p ) % dotstate ( 1 : mySizePlasticDotState , c ) &
* crystallite_subdt ( g , i , e )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) = &
- 0.5_pReal &
* sourceState ( p ) % p ( mySource ) % dotstate ( 1 : mySizeSourceDotState , c ) &
* crystallite_subdt ( g , i , e ) ! contribution to absolute residuum in state
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) = &
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) &
+ sourceState ( p ) % p ( mySource ) % dotstate ( 1 : mySizeSourceDotState , c ) &
* crystallite_subdt ( g , i , e )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
2014-08-26 20:14:32 +05:30
!$OMP ENDDO
2013-02-22 04:38:36 +05:30
! --- STATE JUMP ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- UPDATE DEPENDENT STATES (EULER INTEGRATION) ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
2013-11-21 16:28:41 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-10-19 00:27:28 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientations to constitutive_microstructure
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-09-10 03:22:00 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
!$OMP END PARALLEL
2014-05-27 20:16:03 +05:30
endif integrationMode
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- STRESS INTEGRATION (EULER INTEGRATION) ---
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
!$OMP PARALLEL DO
2015-09-10 03:22:00 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e )
!$OMP FLUSH(crystallite_todo)
2015-09-10 03:22:00 +05:30
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
2013-02-22 04:38:36 +05:30
!$OMP CRITICAL (checkTodo)
2015-09-10 03:22:00 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
2013-02-22 04:38:36 +05:30
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
2014-05-27 20:16:03 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
if ( numerics_integrationMode == 1_pInt ) then
2014-08-26 20:14:32 +05:30
!$OMP PARALLEL
2013-10-16 18:34:59 +05:30
! --- DOT STATE (HEUN METHOD) ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-10-19 00:27:28 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-10-16 18:34:59 +05:30
! --- ERROR ESTIMATE FOR STATE (HEUN METHOD) ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP SINGLE
2015-05-28 22:32:23 +05:30
relPlasticStateResiduum = 0.0_pReal
relSourceStateResiduum = 0.0_pReal
2013-02-22 04:38:36 +05:30
!$OMP END SINGLE
2014-05-27 20:16:03 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,converged,p,c,s)
2014-05-27 20:16:03 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-05-27 20:16:03 +05:30
! --- contribution of heun step to absolute residui ---
2015-05-28 22:32:23 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) = &
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) &
+ 0.5_pReal * plasticState ( p ) % dotState ( : , c ) &
* crystallite_subdt ( g , i , e ) ! contribution to absolute residuum in state
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) = &
sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) &
+ 0.5_pReal * sourceState ( p ) % p ( mySource ) % dotState ( : , c ) &
* crystallite_subdt ( g , i , e ) ! contribution to absolute residuum in state
enddo
!$OMP FLUSH(plasticStateResiduum)
!$OMP FLUSH(sourceStateResiduum)
2015-10-14 00:22:01 +05:30
! --- relative residui ---
2014-06-25 04:51:25 +05:30
forall ( s = 1_pInt : mySizePlasticDotState , abs ( plasticState ( p ) % dotState ( s , c ) ) > 0.0_pReal ) &
2015-05-28 22:32:23 +05:30
relPlasticStateResiduum ( s , g , i , e ) = &
plasticStateResiduum ( s , g , i , e ) / plasticState ( p ) % dotState ( s , c )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
forall ( s = 1_pInt : mySizeSourceDotState , abs ( sourceState ( p ) % p ( mySource ) % dotState ( s , c ) ) > 0.0_pReal ) &
relSourceStateResiduum ( s , mySource , g , i , e ) = &
sourceStateResiduum ( s , mySource , g , i , e ) / sourceState ( p ) % p ( mySource ) % dotState ( s , c )
enddo
!$OMP FLUSH(relPlasticStateResiduum)
!$OMP FLUSH(relSourceStateResiduum)
2015-10-14 00:22:01 +05:30
#ifndef _OPENMP
2014-07-02 17:57:39 +05:30
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
. and . ( ( e == debug_e . and . i == debug_i . and . g == debug_g ) &
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
write ( 6 , '(a,i8,1x,i2,1x,i3,/)' ) '<< CRYST >> updateState at el ip g ' , e , i , g
write ( 6 , '(a,/,(12x,12(f12.1,1x)),/)' ) '<< CRYST >> absolute residuum tolerance' , &
2015-05-28 22:32:23 +05:30
plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) / plasticState ( p ) % aTolState ( 1 : mySizePlasticDotState )
2014-05-27 20:16:03 +05:30
write ( 6 , '(a,/,(12x,12(f12.1,1x)),/)' ) '<< CRYST >> relative residuum tolerance' , &
2015-05-28 22:32:23 +05:30
relPlasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) / rTol_crystalliteState
2014-06-25 04:51:25 +05:30
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> dotState' , plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c ) &
2015-05-28 22:32:23 +05:30
- 2.0_pReal * plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) / crystallite_subdt ( g , i , e ) ! calculate former dotstate from higher order solution and state residuum
2014-09-03 01:41:57 +05:30
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , plasticState ( p ) % state ( 1 : mySizePlasticDotState , c )
2014-05-27 20:16:03 +05:30
endif
2012-03-09 01:55:28 +05:30
#endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- converged ? ---
2015-05-28 22:32:23 +05:30
converged = all ( abs ( relPlasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) ) < &
rTol_crystalliteState . or . &
abs ( plasticStateResiduum ( 1 : mySizePlasticDotState , g , i , e ) ) < &
plasticState ( p ) % aTolState ( 1 : mySizePlasticDotState ) )
2015-10-14 00:22:01 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-05-28 22:32:23 +05:30
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
converged = converged . and . &
all ( abs ( relSourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) ) < &
2014-06-25 04:51:25 +05:30
rTol_crystalliteState . or . &
2015-05-28 22:32:23 +05:30
abs ( sourceStateResiduum ( 1 : mySizeSourceDotState , mySource , g , i , e ) ) < &
sourceState ( p ) % p ( mySource ) % aTolState ( 1 : mySizeSourceDotState ) )
enddo
if ( converged ) then
2014-05-27 20:16:03 +05:30
crystallite_converged ( g , i , e ) = . true . ! ... converged per definitionem
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( 2 , numerics_integrationMode ) = &
debug_StateLoopDistribution ( 2 , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
elseif ( numerics_integrationMode > 1 ) then ! stiffness calculation
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
!$OMP PARALLEL DO
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
crystallite_converged ( g , i , e ) = . true . ! ... converged per definitionem
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( 2 , numerics_integrationMode ) = &
debug_StateLoopDistribution ( 2 , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
enddo ; enddo ; enddo
2014-05-27 20:16:03 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- NONLOCAL CONVERGENCE CHECK ---
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i8,a,i2,/)' ) '<< CRYST >> ' , count ( crystallite_converged ( : , : , : ) ) , ' grains converged'
2014-05-27 20:16:03 +05:30
if ( ( . not . singleRun ) . and . any ( . not . crystallite_converged . and . . not . crystallite_localPlasticity ) ) & ! any non-local not yet converged (or broken)...
2014-08-27 21:24:11 +05:30
crystallite_converged = crystallite_converged . and . crystallite_localPlasticity ! ...restart all non-local as not converged
2014-05-27 20:16:03 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_integrateStateAdaptiveEuler
2010-10-01 17:48:49 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-10-16 18:34:59 +05:30
!> @brief integrate stress, and state with 1st order explicit Euler method
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-26 18:53:36 +05:30
subroutine crystallite_integrateStateEuler ( )
2015-04-13 15:32:52 +05:30
use prec , only : &
prec_isNaN
2013-11-21 16:28:41 +05:30
use debug , only : &
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-11-21 16:28:41 +05:30
debug_StateLoopDistribution
use numerics , only : &
numerics_integrationMode , &
numerics_timeSyncing
2014-08-26 20:14:32 +05:30
use FEsolving , only : &
FEsolving_execElem , &
2013-11-21 16:28:41 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems
use material , only : &
2014-05-27 20:16:03 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt , &
2015-05-28 22:32:23 +05:30
phase_Nsources , &
2013-11-21 16:28:41 +05:30
homogenization_Ngrains
use constitutive , only : &
2014-05-27 20:16:03 +05:30
constitutive_collectDotState , &
2014-06-23 00:28:29 +05:30
constitutive_microstructure
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
integer ( pInt ) :: &
e , & ! element index in element loop
i , & ! integration point index in ip loop
g , & ! grain index in grain loop
2015-05-28 22:32:23 +05:30
p , & ! phase loop
2014-06-25 04:51:25 +05:30
c , &
2015-05-28 22:32:23 +05:30
mySource , &
2014-06-25 04:51:25 +05:30
mySizePlasticDotState , &
2015-05-28 22:32:23 +05:30
mySizeSourceDotState
2013-11-21 16:28:41 +05:30
integer ( pInt ) , dimension ( 2 ) :: &
eIter ! bounds for element iteration
integer ( pInt ) , dimension ( 2 , mesh_NcpElems ) :: &
iIter , & ! bounds for ip iteration
gIter ! bounds for grain iteration
logical :: &
2015-09-10 03:22:00 +05:30
NaN , &
2013-11-21 16:28:41 +05:30
singleRun ! flag indicating computation for single (g,i,e) triple
2013-04-26 18:53:36 +05:30
eIter = FEsolving_execElem ( 1 : 2 )
do e = eIter ( 1 ) , eIter ( 2 )
iIter ( 1 : 2 , e ) = FEsolving_execIP ( 1 : 2 , e )
gIter ( 1 : 2 , e ) = [ 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) ) ]
enddo
2014-08-26 20:14:32 +05:30
2013-04-30 17:44:07 +05:30
singleRun = ( eIter ( 1 ) == eIter ( 2 ) . and . iIter ( 1 , eIter ( 1 ) ) == iIter ( 2 , eIter ( 2 ) ) )
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
if ( numerics_integrationMode == 1_pInt ) then
2014-05-27 20:16:03 +05:30
!$OMP PARALLEL
2014-08-26 20:14:32 +05:30
2013-10-16 18:34:59 +05:30
! --- DOT STATE ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-10-19 00:27:28 +05:30
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
c = phasememberAt ( g , i , e )
p = phaseAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) . and . . not . numerics_timeSyncing ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
else ! if broken local...
crystallite_todo ( g , i , e ) = . false . ! ... skip this one next time
endif
endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-10-16 18:34:59 +05:30
! --- UPDATE STATE ---
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) = &
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) &
+ plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c ) &
2015-10-14 00:22:01 +05:30
* crystallite_subdt ( g , i , e )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) = &
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) &
+ sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , c ) &
* crystallite_subdt ( g , i , e )
enddo
2014-08-26 20:14:32 +05:30
2014-07-02 17:57:39 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
. and . ( ( e == debug_e . and . i == debug_i . and . g == debug_g ) &
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-07-02 17:57:39 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3,/)' ) '<< CRYST >> update state at el ip g ' , e , i , g
2015-05-28 22:32:23 +05:30
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> dotState' , plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c )
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , plasticState ( p ) % state ( 1 : mySizePlasticDotState , c )
2014-07-02 17:57:39 +05:30
endif
#endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- STATE JUMP ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
2015-09-10 03:22:00 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
!$OMP FLUSH(crystallite_todo)
2015-09-10 03:22:00 +05:30
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) & ! if broken non-local...
2013-02-22 04:38:36 +05:30
. and . . not . numerics_timeSyncing ) then
!$OMP CRITICAL (checkTodo)
2015-09-10 03:22:00 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
2013-02-22 04:38:36 +05:30
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- UPDATE DEPENDENT STATES ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-10-19 00:27:28 +05:30
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientations to constitutive_microstructure
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-05-28 22:32:23 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2014-06-25 04:51:25 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
!$OMP END PARALLEL
2013-02-22 04:38:36 +05:30
endif
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
!$OMP PARALLEL
2013-02-22 04:38:36 +05:30
! --- STRESS INTEGRATION ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e )
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) & ! if broken non-local...
. and . . not . numerics_timeSyncing ) then
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
2011-11-04 18:14:50 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- SET CONVERGENCE FLAG ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
crystallite_converged ( g , i , e ) = . true . ! if still "to do" then converged per definitionem
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( 1 , numerics_integrationMode ) = &
debug_StateLoopDistribution ( 1 , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- CHECK NON-LOCAL CONVERGENCE ---
2014-08-26 20:14:32 +05:30
if ( . not . singleRun ) then ! if not requesting Integration of just a single IP
2013-02-22 04:38:36 +05:30
if ( any ( . not . crystallite_converged . and . . not . crystallite_localPlasticity ) & ! any non-local not yet converged (or broken)...
2013-10-19 00:27:28 +05:30
. and . . not . numerics_timeSyncing ) &
2013-02-22 04:38:36 +05:30
crystallite_converged = crystallite_converged . and . crystallite_localPlasticity ! ...restart all non-local as not converged
endif
2014-08-26 20:14:32 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_integrateStateEuler
2010-10-01 17:48:49 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2014-08-26 20:14:32 +05:30
!> @brief integrate stress, state with adaptive 1st order explicit Euler method
!> using Fixed Point Iteration to adapt the stepsize
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-26 18:53:36 +05:30
subroutine crystallite_integrateStateFPI ( )
2015-04-13 15:32:52 +05:30
use prec , only : &
prec_isNaN
2013-11-21 16:28:41 +05:30
use debug , only : &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-11-21 16:28:41 +05:30
debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
debug_StateLoopDistribution
use numerics , only : &
nState , &
numerics_integrationMode , &
rTol_crystalliteState
use FEsolving , only : &
2014-08-26 20:14:32 +05:30
FEsolving_execElem , &
2013-11-21 16:28:41 +05:30
FEsolving_execIP
use mesh , only : &
mesh_element , &
mesh_NcpElems
use material , only : &
2014-05-27 20:16:03 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt , &
2015-05-28 22:32:23 +05:30
phase_Nsources , &
2013-11-21 16:28:41 +05:30
homogenization_Ngrains
use constitutive , only : &
2014-05-27 20:16:03 +05:30
constitutive_collectDotState , &
constitutive_microstructure , &
2015-05-28 22:32:23 +05:30
constitutive_plasticity_maxSizeDotState , &
constitutive_source_maxSizeDotState
2014-07-02 17:57:39 +05:30
2014-08-26 20:14:32 +05:30
implicit none
2013-05-17 23:22:46 +05:30
integer ( pInt ) :: &
NiterationState , & !< number of iterations in state loop
e , & !< element index in element loop
i , & !< integration point index in ip loop
g , & !< grain index in grain loop
2014-06-25 04:51:25 +05:30
p , &
c , &
2015-05-28 22:32:23 +05:30
mySource , &
2014-09-03 01:16:52 +05:30
mySizePlasticDotState , & ! size of dot states
2015-05-28 22:32:23 +05:30
mySizeSourceDotState
2013-11-21 16:28:41 +05:30
integer ( pInt ) , dimension ( 2 ) :: &
eIter ! bounds for element iteration
integer ( pInt ) , dimension ( 2 , mesh_NcpElems ) :: &
iIter , & ! bounds for ip iteration
gIter ! bounds for grain iteration
real ( pReal ) :: &
dot_prod12 , &
dot_prod22 , &
2015-05-28 22:32:23 +05:30
plasticStateDamper , & ! damper for integration of state
sourceStateDamper
real ( pReal ) , dimension ( constitutive_plasticity_maxSizeDotState ) :: &
plasticStateResiduum , &
tempPlasticState
real ( pReal ) , dimension ( constitutive_source_maxSizeDotState , maxval ( phase_Nsources ) ) :: &
sourceStateResiduum , & ! residuum from evolution in micrstructure
tempSourceState
2013-11-21 16:28:41 +05:30
logical :: &
2015-05-28 22:32:23 +05:30
converged , &
2015-09-10 03:22:00 +05:30
NaN , &
2014-01-22 00:15:41 +05:30
singleRun , & ! flag indicating computation for single (g,i,e) triple
doneWithIntegration
2014-08-26 20:14:32 +05:30
2013-04-26 18:53:36 +05:30
eIter = FEsolving_execElem ( 1 : 2 )
do e = eIter ( 1 ) , eIter ( 2 )
iIter ( 1 : 2 , e ) = FEsolving_execIP ( 1 : 2 , e )
gIter ( 1 : 2 , e ) = [ 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) ) ]
enddo
2014-08-26 20:14:32 +05:30
2013-04-30 17:44:07 +05:30
singleRun = ( eIter ( 1 ) == eIter ( 2 ) . and . iIter ( 1 , eIter ( 1 ) ) == iIter ( 2 , eIter ( 2 ) ) )
2014-05-27 20:16:03 +05:30
!--------------------------------------------------------------------------------------------------
! initialize dotState
if ( . not . singleRun ) then
2015-10-14 00:22:01 +05:30
forall ( p = 1_pInt : size ( plasticState ) )
2014-09-03 01:16:52 +05:30
plasticState ( p ) % previousDotState = 0.0_pReal
2014-05-27 20:16:03 +05:30
plasticState ( p ) % previousDotState2 = 0.0_pReal
end forall
2015-05-28 22:32:23 +05:30
do p = 1_pInt , size ( sourceState ) ; do mySource = 1_pInt , phase_Nsources ( p )
sourceState ( p ) % p ( mySource ) % previousDotState = 0.0_pReal
sourceState ( p ) % p ( mySource ) % previousDotState2 = 0.0_pReal
enddo ; enddo
2014-05-27 20:16:03 +05:30
else
e = eIter ( 1 )
i = iIter ( 1 , e )
2014-07-10 14:17:00 +05:30
do g = gIter ( 1 , e ) , gIter ( 2 , e )
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-10-14 00:22:01 +05:30
plasticState ( p ) % previousDotState ( : , c ) = 0.0_pReal
plasticState ( p ) % previousDotState2 ( : , c ) = 0.0_pReal
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-10-14 00:22:01 +05:30
sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) = 0.0_pReal
sourceState ( p ) % p ( mySource ) % previousDotState2 ( : , c ) = 0.0_pReal
2015-05-28 22:32:23 +05:30
enddo
2014-05-27 20:16:03 +05:30
enddo
endif
2013-02-22 04:38:36 +05:30
! --+>> PREGUESS FOR STATE <<+--
2014-08-26 20:14:32 +05:30
2013-11-21 16:28:41 +05:30
! --- DOT STATES ---
2014-08-26 20:14:32 +05:30
2013-11-21 16:28:41 +05:30
!$OMP PARALLEL
2013-02-22 04:38:36 +05:30
!$OMP DO
2014-08-26 20:14:32 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
2014-07-07 19:51:58 +05:30
2013-02-22 04:38:36 +05:30
!$OMP ENDDO
2015-09-10 03:22:00 +05:30
!$OMP DO PRIVATE(p,c,NaN)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-05-27 20:16:03 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken is a non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals done (and broken)
!$OMP END CRITICAL (checkTodo)
else ! broken one was local...
crystallite_todo ( g , i , e ) = . false . ! ... done (and broken)
endif
2014-08-26 20:14:32 +05:30
endif
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2013-10-16 18:34:59 +05:30
! --- UPDATE STATE ---
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
!$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2014-06-25 04:51:25 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) = &
plasticState ( p ) % subState0 ( 1 : mySizePlasticDotState , c ) &
+ plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c ) &
* crystallite_subdt ( g , i , e )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) = &
sourceState ( p ) % p ( mySource ) % subState0 ( 1 : mySizeSourceDotState , c ) &
+ sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , c ) &
* crystallite_subdt ( g , i , e )
enddo
2013-02-22 04:38:36 +05:30
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2013-02-22 04:38:36 +05:30
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --+>> STATE LOOP <<+--
2014-07-09 19:04:33 +05:30
2013-02-22 04:38:36 +05:30
NiterationState = 0_pInt
2014-01-22 00:15:41 +05:30
doneWithIntegration = . false .
crystalliteLooping : do while ( . not . doneWithIntegration . and . NiterationState < nState )
2013-02-22 04:38:36 +05:30
NiterationState = NiterationState + 1_pInt
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP PARALLEL
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- UPDATE DEPENDENT STATES ---
2014-08-26 20:14:32 +05:30
2014-06-25 04:51:25 +05:30
!$OMP DO PRIVATE(p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) &
2015-10-14 00:22:01 +05:30
!***dirty way to pass orientations to constitutive_micrsotructure
call constitutive_microstructure ( crystallite_orientation , &
crystallite_Fe ( 1 : 3 , 1 : 3 , g , i , e ) , &
2014-11-29 01:36:24 +05:30
crystallite_Fp ( 1 : 3 , 1 : 3 , g , i , e ) , &
2015-05-28 22:32:23 +05:30
g , i , e ) ! update dependent state variables to be consistent with basic states
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-10-14 00:22:01 +05:30
plasticState ( p ) % previousDotState2 ( : , c ) = plasticState ( p ) % previousDotState ( : , c )
plasticState ( p ) % previousDotState ( : , c ) = plasticState ( p ) % dotState ( : , c )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-10-14 00:22:01 +05:30
sourceState ( p ) % p ( mySource ) % previousDotState2 ( : , c ) = sourceState ( p ) % p ( mySource ) % previousDotState ( : , c )
sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) = sourceState ( p ) % p ( mySource ) % dotState ( : , c )
2015-05-28 22:32:23 +05:30
enddo
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- STRESS INTEGRATION ---
2014-07-09 19:04:33 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
crystallite_todo ( g , i , e ) = crystallite_integrateStress ( g , i , e )
!$OMP FLUSH(crystallite_todo)
2014-08-26 20:14:32 +05:30
if ( . not . crystallite_todo ( g , i , e ) . and . . not . crystallite_localPlasticity ( g , i , e ) ) then ! broken non-local...
!$OMP CRITICAL (checkTodo)
2013-02-22 04:38:36 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ... then all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2013-02-22 04:38:36 +05:30
!$OMP SINGLE
!$OMP CRITICAL (write2out)
2013-10-19 00:27:28 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-02-22 04:38:36 +05:30
write ( 6 , '(a,i8,a)' ) '<< CRYST >> ' , count ( crystallite_todo ( : , : , : ) ) , ' grains todo after stress integration'
!$OMP END CRITICAL (write2out)
!$OMP END SINGLE
2014-08-26 20:14:32 +05:30
2013-10-16 18:34:59 +05:30
! --- DOT STATE ---
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2014-09-23 16:08:20 +05:30
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) &
2015-05-28 22:32:23 +05:30
call constitutive_collectDotState ( crystallite_Tstar_v ( 1 : 6 , g , i , e ) , &
2014-09-27 02:19:25 +05:30
crystallite_Fe , &
2014-10-10 17:58:57 +05:30
crystallite_Fp , &
2013-11-21 16:28:41 +05:30
crystallite_subdt ( g , i , e ) , crystallite_subFrac , g , i , e )
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-07-09 19:04:33 +05:30
2014-06-25 04:51:25 +05:30
!$OMP DO PRIVATE(p,c)
2013-02-22 04:38:36 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-09-10 03:22:00 +05:30
NaN = any ( prec_isNaN ( plasticState ( p ) % dotState ( : , c ) ) )
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-09-10 03:22:00 +05:30
NaN = NaN . or . any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) ) )
2015-10-14 00:22:01 +05:30
enddo
2015-09-10 03:22:00 +05:30
if ( NaN ) then ! NaN occured in any dotState
2014-09-03 01:16:52 +05:30
crystallite_todo ( g , i , e ) = . false . ! ... skip me next time
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if me is non-local...
2014-05-27 20:16:03 +05:30
!$OMP CRITICAL (checkTodo)
2014-09-03 01:16:52 +05:30
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
2014-05-27 20:16:03 +05:30
!$OMP END CRITICAL (checkTodo)
2014-08-26 20:14:32 +05:30
endif
endif
2013-02-22 04:38:36 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
2014-05-27 20:16:03 +05:30
2013-10-16 18:34:59 +05:30
! --- UPDATE STATE ---
2014-07-09 19:04:33 +05:30
2014-06-25 04:51:25 +05:30
!$OMP DO PRIVATE(dot_prod12,dot_prod22, &
2015-05-28 22:32:23 +05:30
!$OMP& mySizePlasticDotState,mySizeSourceDotState, &
!$OMP& plasticStateResiduum,sourceStateResiduum, &
!$OMP& plasticStatedamper,sourceStateDamper, &
!$OMP& tempPlasticState,tempSourceState,converged,p,c)
2013-11-21 16:28:41 +05:30
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
2013-02-22 04:38:36 +05:30
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
2013-10-16 18:34:59 +05:30
2016-01-15 05:49:44 +05:30
p = phaseAt ( g , i , e )
c = phasememberAt ( g , i , e )
2015-05-28 22:32:23 +05:30
dot_prod12 = dot_product ( plasticState ( p ) % dotState ( : , c ) &
- plasticState ( p ) % previousDotState ( : , c ) , &
plasticState ( p ) % previousDotState ( : , c ) &
- plasticState ( p ) % previousDotState2 ( : , c ) )
dot_prod22 = dot_product ( plasticState ( p ) % previousDotState ( : , c ) &
- plasticState ( p ) % previousDotState2 ( : , c ) , &
plasticState ( p ) % previousDotState ( : , c ) &
- plasticState ( p ) % previousDotState2 ( : , c ) )
2014-05-27 20:16:03 +05:30
if ( dot_prod22 > 0.0_pReal &
. and . ( dot_prod12 < 0.0_pReal &
2014-06-25 04:51:25 +05:30
. or . dot_product ( plasticState ( p ) % dotState ( : , c ) , &
plasticState ( p ) % previousDotState ( : , c ) ) < 0.0_pReal ) ) then
2015-05-28 22:32:23 +05:30
plasticStateDamper = 0.75_pReal + 0.25_pReal * tanh ( 2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22 )
2014-06-25 04:51:25 +05:30
else
2015-05-28 22:32:23 +05:30
plasticStateDamper = 1.0_pReal
2014-07-07 19:51:58 +05:30
endif
2015-05-28 22:32:23 +05:30
! --- get residui ---
2014-09-03 01:16:52 +05:30
2015-05-28 22:32:23 +05:30
mySizePlasticDotState = plasticState ( p ) % sizeDotState
plasticStateResiduum ( 1 : mySizePlasticDotState ) = &
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) &
- plasticState ( p ) % subState0 ( 1 : mySizePlasticDotState , c ) &
- ( plasticState ( p ) % dotState ( 1 : mySizePlasticDotState , c ) * plasticStateDamper &
+ plasticState ( p ) % previousDotState ( 1 : mySizePlasticDotState , c ) &
* ( 1.0_pReal - plasticStateDamper ) ) * crystallite_subdt ( g , i , e )
2014-09-03 01:16:52 +05:30
2015-05-28 22:32:23 +05:30
! --- correct state with residuum ---
tempPlasticState ( 1 : mySizePlasticDotState ) = &
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) &
- plasticStateResiduum ( 1 : mySizePlasticDotState ) ! need to copy to local variable, since we cant flush a pointer in openmp
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp)
2014-12-08 16:15:12 +05:30
2015-05-28 22:32:23 +05:30
plasticState ( p ) % dotState ( : , c ) = plasticState ( p ) % dotState ( : , c ) * plasticStateDamper &
+ plasticState ( p ) % previousDotState ( : , c ) &
* ( 1.0_pReal - plasticStateDamper )
2015-10-14 00:22:01 +05:30
2015-05-28 22:32:23 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
dot_prod12 = dot_product ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) &
- sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) , &
sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) &
- sourceState ( p ) % p ( mySource ) % previousDotState2 ( : , c ) )
dot_prod22 = dot_product ( sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) &
- sourceState ( p ) % p ( mySource ) % previousDotState2 ( : , c ) , &
sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) &
- sourceState ( p ) % p ( mySource ) % previousDotState2 ( : , c ) )
if ( dot_prod22 > 0.0_pReal &
. and . ( dot_prod12 < 0.0_pReal &
. or . dot_product ( sourceState ( p ) % p ( mySource ) % dotState ( : , c ) , &
sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) ) < 0.0_pReal ) ) then
sourceStateDamper = 0.75_pReal + 0.25_pReal * tanh ( 2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22 )
else
sourceStateDamper = 1.0_pReal
endif
2014-05-27 20:16:03 +05:30
! --- get residui ---
2015-05-28 22:32:23 +05:30
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceStateResiduum ( 1 : mySizeSourceDotState , mySource ) = &
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) &
- sourceState ( p ) % p ( mySource ) % subState0 ( 1 : mySizeSourceDotState , c ) &
- ( sourceState ( p ) % p ( mySource ) % dotState ( 1 : mySizeSourceDotState , c ) * sourceStateDamper &
+ sourceState ( p ) % p ( mySource ) % previousDotState ( 1 : mySizeSourceDotState , c ) &
* ( 1.0_pReal - sourceStateDamper ) ) * crystallite_subdt ( g , i , e )
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
! --- correct state with residuum ---
2015-05-28 22:32:23 +05:30
tempSourceState ( 1 : mySizeSourceDotState , mySource ) = &
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) &
- sourceStateResiduum ( 1 : mySizeSourceDotState , mySource ) ! need to copy to local variable, since we cant flush a pointer in openmp
! --- store corrected dotState --- (cannot do this before state update, because not sure how to flush pointers in openmp)
sourceState ( p ) % p ( mySource ) % dotState ( : , c ) = &
sourceState ( p ) % p ( mySource ) % dotState ( : , c ) * sourceStateDamper &
+ sourceState ( p ) % p ( mySource ) % previousDotState ( : , c ) &
* ( 1.0_pReal - sourceStateDamper )
2015-10-14 00:22:01 +05:30
enddo
2015-05-28 22:32:23 +05:30
2012-05-17 20:55:21 +05:30
#ifndef _OPENMP
2014-05-15 18:31:54 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2013-02-22 04:38:36 +05:30
. and . ( ( e == debug_e . and . i == debug_i . and . g == debug_g ) &
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3,/)' ) '<< CRYST >> update state at el ip g ' , e , i , g
2015-05-28 22:32:23 +05:30
write ( 6 , '(a,f6.1,/)' ) '<< CRYST >> plasticstatedamper ' , plasticStatedamper
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> plastic state residuum' , plasticStateResiduum ( 1 : mySizePlasticDotState )
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , tempPlasticState ( 1 : mySizePlasticDotState )
2013-02-22 04:38:36 +05:30
endif
2012-05-17 20:55:21 +05:30
#endif
2014-05-27 20:16:03 +05:30
! --- converged ? ---
2015-05-28 22:32:23 +05:30
converged = all ( abs ( plasticStateResiduum ( 1 : mySizePlasticDotState ) ) < &
plasticState ( p ) % aTolState ( 1 : mySizePlasticDotState ) &
. or . abs ( plasticStateResiduum ( 1 : mySizePlasticDotState ) ) < &
rTol_crystalliteState * abs ( tempPlasticState ( 1 : mySizePlasticDotState ) ) )
2015-10-14 00:22:01 +05:30
do mySource = 1_pInt , phase_Nsources ( p )
2015-05-28 22:32:23 +05:30
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
converged = converged . and . &
all ( abs ( sourceStateResiduum ( 1 : mySizeSourceDotState , mySource ) ) < &
sourceState ( p ) % p ( mySource ) % aTolState ( 1 : mySizeSourceDotState ) &
. or . abs ( sourceStateResiduum ( 1 : mySizeSourceDotState , mySource ) ) < &
2015-10-14 00:22:01 +05:30
rTol_crystalliteState * abs ( tempSourceState ( 1 : mySizeSourceDotState , mySource ) ) )
2015-05-28 22:32:23 +05:30
enddo
if ( converged ) then
2014-06-25 04:51:25 +05:30
crystallite_converged ( g , i , e ) = . true . ! ... converged per definition
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionState)
debug_StateLoopDistribution ( NiterationState , numerics_integrationMode ) = &
debug_StateLoopDistribution ( NiterationState , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionState)
endif
endif
2015-05-28 22:32:23 +05:30
plasticState ( p ) % state ( 1 : mySizePlasticDotState , c ) = &
tempPlasticState ( 1 : mySizePlasticDotState )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDotState = sourceState ( p ) % p ( mySource ) % sizeDotState
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDotState , c ) = &
tempSourceState ( 1 : mySizeSourceDotState , mySource )
2015-10-14 00:22:01 +05:30
enddo
2014-05-27 20:16:03 +05:30
endif
2013-02-22 04:38:36 +05:30
enddo ; enddo ; enddo
!$OMP ENDDO
! --- STATE JUMP ---
2014-07-09 19:04:33 +05:30
2013-02-22 04:38:36 +05:30
!$OMP DO
do e = eIter ( 1 ) , eIter ( 2 ) ; do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
!$OMP FLUSH(crystallite_todo)
if ( crystallite_todo ( g , i , e ) . and . crystallite_converged ( g , i , e ) ) then ! converged and still alive...
2014-08-26 20:14:32 +05:30
crystallite_todo ( g , i , e ) = crystallite_stateJump ( g , i , e )
2013-02-22 04:38:36 +05:30
!$OMP FLUSH(crystallite_todo)
if ( . not . crystallite_todo ( g , i , e ) ) then ! if state jump fails, then convergence is broken
2014-08-26 20:14:32 +05:30
crystallite_converged ( g , i , e ) = . false .
2013-02-22 04:38:36 +05:30
if ( . not . crystallite_localPlasticity ( g , i , e ) ) then ! if broken non-local...
!$OMP CRITICAL (checkTodo)
crystallite_todo = crystallite_todo . and . crystallite_localPlasticity ! ...all non-locals skipped
!$OMP END CRITICAL (checkTodo)
endif
endif
endif
enddo ; enddo ; enddo
!$OMP ENDDO
!$OMP END PARALLEL
2014-08-26 20:14:32 +05:30
2014-05-27 20:16:03 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) &
2013-05-17 23:22:46 +05:30
write ( 6 , '(a,i8,a,i2,/)' ) '<< CRYST >> ' , count ( crystallite_converged ( : , : , : ) ) , &
2014-08-27 21:24:11 +05:30
' grains converged after state integration #' , NiterationState
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- NON-LOCAL CONVERGENCE CHECK ---
2014-08-26 20:14:32 +05:30
if ( . not . singleRun ) then ! if not requesting Integration of just a single IP
2013-10-19 00:27:28 +05:30
if ( any ( . not . crystallite_converged . and . . not . crystallite_localPlasticity ) ) & ! any non-local not yet converged (or broken)...
2013-02-22 04:38:36 +05:30
crystallite_converged = crystallite_converged . and . crystallite_localPlasticity ! ...restart all non-local as not converged
endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt ) then
2013-04-29 16:47:30 +05:30
write ( 6 , '(a,i8,a)' ) '<< CRYST >> ' , count ( crystallite_converged ( : , : , : ) ) , &
' grains converged after non-local check'
write ( 6 , '(a,i8,a,i2,/)' ) '<< CRYST >> ' , count ( crystallite_todo ( : , : , : ) ) , &
2014-08-27 21:24:11 +05:30
' grains todo after state integration #' , NiterationState
2013-02-22 04:38:36 +05:30
endif
2014-01-22 00:15:41 +05:30
! --- CHECK IF DONE WITH INTEGRATION ---
doneWithIntegration = . true .
elemLoop : do e = eIter ( 1 ) , eIter ( 2 )
do i = iIter ( 1 , e ) , iIter ( 2 , e ) ; do g = gIter ( 1 , e ) , gIter ( 2 , e ) ! iterate over elements, ips and grains
if ( crystallite_todo ( g , i , e ) . and . . not . crystallite_converged ( g , i , e ) ) then
doneWithIntegration = . false .
exit elemLoop
endif
enddo ; enddo
enddo elemLoop
2013-05-17 23:22:46 +05:30
enddo crystalliteLooping
2012-03-09 01:55:28 +05:30
end subroutine crystallite_integrateStateFPI
2010-10-01 17:48:49 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates a jump in the state according to the current state and the current stress
2014-06-17 12:24:49 +05:30
!> returns true, if state jump was successfull or not needed. false indicates NaN in delta state
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2016-01-17 20:20:33 +05:30
logical function crystallite_stateJump ( ipc , ip , el )
2015-09-10 18:31:33 +05:30
use prec , only : &
prec_isNaN
2013-04-29 16:47:30 +05:30
use debug , only : &
2015-04-21 20:03:38 +05:30
debug_level , &
2013-04-29 16:47:30 +05:30
debug_crystallite , &
debug_levelExtensive , &
2015-04-21 20:03:38 +05:30
debug_levelSelective , &
debug_e , &
debug_i , &
debug_g
2013-11-21 16:28:41 +05:30
use material , only : &
2014-05-27 20:16:03 +05:30
plasticState , &
2015-06-01 21:32:27 +05:30
sourceState , &
phase_Nsources , &
2016-01-15 05:49:44 +05:30
phaseAt , phasememberAt
2013-11-21 16:28:41 +05:30
use constitutive , only : &
2014-08-26 20:14:32 +05:30
constitutive_collectDeltaState
2014-07-02 17:57:39 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
integer ( pInt ) , intent ( in ) :: &
2016-01-17 20:20:33 +05:30
el , & ! element index
ip , & ! integration point index
ipc ! grain index
2014-06-25 04:51:25 +05:30
2013-11-21 16:28:41 +05:30
integer ( pInt ) :: &
2014-06-25 04:51:25 +05:30
c , &
p , &
2015-06-01 21:32:27 +05:30
mySource , &
mySizePlasticDeltaState , &
mySizeSourceDeltaState
2014-07-02 17:57:39 +05:30
2016-01-17 20:20:33 +05:30
c = phasememberAt ( ipc , ip , el )
p = phaseAt ( ipc , ip , el )
call constitutive_collectDeltaState ( crystallite_Tstar_v ( 1 : 6 , ipc , ip , el ) , crystallite_Fe ( 1 : 3 , 1 : 3 , ipc , ip , el ) , ipc , ip , el )
2015-06-01 21:32:27 +05:30
mySizePlasticDeltaState = plasticState ( p ) % sizeDeltaState
2015-09-10 18:31:33 +05:30
if ( any ( prec_isNaN ( plasticState ( p ) % deltaState ( : , c ) ) ) ) then ! NaN occured in deltaState
2015-06-01 21:32:27 +05:30
crystallite_stateJump = . false .
return
endif
plasticState ( p ) % state ( 1 : mySizePlasticDeltaState , c ) = plasticState ( p ) % state ( 1 : mySizePlasticDeltaState , c ) + &
plasticState ( p ) % deltaState ( 1 : mySizePlasticDeltaState , c )
do mySource = 1_pInt , phase_Nsources ( p )
mySizeSourceDeltaState = sourceState ( p ) % p ( mySource ) % sizeDeltaState
2015-09-10 18:31:33 +05:30
if ( any ( prec_isNaN ( sourceState ( p ) % p ( mySource ) % deltaState ( : , c ) ) ) ) then ! NaN occured in deltaState
2014-06-17 12:24:49 +05:30
crystallite_stateJump = . false .
return
endif
2015-06-01 21:32:27 +05:30
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDeltaState , c ) = &
sourceState ( p ) % p ( mySource ) % state ( 1 : mySizeSourceDeltaState , c ) + &
sourceState ( p ) % p ( mySource ) % deltaState ( 1 : mySizeSourceDeltaState , c )
enddo
2014-07-23 18:56:05 +05:30
2012-06-06 20:41:30 +05:30
#ifndef _OPENMP
2015-06-01 21:32:27 +05:30
if ( any ( plasticState ( p ) % deltaState ( 1 : mySizePlasticDeltaState , c ) / = 0.0_pReal ) &
. and . iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2015-06-01 21:32:27 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3, /)' ) '<< CRYST >> update state at el ip ipc ' , el , ip , ipc
2015-06-01 21:32:27 +05:30
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> deltaState' , plasticState ( p ) % deltaState ( 1 : mySizePlasticDeltaState , c )
write ( 6 , '(a,/,(12x,12(e12.5,1x)),/)' ) '<< CRYST >> new state' , plasticState ( p ) % state ( 1 : mySizePlasticDeltaState , c )
2014-06-17 12:24:49 +05:30
endif
2015-06-01 21:32:27 +05:30
#endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
crystallite_stateJump = . true .
2014-08-26 20:14:32 +05:30
2012-06-06 20:41:30 +05:30
end function crystallite_stateJump
2014-11-06 17:19:37 +05:30
2014-09-10 14:07:12 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Map 2nd order tensor to reference config
!--------------------------------------------------------------------------------------------------
2016-01-17 20:20:33 +05:30
function crystallite_push33ToRef ( ipc , ip , el , tensor33 )
2014-09-10 14:07:12 +05:30
use math , only : &
2015-08-03 16:37:19 +05:30
math_mul33x33 , &
math_inv33 , &
math_transpose33 , &
math_EulerToR
use material , only : &
material_EulerAngles
2014-09-10 14:07:12 +05:30
implicit none
real ( pReal ) , dimension ( 3 , 3 ) :: crystallite_push33ToRef
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: tensor33
2015-08-03 16:37:19 +05:30
real ( pReal ) , dimension ( 3 , 3 ) :: T
2014-09-10 14:07:12 +05:30
integer ( pInt ) , intent ( in ) :: &
2016-01-17 20:20:33 +05:30
el , & ! element index
ip , & ! integration point index
ipc ! grain index
2014-09-10 14:07:12 +05:30
2016-01-17 20:20:33 +05:30
T = math_mul33x33 ( math_EulerToR ( material_EulerAngles ( 1 : 3 , ipc , ip , el ) ) , &
math_transpose33 ( math_inv33 ( crystallite_subF ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) ) )
2015-08-03 16:37:19 +05:30
crystallite_push33ToRef = math_mul33x33 ( math_transpose33 ( T ) , math_mul33x33 ( tensor33 , T ) )
2014-09-10 14:07:12 +05:30
end function crystallite_push33ToRef
2014-11-06 17:19:37 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2014-08-26 20:14:32 +05:30
!> @brief calculation of stress (P) with time integration based on a residuum in Lp and
!> intermediate acceleration of the Newton-Raphson correction
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-29 16:47:30 +05:30
logical function crystallite_integrateStress ( &
2016-01-17 20:20:33 +05:30
ipc , & ! grain number
ip , & ! integration point number
el , & ! element number
2013-02-22 04:38:36 +05:30
timeFraction &
)
2015-04-21 17:53:00 +05:30
use prec , only : pLongInt , &
2015-09-10 18:31:33 +05:30
tol_math_check , &
prec_isNaN
2013-02-22 04:38:36 +05:30
use numerics , only : nStress , &
aTol_crystalliteStress , &
rTol_crystalliteStress , &
iJacoLpresiduum , &
numerics_integrationMode
use debug , only : debug_level , &
debug_crystallite , &
debug_levelBasic , &
debug_levelExtensive , &
debug_levelSelective , &
2015-04-21 20:03:38 +05:30
debug_e , &
debug_i , &
debug_g , &
2013-02-22 04:38:36 +05:30
debug_cumLpCalls , &
debug_cumLpTicks , &
2015-03-06 18:39:00 +05:30
debug_StressLoopLpDistribution , &
debug_StressLoopLiDistribution
2013-02-22 04:38:36 +05:30
use constitutive , only : constitutive_LpAndItsTangent , &
2014-11-01 00:33:08 +05:30
constitutive_LiAndItsTangent , &
constitutive_TandItsTangent
2013-02-22 04:38:36 +05:30
use math , only : math_mul33x33 , &
math_mul33xx33 , &
2014-11-01 00:33:08 +05:30
math_mul3333xx3333 , &
2013-02-22 04:38:36 +05:30
math_mul66x6 , &
math_mul99x99 , &
math_transpose33 , &
math_inv33 , &
math_invert , &
math_det33 , &
math_I3 , &
math_identity2nd , &
math_Mandel66to3333 , &
math_Mandel6to33 , &
math_Mandel33to6 , &
math_Plain3333to99 , &
math_Plain33to9 , &
2015-03-06 18:39:00 +05:30
math_Plain9to33 , &
math_Plain99to3333
2015-04-21 20:03:38 +05:30
use mesh , only : mesh_element
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2016-01-17 20:20:33 +05:30
integer ( pInt ) , intent ( in ) :: el , & ! element index
ip , & ! integration point index
ipc ! grain index
2013-02-22 04:38:36 +05:30
real ( pReal ) , optional , intent ( in ) :: timeFraction ! fraction of timestep
2013-04-29 16:47:30 +05:30
2013-02-22 04:38:36 +05:30
!*** local variables ***!
real ( pReal ) , dimension ( 3 , 3 ) :: Fg_new , & ! deformation gradient at end of timestep
Fp_current , & ! plastic deformation gradient at start of timestep
2014-11-01 00:33:08 +05:30
Fi_current , & ! intermediate deformation gradient at start of timestep
2013-02-22 04:38:36 +05:30
Fp_new , & ! plastic deformation gradient at end of timestep
Fe_new , & ! elastic deformation gradient at end of timestep
invFp_new , & ! inverse of Fp_new
2015-03-06 18:39:00 +05:30
Fi_new , & ! gradient of intermediate deformation stages
invFi_new , &
2013-02-22 04:38:36 +05:30
invFp_current , & ! inverse of Fp_current
2014-11-01 00:33:08 +05:30
invFi_current , & ! inverse of Fp_current
2013-02-22 04:38:36 +05:30
Lpguess , & ! current guess for plastic velocity gradient
Lpguess_old , & ! known last good guess for plastic velocity gradient
Lp_constitutive , & ! plastic velocity gradient resulting from constitutive law
2014-11-13 18:23:20 +05:30
residuumLp , & ! current residuum of plastic velocity gradient
residuumLp_old , & ! last residuum of plastic velocity gradient
2013-02-22 04:38:36 +05:30
deltaLp , & ! direction of next guess
2014-11-13 18:23:20 +05:30
Liguess , & ! current guess for intermediate velocity gradient
Liguess_old , & ! known last good guess for intermediate velocity gradient
Li_constitutive , & ! intermediate velocity gradient resulting from constitutive law
residuumLi , & ! current residuum of intermediate velocity gradient
residuumLi_old , & ! last residuum of intermediate velocity gradient
2014-11-01 00:33:08 +05:30
deltaLi , & ! direction of next guess
Tstar , & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration
A , &
2013-02-22 04:38:36 +05:30
B , &
2014-10-20 21:13:28 +05:30
Fe , & ! elastic deformation gradient
2014-11-01 00:33:08 +05:30
temp_33
2013-02-22 04:38:36 +05:30
real ( pReal ) , dimension ( 6 ) :: Tstar_v ! 2nd Piola-Kirchhoff Stress in Mandel-Notation
real ( pReal ) , dimension ( 9 ) :: work ! needed for matrix inversion by LAPACK
integer ( pInt ) , dimension ( 9 ) :: ipiv ! needed for matrix inversion by LAPACK
2015-03-18 23:33:18 +05:30
real ( pReal ) , dimension ( 9 , 9 ) :: dRLp_dLp , & ! partial derivative of residuum (Jacobian for NEwton-Raphson scheme)
2014-11-13 18:23:20 +05:30
dRLp_dLp2 , & ! working copy of dRdLp
dRLi_dLi ! partial derivative of residuumI (Jacobian for NEwton-Raphson scheme)
2013-02-22 04:38:36 +05:30
real ( pReal ) , dimension ( 3 , 3 , 3 , 3 ) :: dT_dFe3333 , & ! partial derivative of 2nd Piola-Kirchhoff stress
2015-03-06 18:39:00 +05:30
dT_dFi3333 , &
2014-11-01 00:33:08 +05:30
dFe_dLp3333 , & ! partial derivative of elastic deformation gradient
2015-01-29 19:28:25 +05:30
dFe_dLi3333 , &
2015-03-06 18:39:00 +05:30
dFi_dLi3333 , &
dLp_dFi3333 , &
dLi_dFi3333 , &
dLp_dT3333 , &
dLi_dT3333
2015-04-11 00:39:26 +05:30
real ( pReal ) detInvFi , & ! determinant of InvFi
2014-11-13 18:23:20 +05:30
steplengthLp0 , &
steplengthLp , &
steplengthLi0 , &
steplengthLi , &
2013-02-22 04:38:36 +05:30
dt , & ! time increment
2014-11-13 18:23:20 +05:30
aTolLp , &
aTolLi
integer ( pInt ) NiterationStressLp , & ! number of stress integrations
NiterationStressLi , & ! number of inner stress integrations
2013-02-22 04:38:36 +05:30
ierr , & ! error indicator for LAPACK
o , &
p , &
2014-11-13 18:23:20 +05:30
jacoCounterLp , &
jacoCounterLi ! counters to check for Jacobian update
2013-02-22 04:38:36 +05:30
integer ( pLongInt ) tick , &
tock , &
tickrate , &
maxticks
2013-10-19 00:27:28 +05:30
2013-06-11 22:05:04 +05:30
external :: &
2013-10-19 00:27:28 +05:30
#if(FLOAT==8)
2013-06-11 22:05:04 +05:30
dgesv
#elif(FLOAT==4)
sgesv
#endif
2013-02-22 04:38:36 +05:30
!* be pessimistic
crystallite_integrateStress = . false .
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2013-02-22 04:38:36 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,i2,1x,i3)' ) '<< CRYST >> integrateStress at el ip ipc ' , el , ip , ipc
2013-02-22 04:38:36 +05:30
endif
2011-03-29 12:57:19 +05:30
#endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* only integrate over fraction of timestep?
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
if ( present ( timeFraction ) ) then
2016-01-17 20:20:33 +05:30
dt = crystallite_subdt ( ipc , ip , el ) * timeFraction
Fg_new = crystallite_subF0 ( 1 : 3 , 1 : 3 , ipc , ip , el ) &
+ ( crystallite_subF ( 1 : 3 , 1 : 3 , ipc , ip , el ) - crystallite_subF0 ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) * timeFraction
2014-08-26 20:14:32 +05:30
else
2016-01-17 20:20:33 +05:30
dt = crystallite_subdt ( ipc , ip , el )
Fg_new = crystallite_subF ( 1 : 3 , 1 : 3 , ipc , ip , el )
2013-02-22 04:38:36 +05:30
endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* feed local variables
2014-08-26 20:14:32 +05:30
2016-01-17 20:20:33 +05:30
Fp_current = crystallite_subFp0 ( 1 : 3 , 1 : 3 , ipc , ip , el ) ! "Fp_current" is only used as temp var here...
Lpguess = crystallite_Lp ( 1 : 3 , 1 : 3 , ipc , ip , el ) ! ... and take it as first guess
Fi_current = crystallite_subFi0 ( 1 : 3 , 1 : 3 , ipc , ip , el ) ! intermediate configuration, assume decomposition as F = Fe Fi Fp
Liguess = crystallite_Li ( 1 : 3 , 1 : 3 , ipc , ip , el ) ! ... and take it as first guess
2015-03-06 18:39:00 +05:30
Liguess_old = Liguess
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* inversion of Fp_current...
2014-08-26 20:14:32 +05:30
invFp_current = math_inv33 ( Fp_current )
2015-04-11 13:55:23 +05:30
if ( all ( abs ( invFp_current ) < = tiny ( 0.0_pReal ) ) ) then ! math_inv33 returns zero when failed, avoid floating point comparison
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2014-08-27 21:24:11 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3)' ) '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip g ' , &
2016-01-18 21:43:27 +05:30
el , '(' , mesh_element ( 1 , el ) , ')' , ip , ipc
2013-10-19 00:27:28 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) > 0_pInt ) &
write ( 6 , '(/,a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Fp_current' , math_transpose33 ( Fp_current ( 1 : 3 , 1 : 3 ) )
2013-02-22 04:38:36 +05:30
endif
2011-03-29 12:57:19 +05:30
#endif
2013-02-22 04:38:36 +05:30
return
endif
2015-04-11 13:55:23 +05:30
A = math_mul33x33 ( Fg_new , invFp_current ) ! intermediate tensor needed later to calculate dFe_dLp
2014-11-13 18:23:20 +05:30
!* inversion of Fi_current...
2014-11-01 00:33:08 +05:30
invFi_current = math_inv33 ( Fi_current )
2015-04-11 13:55:23 +05:30
if ( all ( abs ( invFi_current ) < = tiny ( 0.0_pReal ) ) ) then ! math_inv33 returns zero when failed, avoid floating point comparison
2014-11-01 00:33:08 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3)' ) '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ' , &
el , '(' , mesh_element ( 1 , el ) , ')' , ip , ipc
2014-11-01 00:33:08 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) > 0_pInt ) &
write ( 6 , '(/,a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Fp_current' , math_transpose33 ( Fi_current ( 1 : 3 , 1 : 3 ) )
endif
#endif
return
endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* start LpLoop with normal step length
2014-08-26 20:14:32 +05:30
2014-11-13 18:23:20 +05:30
NiterationStressLi = 0_pInt
jacoCounterLi = 0_pInt
steplengthLi0 = 1.0_pReal
steplengthLi = steplengthLi0
residuumLi_old = 0.0_pReal
2014-08-26 20:14:32 +05:30
2014-11-12 22:10:50 +05:30
LiLoop : do
2014-11-13 18:23:20 +05:30
NiterationStressLi = NiterationStressLi + 1_pInt
IloopsExeced : if ( NiterationStressLi > nStress ) then
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-10-19 00:27:28 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) &
2014-11-12 22:10:50 +05:30
write ( 6 , '(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)' ) '<< CRYST >> integrateStress reached inelastic loop limit' , nStress , &
2016-01-17 20:20:33 +05:30
' at el (elFE) ip ipc ' , el , mesh_element ( 1 , el ) , ip , ipc
2011-03-29 12:57:19 +05:30
#endif
2013-02-22 04:38:36 +05:30
return
2014-11-12 22:10:50 +05:30
endif IloopsExeced
2015-03-06 18:39:00 +05:30
invFi_new = math_mul33x33 ( invFi_current , math_I3 - dt * Liguess )
Fi_new = math_inv33 ( invFi_new )
detInvFi = math_det33 ( invFi_new )
2014-11-12 22:10:50 +05:30
2014-11-13 18:23:20 +05:30
NiterationStressLp = 0_pInt
jacoCounterLp = 0_pInt
steplengthLp0 = 1.0_pReal
steplengthLp = steplengthLp0
residuumLp_old = 0.0_pReal
Lpguess_old = Lpguess
2014-11-12 22:10:50 +05:30
2015-10-14 00:22:01 +05:30
LpLoop : do ! inner stress integration loop for consistency with Fi
2014-11-13 18:23:20 +05:30
NiterationStressLp = NiterationStressLp + 1_pInt
loopsExeced : if ( NiterationStressLp > nStress ) then
2014-11-01 00:33:08 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) &
2014-11-12 22:10:50 +05:30
write ( 6 , '(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)' ) '<< CRYST >> integrateStress reached loop limit' , nStress , &
2016-01-17 20:20:33 +05:30
' at el (elFE) ip ipc ' , el , mesh_element ( 1 , el ) , ip , ipc
2014-11-01 00:33:08 +05:30
#endif
return
2014-11-12 22:10:50 +05:30
endif loopsExeced
2015-10-14 00:22:01 +05:30
2014-11-01 00:33:08 +05:30
!* calculate (elastic) 2nd Piola--Kirchhoff stress tensor and its tangent from constitutive law
2014-11-12 22:10:50 +05:30
B = math_I3 - dt * Lpguess
2015-03-06 18:39:00 +05:30
Fe = math_mul33x33 ( math_mul33x33 ( A , B ) , invFi_new ) ! current elastic deformation tensor
2016-01-17 20:20:33 +05:30
call constitutive_TandItsTangent ( Tstar , dT_dFe3333 , dT_dFi3333 , Fe , Fi_new , ipc , ip , el ) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration
2014-11-01 00:33:08 +05:30
Tstar_v = math_Mandel33to6 ( Tstar )
2014-11-12 22:10:50 +05:30
!* calculate plastic velocity gradient and its tangent from constitutive law
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
call system_clock ( count = tick , count_rate = tickrate , count_max = maxticks )
endif
2015-03-06 18:39:00 +05:30
call constitutive_LpAndItsTangent ( Lp_constitutive , dLp_dT3333 , dLp_dFi3333 , &
2016-01-17 20:20:33 +05:30
Tstar_v , Fi_new , ipc , ip , el )
2014-11-01 00:33:08 +05:30
2014-11-12 22:10:50 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
call system_clock ( count = tock , count_rate = tickrate , count_max = maxticks )
!$OMP CRITICAL (debugTimingLpTangent)
debug_cumLpCalls = debug_cumLpCalls + 1_pInt
debug_cumLpTicks = debug_cumLpTicks + tock - tick
!$OMP FLUSH (debug_cumLpTicks)
if ( tock < tick ) debug_cumLpTicks = debug_cumLpTicks + maxticks
!$OMP END CRITICAL (debugTimingLpTangent)
endif
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2014-11-12 22:10:50 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2015-08-05 02:56:22 +05:30
write ( 6 , '(a,i3,/)' ) '<< CRYST >> stress iteration ' , NiterationStressLp
2014-11-12 22:10:50 +05:30
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Lp_constitutive' , math_transpose33 ( Lp_constitutive )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Lpguess' , math_transpose33 ( Lpguess )
endif
#endif
2014-11-01 00:33:08 +05:30
!* update current residuum and check for convergence of loop
2016-01-09 21:31:30 +05:30
aTolLp = max ( rTol_crystalliteStress * max ( norm2 ( Lpguess ) , norm2 ( Lp_constitutive ) ) , & ! absolute tolerance from largest acceptable relative error
2014-11-13 18:23:20 +05:30
aTol_crystalliteStress ) ! minimum lower cutoff
residuumLp = Lpguess - Lp_constitutive
2014-11-12 22:10:50 +05:30
2015-09-10 18:31:33 +05:30
if ( any ( prec_isNaN ( residuumLp ) ) ) then ! NaN in residuum...
2014-11-12 22:10:50 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) &
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3,a)' ) '<< CRYST >> integrateStress encountered NaN at el (elFE) ip ipc ' , &
el , mesh_element ( 1 , el ) , ip , ipc , &
2014-11-13 18:23:20 +05:30
' ; iteration ' , NiterationStressLp , &
2014-11-12 22:10:50 +05:30
' >> returning..!'
#endif
return ! ...me = .false. to inform integrator about problem
2016-01-09 21:31:30 +05:30
elseif ( norm2 ( residuumLp ) < aTolLp ) then ! converged if below absolute tolerance
2014-11-12 22:10:50 +05:30
exit LpLoop ! ...leave iteration loop
2014-11-13 18:23:20 +05:30
elseif ( NiterationStressLp == 1_pInt &
2016-01-09 21:31:30 +05:30
. or . norm2 ( residuumLp ) < norm2 ( residuumLp_old ) ) then ! not converged, but improved norm of residuum (always proceed in first iteration)...
2014-11-13 18:23:20 +05:30
residuumLp_old = residuumLp ! ...remember old values and...
Lpguess_old = Lpguess
steplengthLp = steplengthLp0 ! ...proceed with normal step length (calculate new search direction)
2014-11-12 22:10:50 +05:30
else ! not converged and residuum not improved...
2014-11-13 18:23:20 +05:30
steplengthLp = 0.5_pReal * steplengthLp ! ...try with smaller step length in same direction
Lpguess = Lpguess_old + steplengthLp * deltaLp
2014-11-12 22:10:50 +05:30
cycle LpLoop
2014-11-01 00:33:08 +05:30
endif
2014-08-26 20:14:32 +05:30
2014-11-12 22:10:50 +05:30
2014-11-01 00:33:08 +05:30
!* calculate Jacobian for correction term
2014-11-13 18:23:20 +05:30
if ( mod ( jacoCounterLp , iJacoLpresiduum ) == 0_pInt ) then
2014-11-12 22:10:50 +05:30
dFe_dLp3333 = 0.0_pReal
introduced simpler multiplication and forall loops
matmul is ok for openmp, check in the web and run the state integration test.
Example program testing for new state update for rkck dot state:
program test
real, dimension(6,10) :: dotState=reshape(&
[1,1,1,1,1,1,1,1,1,1,&
2,2,2,2,2,2,2,2,2,2,&
3,3,3,3,3,3,3,3,3,3,&
4,4,4,4,4,4,4,4,4,4,&
5,5,5,5,5,5,5,5,5,5,&
6,6,6,6,6,6,6,6,6,6],[6,10])
real, dimension(10) :: residuum
real, dimension(6) :: B=2.5
integer :: i
residuum = B(1)*dotState(1,:)+&
B(2)*dotState(2,:)+&
B(3)*dotState(3,:)+&
B(4)*dotState(4,:)+&
B(5)*dotState(5,:)+&
B(6)*dotState(6,:)
do i =1,10
print*,residuum(i)
enddo
residuum = matmul(transpose(dotState),B)
do i =1,10
print*,residuum(i)
enddo
end program test
2015-04-01 22:15:53 +05:30
forall ( o = 1_pInt : 3_pInt , p = 1_pInt : 3_pInt ) &
2015-03-06 18:39:00 +05:30
dFe_dLp3333 ( o , 1 : 3 , p , 1 : 3 ) = A ( o , p ) * math_transpose33 ( invFi_new ) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
2014-11-13 18:23:20 +05:30
dFe_dLp3333 = - dt * dFe_dLp3333
dRLp_dLp = math_identity2nd ( 9_pInt ) &
2015-03-06 18:39:00 +05:30
- math_Plain3333to99 ( math_mul3333xx3333 ( math_mul3333xx3333 ( dLp_dT3333 , dT_dFe3333 ) , dFe_dLp3333 ) )
2014-11-13 18:23:20 +05:30
dRLp_dLp2 = dRLp_dLp ! will be overwritten in first call to LAPACK routine
work = math_plain33to9 ( residuumLp )
2014-11-01 00:33:08 +05:30
#if(FLOAT==8)
2014-11-13 18:23:20 +05:30
call dgesv ( 9 , 1 , dRLp_dLp2 , 9 , ipiv , work , 9 , ierr ) ! solve dRLp/dLp * delta Lp = -res for delta Lp
2014-11-01 00:33:08 +05:30
#elif(FLOAT==4)
2014-11-13 18:23:20 +05:30
call sgesv ( 9 , 1 , dRLp_dLp2 , 9 , ipiv , work , 9 , ierr ) ! solve dRLp/dLp * delta Lp = -res for delta Lp
2014-11-01 00:33:08 +05:30
#endif
if ( ierr / = 0_pInt ) then
2014-11-12 22:10:50 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)' ) '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip ipc ' , &
el , mesh_element ( 1 , el ) , ip , ipc
2014-11-12 22:10:50 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2014-11-12 22:10:50 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
write ( 6 , * )
2014-11-13 18:23:20 +05:30
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dR_dLp' , transpose ( dRLp_dLp )
2015-03-06 18:39:00 +05:30
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dFe_dLp' , transpose ( math_Plain3333to99 ( dFe_dLp3333 ) )
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dT_dFe_constitutive' , transpose ( math_Plain3333to99 ( dT_dFe3333 ) )
2015-03-18 23:33:18 +05:30
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dLp_dT_constitutive' , transpose ( math_Plain3333to99 ( dLp_dT3333 ) )
2014-11-12 22:10:50 +05:30
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> A' , math_transpose33 ( A )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> B' , math_transpose33 ( B )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Lp_constitutive' , math_transpose33 ( Lp_constitutive )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Lpguess' , math_transpose33 ( Lpguess )
endif
endif
#endif
2014-11-01 00:33:08 +05:30
return
endif
2014-11-12 22:10:50 +05:30
deltaLp = - math_plain9to33 ( work )
2014-11-01 00:33:08 +05:30
endif
2015-04-11 13:55:23 +05:30
jacoCounterLp = jacoCounterLp + 1_pInt ! increase counter for jaco update
2014-08-26 20:14:32 +05:30
2014-11-13 18:23:20 +05:30
Lpguess = Lpguess + steplengthLp * deltaLp
2014-08-26 20:14:32 +05:30
2014-11-12 22:10:50 +05:30
enddo LpLoop
2014-08-26 20:14:32 +05:30
2015-03-06 18:39:00 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionStress)
debug_StressLoopLpDistribution ( NiterationStressLp , numerics_integrationMode ) = &
debug_StressLoopLpDistribution ( NiterationStressLp , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionStress)
endif
2014-11-12 22:10:50 +05:30
!* calculate intermediate velocity gradient and its tangent from constitutive law
2014-08-26 20:14:32 +05:30
2015-03-06 18:39:00 +05:30
call constitutive_LiAndItsTangent ( Li_constitutive , dLi_dT3333 , dLi_dFi3333 , &
2016-01-17 20:20:33 +05:30
Tstar_v , Fi_new , ipc , ip , el )
2014-08-26 20:14:32 +05:30
2015-08-05 02:56:22 +05:30
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2015-08-05 02:56:22 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Li_constitutive' , math_transpose33 ( Li_constitutive )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Liguess' , math_transpose33 ( Liguess )
endif
#endif
2013-02-22 04:38:36 +05:30
!* update current residuum and check for convergence of loop
2014-08-26 20:14:32 +05:30
2016-01-09 21:31:30 +05:30
aTolLi = max ( rTol_crystalliteStress * max ( norm2 ( Liguess ) , norm2 ( Li_constitutive ) ) , & ! absolute tolerance from largest acceptable relative error
2015-04-11 13:55:23 +05:30
aTol_crystalliteStress ) ! minimum lower cutoff
2014-11-13 18:23:20 +05:30
residuumLi = Liguess - Li_constitutive
2015-09-10 18:31:33 +05:30
if ( any ( prec_isNaN ( residuumLi ) ) ) then ! NaN in residuum...
2015-04-11 13:55:23 +05:30
return ! ...me = .false. to inform integrator about problem
2016-01-09 21:31:30 +05:30
elseif ( norm2 ( residuumLi ) < aTolLi ) then ! converged if below absolute tolerance
2015-04-11 13:55:23 +05:30
exit LiLoop ! ...leave iteration loop
2014-11-13 18:23:20 +05:30
elseif ( NiterationStressLi == 1_pInt &
2016-01-09 21:31:30 +05:30
. or . norm2 ( residuumLi ) < norm2 ( residuumLi_old ) ) then ! not converged, but improved norm of residuum (always proceed in first iteration)...
2015-04-11 13:55:23 +05:30
residuumLi_old = residuumLi ! ...remember old values and...
2014-11-13 18:23:20 +05:30
Liguess_old = Liguess
2015-04-11 13:55:23 +05:30
steplengthLi = steplengthLi0 ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLi = 0.5_pReal * steplengthLi ! ...try with smaller step length in same direction
2014-11-13 18:23:20 +05:30
Liguess = Liguess_old + steplengthLi * deltaLi
2014-11-12 22:10:50 +05:30
cycle LiLoop
2013-02-22 04:38:36 +05:30
endif
2014-08-26 20:14:32 +05:30
!* calculate Jacobian for correction term
2014-11-13 18:23:20 +05:30
if ( mod ( jacoCounterLi , iJacoLpresiduum ) == 0_pInt ) then
temp_33 = math_mul33x33 ( math_mul33x33 ( A , B ) , invFi_current )
2015-03-06 18:39:00 +05:30
dFe_dLi3333 = 0.0_pReal
dFi_dLi3333 = 0.0_pReal
introduced simpler multiplication and forall loops
matmul is ok for openmp, check in the web and run the state integration test.
Example program testing for new state update for rkck dot state:
program test
real, dimension(6,10) :: dotState=reshape(&
[1,1,1,1,1,1,1,1,1,1,&
2,2,2,2,2,2,2,2,2,2,&
3,3,3,3,3,3,3,3,3,3,&
4,4,4,4,4,4,4,4,4,4,&
5,5,5,5,5,5,5,5,5,5,&
6,6,6,6,6,6,6,6,6,6],[6,10])
real, dimension(10) :: residuum
real, dimension(6) :: B=2.5
integer :: i
residuum = B(1)*dotState(1,:)+&
B(2)*dotState(2,:)+&
B(3)*dotState(3,:)+&
B(4)*dotState(4,:)+&
B(5)*dotState(5,:)+&
B(6)*dotState(6,:)
do i =1,10
print*,residuum(i)
enddo
residuum = matmul(transpose(dotState),B)
do i =1,10
print*,residuum(i)
enddo
end program test
2015-04-01 22:15:53 +05:30
forall ( o = 1_pInt : 3_pInt , p = 1_pInt : 3_pInt )
2015-04-11 13:55:23 +05:30
dFe_dLi3333 ( 1 : 3 , o , 1 : 3 , p ) = - dt * math_I3 ( o , p ) * temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
2015-03-06 18:39:00 +05:30
dFi_dLi3333 ( 1 : 3 , o , 1 : 3 , p ) = - dt * math_I3 ( o , p ) * invFi_current
introduced simpler multiplication and forall loops
matmul is ok for openmp, check in the web and run the state integration test.
Example program testing for new state update for rkck dot state:
program test
real, dimension(6,10) :: dotState=reshape(&
[1,1,1,1,1,1,1,1,1,1,&
2,2,2,2,2,2,2,2,2,2,&
3,3,3,3,3,3,3,3,3,3,&
4,4,4,4,4,4,4,4,4,4,&
5,5,5,5,5,5,5,5,5,5,&
6,6,6,6,6,6,6,6,6,6],[6,10])
real, dimension(10) :: residuum
real, dimension(6) :: B=2.5
integer :: i
residuum = B(1)*dotState(1,:)+&
B(2)*dotState(2,:)+&
B(3)*dotState(3,:)+&
B(4)*dotState(4,:)+&
B(5)*dotState(5,:)+&
B(6)*dotState(6,:)
do i =1,10
print*,residuum(i)
enddo
residuum = matmul(transpose(dotState),B)
do i =1,10
print*,residuum(i)
enddo
end program test
2015-04-01 22:15:53 +05:30
end forall
forall ( o = 1_pInt : 3_pInt , p = 1_pInt : 3_pInt ) &
2015-03-06 18:39:00 +05:30
dFi_dLi3333 ( 1 : 3 , 1 : 3 , o , p ) = math_mul33x33 ( math_mul33x33 ( Fi_new , dFi_dLi3333 ( 1 : 3 , 1 : 3 , o , p ) ) , Fi_new )
dRLi_dLi = math_identity2nd ( 9_pInt ) &
- math_Plain3333to99 ( math_mul3333xx3333 ( dLi_dT3333 , math_mul3333xx3333 ( dT_dFe3333 , dFe_dLi3333 ) + &
math_mul3333xx3333 ( dT_dFi3333 , dFi_dLi3333 ) ) ) &
- math_Plain3333to99 ( math_mul3333xx3333 ( dLi_dFi3333 , dFi_dLi3333 ) )
2014-11-13 18:23:20 +05:30
work = math_plain33to9 ( residuumLi )
2012-08-28 22:29:45 +05:30
#if(FLOAT==8)
2015-04-11 13:55:23 +05:30
call dgesv ( 9 , 1 , dRLi_dLi , 9 , ipiv , work , 9 , ierr ) ! solve dRLi/dLp * delta Li = -res for delta Li
2012-08-28 22:29:45 +05:30
#elif(FLOAT==4)
2015-04-11 13:55:23 +05:30
call sgesv ( 9 , 1 , dRLi_dLi , 9 , ipiv , work , 9 , ierr ) ! solve dRLi/dLp * delta Li = -res for delta Li
2012-08-28 22:29:45 +05:30
#endif
2015-08-05 02:56:22 +05:30
if ( ierr / = 0_pInt ) then
#ifndef _OPENMP
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)' ) '<< CRYST >> integrateStress failed on dR/dLi inversion at el ip ipc ' , &
el , mesh_element ( 1 , el ) , ip , ipc
2015-08-05 02:56:22 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2015-08-05 02:56:22 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
write ( 6 , * )
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dR_dLi' , transpose ( dRLi_dLi )
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dFe_dLi' , transpose ( math_Plain3333to99 ( dFe_dLi3333 ) )
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dT_dFi_constitutive' , transpose ( math_Plain3333to99 ( dT_dFi3333 ) )
write ( 6 , '(a,/,9(12x,9(e15.3,1x)/))' ) '<< CRYST >> dLi_dT_constitutive' , transpose ( math_Plain3333to99 ( dLi_dT3333 ) )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Li_constitutive' , math_transpose33 ( Li_constitutive )
write ( 6 , '(a,/,3(12x,3(e20.7,1x)/))' ) '<< CRYST >> Liguess' , math_transpose33 ( Liguess )
endif
endif
#endif
return
endif
2014-11-12 22:10:50 +05:30
deltaLi = - math_plain9to33 ( work )
2013-02-22 04:38:36 +05:30
endif
2015-04-11 13:55:23 +05:30
jacoCounterLi = jacoCounterLi + 1_pInt ! increase counter for jaco update
2014-08-26 20:14:32 +05:30
2014-11-13 18:23:20 +05:30
Liguess = Liguess + steplengthLi * deltaLi
2015-10-14 00:22:01 +05:30
enddo LiLoop
2014-08-26 20:14:32 +05:30
2015-03-06 18:39:00 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
!$OMP CRITICAL (distributionStress)
debug_StressLoopLiDistribution ( NiterationStressLi , numerics_integrationMode ) = &
debug_StressLoopLiDistribution ( NiterationStressLi , numerics_integrationMode ) + 1_pInt
!$OMP END CRITICAL (distributionStress)
endif
2013-02-22 04:38:36 +05:30
!* calculate new plastic and elastic deformation gradient
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
invFp_new = math_mul33x33 ( invFp_current , B )
2015-04-11 00:39:26 +05:30
invFp_new = invFp_new / math_det33 ( invFp_new ) ** ( 1.0_pReal / 3.0_pReal ) ! regularize by det
Fp_new = math_inv33 ( invFp_new )
2015-04-11 13:55:23 +05:30
if ( all ( abs ( Fp_new ) < = tiny ( 0.0_pReal ) ) ) then ! math_inv33 returns zero when failed, avoid floating point comparison
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelBasic ) / = 0_pInt ) then
2016-01-17 20:20:33 +05:30
write ( 6 , '(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)' ) '<< CRYST >> integrateStress failed on invFp_new inversion at el ip ipc ' , &
el , mesh_element ( 1 , el ) , ip , ipc , ' ; iteration ' , NiterationStressLp
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2013-10-19 00:27:28 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) &
write ( 6 , '(/,a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> invFp_new' , math_transpose33 ( invFp_new )
2013-02-22 04:38:36 +05:30
endif
2011-03-29 12:57:19 +05:30
#endif
2013-02-22 04:38:36 +05:30
return
endif
2015-03-06 18:39:00 +05:30
Fe_new = math_mul33x33 ( math_mul33x33 ( Fg_new , invFp_new ) , invFi_new ) ! calc resulting Fe
2014-08-26 20:14:32 +05:30
2014-01-16 16:06:40 +05:30
!* calculate 1st Piola-Kirchhoff stress
2014-08-26 20:14:32 +05:30
2016-01-17 20:20:33 +05:30
crystallite_P ( 1 : 3 , 1 : 3 , ipc , ip , el ) = math_mul33x33 ( math_mul33x33 ( Fg_new , invFp_new ) , &
2014-10-20 21:13:28 +05:30
math_mul33x33 ( math_Mandel6to33 ( Tstar_v ) , &
2015-03-06 18:39:00 +05:30
math_transpose33 ( invFp_new ) ) )
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* store local values in global variables
2014-08-26 20:14:32 +05:30
2016-01-17 20:20:33 +05:30
crystallite_Lp ( 1 : 3 , 1 : 3 , ipc , ip , el ) = Lpguess
crystallite_Li ( 1 : 3 , 1 : 3 , ipc , ip , el ) = Liguess
crystallite_Tstar_v ( 1 : 6 , ipc , ip , el ) = Tstar_v
crystallite_Fp ( 1 : 3 , 1 : 3 , ipc , ip , el ) = Fp_new
crystallite_Fi ( 1 : 3 , 1 : 3 , ipc , ip , el ) = Fi_new
crystallite_Fe ( 1 : 3 , 1 : 3 , ipc , ip , el ) = Fe_new
crystallite_invFp ( 1 : 3 , 1 : 3 , ipc , ip , el ) = invFp_new
crystallite_invFi ( 1 : 3 , 1 : 3 , ipc , ip , el ) = invFi_new
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!* set return flag to true
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
crystallite_integrateStress = . true .
2011-03-29 12:57:19 +05:30
#ifndef _OPENMP
2013-02-22 04:38:36 +05:30
if ( iand ( debug_level ( debug_crystallite ) , debug_levelExtensive ) / = 0_pInt &
2016-01-17 20:20:33 +05:30
. and . ( ( el == debug_e . and . ip == debug_i . and . ipc == debug_g ) &
2014-08-26 20:14:32 +05:30
. or . . not . iand ( debug_level ( debug_crystallite ) , debug_levelSelective ) / = 0_pInt ) ) then
2016-01-18 21:43:27 +05:30
write ( 6 , '(a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> P / MPa' , math_transpose33 ( crystallite_P ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) * 1.0e-6_pReal
2013-02-22 04:38:36 +05:30
write ( 6 , '(a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Cauchy / MPa' , &
2016-01-18 21:43:27 +05:30
math_mul33x33 ( crystallite_P ( 1 : 3 , 1 : 3 , ipc , ip , el ) , math_transpose33 ( Fg_new ) ) * 1.0e-6_pReal / math_det33 ( Fg_new )
2013-02-22 04:38:36 +05:30
write ( 6 , '(a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Fe Lp Fe^-1' , &
2016-01-18 21:43:27 +05:30
math_transpose33 ( math_mul33x33 ( Fe_new , math_mul33x33 ( crystallite_Lp ( 1 : 3 , 1 : 3 , ipc , ip , el ) , math_inv33 ( Fe_new ) ) ) ) ! transpose to get correct print out order
write ( 6 , '(a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Fp' , math_transpose33 ( crystallite_Fp ( 1 : 3 , 1 : 3 , ipc , ip , el ) )
write ( 6 , '(a,/,3(12x,3(f12.7,1x)/))' ) '<< CRYST >> Fi' , math_transpose33 ( crystallite_Fi ( 1 : 3 , 1 : 3 , ipc , ip , el ) )
2013-02-22 04:38:36 +05:30
endif
2011-03-29 12:57:19 +05:30
#endif
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
end function crystallite_integrateStress
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief calculates orientations and disorientations (in case of single grain ips)
!--------------------------------------------------------------------------------------------------
2012-03-09 01:55:28 +05:30
subroutine crystallite_orientations
2013-11-21 16:28:41 +05:30
use math , only : &
2016-01-13 03:09:31 +05:30
math_rotationalPart33 , &
2013-11-21 16:28:41 +05:30
math_RtoQ , &
math_qConj
use FEsolving , only : &
2014-08-26 20:14:32 +05:30
FEsolving_execElem , &
2013-11-21 16:28:41 +05:30
FEsolving_execIP
use material , only : &
material_phase , &
homogenization_Ngrains , &
2014-09-03 01:16:52 +05:30
plasticState
2013-11-21 16:28:41 +05:30
use mesh , only : &
mesh_element , &
mesh_ipNeighborhood , &
FE_NipNeighbors , &
FE_geomtype , &
FE_celltype
2014-02-28 18:58:27 +05:30
use lattice , only : &
2014-03-09 02:20:31 +05:30
lattice_qDisorientation , &
lattice_structure
2014-12-08 21:25:30 +05:30
use plastic_nonlocal , only : &
plastic_nonlocal_updateCompatibility
2014-07-02 17:57:39 +05:30
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
integer ( pInt ) &
2016-01-17 23:26:24 +05:30
c , & !< counter in integration point component loop
i , & !< counter in integration point loop
e , & !< counter in element loop
n , & !< counter in neighbor loop
neighboring_e , & !< neighbor element
neighboring_i , & !< neighbor integration point
2013-11-21 16:28:41 +05:30
myPhase , & ! phase
2014-03-12 05:25:40 +05:30
neighboringPhase
2013-11-21 16:28:41 +05:30
real ( pReal ) , dimension ( 4 ) :: &
orientation
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- CALCULATE ORIENTATION AND LATTICE ROTATION ---
2014-08-26 20:14:32 +05:30
2016-01-13 03:09:31 +05:30
!$OMP PARALLEL DO PRIVATE(orientation)
2013-02-22 04:38:36 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2016-01-17 23:26:24 +05:30
do c = 1_pInt , homogenization_Ngrains ( mesh_element ( 3 , e ) )
2014-07-02 17:57:39 +05:30
! somehow this subroutine is not threadsafe, so need critical statement here; not clear, what exactly the problem is
2014-08-26 20:14:32 +05:30
!$OMP CRITICAL (polarDecomp)
2016-01-17 23:26:24 +05:30
orientation = math_RtoQ ( transpose ( math_rotationalPart33 ( crystallite_Fe ( 1 : 3 , 1 : 3 , c , i , e ) ) ) ) ! rotational part from polar decomposition as quaternion
2013-02-27 16:02:37 +05:30
!$OMP END CRITICAL (polarDecomp)
2016-01-17 23:26:24 +05:30
crystallite_rotation ( 1 : 4 , c , i , e ) = lattice_qDisorientation ( crystallite_orientation0 ( 1 : 4 , c , i , e ) , & ! active rotation from ori0
2014-03-09 02:20:31 +05:30
orientation ) ! to current orientation (with no symmetry)
2016-01-17 23:26:24 +05:30
crystallite_orientation ( 1 : 4 , c , i , e ) = orientation
2016-01-13 03:09:31 +05:30
enddo ; enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- UPDATE SOME ADDITIONAL VARIABLES THAT ARE NEEDED FOR NONLOCAL MATERIAL ---
2014-03-12 05:25:40 +05:30
! --- we use crystallite_orientation from above, so need a separate loop
2014-08-26 20:14:32 +05:30
2014-03-12 20:59:14 +05:30
!$OMP PARALLEL DO PRIVATE(myPhase,neighboring_e,neighboring_i,neighboringPhase)
2013-02-22 04:38:36 +05:30
do e = FEsolving_execElem ( 1 ) , FEsolving_execElem ( 2 )
do i = FEsolving_execIP ( 1 , e ) , FEsolving_execIP ( 2 , e )
2015-10-14 00:22:01 +05:30
myPhase = material_phase ( 1 , i , e ) ! get my phase (non-local models make no sense with more than one grain per material point)
2014-09-03 01:16:52 +05:30
if ( plasticState ( myPhase ) % nonLocal ) then ! if nonlocal model
2013-02-22 04:38:36 +05:30
! --- calculate disorientation between me and my neighbor ---
2014-08-26 20:14:32 +05:30
2013-04-22 19:05:35 +05:30
do n = 1_pInt , FE_NipNeighbors ( FE_celltype ( FE_geomtype ( mesh_element ( 2 , e ) ) ) ) ! loop through my neighbors
2013-02-22 04:38:36 +05:30
neighboring_e = mesh_ipNeighborhood ( 1 , n , i , e )
neighboring_i = mesh_ipNeighborhood ( 2 , n , i , e )
2014-03-12 20:59:14 +05:30
if ( neighboring_e > 0 . and . neighboring_i > 0 ) then ! if neighbor exists
2013-02-22 04:38:36 +05:30
neighboringPhase = material_phase ( 1 , neighboring_i , neighboring_e ) ! get my neighbor's phase
2014-09-03 01:16:52 +05:30
if ( plasticState ( neighboringPhase ) % nonLocal ) then ! neighbor got also nonlocal plasticity
2014-03-12 05:25:40 +05:30
if ( lattice_structure ( myPhase ) == lattice_structure ( neighboringPhase ) ) then ! if my neighbor has same crystal structure like me
2013-02-22 04:38:36 +05:30
crystallite_disorientation ( : , n , 1 , i , e ) = &
2014-02-28 18:58:27 +05:30
lattice_qDisorientation ( crystallite_orientation ( 1 : 4 , 1 , i , e ) , &
2014-08-26 20:14:32 +05:30
crystallite_orientation ( 1 : 4 , 1 , neighboring_i , neighboring_e ) , &
2016-01-13 03:09:31 +05:30
lattice_structure ( myPhase ) ) ! calculate disorientation for given symmetry
2013-02-22 04:38:36 +05:30
else ! for neighbor with different phase
2013-11-21 16:28:41 +05:30
crystallite_disorientation ( : , n , 1 , i , e ) = [ 0.0_pReal , 1.0_pReal , 0.0_pReal , 0.0_pReal ] ! 180 degree rotation about 100 axis
2013-02-22 04:38:36 +05:30
endif
else ! for neighbor with local plasticity
2013-11-21 16:28:41 +05:30
crystallite_disorientation ( : , n , 1 , i , e ) = [ - 1.0_pReal , 0.0_pReal , 0.0_pReal , 0.0_pReal ] ! homomorphic identity
2013-02-22 04:38:36 +05:30
endif
else ! no existing neighbor
2013-11-21 16:28:41 +05:30
crystallite_disorientation ( : , n , 1 , i , e ) = [ - 1.0_pReal , 0.0_pReal , 0.0_pReal , 0.0_pReal ] ! homomorphic identity
2013-02-22 04:38:36 +05:30
endif
enddo
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
! --- calculate compatibility and transmissivity between me and my neighbor ---
2014-08-26 20:14:32 +05:30
2014-12-08 21:25:30 +05:30
call plastic_nonlocal_updateCompatibility ( crystallite_orientation , i , e )
2014-08-26 20:14:32 +05:30
2013-02-22 04:38:36 +05:30
endif
2016-01-13 03:09:31 +05:30
enddo ; enddo
2013-02-22 04:38:36 +05:30
!$OMP END PARALLEL DO
2014-08-26 20:14:32 +05:30
2012-03-09 01:55:28 +05:30
end subroutine crystallite_orientations
2009-12-18 21:16:33 +05:30
2013-02-22 04:38:36 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief return results of particular grain
!--------------------------------------------------------------------------------------------------
2013-10-16 18:34:59 +05:30
function crystallite_postResults ( ipc , ip , el )
2013-05-08 17:32:30 +05:30
use math , only : &
math_qToEuler , &
2013-06-07 15:05:00 +05:30
math_qToEulerAxisAngle , &
2013-05-08 17:32:30 +05:30
math_mul33x33 , &
math_transpose33 , &
math_det33 , &
math_I3 , &
inDeg , &
math_Mandel6to33 , &
math_qMul , &
math_qConj
use mesh , only : &
mesh_element , &
mesh_ipVolume , &
mesh_maxNipNeighbors , &
mesh_ipNeighborhood , &
FE_NipNeighbors , &
FE_geomtype , &
FE_celltype
use material , only : &
2014-06-30 20:17:30 +05:30
plasticState , &
2015-05-28 22:32:23 +05:30
sourceState , &
2013-05-08 17:32:30 +05:30
microstructure_crystallite , &
crystallite_Noutput , &
material_phase , &
material_texture , &
homogenization_Ngrains
use constitutive , only : &
2014-09-03 01:16:52 +05:30
constitutive_homogenizedC , &
constitutive_postResults
2014-08-26 20:14:32 +05:30
2009-05-07 21:57:36 +05:30
implicit none
2013-11-21 16:28:41 +05:30
integer ( pInt ) , intent ( in ) :: &
el , & !< element index
ip , & !< integration point index
ipc !< grain index
2009-05-07 21:57:36 +05:30
2014-08-10 16:44:43 +05:30
real ( pReal ) , dimension ( 1 + crystallite_sizePostResults ( microstructure_crystallite ( mesh_element ( 4 , el ) ) ) + &
1 + plasticState ( material_phase ( ipc , ip , el ) ) % sizePostResults + &
2015-10-14 00:22:01 +05:30
sum ( sourceState ( material_phase ( ipc , ip , el ) ) % p ( : ) % sizePostResults ) ) :: &
2014-08-10 16:44:43 +05:30
crystallite_postResults
2013-11-21 16:28:41 +05:30
real ( pReal ) , dimension ( 3 , 3 ) :: &
Ee
real ( pReal ) , dimension ( 4 ) :: &
rotation
real ( pReal ) :: &
detF
integer ( pInt ) :: &
o , &
c , &
crystID , &
mySize , &
n
2015-10-14 00:22:01 +05:30
2010-02-25 23:09:11 +05:30
2013-05-08 17:32:30 +05:30
crystID = microstructure_crystallite ( mesh_element ( 4 , el ) )
2010-02-25 23:09:11 +05:30
crystallite_postResults = 0.0_pReal
c = 0_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 ) = real ( crystallite_sizePostResults ( crystID ) , pReal ) ! size of results from cryst
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
c = c + 1_pInt
2014-08-26 20:14:32 +05:30
2012-02-21 22:01:37 +05:30
do o = 1_pInt , crystallite_Noutput ( crystID )
2011-08-01 23:40:55 +05:30
mySize = 0_pInt
2013-12-12 22:39:59 +05:30
select case ( crystallite_outputID ( o , crystID ) )
case ( phase_ID )
2011-08-01 23:40:55 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
crystallite_postResults ( c + 1 ) = real ( material_phase ( ipc , ip , el ) , pReal ) ! phaseID of grain
2013-12-12 22:39:59 +05:30
case ( texture_ID )
2011-08-01 23:40:55 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
crystallite_postResults ( c + 1 ) = real ( material_texture ( ipc , ip , el ) , pReal ) ! textureID of grain
2013-12-12 22:39:59 +05:30
case ( volume_ID )
2011-08-01 23:40:55 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
detF = math_det33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) ! V_current = det(F) * V_reference
2013-11-21 16:28:41 +05:30
crystallite_postResults ( c + 1 ) = detF * mesh_ipVolume ( ip , el ) &
/ homogenization_Ngrains ( mesh_element ( 3 , el ) ) ! grain volume (not fraction but absolute)
2013-12-12 22:39:59 +05:30
case ( orientation_ID )
2011-08-01 23:40:55 +05:30
mySize = 4_pInt
2013-10-16 18:34:59 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = crystallite_orientation ( 1 : 4 , ipc , ip , el ) ! grain orientation as quaternion
2013-12-12 22:39:59 +05:30
case ( eulerangles_ID )
2011-08-01 23:40:55 +05:30
mySize = 3_pInt
2013-11-21 16:28:41 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = inDeg &
* math_qToEuler ( crystallite_orientation ( 1 : 4 , ipc , ip , el ) ) ! grain orientation as Euler angles in degree
2013-12-12 22:39:59 +05:30
case ( grainrotation_ID )
2011-08-01 23:40:55 +05:30
mySize = 4_pInt
2013-06-07 15:05:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
math_qToEulerAxisAngle ( crystallite_rotation ( 1 : 4 , ipc , ip , el ) ) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates
2013-10-19 00:27:28 +05:30
crystallite_postResults ( c + 4 ) = inDeg * crystallite_postResults ( c + 4 ) ! angle in degree
2013-12-12 22:39:59 +05:30
case ( grainrotationx_ID )
2013-01-16 14:15:41 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
rotation = math_qToEulerAxisAngle ( crystallite_rotation ( 1 : 4 , ipc , ip , el ) ) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates
2013-10-19 00:27:28 +05:30
crystallite_postResults ( c + 1 ) = inDeg * rotation ( 1 ) * rotation ( 4 ) ! angle in degree
2013-12-12 22:39:59 +05:30
case ( grainrotationy_ID )
2013-01-16 14:15:41 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
rotation = math_qToEulerAxisAngle ( crystallite_rotation ( 1 : 4 , ipc , ip , el ) ) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates
2013-10-19 00:27:28 +05:30
crystallite_postResults ( c + 1 ) = inDeg * rotation ( 2 ) * rotation ( 4 ) ! angle in degree
2013-12-12 22:39:59 +05:30
case ( grainrotationz_ID )
2013-01-16 14:15:41 +05:30
mySize = 1_pInt
2013-10-16 18:34:59 +05:30
rotation = math_qToEulerAxisAngle ( crystallite_rotation ( 1 : 4 , ipc , ip , el ) ) ! grain rotation away from initial orientation as axis-angle in sample reference coordinates
2013-10-19 00:27:28 +05:30
crystallite_postResults ( c + 1 ) = inDeg * rotation ( 3 ) * rotation ( 4 ) ! angle in degree
2011-05-11 22:08:45 +05:30
! remark: tensor output is of the form 11,12,13, 21,22,23, 31,32,33
! thus row index i is slow, while column index j is fast. reminder: "row is slow"
2014-08-26 20:14:32 +05:30
2013-12-12 22:39:59 +05:30
case ( defgrad_ID )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_transpose33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( e_ID )
2012-01-20 15:55:35 +05:30
mySize = 9_pInt
crystallite_postResults ( c + 1 : c + mySize ) = 0.5_pReal * reshape ( ( math_mul33x33 ( &
2013-10-16 18:34:59 +05:30
math_transpose33 ( crystallite_partionedF ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , &
crystallite_partionedF ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) - math_I3 ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( fe_ID )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_transpose33 ( crystallite_Fe ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( ee_ID )
2013-10-16 18:34:59 +05:30
Ee = 0.5_pReal * ( math_mul33x33 ( math_transpose33 ( crystallite_Fe ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , &
crystallite_Fe ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) - math_I3 )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2012-02-16 00:28:38 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = reshape ( Ee , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( fp_ID )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_transpose33 ( crystallite_Fp ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2015-03-06 18:39:00 +05:30
case ( fi_ID )
mySize = 9_pInt
crystallite_postResults ( c + 1 : c + mySize ) = &
reshape ( math_transpose33 ( crystallite_Fi ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( lp_ID )
2011-02-25 13:45:26 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_transpose33 ( crystallite_Lp ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2015-03-06 18:39:00 +05:30
case ( li_ID )
mySize = 9_pInt
crystallite_postResults ( c + 1 : c + mySize ) = &
reshape ( math_transpose33 ( crystallite_Li ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( p_ID )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_transpose33 ( crystallite_P ( 1 : 3 , 1 : 3 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( s_ID )
2010-05-18 13:27:13 +05:30
mySize = 9_pInt
2013-05-08 23:18:00 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = &
2013-10-16 18:34:59 +05:30
reshape ( math_Mandel6to33 ( crystallite_Tstar_v ( 1 : 6 , ipc , ip , el ) ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( elasmatrix_ID )
2012-03-01 18:36:09 +05:30
mySize = 36_pInt
2013-10-16 18:34:59 +05:30
crystallite_postResults ( c + 1 : c + mySize ) = reshape ( constitutive_homogenizedC ( ipc , ip , el ) , [ mySize ] )
2013-12-12 22:39:59 +05:30
case ( neighboringelement_ID )
2013-05-08 17:32:30 +05:30
mySize = mesh_maxNipNeighbors
crystallite_postResults ( c + 1 : c + mySize ) = 0.0_pReal
forall ( n = 1_pInt : FE_NipNeighbors ( FE_celltype ( FE_geomtype ( mesh_element ( 2 , el ) ) ) ) ) &
crystallite_postResults ( c + n ) = real ( mesh_ipNeighborhood ( 1 , n , ip , el ) , pReal )
2013-12-12 22:39:59 +05:30
case ( neighboringip_ID )
2013-05-08 17:32:30 +05:30
mySize = mesh_maxNipNeighbors
crystallite_postResults ( c + 1 : c + mySize ) = 0.0_pReal
forall ( n = 1_pInt : FE_NipNeighbors ( FE_celltype ( FE_geomtype ( mesh_element ( 2 , el ) ) ) ) ) &
crystallite_postResults ( c + n ) = real ( mesh_ipNeighborhood ( 2 , n , ip , el ) , pReal )
2010-02-25 23:09:11 +05:30
end select
2011-08-01 23:40:55 +05:30
c = c + mySize
2010-02-25 23:09:11 +05:30
enddo
2011-05-11 22:08:45 +05:30
2014-06-30 20:17:30 +05:30
crystallite_postResults ( c + 1 ) = real ( plasticState ( material_phase ( ipc , ip , el ) ) % sizePostResults , pReal ) ! size of constitutive results
c = c + 1_pInt
2014-09-23 16:08:20 +05:30
if ( size ( crystallite_postResults ) - c > 0_pInt ) &
crystallite_postResults ( c + 1 : size ( crystallite_postResults ) ) = &
2014-06-30 20:17:30 +05:30
constitutive_postResults ( crystallite_Tstar_v ( 1 : 6 , ipc , ip , el ) , crystallite_Fe , &
2014-10-10 17:58:57 +05:30
ipc , ip , el )
2014-06-25 04:51:25 +05:30
2012-03-09 01:55:28 +05:30
end function crystallite_postResults
2009-05-07 21:57:36 +05:30
2013-02-22 04:38:36 +05:30
end module crystallite