took some gfortran complaints serious (unused imports, implicit castings)

This commit is contained in:
Martin Diehl 2015-04-11 11:47:33 +00:00
parent 064266c0cd
commit 0ba8f27320
15 changed files with 54 additions and 95 deletions

View File

@ -760,7 +760,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v
case (PLASTICITY_NONLOCAL_ID)
call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, &
constitutive_getTemperature(ipc,ip,el), &
ipc,ip,el)
ip,el)
case (PLASTICITY_DISLOTWIN_ID)
call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, &
constitutive_getTemperature(ipc,ip,el), &

View File

@ -69,9 +69,6 @@ subroutine damage_gurson_init(fileUnit)
debug_level,&
debug_constitutive,&
debug_levelBasic
use mesh, only: &
mesh_maxNips, &
mesh_NcpElems
use IO, only: &
IO_read, &
IO_lc, &
@ -86,7 +83,6 @@ subroutine damage_gurson_init(fileUnit)
IO_timeStamp, &
IO_EOF
use material, only: &
homogenization_maxNgrains, &
phase_damage, &
phase_damageInstance, &
phase_Noutput, &
@ -318,9 +314,9 @@ subroutine damage_gurson_dotState(Tstar_v, Lp, ipc, ip, el)
Tstar_dev
phase = mappingConstitutive(2,ipc,ip,el)
constituent = mappingConstitutive(1,ipc,ip,el)
Tstar_dev = math_Mandel6to33(Tstar_v) - math_trace33(math_Mandel6to33(Tstar_v))/3*math_I3
Tstar_dev = math_Mandel6to33(Tstar_v) - math_trace33(math_Mandel6to33(Tstar_v))/3.0_pReal*math_I3
i1 = sum(Tstar_v(1:3))
j2 = 0.5_pReal*(math_norm33(Tstar_dev))**2
j2 = 0.5_pReal*(math_norm33(Tstar_dev))**2.0_pReal
j3 = math_j3_33(math_Mandel6to33(Tstar_v))
damageState(phase)%dotState(1,constituent) = &
@ -348,12 +344,10 @@ end subroutine damage_gurson_dotState
subroutine damage_gurson_microstructure(ipc, ip, el)
use material, only: &
mappingConstitutive, &
phase_damageInstance, &
damageState
use math, only: &
math_Mandel6to33, &
math_mul33x33, &
math_I3, &
math_norm33
implicit none
@ -371,10 +365,10 @@ subroutine damage_gurson_microstructure(ipc, ip, el)
voidFraction = damageState(phase)%state(2,constituent) + damageState(phase)%state(3,constituent)
if(voidFraction < damage_gurson_crit_void_fraction(phase)) then
damageState(phase)%state(4,constituent) = 1_pReal - voidFraction ! damage parameter is 1 when no void present
damageState(phase)%state(4,constituent) = 1.0_pReal - voidFraction ! damage parameter is 1 when no void present
else
damageState(phase)%state(4,constituent) = 1_pReal - damage_gurson_crit_void_fraction(phase) + &
5_pReal * (voidFraction - damage_gurson_crit_void_fraction(phase)) ! this accelerated void increase models the effect of void coalescence
damageState(phase)%state(4,constituent) = 1.0_pReal - damage_gurson_crit_void_fraction(phase) + &
5.0_pReal * (voidFraction - damage_gurson_crit_void_fraction(phase)) ! this accelerated void increase models the effect of void coalescence
endif
end subroutine damage_gurson_microstructure

View File

@ -422,8 +422,7 @@ end function damage_isoBrittle_getDamageDiffusion33
!--------------------------------------------------------------------------------------------------
function damage_isoBrittle_getDamagedC66(C, ipc, ip, el)
use material, only: &
mappingConstitutive, &
damageState
mappingConstitutive
implicit none
integer(pInt), intent(in) :: &

View File

@ -393,8 +393,7 @@ end function damage_isoDuctile_getLocalDamage
!--------------------------------------------------------------------------------------------------
function damage_isoDuctile_getDamagedC66(C, ipc, ip, el)
use material, only: &
mappingConstitutive, &
damageState
mappingConstitutive
implicit none
integer(pInt), intent(in) :: &

View File

@ -40,12 +40,10 @@ subroutine damage_none_init
numerics_integrator
use material, only: &
phase_damage, &
phase_Noutput, &
LOCAL_DAMAGE_NONE_label, &
LOCAL_DAMAGE_NONE_ID, &
material_phase, &
damageState, &
MATERIAL_partPhase
damageState
implicit none

View File

@ -976,8 +976,6 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine lattice_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 IO, only: &
IO_open_file,&
IO_open_jobFile_stat, &

View File

@ -1113,8 +1113,6 @@ subroutine material_populateGrains
use IO, only: &
IO_error, &
IO_hybridIA
use FEsolving, only: &
FEsolving_execIP
use debug, only: &
debug_level, &
debug_material, &

View File

@ -461,12 +461,14 @@ module mesh
mesh_abaqus_count_cpSizes, &
mesh_abaqus_build_elements, &
#endif
mesh_get_damaskOptions, &
mesh_build_cellconnectivity, &
mesh_build_ipAreas, &
#ifndef Spectral
mesh_build_nodeTwins, &
mesh_build_sharedElems, &
mesh_build_ipNeighborhood, &
#endif
mesh_get_damaskOptions, &
mesh_build_cellconnectivity, &
mesh_build_ipAreas, &
mesh_tell_statistics, &
FE_mapElemtype, &
mesh_faceMatch, &
@ -513,9 +515,11 @@ subroutine mesh_init(ip,el)
worldrank
use FEsolving, only: &
FEsolving_execElem, &
#ifndef Spectral
modelName, &
#endif
FEsolving_execIP, &
calcMode, &
modelName
calcMode
implicit none
#ifdef Spectral
@ -564,7 +568,7 @@ subroutine mesh_init(ip,el)
if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6)
gridGlobal = mesh_spectral_getGrid(fileUnit)
gridMPI = gridGlobal
gridMPI = int(gridGlobal,C_INTPTR_T)
alloc_local = fftw_mpi_local_size_3d(gridMPI(3), gridMPI(2), gridMPI(1)/2 +1, &
MPI_COMM_WORLD, local_K, local_K_offset)
gridLocal = [gridGlobal(1:2),int(local_K,pInt)]
@ -587,13 +591,13 @@ subroutine mesh_init(ip,el)
geomSizeOffset = 0.0_pReal
#endif
if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6)
call mesh_spectral_count(FILEUNIT)
call mesh_spectral_count()
if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6)
call mesh_spectral_mapNodesAndElems
if (myDebug) write(6,'(a)') ' Mapped nodes and elements'; flush(6)
call mesh_spectral_count_cpSizes
if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6)
call mesh_spectral_build_nodes(FILEUNIT)
call mesh_spectral_build_nodes()
if (myDebug) write(6,'(a)') ' Built nodes'; flush(6)
call mesh_spectral_build_elements(FILEUNIT)
if (myDebug) write(6,'(a)') ' Built elements'; flush(6)
@ -1247,10 +1251,9 @@ end function mesh_spectral_getHomogenization
!> @brief Count overall number of nodes and elements in mesh and stores them in
!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_count(fileUnit)
subroutine mesh_spectral_count()
implicit none
integer(pInt), intent(in) :: fileUnit
mesh_Nelems = product(gridLocal)
mesh_NcpElems= mesh_Nelems
@ -1305,11 +1308,10 @@ end subroutine mesh_spectral_count_cpSizes
!> @brief Store x,y,z coordinates of all nodes in mesh.
!! Allocates global arrays 'mesh_node0' and 'mesh_node'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_nodes(fileUnit)
subroutine mesh_spectral_build_nodes()
implicit none
integer(pInt), intent(in) :: fileUnit
integer(pInt) :: n
integer(pInt) :: n
allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal)
allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal)
@ -3672,9 +3674,9 @@ subroutine mesh_build_ipAreas
enddo
!$OMP END PARALLEL DO
end subroutine mesh_build_ipAreas
end subroutine mesh_build_ipAreas
#ifndef Spectral
!--------------------------------------------------------------------------------------------------
!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins'
!--------------------------------------------------------------------------------------------------
@ -3980,6 +3982,7 @@ subroutine mesh_build_ipNeighborhood
enddo
end subroutine mesh_build_ipNeighborhood
#endif
!--------------------------------------------------------------------------------------------------

View File

@ -163,8 +163,6 @@ subroutine plastic_disloKMC_init(fileUnit)
math_Mandel3333to66, &
math_Voigt66to3333, &
math_mul3x3
use mesh, only: &
mesh_NcpElems
use IO, only: &
IO_read, &
IO_lc, &
@ -563,17 +561,17 @@ subroutine plastic_disloKMC_init(fileUnit)
if (plastic_disloKMC_Qsd(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOKMC_label//')')
if (sum(plastic_disloKMC_Ntwin(:,instance)) > 0_pInt) then
if (plastic_disloKMC_SFE_0K(instance) == 0.0_pReal .and. &
plastic_disloKMC_dSFE_dT(instance) == 0.0_pReal .and. &
lattice_structure(phase) == LATTICE_fcc_ID) &
if (abs(plastic_disloKMC_SFE_0K(instance)) <= tiny(0.0_pReal) .and. &
abs(plastic_disloKMC_dSFE_dT(instance)) <= tiny(0.0_pReal) .and. &
lattice_structure(phase) == LATTICE_fcc_ID) &
call IO_error(211_pInt,el=instance,ext_msg='SFE0K ('//PLASTICITY_DISLOKMC_label//')')
if (plastic_disloKMC_aTolRho(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOKMC_label//')')
if (plastic_disloKMC_aTolTwinFrac(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOKMC_label//')')
endif
if (plastic_disloKMC_dipoleFormationFactor(instance) /= 0.0_pReal .and. &
plastic_disloKMC_dipoleFormationFactor(instance) /= 1.0_pReal) &
if (abs(plastic_disloKMC_dipoleFormationFactor(instance)) > tiny(0.0_pReal) .and. &
plastic_disloKMC_dipoleFormationFactor(instance) /= 1.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='dipoleFormationFactor ('//PLASTICITY_DISLOKMC_label//')')
!--------------------------------------------------------------------------------------------------
@ -935,7 +933,6 @@ end subroutine plastic_disloKMC_aTolState
!--------------------------------------------------------------------------------------------------
function plastic_disloKMC_homogenizedC(ipc,ip,el)
use material, only: &
homogenization_maxNgrains, &
phase_plasticityInstance, &
plasticState, &
mappingConstitutive
@ -1362,7 +1359,6 @@ subroutine plastic_disloKMC_dotState(Tstar_v,Temperature,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_Stwin_v, &
lattice_Sslip, &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily, &
lattice_NslipSystem, &
@ -1491,7 +1487,7 @@ subroutine plastic_disloKMC_dotState(Tstar_v,Temperature,ipc,ip,el)
!* Dipole formation
EdgeDipMinDistance = &
plastic_disloKMC_CEdgeDipMinDistance(instance)*plastic_disloKMC_burgersPerSlipSystem(j,instance)
if (tau_slip_pos == 0.0_pReal) then
if (abs(tau_slip_pos) <= tiny(0.0_pReal)) then
DotRhoDipFormation = 0.0_pReal
else
EdgeDipDistance = &
@ -1519,7 +1515,7 @@ subroutine plastic_disloKMC_dotState(Tstar_v,Temperature,ipc,ip,el)
plastic_disloKMC_CAtomicVolume(instance)*plastic_disloKMC_burgersPerSlipSystem(j,instance)**(3.0_pReal)
VacancyDiffusion = &
plastic_disloKMC_D0(instance)*exp(-plastic_disloKMC_Qsd(instance)/(kB*Temperature))
if (tau_slip_pos == 0.0_pReal) then
if (abs(tau_slip_pos) <= tiny(0.0_pReal)) then
DotRhoEdgeDipClimb = 0.0_pReal
else
ClimbVelocity = &
@ -1602,7 +1598,6 @@ function plastic_disloKMC_postResults(Tstar_v,Temperature,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_Stwin_v, &
lattice_Sslip, &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily, &
lattice_NslipSystem, &
@ -1807,7 +1802,7 @@ function plastic_disloKMC_postResults(Tstar_v,Temperature,ipc,ip,el)
c = c + nt
elseif(plastic_disloKMC_outputID(o,instance) == stress_exponent_ID) then
do j = 1_pInt, ns
if ((gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal==0.0_pReal) then
if (abs(gdot_slip_pos(j)+gdot_slip_neg(j))<=tiny(0.0_pReal)) then
plastic_disloKMC_postResults(c+j) = 0.0_pReal
else
plastic_disloKMC_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/&

View File

@ -168,8 +168,6 @@ subroutine plastic_disloUCLA_init(fileUnit)
math_Mandel3333to66, &
math_Voigt66to3333, &
math_mul3x3
use mesh, only: &
mesh_NcpElems
use IO, only: &
IO_read, &
IO_lc, &
@ -582,17 +580,17 @@ subroutine plastic_disloUCLA_init(fileUnit)
if (plastic_disloUCLA_Qsd(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='Qsd ('//PLASTICITY_DISLOUCLA_label//')')
if (sum(plastic_disloUCLA_Ntwin(:,instance)) > 0_pInt) then
if (plastic_disloUCLA_SFE_0K(instance) == 0.0_pReal .and. &
plastic_disloUCLA_dSFE_dT(instance) == 0.0_pReal .and. &
lattice_structure(phase) == LATTICE_fcc_ID) &
if (abs(plastic_disloUCLA_SFE_0K(instance)) <= tiny(0.0_pReal) .and. &
abs(plastic_disloUCLA_dSFE_dT(instance)) <= tiny(0.0_pReal) .and. &
lattice_structure(phase) == LATTICE_fcc_ID) &
call IO_error(211_pInt,el=instance,ext_msg='SFE0K ('//PLASTICITY_DISLOUCLA_label//')')
if (plastic_disloUCLA_aTolRho(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='aTolRho ('//PLASTICITY_DISLOUCLA_label//')')
if (plastic_disloUCLA_aTolTwinFrac(instance) <= 0.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='aTolTwinFrac ('//PLASTICITY_DISLOUCLA_label//')')
endif
if (plastic_disloUCLA_dipoleFormationFactor(instance) /= 0.0_pReal .and. &
plastic_disloUCLA_dipoleFormationFactor(instance) /= 1.0_pReal) &
if (abs(plastic_disloUCLA_dipoleFormationFactor(instance)) > tiny(0.0_pReal) .and. &
plastic_disloUCLA_dipoleFormationFactor(instance) /= 1.0_pReal) &
call IO_error(211_pInt,el=instance,ext_msg='dipoleFormationFactor ('//PLASTICITY_DISLOUCLA_label//')')
!--------------------------------------------------------------------------------------------------
@ -953,7 +951,6 @@ end subroutine plastic_disloUCLA_aTolState
!--------------------------------------------------------------------------------------------------
function plastic_disloUCLA_homogenizedC(ipc,ip,el)
use material, only: &
homogenization_maxNgrains, &
phase_plasticityInstance, &
plasticState, &
mappingConstitutive
@ -1445,7 +1442,6 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_Stwin_v, &
lattice_Sslip, &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily, &
lattice_NslipSystem, &
@ -1587,7 +1583,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el)
!* Dipole formation
EdgeDipMinDistance = &
plastic_disloUCLA_CEdgeDipMinDistance(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)
if (tau_slip_pos == 0.0_pReal) then
if (abs(tau_slip_pos) <= tiny(0.0_pReal)) then
DotRhoDipFormation = 0.0_pReal
else
EdgeDipDistance = &
@ -1615,7 +1611,7 @@ subroutine plastic_disloUCLA_dotState(Tstar_v,Temperature,ipc,ip,el)
plastic_disloUCLA_CAtomicVolume(instance)*plastic_disloUCLA_burgersPerSlipSystem(j,instance)**(3.0_pReal)
VacancyDiffusion = &
plastic_disloUCLA_D0(instance)*exp(-plastic_disloUCLA_Qsd(instance)/(kB*Temperature))
if (tau_slip_pos == 0.0_pReal) then
if (abs(tau_slip_pos) <= tiny(0.0_pReal)) then
DotRhoEdgeDipClimb = 0.0_pReal
else
ClimbVelocity = &
@ -1698,7 +1694,6 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_Stwin_v, &
lattice_Sslip, &
lattice_maxNslipFamily, &
lattice_maxNtwinFamily, &
lattice_NslipSystem, &
@ -1970,7 +1965,7 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el)
c = c + nt
elseif(plastic_disloUCLA_outputID(o,instance) == stress_exponent_ID) then
do j = 1_pInt, ns
if ((gdot_slip_pos(j)+gdot_slip_neg(j))*0.5_pReal==0.0_pReal) then
if (abs(gdot_slip_pos(j)+gdot_slip_neg(j))<=tiny(0.0_pReal)) then
plastic_disloUCLA_postResults(c+j) = 0.0_pReal
else
plastic_disloUCLA_postResults(c+j) = (tau_slip_pos(j)+tau_slip_neg(j))/&

View File

@ -1200,7 +1200,6 @@ subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el)
plasticState, &
mappingConstitutive
use lattice, only: &
lattice_structure, &
lattice_mu, &
lattice_nu
@ -1763,7 +1762,7 @@ subroutine plastic_dislotwin_dotState(Tstar_v,Temperature,ipc,ip,el)
!* Dipole formation
EdgeDipMinDistance = &
plastic_dislotwin_CEdgeDipMinDistance(instance)*plastic_dislotwin_burgersPerSlipSystem(j,instance)
if (tau_slip(j) == 0.0_pReal) then
if (abs(tau_slip(j)) <= tiny(0.0_pReal)) then
DotRhoDipFormation(j) = 0.0_pReal
else
EdgeDipDistance(j) = &

View File

@ -117,7 +117,6 @@ subroutine plastic_j2_init(fileUnit)
#endif
IO_EOF
use material, only: &
homogenization_maxNgrains, &
phase_plasticity, &
phase_plasticityInstance, &
phase_Noutput, &
@ -369,13 +368,9 @@ subroutine plastic_j2_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
math_Plain3333to99, &
math_deviatoric33, &
math_mul33xx33
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
use material, only: &
mappingConstitutive, &
plasticState, &
homogenization_maxNgrains, &
material_phase, &
phase_plasticityInstance
@ -441,13 +436,9 @@ end subroutine plastic_j2_LpAndItsTangent
subroutine plastic_j2_dotState(Tstar_v,ipc,ip,el)
use math, only: &
math_mul6x6
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
use material, only: &
mappingConstitutive, &
plasticState, &
homogenization_maxNgrains, &
material_phase, &
phase_plasticityInstance
@ -489,7 +480,7 @@ subroutine plastic_j2_dotState(Tstar_v,ipc,ip,el)
!--------------------------------------------------------------------------------------------------
! hardening coefficient
if (abs(gamma_dot) > 1e-12_pReal) then
if (plastic_j2_tausat_SinhFitA(instance) == 0.0_pReal) then
if (abs(plastic_j2_tausat_SinhFitA(instance)) <= tiny(0.0_pReal)) then
saturation = plastic_j2_tausat(instance)
else
saturation = ( plastic_j2_tausat(instance) &
@ -523,16 +514,11 @@ end subroutine plastic_j2_dotState
function plastic_j2_postResults(Tstar_v,ipc,ip,el)
use math, only: &
math_mul6x6
use mesh, only: &
mesh_NcpElems, &
mesh_maxNips
use material, only: &
homogenization_maxNgrains, &
material_phase, &
plasticState, &
mappingConstitutive, &
phase_plasticityInstance, &
phase_Noutput
phase_plasticityInstance
implicit none
real(pReal), dimension(6), intent(in) :: &

View File

@ -40,12 +40,10 @@ subroutine plastic_none_init
numerics_integrator
use material, only: &
phase_plasticity, &
phase_Noutput, &
PLASTICITY_NONE_label, &
material_phase, &
plasticState, &
PLASTICITY_none_ID, &
MATERIAL_partPhase
PLASTICITY_none_ID
implicit none

View File

@ -293,7 +293,6 @@ use material, only: phase_plasticity, &
PLASTICITY_NONLOCAL_label, &
PLASTICITY_NONLOCAL_ID, &
plasticState, &
material_Nphase, &
MATERIAL_partPhase ,&
material_phase
use lattice
@ -2003,7 +2002,7 @@ end subroutine plastic_nonlocal_kinetics
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ipc, ip, el)
subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el)
use math, only: math_Plain3333to99, &
math_mul6x6, &
@ -2027,8 +2026,7 @@ use mesh, only: mesh_ipVolume
implicit none
!*** input variables
integer(pInt), intent(in) :: ipc, &
ip, & !< current integration point
integer(pInt), intent(in) :: ip, & !< current integration point
el !< current element number
real(pReal), intent(in) :: Temperature !< temperature
real(pReal), dimension(6), intent(in) :: Tstar_v !< 2nd Piola-Kirchhoff stress in Mandel notation
@ -3160,7 +3158,7 @@ do n = 1_pInt,Nneighbors
where (my_compatibility(2,1:ns,s1,n) >= thresholdValue) &
belowThreshold(1:ns) = .false.
if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal) &
where (abs(my_compatibility(1:2,1:ns,s1,n)) == thresholdValue) &
where (abs(my_compatibility(1:2,1:ns,s1,n)) == thresholdValue) & ! MD: rather check below threshold?
my_compatibility(1:2,1:ns,s1,n) = sign((1.0_pReal - my_compatibilitySum) &
/ nThresholdValues, my_compatibility(1:2,1:ns,s1,n))
my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue

View File

@ -475,7 +475,7 @@ subroutine plastic_phenopowerlaw_init(fileUnit)
if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. &
plastic_phenopowerlaw_Nslip(:,instance) > 0)) &
call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')')
if (any(plastic_phenopowerlaw_a_slip(instance) == 0.0_pReal .and. &
if (any(abs(plastic_phenopowerlaw_a_slip(instance)) <= tiny(0.0_pReal) .and. &
plastic_phenopowerlaw_Nslip(:,instance) > 0)) &
call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')')
if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. &
@ -732,7 +732,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,
lattice_NtwinSystem, &
lattice_NnonSchmid
use material, only: &
material_phase, &
plasticState, &
mappingConstitutive, &
phase_plasticityInstance
@ -814,7 +813,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,
(gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph)
! Calculation of the tangent of Lp
if (gdot_slip_pos /= 0.0_pReal) then
if (abs(gdot_slip_pos) > tiny(0.0_pReal)) then
dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenopowerlaw_n_slip(instance)/tau_slip_pos
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &
@ -822,7 +821,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,
nonSchmid_tensor(m,n,1)
endif
if (gdot_slip_neg /= 0.0_pReal) then
if (abs(gdot_slip_neg) > tiny(0.0_pReal)) then
dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenopowerlaw_n_slip(instance)/tau_slip_neg
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &
@ -849,7 +848,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,
Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph)
! Calculation of the tangent of Lp
if (gdot_twin /= 0.0_pReal) then
if (abs(gdot_twin) > tiny(0.0_pReal)) then
dgdot_dtautwin = gdot_twin*plastic_phenopowerlaw_n_twin(instance)/tau_twin
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + &