removed compiler warnings about conversion and floating point comparison
This commit is contained in:
Martin Diehl
parent
a58e85e96d
commit
8d285e4190
|
|
@ -251,8 +251,6 @@ subroutine CPFEM_general(age, dt)
|
|||
crystallite_Tstar0_v, &
|
||||
crystallite_Tstar_v
|
||||
use homogenization, only: &
|
||||
materialpoint_F, &
|
||||
materialpoint_F0, &
|
||||
materialpoint_stressAndItsTangent, &
|
||||
materialpoint_postResults
|
||||
use IO, only: &
|
||||
|
|
|
|||
|
|
@ -604,8 +604,6 @@ subroutine constitutive_LiAndItsTangent(Li, dLi_dTstar3333, dLi_dFi3333, Tstar_v
|
|||
use material, only: &
|
||||
phase_plasticity, &
|
||||
material_phase, &
|
||||
material_homog, &
|
||||
phaseAt, phasememberAt, &
|
||||
phase_kinematics, &
|
||||
phase_Nkinematics, &
|
||||
PLASTICITY_isotropic_ID, &
|
||||
|
|
|
|||
|
|
@ -197,8 +197,6 @@ subroutine crystallite_init
|
|||
nMax, & !< maximum number of ip neighbors
|
||||
myNcomponents, & !< number of components at current IP
|
||||
section = 0_pInt, &
|
||||
j, &
|
||||
p, &
|
||||
mySize
|
||||
|
||||
character(len=65536) :: &
|
||||
|
|
@ -511,7 +509,8 @@ end subroutine crystallite_init
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine crystallite_stressAndItsTangent(updateJaco)
|
||||
use prec, only: &
|
||||
tol_math_check
|
||||
tol_math_check, &
|
||||
dNeq
|
||||
use numerics, only: &
|
||||
subStepMinCryst, &
|
||||
subStepSizeCryst, &
|
||||
|
|
@ -803,7 +802,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
|
|||
endif
|
||||
else
|
||||
subFracIntermediate = maxval(crystallite_subFrac, mask=.not.crystallite_localPlasticity)
|
||||
if (abs(subFracIntermediate) > tiny(0.0_pReal)) then
|
||||
if (dNeq(subFracIntermediate,0.0_pReal)) then
|
||||
crystallite_neighborEnforcedCutback = .false. ! look for ips that require a cutback because of a nonconverged neighbor
|
||||
!$OMP PARALLEL
|
||||
!$OMP DO PRIVATE(neighboring_e,neighboring_i)
|
||||
|
|
@ -3352,7 +3351,8 @@ end subroutine crystallite_integrateStateFPI
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
logical function crystallite_stateJump(ipc,ip,el)
|
||||
use prec, only: &
|
||||
prec_isNaN
|
||||
prec_isNaN, &
|
||||
dNeq
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_crystallite, &
|
||||
|
|
@ -3404,7 +3404,7 @@ logical function crystallite_stateJump(ipc,ip,el)
|
|||
enddo
|
||||
|
||||
#ifndef _OPENMP
|
||||
if (any(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) /= 0.0_pReal) &
|
||||
if (any(dNeq(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c),0.0_pReal)) &
|
||||
.and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
|
||||
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
|
||||
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
|
||||
|
|
@ -3459,7 +3459,8 @@ logical function crystallite_integrateStress(&
|
|||
)
|
||||
use prec, only: pLongInt, &
|
||||
tol_math_check, &
|
||||
prec_isNaN
|
||||
prec_isNaN, &
|
||||
dEq
|
||||
use numerics, only: nStress, &
|
||||
aTol_crystalliteStress, &
|
||||
rTol_crystalliteStress, &
|
||||
|
|
@ -3607,7 +3608,7 @@ logical function crystallite_integrateStress(&
|
|||
!* inversion of Fp_current...
|
||||
|
||||
invFp_current = math_inv33(Fp_current)
|
||||
if (all(abs(invFp_current) <= tiny(0.0_pReal))) then ! math_inv33 returns zero when failed, avoid floating point comparison
|
||||
failedInversionFp: if (all(dEq(invFp_current,0.0_pReal))) then
|
||||
#ifndef _OPENMP
|
||||
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
|
||||
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip g ',&
|
||||
|
|
@ -3617,13 +3618,12 @@ logical function crystallite_integrateStress(&
|
|||
endif
|
||||
#endif
|
||||
return
|
||||
endif
|
||||
endif failedInversionFp
|
||||
A = math_mul33x33(Fg_new,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp
|
||||
|
||||
!* inversion of Fi_current...
|
||||
|
||||
invFi_current = math_inv33(Fi_current)
|
||||
if (all(abs(invFi_current) <= tiny(0.0_pReal))) then ! math_inv33 returns zero when failed, avoid floating point comparison
|
||||
failedInversionFi: if (all(dEq(invFi_current,0.0_pReal))) then
|
||||
#ifndef _OPENMP
|
||||
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
|
||||
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',&
|
||||
|
|
@ -3633,7 +3633,7 @@ logical function crystallite_integrateStress(&
|
|||
endif
|
||||
#endif
|
||||
return
|
||||
endif
|
||||
endif failedInversionFi
|
||||
|
||||
!* start LpLoop with normal step length
|
||||
|
||||
|
|
@ -3883,7 +3883,7 @@ logical function crystallite_integrateStress(&
|
|||
invFp_new = math_mul33x33(invFp_current,B)
|
||||
invFp_new = invFp_new / math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize by det
|
||||
Fp_new = math_inv33(invFp_new)
|
||||
if (all(abs(Fp_new)<= tiny(0.0_pReal))) then ! math_inv33 returns zero when failed, avoid floating point comparison
|
||||
failedInversionFp2: if (all(dEq(invFp_new,0.0_pReal))) then
|
||||
#ifndef _OPENMP
|
||||
if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
|
||||
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip ipc ',&
|
||||
|
|
@ -3895,7 +3895,7 @@ logical function crystallite_integrateStress(&
|
|||
endif
|
||||
#endif
|
||||
return
|
||||
endif
|
||||
endif failedInversionFp2
|
||||
Fe_new = math_mul33x33(math_mul33x33(Fg_new,invFp_new),invFi_new) ! calc resulting Fe
|
||||
|
||||
!* calculate 1st Piola-Kirchhoff stress
|
||||
|
|
@ -4116,7 +4116,7 @@ function crystallite_postResults(ipc, ip, el)
|
|||
mySize = 1_pInt
|
||||
detF = math_det33(crystallite_partionedF(1:3,1:3,ipc,ip,el)) ! V_current = det(F) * V_reference
|
||||
crystallite_postResults(c+1) = detF * mesh_ipVolume(ip,el) &
|
||||
/ homogenization_Ngrains(mesh_element(3,el)) ! grain volume (not fraction but absolute)
|
||||
/ real(homogenization_Ngrains(mesh_element(3,el)),pReal) ! grain volume (not fraction but absolute)
|
||||
case (orientation_ID)
|
||||
mySize = 4_pInt
|
||||
crystallite_postResults(c+1:c+mySize) = crystallite_orientation(1:4,ipc,ip,el) ! grain orientation as quaternion
|
||||
|
|
|
|||
|
|
@ -223,7 +223,7 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
SOURCE_damage_isoBrittle_ID, &
|
||||
|
|
@ -280,8 +280,8 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
|
|||
enddo
|
||||
enddo
|
||||
|
||||
phiDot = phiDot/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
|
||||
end subroutine damage_local_getSourceAndItsTangent
|
||||
|
||||
|
|
|
|||
|
|
@ -184,7 +184,7 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
SOURCE_damage_isoBrittle_ID, &
|
||||
|
|
@ -241,8 +241,8 @@ subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip,
|
|||
enddo
|
||||
enddo
|
||||
|
||||
phiDot = phiDot/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
phiDot = phiDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
|
||||
end subroutine damage_nonlocal_getSourceAndItsTangent
|
||||
|
||||
|
|
@ -279,9 +279,7 @@ function damage_nonlocal_getDiffusion33(ip,el)
|
|||
enddo
|
||||
|
||||
damage_nonlocal_getDiffusion33 = &
|
||||
charLength*charLength* &
|
||||
damage_nonlocal_getDiffusion33/ &
|
||||
homogenization_Ngrains(homog)
|
||||
charLength**2_pInt*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
end function damage_nonlocal_getDiffusion33
|
||||
|
||||
|
|
@ -310,7 +308,8 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
|
|||
damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
|
||||
enddo
|
||||
|
||||
damage_nonlocal_getMobility = damage_nonlocal_getMobility /homogenization_Ngrains(mesh_element(3,el))
|
||||
damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
|
||||
real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function damage_nonlocal_getMobility
|
||||
|
||||
|
|
|
|||
|
|
@ -46,10 +46,10 @@ module debug
|
|||
integer(pInt),protected, dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other"
|
||||
debug_level = 0_pInt
|
||||
|
||||
integer(pInt), public :: &
|
||||
debug_cumLpCalls = 0_pInt, & !< total number of calls to LpAndItsTangent
|
||||
debug_cumDeltaStateCalls = 0_pInt, & !< total number of calls to deltaState
|
||||
debug_cumDotStateCalls = 0_pInt !< total number of calls to dotState
|
||||
integer(pLongInt), public :: &
|
||||
debug_cumLpCalls = 0_pLongInt, & !< total number of calls to LpAndItsTangent
|
||||
debug_cumDeltaStateCalls = 0_pLongInt, & !< total number of calls to deltaState
|
||||
debug_cumDotStateCalls = 0_pLongInt !< total number of calls to dotState
|
||||
|
||||
integer(pInt), protected, public :: &
|
||||
debug_e = 1_pInt, &
|
||||
|
|
@ -67,6 +67,7 @@ module debug
|
|||
debug_jacobianMaxLocation = 0_pInt, &
|
||||
debug_jacobianMinLocation = 0_pInt
|
||||
|
||||
|
||||
integer(pInt), dimension(:), allocatable, public :: &
|
||||
debug_CrystalliteLoopDistribution, & !< distribution of crystallite cutbacks
|
||||
debug_MaterialpointStateLoopDistribution, &
|
||||
|
|
|
|||
|
|
@ -77,7 +77,6 @@ subroutine kinematics_thermal_expansion_init(fileUnit)
|
|||
integer(pInt) :: maxNinstance,phase,instance,kinematics
|
||||
character(len=65536) :: &
|
||||
tag = '', &
|
||||
output = '', &
|
||||
line = ''
|
||||
|
||||
mainProcess: if (worldrank == 0) then
|
||||
|
|
|
|||
|
|
@ -1232,6 +1232,8 @@ end subroutine material_parseTexture
|
|||
!! calculates the volume of the grains and deals with texture components and hybridIA
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine material_populateGrains
|
||||
use prec, only: &
|
||||
dEq
|
||||
use math, only: &
|
||||
math_RtoEuler, &
|
||||
math_EulerToR, &
|
||||
|
|
@ -1451,7 +1453,7 @@ subroutine material_populateGrains
|
|||
texture_Fiber( 5,t,textureID))
|
||||
enddo
|
||||
constituentGrain = &
|
||||
constituentGrain + int(myNorientations*texture_fiber(6,t,textureID),pInt) ! advance counter for grains of current constituent
|
||||
constituentGrain + int(real(myNorientations,pReal)*texture_fiber(6,t,textureID),pInt) ! advance counter for grains of current constituent
|
||||
enddo fiber
|
||||
|
||||
random: do constituentGrain = constituentGrain+1_pInt,myNorientations ! fill remainder with random
|
||||
|
|
@ -1462,7 +1464,7 @@ subroutine material_populateGrains
|
|||
else
|
||||
orientationOfGrain(1:3,grain+1_pInt:grain+myNorientations) = &
|
||||
IO_hybridIA(myNorientations,texture_ODFfile(textureID))
|
||||
if (all(orientationOfGrain(1:3,grain+1_pInt) == -1.0_pReal)) call IO_error(156_pInt)
|
||||
if (all(dEq(orientationOfGrain(1:3,grain+1_pInt),-1.0_pReal))) call IO_error(156_pInt)
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -1501,7 +1503,7 @@ subroutine material_populateGrains
|
|||
|
||||
do j = 1_pInt,NgrainsOfConstituent(i)-1_pInt ! walk thru grains of current constituent
|
||||
call random_number(rnd)
|
||||
t = nint(rnd*(NgrainsOfConstituent(i)-j)+j+0.5_pReal,pInt) ! select a grain in remaining list
|
||||
t = nint(rnd*real(NgrainsOfConstituent(i)-j,pReal)+real(j,pReal)+0.5_pReal,pInt) ! select a grain in remaining list
|
||||
m = phaseOfGrain(grain+t) ! exchange current with random
|
||||
phaseOfGrain(grain+t) = phaseOfGrain(grain+j)
|
||||
phaseOfGrain(grain+j) = m
|
||||
|
|
@ -1539,7 +1541,7 @@ subroutine material_populateGrains
|
|||
randomOrder = math_range(microstructure_maxNconstituents) ! start out with ordered sequence of constituents
|
||||
call random_number(rndArray) ! as many rnd numbers as (max) constituents
|
||||
do j = 1_pInt, myNconstituents - 1_pInt ! loop over constituents ...
|
||||
r = nint(rndArray(j)*(myNconstituents-j)+j+0.5_pReal,pInt) ! ... select one in remaining list
|
||||
r = nint(rndArray(j)*real(myNconstituents-j,pReal)+real(j,pReal)+0.5_pReal,pInt) ! ... select one in remaining list
|
||||
c = randomOrder(r) ! ... call it "c"
|
||||
randomOrder(r) = randomOrder(j) ! ... and exchange with present position in constituent list
|
||||
grain = sum(NgrainsOfConstituent(1:c-1_pInt)) ! figure out actual starting index in overall/consecutive grain population
|
||||
|
|
|
|||
|
|
@ -723,6 +723,8 @@ end function math_transpose33
|
|||
! returns all zeroes if not possible, i.e. if det close to zero
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
pure function math_inv33(A)
|
||||
use prec, only: &
|
||||
dNeq
|
||||
|
||||
implicit none
|
||||
real(pReal),dimension(3,3),intent(in) :: A
|
||||
|
|
@ -735,7 +737,7 @@ pure function math_inv33(A)
|
|||
|
||||
DetA = A(1,1) * math_inv33(1,1) + A(1,2) * math_inv33(2,1) + A(1,3) * math_inv33(3,1)
|
||||
|
||||
if (abs(DetA) > tiny(DetA)) then ! use a real threshold here
|
||||
if (dNeq(DetA,0.0_pReal)) then
|
||||
math_inv33(1,2) = -A(1,2) * A(3,3) + A(1,3) * A(3,2)
|
||||
math_inv33(2,2) = A(1,1) * A(3,3) - A(1,3) * A(3,1)
|
||||
math_inv33(3,2) = -A(1,1) * A(3,2) + A(1,2) * A(3,1)
|
||||
|
|
|
|||
|
|
@ -199,6 +199,8 @@ contains
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine plastic_dislotwin_init(fileUnit)
|
||||
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
|
||||
use prec, only: &
|
||||
dNeq
|
||||
use debug, only: &
|
||||
debug_level,&
|
||||
debug_constitutive,&
|
||||
|
|
@ -773,8 +775,8 @@ subroutine plastic_dislotwin_init(fileUnit)
|
|||
if (plastic_dislotwin_sbVelocity(instance) > 0.0_pReal .and. &
|
||||
plastic_dislotwin_pShearBand(instance) <= 0.0_pReal) &
|
||||
call IO_error(211_pInt,el=instance,ext_msg='pShearBand ('//PLASTICITY_DISLOTWIN_label//')')
|
||||
if (abs(plastic_dislotwin_dipoleFormationFactor(instance)) > tiny(0.0_pReal) .and. &
|
||||
plastic_dislotwin_dipoleFormationFactor(instance) /= 1.0_pReal) &
|
||||
if (dNeq(plastic_dislotwin_dipoleFormationFactor(instance), 0.0_pReal) .and. &
|
||||
dNeq(plastic_dislotwin_dipoleFormationFactor(instance), 1.0_pReal)) &
|
||||
call IO_error(211_pInt,el=instance,ext_msg='dipoleFormationFactor ('//PLASTICITY_DISLOTWIN_label//')')
|
||||
if (plastic_dislotwin_sbVelocity(instance) > 0.0_pReal .and. &
|
||||
plastic_dislotwin_qShearBand(instance) <= 0.0_pReal) &
|
||||
|
|
|
|||
|
|
@ -2382,7 +2382,8 @@ end subroutine plastic_nonlocal_deltaState
|
|||
subroutine plastic_nonlocal_dotState(Tstar_v, Fe, Fp, Temperature, &
|
||||
timestep,subfrac, ip,el)
|
||||
|
||||
use prec, only: DAMASK_NaN
|
||||
use prec, only: DAMASK_NaN, &
|
||||
dNeq
|
||||
use numerics, only: numerics_integrationMode, &
|
||||
numerics_timeSyncing
|
||||
use IO, only: IO_error
|
||||
|
|
@ -2760,8 +2761,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then
|
|||
endif
|
||||
|
||||
if (considerEnteringFlux) then
|
||||
if(numerics_timeSyncing .and. (subfrac(1_pInt,neighbor_ip,neighbor_el) /= subfrac(1_pInt,ip,el))) &
|
||||
then ! for timesyncing: in case of a timestep at the interface we have to use "state0" to make sure that fluxes n both sides are equal
|
||||
if(numerics_timeSyncing .and. (dNeq(subfrac(1,neighbor_ip,neighbor_el),subfrac(1,ip,el)))) then ! for timesyncing: in case of a timestep at the interface we have to use "state0" to make sure that fluxes n both sides are equal
|
||||
forall (s = 1:ns, t = 1_pInt:4_pInt)
|
||||
|
||||
neighbor_v(s,t) = plasticState(np)%state0(iV (s,t,neighbor_instance),no)
|
||||
|
|
@ -3078,13 +3078,11 @@ slipDirection(1:3,1:ns) = lattice_sd(1:3, slipSystemLattice(1:ns,instance), ph)
|
|||
!*** start out fully compatible
|
||||
|
||||
my_compatibility = 0.0_pReal
|
||||
forall(s1 = 1_pInt:ns) &
|
||||
my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal
|
||||
|
||||
forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,1:Nneighbors) = 1.0_pReal
|
||||
|
||||
!*** Loop thrugh neighbors and check whether there is any my_compatibility.
|
||||
|
||||
do n = 1_pInt,Nneighbors
|
||||
neighbors: do n = 1_pInt,Nneighbors
|
||||
neighbor_e = mesh_ipNeighborhood(1,n,i,e)
|
||||
neighbor_i = mesh_ipNeighborhood(2,n,i,e)
|
||||
|
||||
|
|
@ -3093,8 +3091,7 @@ do n = 1_pInt,Nneighbors
|
|||
!* Set surface transmissivity to the value specified in the material.config
|
||||
|
||||
if (neighbor_e <= 0_pInt .or. neighbor_i <= 0_pInt) then
|
||||
forall(s1 = 1_pInt:ns) &
|
||||
my_compatibility(1:2,s1,s1,n) = sqrt(surfaceTransmissivity(instance))
|
||||
forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = sqrt(surfaceTransmissivity(instance))
|
||||
cycle
|
||||
endif
|
||||
|
||||
|
|
@ -3107,10 +3104,8 @@ do n = 1_pInt,Nneighbors
|
|||
|
||||
neighbor_phase = material_phase(1,neighbor_i,neighbor_e)
|
||||
if (neighbor_phase /= ph) then
|
||||
if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph)) then
|
||||
forall(s1 = 1_pInt:ns) &
|
||||
my_compatibility(1:2,s1,s1,n) = 0.0_pReal ! = sqrt(0.0)
|
||||
endif
|
||||
if (.not. phase_localPlasticity(neighbor_phase) .and. .not. phase_localPlasticity(ph))&
|
||||
forall(s1 = 1_pInt:ns) my_compatibility(1:2,s1,s1,n) = 0.0_pReal
|
||||
cycle
|
||||
endif
|
||||
|
||||
|
|
@ -3141,33 +3136,33 @@ do n = 1_pInt,Nneighbors
|
|||
else
|
||||
absoluteMisorientation = lattice_qDisorientation(orientation(1:4,1,i,e), &
|
||||
orientation(1:4,1,neighbor_i,neighbor_e)) ! no symmetry
|
||||
do s1 = 1_pInt,ns ! my slip systems
|
||||
do s2 = 1_pInt,ns ! my neighbor's slip systems
|
||||
mySlipSystems: do s1 = 1_pInt,ns
|
||||
neighborSlipSystems: do s2 = 1_pInt,ns
|
||||
my_compatibility(1,s2,s1,n) = math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2))) &
|
||||
* abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2))))
|
||||
my_compatibility(2,s2,s1,n) = abs(math_mul3x3(slipNormal(1:3,s1), math_qRot(absoluteMisorientation, slipNormal(1:3,s2)))) &
|
||||
* abs(math_mul3x3(slipDirection(1:3,s1), math_qRot(absoluteMisorientation, slipDirection(1:3,s2))))
|
||||
enddo
|
||||
enddo neighborSlipSystems
|
||||
|
||||
my_compatibilitySum = 0.0_pReal
|
||||
belowThreshold = .true.
|
||||
do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold(1:ns)))
|
||||
thresholdValue = maxval(my_compatibility(2,1:ns,s1,n), belowThreshold(1:ns)) ! screws always positive
|
||||
nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) == thresholdValue),pReal)
|
||||
nThresholdValues = real(count(my_compatibility(2,1:ns,s1,n) >= thresholdValue),pReal)
|
||||
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) & ! MD: rather check below threshold?
|
||||
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
|
||||
enddo
|
||||
where (belowThreshold(1:ns)) my_compatibility(1,1:ns,s1,n) = 0.0_pReal
|
||||
where (belowThreshold(1:ns)) my_compatibility(2,1:ns,s1,n) = 0.0_pReal
|
||||
enddo ! my slip systems cycle
|
||||
enddo mySlipSystems
|
||||
endif
|
||||
|
||||
enddo ! neighbor cycle
|
||||
enddo neighbors
|
||||
|
||||
compatibility(1:2,1:ns,1:ns,1:Nneighbors,i,e) = my_compatibility
|
||||
|
||||
|
|
|
|||
|
|
@ -873,7 +873,7 @@ subroutine plastic_phenoplus_microstructure(orientation,ipc,ip,el)
|
|||
ENDDO LOOPFINDNEISHEAR
|
||||
|
||||
!***calculate the average accumulative shear and use it as cutoff
|
||||
avg_acshear_ne = SUM(ne_acshear)/ns
|
||||
avg_acshear_ne = sum(ne_acshear)/real(ns,pReal)
|
||||
|
||||
!***
|
||||
IF (ph==neighbor_ph) THEN
|
||||
|
|
|
|||
|
|
@ -210,8 +210,7 @@ function porosity_phasefield_getFormationEnergy(ip,el)
|
|||
enddo
|
||||
|
||||
porosity_phasefield_getFormationEnergy = &
|
||||
porosity_phasefield_getFormationEnergy/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
porosity_phasefield_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function porosity_phasefield_getFormationEnergy
|
||||
|
||||
|
|
@ -243,8 +242,7 @@ function porosity_phasefield_getSurfaceEnergy(ip,el)
|
|||
enddo
|
||||
|
||||
porosity_phasefield_getSurfaceEnergy = &
|
||||
porosity_phasefield_getSurfaceEnergy/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
porosity_phasefield_getSurfaceEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function porosity_phasefield_getSurfaceEnergy
|
||||
|
||||
|
|
@ -308,7 +306,7 @@ subroutine porosity_phasefield_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi,
|
|||
enddo
|
||||
W_e = W_e + sum(abs(strain*math_mul66x6(C,strain)))
|
||||
enddo
|
||||
W_e = W_e/homogenization_Ngrains(homog)
|
||||
W_e = W_e/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
phiDot = 2.0_pReal*(1.0_pReal - phi)*(1.0_pReal - Cv)*(1.0_pReal - Cv) - &
|
||||
2.0_pReal*phi*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ &
|
||||
|
|
@ -350,8 +348,7 @@ function porosity_phasefield_getDiffusion33(ip,el)
|
|||
enddo
|
||||
|
||||
porosity_phasefield_getDiffusion33 = &
|
||||
porosity_phasefield_getDiffusion33/ &
|
||||
homogenization_Ngrains(homog)
|
||||
porosity_phasefield_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
end function porosity_phasefield_getDiffusion33
|
||||
|
||||
|
|
@ -377,10 +374,12 @@ real(pReal) function porosity_phasefield_getMobility(ip,el)
|
|||
porosity_phasefield_getMobility = 0.0_pReal
|
||||
|
||||
do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
|
||||
porosity_phasefield_getMobility = porosity_phasefield_getMobility + lattice_PorosityMobility(material_phase(ipc,ip,el))
|
||||
porosity_phasefield_getMobility = porosity_phasefield_getMobility &
|
||||
+ lattice_PorosityMobility(material_phase(ipc,ip,el))
|
||||
enddo
|
||||
|
||||
porosity_phasefield_getMobility = porosity_phasefield_getMobility/homogenization_Ngrains(mesh_element(3,el))
|
||||
porosity_phasefield_getMobility = &
|
||||
porosity_phasefield_getMobility/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function porosity_phasefield_getMobility
|
||||
|
||||
|
|
|
|||
|
|
@ -21,10 +21,10 @@ module prec
|
|||
#if (FLOAT==8)
|
||||
integer, parameter, public :: pReal = 8 !< floating point double precision (was selected_real_kind(15,300), number with 15 significant digits, up to 1e+-300)
|
||||
#ifdef __INTEL_COMPILER
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF8000000000000' !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF8000000000000' !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html)
|
||||
#endif
|
||||
#ifdef __GFORTRAN__
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF8000000000000',pReal) !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html, copy can be found in documentation/Code/Fortran)
|
||||
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF8000000000000',pReal) !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html)
|
||||
#endif
|
||||
#else
|
||||
NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION
|
||||
|
|
|
|||
|
|
@ -102,8 +102,6 @@ module spectral_utilities
|
|||
real(pReal) :: density
|
||||
end type tSolutionParams
|
||||
|
||||
type(tSolutionParams), private :: params
|
||||
|
||||
type, public :: phaseFieldDataBin !< set of parameters defining a phase field
|
||||
real(pReal) :: diffusion = 0.0_pReal, & !< thermal conductivity
|
||||
mobility = 0.0_pReal, & !< thermal mobility
|
||||
|
|
@ -265,8 +263,9 @@ subroutine utilities_init()
|
|||
enddo
|
||||
elseif (divergence_correction == 2_pInt) then
|
||||
do j = 1_pInt, 3_pInt
|
||||
if (j /= minloc(geomSize/grid,1) .and. j /= maxloc(geomSize/grid,1)) &
|
||||
scaledGeomSize = geomSize/geomSize(j)*grid(j)
|
||||
if ( j /= int(minloc(geomSize/real(grid,pReal),1),pInt) &
|
||||
.and. j /= int(maxloc(geomSize/real(grid,pReal),1),pInt)) &
|
||||
scaledGeomSize = geomSize/geomSize(j)*real(grid(j),pReal)
|
||||
enddo
|
||||
else
|
||||
scaledGeomSize = geomSize
|
||||
|
|
@ -543,7 +542,7 @@ subroutine utilities_fourierGammaConvolution(fieldAim)
|
|||
integer(pInt) :: &
|
||||
i, j, k, &
|
||||
l, m, n, o
|
||||
logical :: ierr
|
||||
logical :: err
|
||||
|
||||
|
||||
if (worldrank == 0_pInt) then
|
||||
|
|
@ -563,7 +562,7 @@ subroutine utilities_fourierGammaConvolution(fieldAim)
|
|||
matA(1:3,1:3) = real(temp33_complex); matA(4:6,4:6) = real(temp33_complex)
|
||||
matA(1:3,4:6) = aimag(temp33_complex); matA(4:6,1:3) = -aimag(temp33_complex)
|
||||
if (abs(math_det33(matA(1:3,1:3))) > 1e-16) then
|
||||
call math_invert(6_pInt, matA, matInvA, ierr)
|
||||
call math_invert(6_pInt, matA, matInvA, err)
|
||||
temp33_complex = cmplx(matInvA(1:3,1:3),matInvA(1:3,4:6),pReal)
|
||||
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt) &
|
||||
gamma_hat(l,m,n,o,1,1,1) = temp33_complex(l,n)*conjg(-xi1st(o,i,j,k))*xi1st(m,i,j,k)
|
||||
|
|
@ -623,6 +622,8 @@ end subroutine utilities_fourierGreenConvolution
|
|||
!> @brief calculate root mean square of divergence of field_fourier
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
real(pReal) function utilities_divergenceRMS()
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use mesh, only: &
|
||||
|
|
@ -631,8 +632,8 @@ real(pReal) function utilities_divergenceRMS()
|
|||
grid3
|
||||
|
||||
implicit none
|
||||
integer(pInt) :: i, j, k
|
||||
PetscErrorCode :: ierr
|
||||
integer(pInt) :: i, j, k, ierr
|
||||
complex(pReal), dimension(3) :: rescaledGeom
|
||||
|
||||
external :: &
|
||||
MPI_Allreduce
|
||||
|
|
@ -641,6 +642,7 @@ real(pReal) function utilities_divergenceRMS()
|
|||
write(6,'(/,a)') ' ... calculating divergence ................................................'
|
||||
flush(6)
|
||||
endif
|
||||
rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! calculating RMS divergence criterion in Fourier space
|
||||
|
|
@ -649,22 +651,23 @@ real(pReal) function utilities_divergenceRMS()
|
|||
do i = 2_pInt, grid1Red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice.
|
||||
utilities_divergenceRMS = utilities_divergenceRMS &
|
||||
+ 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,j,k),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again
|
||||
conjg(-xi1st(1:3,i,j,k))*geomSize/scaledGeomSize))**2.0_pReal)& ! --> sum squared L_2 norm of vector
|
||||
conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2.0_pReal)& ! --> sum squared L_2 norm of vector
|
||||
+sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,j,k),&
|
||||
conjg(-xi1st(1:3,i,j,k))*geomSize/scaledGeomSize))**2.0_pReal))
|
||||
conjg(-xi1st(1:3,i,j,k))*rescaledGeom))**2.0_pReal))
|
||||
enddo
|
||||
utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if grid(1) /= 1)
|
||||
+ sum( real(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), &
|
||||
conjg(-xi1st(1:3,1,j,k))*geomSize/scaledGeomSize))**2.0_pReal) &
|
||||
conjg(-xi1st(1:3,1,j,k))*rescaledGeom))**2.0_pReal) &
|
||||
+ sum(aimag(matmul(tensorField_fourier(1:3,1:3,1 ,j,k), &
|
||||
conjg(-xi1st(1:3,1,j,k))*geomSize/scaledGeomSize))**2.0_pReal) &
|
||||
conjg(-xi1st(1:3,1,j,k))*rescaledGeom))**2.0_pReal) &
|
||||
+ sum( real(matmul(tensorField_fourier(1:3,1:3,grid1Red,j,k), &
|
||||
conjg(-xi1st(1:3,grid1Red,j,k))*geomSize/scaledGeomSize))**2.0_pReal) &
|
||||
conjg(-xi1st(1:3,grid1Red,j,k))*rescaledGeom))**2.0_pReal) &
|
||||
+ sum(aimag(matmul(tensorField_fourier(1:3,1:3,grid1Red,j,k), &
|
||||
conjg(-xi1st(1:3,grid1Red,j,k))*geomSize/scaledGeomSize))**2.0_pReal)
|
||||
conjg(-xi1st(1:3,grid1Red,j,k))*rescaledGeom))**2.0_pReal)
|
||||
enddo; enddo
|
||||
if(grid(1) == 1_pInt) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of grid(1) == 1
|
||||
call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='utilities_divergenceRMS')
|
||||
utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space
|
||||
|
||||
|
||||
|
|
@ -675,6 +678,8 @@ end function utilities_divergenceRMS
|
|||
!> @brief calculate max of curl of field_fourier
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
real(pReal) function utilities_curlRMS()
|
||||
use IO, only: &
|
||||
IO_error
|
||||
use numerics, only: &
|
||||
worldrank
|
||||
use mesh, only: &
|
||||
|
|
@ -683,9 +688,9 @@ real(pReal) function utilities_curlRMS()
|
|||
grid3
|
||||
|
||||
implicit none
|
||||
integer(pInt) :: i, j, k, l
|
||||
integer(pInt) :: i, j, k, l, ierr
|
||||
complex(pReal), dimension(3,3) :: curl_fourier
|
||||
PetscErrorCode :: ierr
|
||||
complex(pReal), dimension(3) :: rescaledGeom
|
||||
|
||||
external :: &
|
||||
MPI_Reduce, &
|
||||
|
|
@ -695,6 +700,7 @@ real(pReal) function utilities_curlRMS()
|
|||
write(6,'(/,a)') ' ... calculating curl ......................................................'
|
||||
flush(6)
|
||||
endif
|
||||
rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! calculating max curl criterion in Fourier space
|
||||
|
|
@ -703,39 +709,40 @@ real(pReal) function utilities_curlRMS()
|
|||
do k = 1_pInt, grid3; do j = 1_pInt, grid(2);
|
||||
do i = 2_pInt, grid1Red - 1_pInt
|
||||
do l = 1_pInt, 3_pInt
|
||||
curl_fourier(l,1) = (+tensorField_fourier(l,3,i,j,k)*xi1st(2,i,j,k)*geomSize(2)/scaledGeomSize(2) &
|
||||
-tensorField_fourier(l,2,i,j,k)*xi1st(3,i,j,k)*geomSize(3)/scaledGeomSize(3))
|
||||
curl_fourier(l,2) = (+tensorField_fourier(l,1,i,j,k)*xi1st(3,i,j,k)*geomSize(3)/scaledGeomSize(3) &
|
||||
-tensorField_fourier(l,3,i,j,k)*xi1st(1,i,j,k)*geomSize(1)/scaledGeomSize(1))
|
||||
curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*geomSize(1)/scaledGeomSize(1) &
|
||||
-tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*geomSize(2)/scaledGeomSize(2))
|
||||
curl_fourier(l,1) = (+tensorField_fourier(l,3,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2) &
|
||||
-tensorField_fourier(l,2,i,j,k)*xi1st(3,i,j,k)*rescaledGeom(3))
|
||||
curl_fourier(l,2) = (+tensorField_fourier(l,1,i,j,k)*xi1st(3,i,j,k)*rescaledGeom(3) &
|
||||
-tensorField_fourier(l,3,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1))
|
||||
curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1) &
|
||||
-tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2))
|
||||
enddo
|
||||
utilities_curlRMS = utilities_curlRMS + &
|
||||
2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! Has somewhere a conj. complex counterpart. Therefore count it twice.
|
||||
enddo
|
||||
do l = 1_pInt, 3_pInt
|
||||
curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*geomSize(2)/scaledGeomSize(2) &
|
||||
-tensorField_fourier(l,2,1,j,k)*xi1st(3,1,j,k)*geomSize(3)/scaledGeomSize(3))
|
||||
curl_fourier = (+tensorField_fourier(l,1,1,j,k)*xi1st(3,1,j,k)*geomSize(3)/scaledGeomSize(3) &
|
||||
-tensorField_fourier(l,3,1,j,k)*xi1st(1,1,j,k)*geomSize(1)/scaledGeomSize(1))
|
||||
curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*geomSize(1)/scaledGeomSize(1) &
|
||||
-tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*geomSize(2)/scaledGeomSize(2))
|
||||
curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2) &
|
||||
-tensorField_fourier(l,2,1,j,k)*xi1st(3,1,j,k)*rescaledGeom(3))
|
||||
curl_fourier = (+tensorField_fourier(l,1,1,j,k)*xi1st(3,1,j,k)*rescaledGeom(3) &
|
||||
-tensorField_fourier(l,3,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1))
|
||||
curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1) &
|
||||
-tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2))
|
||||
enddo
|
||||
utilities_curlRMS = utilities_curlRMS + &
|
||||
sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (DC) does not have a conjugate complex counterpart (if grid(1) /= 1)
|
||||
do l = 1_pInt, 3_pInt
|
||||
curl_fourier = (+tensorField_fourier(l,3,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*geomSize(2)/scaledGeomSize(2) &
|
||||
-tensorField_fourier(l,2,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*geomSize(3)/scaledGeomSize(3))
|
||||
curl_fourier = (+tensorField_fourier(l,1,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*geomSize(3)/scaledGeomSize(3) &
|
||||
-tensorField_fourier(l,3,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*geomSize(1)/scaledGeomSize(1))
|
||||
curl_fourier = (+tensorField_fourier(l,2,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*geomSize(1)/scaledGeomSize(1) &
|
||||
-tensorField_fourier(l,1,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*geomSize(2)/scaledGeomSize(2))
|
||||
curl_fourier = (+tensorField_fourier(l,3,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2) &
|
||||
-tensorField_fourier(l,2,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*rescaledGeom(3))
|
||||
curl_fourier = (+tensorField_fourier(l,1,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*rescaledGeom(3) &
|
||||
-tensorField_fourier(l,3,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*rescaledGeom(1))
|
||||
curl_fourier = (+tensorField_fourier(l,2,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*rescaledGeom(1) &
|
||||
-tensorField_fourier(l,1,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2))
|
||||
enddo
|
||||
utilities_curlRMS = utilities_curlRMS + &
|
||||
sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (Nyquist) does not have a conjugate complex counterpart (if grid(1) /= 1)
|
||||
enddo; enddo
|
||||
|
||||
call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
||||
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='utilities_curlRMS')
|
||||
utilities_curlRMS = sqrt(utilities_curlRMS) * wgt
|
||||
if(grid(1) == 1_pInt) utilities_curlRMS = utilities_curlRMS * 0.5_pReal ! counted twice in case of grid(1) == 1
|
||||
|
||||
|
|
|
|||
|
|
@ -236,7 +236,7 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
thermal_typeInstance, &
|
||||
phase_Nsources, &
|
||||
phase_source, &
|
||||
|
|
@ -297,8 +297,8 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
|
|||
enddo
|
||||
enddo
|
||||
|
||||
Tdot = Tdot/homogenization_Ngrains(homog)
|
||||
dTdot_dT = dTdot_dT/homogenization_Ngrains(homog)
|
||||
Tdot = Tdot/real(homogenization_Ngrains(homog),pReal)
|
||||
dTdot_dT = dTdot_dT/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
end subroutine thermal_adiabatic_getSourceAndItsTangent
|
||||
|
||||
|
|
@ -336,8 +336,7 @@ function thermal_adiabatic_getSpecificHeat(ip,el)
|
|||
enddo
|
||||
|
||||
thermal_adiabatic_getSpecificHeat = &
|
||||
thermal_adiabatic_getSpecificHeat/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
thermal_adiabatic_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function thermal_adiabatic_getSpecificHeat
|
||||
|
||||
|
|
@ -375,8 +374,7 @@ function thermal_adiabatic_getMassDensity(ip,el)
|
|||
enddo
|
||||
|
||||
thermal_adiabatic_getMassDensity = &
|
||||
thermal_adiabatic_getMassDensity/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
thermal_adiabatic_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function thermal_adiabatic_getMassDensity
|
||||
|
||||
|
|
|
|||
|
|
@ -190,7 +190,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
thermal_typeInstance, &
|
||||
phase_Nsources, &
|
||||
phase_source, &
|
||||
|
|
@ -252,8 +252,8 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
|
|||
enddo
|
||||
enddo
|
||||
|
||||
Tdot = Tdot/homogenization_Ngrains(homog)
|
||||
dTdot_dT = dTdot_dT/homogenization_Ngrains(homog)
|
||||
Tdot = Tdot/real(homogenization_Ngrains(homog),pReal)
|
||||
dTdot_dT = dTdot_dT/real(homogenization_Ngrains(homog),pReal)
|
||||
|
||||
end subroutine thermal_conduction_getSourceAndItsTangent
|
||||
|
||||
|
|
@ -291,8 +291,7 @@ function thermal_conduction_getConductivity33(ip,el)
|
|||
enddo
|
||||
|
||||
thermal_conduction_getConductivity33 = &
|
||||
thermal_conduction_getConductivity33/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
thermal_conduction_getConductivity33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function thermal_conduction_getConductivity33
|
||||
|
||||
|
|
@ -330,8 +329,7 @@ function thermal_conduction_getSpecificHeat(ip,el)
|
|||
enddo
|
||||
|
||||
thermal_conduction_getSpecificHeat = &
|
||||
thermal_conduction_getSpecificHeat/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
thermal_conduction_getSpecificHeat/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function thermal_conduction_getSpecificHeat
|
||||
|
||||
|
|
@ -369,8 +367,7 @@ function thermal_conduction_getMassDensity(ip,el)
|
|||
enddo
|
||||
|
||||
thermal_conduction_getMassDensity = &
|
||||
thermal_conduction_getMassDensity/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
thermal_conduction_getMassDensity/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function thermal_conduction_getMassDensity
|
||||
|
||||
|
|
|
|||
|
|
@ -219,7 +219,7 @@ subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
SOURCE_vacancy_phenoplasticity_ID, &
|
||||
|
|
@ -266,8 +266,8 @@ subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv
|
|||
enddo
|
||||
enddo
|
||||
|
||||
CvDot = CvDot/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
dCvDot_dCv = dCvDot_dCv/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
|
||||
end subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent
|
||||
|
||||
|
|
@ -301,8 +301,7 @@ function vacancyflux_cahnhilliard_getMobility33(ip,el)
|
|||
enddo
|
||||
|
||||
vacancyflux_cahnhilliard_getMobility33 = &
|
||||
vacancyflux_cahnhilliard_getMobility33/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
vacancyflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function vacancyflux_cahnhilliard_getMobility33
|
||||
|
||||
|
|
@ -336,8 +335,7 @@ function vacancyflux_cahnhilliard_getDiffusion33(ip,el)
|
|||
enddo
|
||||
|
||||
vacancyflux_cahnhilliard_getDiffusion33 = &
|
||||
vacancyflux_cahnhilliard_getDiffusion33/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
vacancyflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function vacancyflux_cahnhilliard_getDiffusion33
|
||||
|
||||
|
|
@ -371,8 +369,7 @@ real(pReal) function vacancyflux_cahnhilliard_getFormationEnergy(ip,el)
|
|||
enddo
|
||||
|
||||
vacancyflux_cahnhilliard_getFormationEnergy = &
|
||||
vacancyflux_cahnhilliard_getFormationEnergy/ &
|
||||
homogenization_Ngrains(mesh_element(3,el))
|
||||
vacancyflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
|
||||
|
||||
end function vacancyflux_cahnhilliard_getFormationEnergy
|
||||
|
||||
|
|
@ -408,7 +405,7 @@ real(pReal) function vacancyflux_cahnhilliard_getEntropicCoeff(ip,el)
|
|||
vacancyflux_cahnhilliard_getEntropicCoeff = &
|
||||
vacancyflux_cahnhilliard_getEntropicCoeff* &
|
||||
temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ &
|
||||
homogenization_Ngrains(material_homog(ip,el))
|
||||
real(homogenization_Ngrains(material_homog(ip,el)),pReal)
|
||||
|
||||
end function vacancyflux_cahnhilliard_getEntropicCoeff
|
||||
|
||||
|
|
@ -467,8 +464,8 @@ subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dC
|
|||
enddo
|
||||
enddo
|
||||
|
||||
KPot = KPot/homogenization_Ngrains(material_homog(ip,el))
|
||||
dKPot_dCv = dKPot_dCv/homogenization_Ngrains(material_homog(ip,el))
|
||||
KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
|
||||
dKPot_dCv = dKPot_dCv/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
|
||||
|
||||
end subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent
|
||||
|
||||
|
|
|
|||
|
|
@ -235,7 +235,7 @@ subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv,
|
|||
use material, only: &
|
||||
homogenization_Ngrains, &
|
||||
mappingHomogenization, &
|
||||
phaseAt, phasememberAt, &
|
||||
phaseAt, &
|
||||
phase_source, &
|
||||
phase_Nsources, &
|
||||
SOURCE_vacancy_phenoplasticity_ID, &
|
||||
|
|
@ -282,8 +282,8 @@ subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv,
|
|||
enddo
|
||||
enddo
|
||||
|
||||
CvDot = CvDot/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
dCvDot_dCv = dCvDot_dCv/homogenization_Ngrains(mappingHomogenization(2,ip,el))
|
||||
CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
|
||||
|
||||
end subroutine vacancyflux_isochempot_getSourceAndItsTangent
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue