diff --git a/code/constitutive.f90 b/code/constitutive.f90 index fa748d653..f53c0209c 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -746,8 +746,8 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) constitutive_dotState(ipc,ip,el)%p = constitutive_dislotwin_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el) case (constitutive_nonlocal_label) - call constitutive_nonlocal_dotState(constitutive_dotState(ipc,ip,el), Tstar_v, Fe, Fp, Temperature, constitutive_state, & - subdt, orientation, ipc, ip, el) + constitutive_dotState(ipc,ip,el)%p = constitutive_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, constitutive_state, & + subdt, orientation, ipc, ip, el) end select diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 55dc5ef91..559d787cb 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -1564,7 +1564,7 @@ endfunction !********************************************************************* !* rate of change of microstructure * !********************************************************************* -subroutine constitutive_nonlocal_dotState(dotState, Tstar_v, Fe, Fp, Temperature, state, timestep, orientation, g,ip,el) +function constitutive_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, state, timestep, orientation, g,ip,el) use prec, only: pReal, & pInt, & @@ -1622,9 +1622,10 @@ real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & state ! current microstructural state !*** input/output variables -type(p_vec), intent(inout) :: dotState ! evolution of state variables / microstructure !*** output variables +real(pReal), dimension(constitutive_nonlocal_sizeDotState(phase_plasticityInstance(material_phase(g,ip,el)))) :: & + constitutive_nonlocal_dotState ! evolution of state variables / microstructure !*** local variables integer(pInt) myInstance, & ! current instance of this plasticity @@ -1731,7 +1732,7 @@ forall (t = 1_pInt:4_pInt) & !*** sanity check for timestep if (timestep <= 0.0_pReal) then ! if illegal timestep... - dotState%p = 0.0_pReal ! ...return without doing anything (-> zero dotState) + constitutive_nonlocal_dotState = 0.0_pReal ! ...return without doing anything (-> zero dotState) return endif @@ -1767,7 +1768,7 @@ if (any(abs(gdot) > 0.0_pReal .and. 2.0_pReal * abs(v) * timestep > mesh_ipVolum write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif #endif - dotState%p = DAMASK_NaN + constitutive_nonlocal_dotState = DAMASK_NaN return endif @@ -2041,10 +2042,10 @@ if ( any(rhoSgl(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < - constitutive_nonl write(6,'(a)') '<< CONST >> enforcing cutback !!!' endif #endif - dotState%p = DAMASK_NaN + constitutive_nonlocal_dotState = DAMASK_NaN return else - dotState%p(1:10_pInt*ns) = dotState%p(1:10_pInt*ns) + reshape(rhoDot,(/10_pInt*ns/)) + constitutive_nonlocal_dotState(1:10_pInt*ns) = reshape(rhoDot,(/10_pInt*ns/)) endif @@ -2069,7 +2070,7 @@ endif endif #endif -endsubroutine +endfunction diff --git a/code/crystallite.f90 b/code/crystallite.f90 index b900b2194..d1d17cd00 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -1085,17 +1085,8 @@ else endif -! --- RESET DOTSTATE --- - !$OMP PARALLEL PRIVATE(mySizeDotState) -!$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 - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero - enddo; enddo; enddo -!$OMP ENDDO - - ! --- FIRST RUNGE KUTTA STEP --- RK4dotTemperature = 0.0_pReal ! initialize Runge-Kutta dotTemperature @@ -1214,7 +1205,6 @@ do n = 1_pInt,4_pInt endif endif endif - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero enddo; enddo; enddo !$OMP ENDDO @@ -1394,17 +1384,8 @@ else endif -! --- RESET DOTSTATE --- - !$OMP PARALLEL PRIVATE(mySizeDotState) -!$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 - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero - enddo; enddo; enddo -!$OMP ENDDO - - ! --- FIRST RUNGE KUTTA STEP --- #ifndef _OPENMP if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then @@ -1517,7 +1498,6 @@ do n = 1_pInt,5_pInt call constitutive_microstructure(crystallite_Temperature(g,i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states endif - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero enddo; enddo; enddo !$OMP ENDDO @@ -1830,15 +1810,6 @@ endif if (numerics_integrationMode < 2) then - ! --- RESET DOTSTATE --- - - !$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 - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero - enddo; enddo; enddo - !$OMP ENDDO - - ! --- DOT STATE AND TEMPERATURE (EULER INTEGRATION) --- stateResiduum = 0.0_pReal @@ -1895,8 +1866,7 @@ if (numerics_integrationMode < 2) then call constitutive_microstructure(crystallite_Temperature(g,i,e), crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fp(1:3,1:3,g,i,e), g, i, e) ! update dependent state variables to be consistent with basic states endif - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero - enddo; enddo; enddo + enddo; enddo; enddo !$OMP ENDDO endif @@ -1964,7 +1934,7 @@ relTemperatureResiduum = 0.0_pReal ! --- contribution of heun step to absolute residui --- stateResiduum(1:mySizeDotState,g,i,e) = stateResiduum(1:mySizeDotState,g,i,e) & - + 0.5_pReal * constitutive_dotState(g,i,e)%p * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state and temperature + + 0.5_pReal * constitutive_dotState(g,i,e)%p * crystallite_subdt(g,i,e) ! contribution to absolute residuum in state and temperature temperatureResiduum(g,i,e) = temperatureResiduum(g,i,e) & + 0.5_pReal * crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) !$OMP FLUSH(stateResiduum,temperatureResiduum) @@ -2100,15 +2070,6 @@ endif if (numerics_integrationMode < 2) then - ! --- RESET DOTSTATE --- - - !$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 - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero - enddo; enddo; enddo - !$OMP ENDDO - - ! --- DOT STATE AND TEMPERATURE --- !$OMP DO @@ -2290,13 +2251,10 @@ endif ! --+>> PREGUESS FOR STATE <<+-- -! --- RESET DOTSTATE --- - !$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 - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero constitutive_previousDotState(g,i,e)%p = 0.0_pReal constitutive_previousDotState2(g,i,e)%p = 0.0_pReal enddo; enddo; enddo @@ -2347,7 +2305,6 @@ endif endif constitutive_previousDotState2(g,i,e)%p = constitutive_previousDotState(g,i,e)%p ! age previous dotState constitutive_previousDotState(g,i,e)%p = constitutive_dotState(g,i,e)%p ! age previous dotState - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL @@ -2456,7 +2413,6 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) endif constitutive_previousDotState2(g,i,e)%p = constitutive_previousDotState(g,i,e)%p ! age previous dotState constitutive_previousDotState(g,i,e)%p = constitutive_dotState(g,i,e)%p ! age previous dotState - constitutive_dotState(g,i,e)%p = 0.0_pReal ! reset dotState to zero enddo; enddo; enddo !$OMP ENDDO