diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index f26a821b4..aea276d4f 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -394,9 +394,12 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature, dt, el k = 1:mesh_NcpElems ) & constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites #ifdef NEWSTATE -!(:) needed? -plasticState(:)%state0=plasticState(:)%state +!(:) needed? A component cannot be an array if the encompassing structure is an array +!plasticState(:)%state0(:,:)=plasticState(:)%state(:,:) + forall ( i = 1:size(plasticState)) & + plasticState(i)%state0= plasticState(i)%state ! microstructure of crystallites #endif + if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then !$OMP CRITICAL (write2out) write(6,'(a)') '<< CPFEM >> aging states' diff --git a/code/DAMASK_spectral_driver.f90 b/code/DAMASK_spectral_driver.f90 index d7fb5a542..ac56f410c 100644 --- a/code/DAMASK_spectral_driver.f90 +++ b/code/DAMASK_spectral_driver.f90 @@ -135,6 +135,7 @@ program DAMASK_spectral_Driver !-------------------------------------------------------------------------------------------------- ! init DAMASK (all modules) call CPFEM_initAll(temperature = 300.0_pReal, el = 1_pInt, ip = 1_pInt) + !print*, 'Flag' write(6,'(/,a)') ' <<<+- DAMASK_spectral_driver init -+>>>' write(6,'(a)') ' $Id$' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 5460be53d..0beddd718 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -50,6 +50,13 @@ module constitutive private :: & constitutive_hooke_TandItsTangent + +#if defined(HDF) || defined(NEWSTATE) + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: mappingConstitutive + integer(pInt), dimension(:,:,:), allocatable, public, protected :: mappingCrystallite + integer(pInt), dimension(:), allocatable :: ConstitutivePosition + integer(pInt), dimension(:), allocatable :: CrystallitePosition +#endif contains @@ -140,10 +147,6 @@ subroutine constitutive_init character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready logical :: knownPlasticity, nonlocalConstitutionPresent #if defined(HDF) || defined(NEWSTATE) - integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: mappingConstitutive - integer(pInt), dimension(:,:,:), allocatable, public, protected :: mappingCrystallite - integer(pInt), dimension(:), allocatable :: ConstitutivePosition - integer(pInt), dimension(:), allocatable :: CrystallitePosition allocate(mappingConstitutive(homogenization_maxngrains,mesh_maxNips,mesh_ncpelems,2),source=0_pInt) allocate(mappingCrystallite (homogenization_maxngrains,mesh_ncpelems,2),source=0_pInt) allocate(ConstitutivePosition(material_nphase),source=0_pInt) @@ -256,7 +259,7 @@ subroutine constitutive_init instance = phase_plasticityInstance(phase) #if defined(HDF) || defined(NEWSTATE) ConstitutivePosition(phase) = ConstitutivePosition(phase)+1_pInt - mappingConstitutive(g,e,i,1:2) = [ConstitutivePosition(phase),phase] + mappingConstitutive(g,i,e,1:2) = [ConstitutivePosition(phase),phase] #endif select case(phase_plasticity(material_phase(g,i,e))) case (PLASTICITY_NONE_ID) diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 91897e758..0f501390b 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -155,8 +155,12 @@ subroutine constitutive_phenopowerlaw_init(fileUnit) write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a)') ' $Id$' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,*) '******Flag in DAMASK********' #include "compilation_info.f90" + + +! write(6,*) 'lattice_maxNslipFamily=',lattice_maxNslipFamily maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) if (maxNinstance == 0_pInt) return @@ -698,7 +702,7 @@ pure subroutine constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar ((abs(tau_slip_neg(j))/state%p(j))**constitutive_phenopowerlaw_n_slip(instance))*& sign(1.0_pReal,tau_slip_neg(j)) Lp = Lp + (1.0_pReal-state%p(index_F))*& ! 1-F - (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) + (gdot_slip_pos(j)+gdot_slip_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,phase) +1 !-------------------------------------------------------------------------------------------------- ! Calculation of the tangent of Lp diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 04613076e..e3f9b15d0 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -3547,4 +3547,11 @@ function crystallite_postResults(ipc, ip, el) end function crystallite_postResults +!subroutine gradients +!use DAMASK_spectral_utilities + +!implicit none + +!end subroutine gradients + end module crystallite diff --git a/code/homogenization.f90 b/code/homogenization.f90 index a5d5059fa..4a33bb9d1 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -292,10 +292,16 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) mesh_NcpElems, & mesh_maxNips use material, only: & +#ifdef NEWSTATE + plasticState, & +#endif homogenization_Ngrains use constitutive, only: & constitutive_state0, & constitutive_partionedState0, & +#ifdef NEWSTATE + mappingConstitutive, & +#endif constitutive_state use crystallite, only: & crystallite_heat, & @@ -379,12 +385,12 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) homogenization_subState0(i,e)%p = homogenization_state0(i,e)%p ! ...internal homogenization state enddo #ifdef NEWSTATE - do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(mesh_element(3,e)) do i = FEsolving_execIP(1,e), FEsolving_execIP(2,e) do g = 1, myNgrains - plasticSate(mappingConstitutive(g,i,e,1))%partionedState0(mappingConstitutive(g,i,e,2)) = & - plasticSate(mappingConstitutive(g,i,e,1))%state0(mappingConstitutive(g,i,e,2)) + plasticState(mappingConstitutive(g,i,e,1))%partionedState0(:,mappingConstitutive(g,i,e,2)) = & + plasticState(mappingConstitutive(g,i,e,1))%state0(:,mappingConstitutive(g,i,e,2)) + enddo + enddo #endif NiterationHomog = 0_pInt @@ -425,11 +431,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e)! ...stiffness crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = crystallite_Tstar_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress forall (g = 1:myNgrains) constitutive_partionedState0(g,i,e)%p = constitutive_state(g,i,e)%p ! ...microstructures -#ifdef NEWSTATE - do g = 1, myNgrains - plasticSate(mappingConstitutive(g,i,e,1))%partionedState0(mappingConstitutive(g,i,e,2)) = & - plasticSate(mappingConstitutive(g,i,e,1))%state(mappingConstitutive(g,i,e,2)) -#endif + if (homogenization_sizeState(i,e) > 0_pInt) & homogenization_subState0(i,e)%p = homogenization_state(i,e)%p ! ...internal state of homog scheme materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad @@ -477,11 +479,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) ! ...stiffness crystallite_Tstar_v(1:6,1:myNgrains,i,e) = crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) ! ...2nd PK stress forall (g = 1:myNgrains) constitutive_state(g,i,e)%p = constitutive_partionedState0(g,i,e)%p ! ...microstructures -#ifdef NEWSTATE - do g = 1, myNgrains - plasticSate(mappingConstitutive(g,i,e,1))%state(mappingConstitutive(g,i,e,2)) = & - plasticSate(mappingConstitutive(g,i,e,1))%partionedState0(mappingConstitutive(g,i,e,2)) -#endif + if (homogenization_sizeState(i,e) > 0_pInt) & homogenization_state(i,e)%p = homogenization_subState0(i,e)%p ! ...internal state of homog scheme endif diff --git a/code/mesh.f90 b/code/mesh.f90 index b59ffba75..9d0f2ede6 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -615,6 +615,7 @@ subroutine mesh_init(ip,el) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" + print*,'flag in mesh',mesh_maxNips,mesh_NcpElems end subroutine mesh_init