From 0ba8f27320622bbf3e7addbdc7846e714651a0a0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 11 Apr 2015 11:47:33 +0000 Subject: [PATCH] took some gfortran complaints serious (unused imports, implicit castings) --- code/constitutive.f90 | 2 +- code/damage_gurson.f90 | 16 +++++----------- code/damage_isoBrittle.f90 | 3 +-- code/damage_isoDuctile.f90 | 3 +-- code/damage_none.f90 | 4 +--- code/lattice.f90 | 2 -- code/material.f90 | 2 -- code/mesh.f90 | 33 ++++++++++++++++++--------------- code/plastic_disloKMC.f90 | 21 ++++++++------------- code/plastic_disloUCLA.f90 | 21 ++++++++------------- code/plastic_dislotwin.f90 | 3 +-- code/plastic_j2.f90 | 18 ++---------------- code/plastic_none.f90 | 4 +--- code/plastic_nonlocal.f90 | 8 +++----- code/plastic_phenopowerlaw.f90 | 9 ++++----- 15 files changed, 54 insertions(+), 95 deletions(-) diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 518b704cb..7ede0f62d 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -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), & diff --git a/code/damage_gurson.f90 b/code/damage_gurson.f90 index 715619b6d..27bdb14e8 100644 --- a/code/damage_gurson.f90 +++ b/code/damage_gurson.f90 @@ -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 diff --git a/code/damage_isoBrittle.f90 b/code/damage_isoBrittle.f90 index 6d3037e19..0e5d58d88 100644 --- a/code/damage_isoBrittle.f90 +++ b/code/damage_isoBrittle.f90 @@ -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) :: & diff --git a/code/damage_isoDuctile.f90 b/code/damage_isoDuctile.f90 index f4f28f1d0..d6e4d36ca 100644 --- a/code/damage_isoDuctile.f90 +++ b/code/damage_isoDuctile.f90 @@ -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) :: & diff --git a/code/damage_none.f90 b/code/damage_none.f90 index 330455f8f..889fee8d0 100644 --- a/code/damage_none.f90 +++ b/code/damage_none.f90 @@ -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 diff --git a/code/lattice.f90 b/code/lattice.f90 index 77e15c6de..bd5893bc9 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -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, & diff --git a/code/material.f90 b/code/material.f90 index 4ee6f9205..1d7a8eb2d 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -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, & diff --git a/code/mesh.f90 b/code/mesh.f90 index 7e60ff625..5ddd514ad 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -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 !-------------------------------------------------------------------------------------------------- diff --git a/code/plastic_disloKMC.f90 b/code/plastic_disloKMC.f90 index b4d7e87d1..c77b6591e 100644 --- a/code/plastic_disloKMC.f90 +++ b/code/plastic_disloKMC.f90 @@ -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))/& diff --git a/code/plastic_disloUCLA.f90 b/code/plastic_disloUCLA.f90 index bef73dcc9..a05b75df8 100644 --- a/code/plastic_disloUCLA.f90 +++ b/code/plastic_disloUCLA.f90 @@ -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))/& diff --git a/code/plastic_dislotwin.f90 b/code/plastic_dislotwin.f90 index 5d00f560f..7c08d6b76 100644 --- a/code/plastic_dislotwin.f90 +++ b/code/plastic_dislotwin.f90 @@ -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) = & diff --git a/code/plastic_j2.f90 b/code/plastic_j2.f90 index a407520a9..db4e13f9f 100644 --- a/code/plastic_j2.f90 +++ b/code/plastic_j2.f90 @@ -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) :: & diff --git a/code/plastic_none.f90 b/code/plastic_none.f90 index 1572a7ad1..db7bbeec5 100644 --- a/code/plastic_none.f90 +++ b/code/plastic_none.f90 @@ -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 diff --git a/code/plastic_nonlocal.f90 b/code/plastic_nonlocal.f90 index 69d94c52e..69de63fc5 100644 --- a/code/plastic_nonlocal.f90 +++ b/code/plastic_nonlocal.f90 @@ -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 diff --git a/code/plastic_phenopowerlaw.f90 b/code/plastic_phenopowerlaw.f90 index 8cb9bdf83..602763817 100644 --- a/code/plastic_phenopowerlaw.f90 +++ b/code/plastic_phenopowerlaw.f90 @@ -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) + &