fixed some errors in changes related to newstate

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?
+!(:) needed? A component cannot be an array if the encompassing structure is an array
-plasticState(:)%state0=plasticState(:)%state
+!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'

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()

code/constitutive.f90

@@ -51,6 +51,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)

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

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

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)) = &
+      plasticState(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))%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       

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