diff --git a/VERSION b/VERSION index 3cad8e739..798bb3353 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-918-gae868d3 +v2.0.1-924-ge1bfde9 diff --git a/src/IO.f90 b/src/IO.f90 index d067a84c0..a00559708 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1581,7 +1581,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (601_pInt) msg = 'Ping-Pong needed when using non-local plasticity' case (602_pInt) - msg = 'invalid element/IP/component (grain) selected for debug' + msg = 'invalid selection for debug' !------------------------------------------------------------------------------------------------- ! DAMASK_marc errors diff --git a/src/crystallite.f90 b/src/crystallite.f90 index bb36bafe5..781bb205c 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -3103,35 +3103,49 @@ logical function crystallite_stateJump(ipc,ip,el) implicit none integer(pInt), intent(in):: & - el, & ! element index - ip, & ! integration point index + el, & ! element index + ip, & ! integration point index ipc ! grain index integer(pInt) :: & c, & p, & mySource, & + myOffsetPlasticDeltaState, & + myOffsetSourceDeltaState, & mySizePlasticDeltaState, & mySizeSourceDeltaState - c= phasememberAt(ipc,ip,el) + 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) - mySizePlasticDeltaState = plasticState(p)%sizeDeltaState - if( any(IEEE_is_NaN(plasticState(p)%deltaState(:,c)))) then ! NaN occured in deltaState + + myOffsetPlasticDeltaState = plasticState(p)%offsetDeltaState + mySizePlasticDeltaState = plasticState(p)%sizeDeltaState + + if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c)))) then ! NaN occured in deltaState crystallite_stateJump = .false. return endif - plasticState(p)%state(1:mySizePlasticDeltaState,c) = plasticState(p)%state(1:mySizePlasticDeltaState,c) + & - plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + + plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & + myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) = & + plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & + myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) + & + plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + do mySource = 1_pInt, phase_Nsources(p) - mySizeSourceDeltaState = sourceState(p)%p(mySource)%sizeDeltaState - if( any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(:,c)))) then ! NaN occured in deltaState + myOffsetSourceDeltaState = sourceState(p)%p(mySource)%offsetDeltaState + mySizeSourceDeltaState = sourceState(p)%p(mySource)%sizeDeltaState + if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c)))) then ! NaN occured in deltaState crystallite_stateJump = .false. return endif - sourceState(p)%p(mySource)%state(1:mySizeSourceDeltaState,c) = & - sourceState(p)%p(mySource)%state(1:mySizeSourceDeltaState,c) + & + sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & + myOffsetSourceDeltaState + mySizeSourceDeltaState,c) = & + sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & + myOffsetSourceDeltaState + mySizeSourceDeltaState,c) + & sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c) enddo @@ -3142,7 +3156,9 @@ logical function crystallite_stateJump(ipc,ip,el) .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3, /)') '<< CRYST >> update state at el ip ipc ',el,ip,ipc 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) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & + plasticState(p)%state(myOffsetSourceDeltaState + 1_pInt : & + myOffsetSourceDeltaState + mySizeSourceDeltaState,c) endif #endif diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c8c5fad01..93fe50631 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -471,7 +471,7 @@ subroutine homogenization_init flush(6) if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) & - call IO_error(602_pInt,ext_msg='component (grain)') + call IO_error(602_pInt,ext_msg='component (grain)', el=debug_e, g=debug_g) end subroutine homogenization_init diff --git a/src/math.f90 b/src/math.f90 index e9c921cd0..f18e4af25 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -3,7 +3,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Mathematical library, including random number generation and tensor represenations +!> @brief Mathematical library, including random number generation and tensor representations !-------------------------------------------------------------------------------------------------- module math use prec, only: & @@ -174,10 +174,8 @@ contains subroutine math_init use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) - use prec, only: tol_math_check - use numerics, only: & - fixedSeed - use IO, only: IO_error, IO_timeStamp + use numerics, only: fixedSeed + use IO, only: IO_timeStamp implicit none integer(pInt) :: i @@ -227,12 +225,10 @@ end subroutine math_init !-------------------------------------------------------------------------------------------------- subroutine math_check - use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use prec, only: tol_math_check - use numerics, only: & - fixedSeed - use IO, only: IO_error, IO_timeStamp + use IO, only: IO_error + implicit none character(len=64) :: error_msg real(pReal), dimension(3,3) :: R,R2 @@ -269,7 +265,7 @@ subroutine math_check if ( any(abs( q-q2) > tol_math_check) .and. & any(abs(-q-q2) > tol_math_check) ) then write (error_msg, '(a,e14.6)' ) & - 'quat -> euler -> quatmaximum deviation ',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) + 'quat -> euler -> quat maximum deviation ',min(maxval(abs( q-q2)),maxval(abs(-q-q2))) call IO_error(401_pInt,ext_msg=error_msg) endif @@ -374,21 +370,19 @@ end subroutine math_qsort !-------------------------------------------------------------------------------------------------- !> @brief vector expansion -!> @details takes a set of numbers (a,b,c,...) and corresponding multipliers (x,y,z,...) -!> to return a vector of x times a, y times b, z times c, ... +!> @details takes a set of numbers (a,b,c,...) and corresponding multiples (x,y,z,...) +!> to return a vector of x times a, y times b, z times c, ... !-------------------------------------------------------------------------------------------------- pure function math_expand(what,how) implicit none - real(pReal), dimension(:), intent(in) :: what - integer(pInt), dimension(:), intent(in) :: how + real(pReal), dimension(:), intent(in) :: what + integer(pInt), dimension(:), intent(in) :: how real(pReal), dimension(sum(how)) :: math_expand - integer(pInt) :: i,o + integer(pInt) :: i - o = 1_pInt - do i = 1, size(how) - math_expand(o:o+how(i)-1_pInt) = what(1+mod(i-1,size(what))) - o = o + how(i) + do i = 1_pInt, size(how) + math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1_pInt,size(what))+1_pInt) enddo end function math_expand @@ -708,22 +702,20 @@ end function math_mul66x6 pure function math_exp33(A,n) implicit none - integer(pInt) :: i,order + integer(pInt) :: i integer(pInt), intent(in), optional :: n - real(pReal), dimension(3,3), intent(in) :: A - real(pReal), dimension(3,3) :: B,math_exp33 - real(pReal) :: invfac - - order = merge(n,5_pInt,present(n)) + real(pReal), dimension(3,3), intent(in) :: A + real(pReal), dimension(3,3) :: B, math_exp33 + real(pReal) :: invFac B = math_I3 ! init - invfac = 1.0_pReal ! 0! + invFac = 1.0_pReal ! 0! math_exp33 = B ! A^0 = eye2 - do i = 1_pInt,n - invfac = invfac/real(i,pReal) ! invfac = 1/i! + do i = 1_pInt, merge(n,5_pInt,present(n)) + invFac = invFac/real(i,pReal) ! invfac = 1/i! B = math_mul33x33(B,A) - math_exp33 = math_exp33 + invfac*B ! exp = SUM (A^i)/i! + math_exp33 = math_exp33 + invFac*B ! exp = SUM (A^i)/i! enddo end function math_exp33 diff --git a/src/prec.f90 b/src/prec.f90 index 44e9d7ac1..c130ba007 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -39,15 +39,16 @@ module prec !http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState integer(pInt) :: & - sizeState = 0_pInt , & !< size of state - sizeDotState = 0_pInt, & !< size of dot state, i.e. parts of the state that are integrated - sizeDeltaState = 0_pInt, & !< size of delta state, i.e. parts of the state that have discontinuous rates - sizePostResults = 0_pInt !< size of output data + sizeState = 0_pInt, & !< size of state + sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates + offsetDeltaState = 0_pInt, & !< offset of delta state + sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDot) follows time evolution by deltaState increments + sizePostResults = 0_pInt !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState - real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/dot/deltaState. However, they will never point to something, but are rather allocated and, hence, contiguous + real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous + state0, & state, & !< state - state0, & !< state at beginning of increment dotState, & !< rate of state change deltaState !< increment of state change real(pReal), allocatable, dimension(:,:) :: &