223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

changed variable name "debug_what" to "debug_level"

This commit is contained in:
Philip Eisenlohr 2012-07-05 09:54:50 +00:00
parent 941936318a
commit 4d09ef0648
19 changed files with 255 additions and 238 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
code/CPFEM.f90
View File

@ -113,7 +113,7 @@ subroutine CPFEM_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: pInt use prec, only: pInt
use debug, only: debug_what, & use debug, only: debug_level, &
debug_CPFEM, & debug_CPFEM, &
debug_levelBasic debug_levelBasic
use IO, only: IO_read_jobBinaryFile use IO, only: IO_read_jobBinaryFile
@ -145,7 +145,7 @@ subroutine CPFEM_init
! *** restore the last converged values of each essential variable from the binary file ! *** restore the last converged values of each essential variable from the binary file
if (restartRead) then if (restartRead) then
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a)') '<< CPFEM >> Restored state variables of last converged step from binary files' write(6,'(a)') '<< CPFEM >> Restored state variables of last converged step from binary files'
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -207,7 +207,7 @@ subroutine CPFEM_init
write(6,*) '<<<+- cpfem init -+>>>' write(6,*) '<<<+- cpfem init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood)
@ -233,7 +233,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
use prec, only: pInt use prec, only: pInt
use numerics, only: defgradTolerance, & use numerics, only: defgradTolerance, &
iJacoStiffness iJacoStiffness
use debug, only: debug_what, & use debug, only: debug_level, &
debug_CPFEM, & debug_CPFEM, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -357,7 +357,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
cp_en = mesh_FEasCP('elem',element) cp_en = mesh_FEasCP('elem',element)
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt .and. cp_en == 1 .and. IP == 1) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt .and. cp_en == 1 .and. IP == 1) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,'(a)') '#############################################' write(6,'(a)') '#############################################'
@ -394,7 +394,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
j = 1:mesh_maxNips, & j = 1:mesh_maxNips, &
k = 1:mesh_NcpElems ) & k = 1:mesh_NcpElems ) &
constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a)') '<< CPFEM >> Aging states' write(6,'(a)') '<< CPFEM >> Aging states'
if (debug_e == cp_en .and. debug_i == IP) then if (debug_e == cp_en .and. debug_i == IP) then
@ -416,7 +416,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
! * dump the last converged values of each essential variable to a binary file ! * dump the last converged values of each essential variable to a binary file
if (restartWrite) then if (restartWrite) then
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a)') '<< CPFEM >> Writing state variables of last converged step to binary files' write(6,'(a)') '<< CPFEM >> Writing state variables of last converged step to binary files'
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -485,7 +485,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
if (terminallyIll .or. outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(1:3,1:3,IP,cp_en)) > defgradTolerance)) then if (terminallyIll .or. outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(1:3,1:3,IP,cp_en)) > defgradTolerance)) then
if (.not. terminallyIll .and. .not. outdatedFFN1) then if (.not. terminallyIll .and. .not. outdatedFFN1) then
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at element ip',cp_en,IP write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at element ip',cp_en,IP
write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',math_transpose33(materialpoint_F(1:3,1:3,IP,cp_en)) write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',math_transpose33(materialpoint_F(1:3,1:3,IP,cp_en))
@ -512,7 +512,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
FEsolving_execElem(2) = cp_en FEsolving_execElem(2) = cp_en
FEsolving_execIP(1,cp_en) = IP FEsolving_execIP(1,cp_en) = IP
FEsolving_execIP(2,cp_en) = IP FEsolving_execIP(2,cp_en) = IP
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,i8,1x,i2)') '<< CPFEM >> Calculation for element ip ',cp_en,IP write(6,'(a,i8,1x,i2)') '<< CPFEM >> Calculation for element ip ',cp_en,IP
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -523,7 +523,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
!* parallel computation and calulation not yet done !* parallel computation and calulation not yet done
elseif (.not. CPFEM_calc_done) then elseif (.not. CPFEM_calc_done) then
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,i8,a,i8)') '<< CPFEM >> Calculation for elements ',FEsolving_execElem(1),' to ',FEsolving_execElem(2) write(6,'(a,i8,a,i8)') '<< CPFEM >> Calculation for elements ',FEsolving_execElem(1),' to ',FEsolving_execElem(2)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -533,7 +533,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
call mesh_build_subNodeCoords() ! update subnodal coordinates call mesh_build_subNodeCoords() ! update subnodal coordinates
call mesh_build_ipCoordinates() ! update ip coordinates call mesh_build_ipCoordinates() ! update ip coordinates
#endif #endif
if (iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,i8,a,i8)') '<< CPFEM >> Start stress and tangent ',FEsolving_execElem(1),' to ',FEsolving_execElem(2) write(6,'(a,i8,a,i8)') '<< CPFEM >> Start stress and tangent ',FEsolving_execElem(1),' to ',FEsolving_execElem(2)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -637,9 +637,9 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP,
Temperature = materialpoint_Temperature(IP,cp_en) ! homogenized result except for potentially non-isothermal starting condition. Temperature = materialpoint_Temperature(IP,cp_en) ! homogenized result except for potentially non-isothermal starting condition.
endif endif
if (mode < 3 .and. iand(debug_what(debug_CPFEM), debug_levelBasic) /= 0_pInt & if (mode < 3 .and. iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt &
.and. ((debug_e == cp_en .and. debug_i == IP) & .and. ((debug_e == cp_en .and. debug_i == IP) &
.or. .not. iand(debug_what(debug_CPFEM), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_CPFEM), debug_levelSelective) /= 0_pInt)) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1.0e6_pReal write(6,'(a,i8,1x,i2,/,12x,6(f10.3,1x)/)') '<< CPFEM >> stress/MPa at el ip ', cp_en, IP, cauchyStress/1.0e6_pReal
write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') '<< CPFEM >> jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1.0e9_pReal write(6,'(a,i8,1x,i2,/,6(12x,6(f10.3,1x)/))') '<< CPFEM >> jacobian/GPa at el ip ', cp_en, IP, transpose(jacobian)/1.0e9_pReal

8
code/DAMASK_abaqus_exp.f
View File

@ -170,7 +170,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, &
use debug, only: debug_info, & use debug, only: debug_info, &
debug_reset, & debug_reset, &
debug_levelBasic, & debug_levelBasic, &
debug_what, & debug_level, &
debug_abaqus debug_abaqus
use mesh, only: mesh_FEasCP use mesh, only: mesh_FEasCP
use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll
@ -210,7 +210,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, &
call CPFEM_initAll(temp,nElement(n),nMatPoint(n)) call CPFEM_initAll(temp,nElement(n),nMatPoint(n))
outdatedByNewInc = .false. outdatedByNewInc = .false.
if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'first call special case..!'; call flush(6) write(6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'first call special case..!'; call flush(6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -219,7 +219,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, &
else if (theTime < totalTime) then ! reached convergence else if (theTime < totalTime) then ! reached convergence
outdatedByNewInc = .true. outdatedByNewInc = .true.
if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write (6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'lastIncConverged + outdated'; call flush(6) write (6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'lastIncConverged + outdated'; call flush(6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -241,7 +241,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, &
theTime = totalTime ! record current starting time theTime = totalTime ! record current starting time
if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,x,i2,x,a,i8,x,i5,a)') 'computationMode',computationMode,'(',nElement(n),nMatPoint(n),')'; call flush(6) write(6,'(a16,x,i2,x,a,i8,x,i5,a)') 'computationMode',computationMode,'(',nElement(n),nMatPoint(n),')'; call flush(6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)

6
code/DAMASK_abaqus_std.f
View File

@ -137,7 +137,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
use debug, only: debug_info, & use debug, only: debug_info, &
debug_reset, & debug_reset, &
debug_levelBasic, & debug_levelBasic, &
debug_what, & debug_level, &
debug_abaqus debug_abaqus
use mesh, only: mesh_FEasCP use mesh, only: mesh_FEasCP
use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll use CPFEM, only: CPFEM_general,CPFEM_init_done, CPFEM_initAll
@ -163,7 +163,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
real(pReal), dimension(6,6) :: ddsdde_h real(pReal), dimension(6,6) :: ddsdde_h
integer(pInt) computationMode, i, cp_en integer(pInt) computationMode, i, cp_en
if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0 .and. noel == 1 .and. npt == 1) then if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0 .and. noel == 1 .and. npt == 1) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) 'el',noel,'ip',npt write(6,*) 'el',noel,'ip',npt
write(6,*) 'got kinc as',kinc write(6,*) 'got kinc as',kinc
@ -251,7 +251,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
theInc = kinc ! record current increment number theInc = kinc ! record current increment number
lastMode = calcMode(npt,cp_en) ! record calculationMode lastMode = calcMode(npt,cp_en) ! record calculationMode
if (iand(debug_what(debug_abaqus),debug_levelBasic) /= 0) then if (iand(debug_level(debug_abaqus),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,x,i2,x,a,i8,a,i8,x,i5,a)') 'computationMode',computationMode,'(',cp_en,':',noel,npt,')'; call flush(6) write(6,'(a16,x,i2,x,a,i8,a,i8,x,i5,a)') 'computationMode',computationMode,'(',cp_en,':',noel,npt,')'; call flush(6)
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)

12
code/DAMASK_spectral.f90
View File

@ -65,7 +65,7 @@ program DAMASK_spectral
IO_write_jobBinaryFile IO_write_jobBinaryFile
use debug, only: & use debug, only: &
debug_what, & debug_level, &
debug_spectral, & debug_spectral, &
debug_levelBasic, & debug_levelBasic, &
debug_spectralDivergence, & debug_spectralDivergence, &
@ -282,7 +282,7 @@ program DAMASK_spectral
N_Fdot = N_Fdot + 1_pInt N_Fdot = N_Fdot + 1_pInt
case('t','time','delta') case('t','time','delta')
N_t = N_t + 1_pInt N_t = N_t + 1_pInt
case('n','incs','increments','steps','logincs','logsteps') case('n','incs','increments','steps','logincs','logincrements','logsteps')
N_n = N_n + 1_pInt N_n = N_n + 1_pInt
end select end select
enddo ! count all identifiers to allocate memory and do sanity check enddo ! count all identifiers to allocate memory and do sanity check
@ -443,10 +443,10 @@ program DAMASK_spectral
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! debugging parameters ! debugging parameters
debugGeneral = iand(debug_what(debug_spectral),debug_levelBasic) /= 0 debugGeneral = iand(debug_level(debug_spectral),debug_levelBasic) /= 0
debugDivergence = iand(debug_what(debug_spectral),debug_spectralDivergence) /= 0 debugDivergence = iand(debug_level(debug_spectral),debug_spectralDivergence) /= 0
debugRestart = iand(debug_what(debug_spectral),debug_spectralRestart) /= 0 debugRestart = iand(debug_level(debug_spectral),debug_spectralRestart) /= 0
debugFFTW = iand(debug_what(debug_spectral),debug_spectralFFTW) /= 0 debugFFTW = iand(debug_level(debug_spectral),debug_spectralFFTW) /= 0
!################################################################################################## !##################################################################################################
! initialization ! initialization

2
code/DAMASK_spectral_AL.f90
View File

@ -64,7 +64,7 @@ program DAMASK_spectral_AL
IO_write_jobBinaryFile IO_write_jobBinaryFile
use debug, only: & use debug, only: &
debug_what, & debug_level, &
debug_spectral, & debug_spectral, &
debug_levelBasic, & debug_levelBasic, &
debug_spectralDivergence, & debug_spectralDivergence, &

4
code/FEsolving.f90
View File

@ -72,7 +72,7 @@ subroutine FE_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: & use debug, only: &
debug_what, & debug_level, &
debug_FEsolving, & debug_FEsolving, &
debug_levelBasic debug_levelBasic
@ -176,7 +176,7 @@ subroutine FE_init
write(6,*) '<<<+- FEsolving init -+>>>' write(6,*) '<<<+- FEsolving init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_what(debug_FEsolving),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then
write(6,*) 'restart writing: ', restartWrite write(6,*) 'restart writing: ', restartWrite
write(6,*) 'restart reading: ', restartRead write(6,*) 'restart reading: ', restartRead
if (restartRead) write(6,*) 'restart Job: ', trim(modelName) if (restartRead) write(6,*) 'restart Job: ', trim(modelName)

22
code/constitutive.f90
View File

@ -82,7 +82,7 @@ contains
!************************************** !**************************************
subroutine constitutive_init subroutine constitutive_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use numerics, only: numerics_integrator use numerics, only: numerics_integrator
@ -428,7 +428,7 @@ constitutive_maxSizePostResults = maxval(constitutive_sizePostResults)
write(6,*) '<<<+- constitutive init -+>>>' write(6,*) '<<<+- constitutive init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
write(6,'(a32,1x,7(i8,1x))') 'constitutive_state0: ', shape(constitutive_state0) write(6,'(a32,1x,7(i8,1x))') 'constitutive_state0: ', shape(constitutive_state0)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0) write(6,'(a32,1x,7(i8,1x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_subState0: ', shape(constitutive_subState0) write(6,'(a32,1x,7(i8,1x))') 'constitutive_subState0: ', shape(constitutive_subState0)
@ -754,7 +754,7 @@ subroutine constitutive_collectDotState(Tstar_v, Fe, Fp, Temperature, subdt, ori
use prec, only: pReal, pLongInt use prec, only: pReal, pLongInt
use debug, only: debug_cumDotStateCalls, & use debug, only: debug_cumDotStateCalls, &
debug_cumDotStateTicks, & debug_cumDotStateTicks, &
debug_what, & debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use mesh, only: mesh_NcpElems, & use mesh, only: mesh_NcpElems, &
@ -794,7 +794,7 @@ integer(pLongInt) tick, tock, &
tickrate, & tickrate, &
maxticks maxticks
if (iand(debug_what(debug_constitutive), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
endif endif
@ -821,7 +821,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el)))
end select end select
if (iand(debug_what(debug_constitutive), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
!$OMP CRITICAL (debugTimingDotState) !$OMP CRITICAL (debugTimingDotState)
debug_cumDotStateCalls = debug_cumDotStateCalls + 1_pInt debug_cumDotStateCalls = debug_cumDotStateCalls + 1_pInt
@ -844,7 +844,7 @@ subroutine constitutive_collectDeltaState(Tstar_v, Temperature, ipc, ip, el)
use prec, only: pReal, pLongInt use prec, only: pReal, pLongInt
use debug, only: debug_cumDeltaStateCalls, & use debug, only: debug_cumDeltaStateCalls, &
debug_cumDeltaStateTicks, & debug_cumDeltaStateTicks, &
debug_what, & debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use mesh, only: mesh_NcpElems, & use mesh, only: mesh_NcpElems, &
@ -878,7 +878,7 @@ integer(pLongInt) tick, tock, &
tickrate, & tickrate, &
maxticks maxticks
if (iand(debug_what(debug_constitutive), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
endif endif
@ -904,7 +904,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el)))
end select end select
if (iand(debug_what(debug_constitutive), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
!$OMP CRITICAL (debugTimingDeltaState) !$OMP CRITICAL (debugTimingDeltaState)
debug_cumDeltaStateCalls = debug_cumDeltaStateCalls + 1_pInt debug_cumDeltaStateCalls = debug_cumDeltaStateCalls + 1_pInt
@ -927,7 +927,7 @@ function constitutive_dotTemperature(Tstar_v,Temperature,ipc,ip,el)
use prec, only: pReal, pLongInt use prec, only: pReal, pLongInt
use debug, only: debug_cumDotTemperatureCalls, & use debug, only: debug_cumDotTemperatureCalls, &
debug_cumDotTemperatureTicks, & debug_cumDotTemperatureTicks, &
debug_what, & debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use material, only: phase_plasticity, & use material, only: phase_plasticity, &
@ -963,7 +963,7 @@ integer(pLongInt) tick, tock, &
maxticks maxticks
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
endif endif
@ -989,7 +989,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el)))
end select end select
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
!$OMP CRITICAL (debugTimingDotTemperature) !$OMP CRITICAL (debugTimingDotTemperature)
debug_cumDotTemperatureCalls = debug_cumDotTemperatureCalls + 1_pInt debug_cumDotTemperatureCalls = debug_cumDotTemperatureCalls + 1_pInt

4
code/constitutive_j2.f90
View File

@ -117,7 +117,7 @@ subroutine constitutive_j2_init(myFile)
IO_error IO_error
use material use material
use debug, only: & use debug, only: &
debug_what, & debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
@ -141,7 +141,7 @@ subroutine constitutive_j2_init(myFile)
maxNinstance = int(count(phase_plasticity == constitutive_j2_label),pInt) maxNinstance = int(count(phase_plasticity == constitutive_j2_label),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,'(a16,1x,i5)') '# instances:',maxNinstance
write(6,*) write(6,*)

4
code/constitutive_none.f90
View File

@ -97,7 +97,7 @@ subroutine constitutive_none_init(myFile)
IO_error IO_error
use material use material
use debug, only: & use debug, only: &
debug_what, & debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use lattice, only: lattice_initializeStructure, lattice_symmetryType use lattice, only: lattice_initializeStructure, lattice_symmetryType
@ -121,7 +121,7 @@ subroutine constitutive_none_init(myFile)
maxNinstance = int(count(phase_plasticity == constitutive_none_label),pInt) maxNinstance = int(count(phase_plasticity == constitutive_none_label),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,'(a16,1x,i5)') '# instances:',maxNinstance
write(6,*) write(6,*)

50
code/constitutive_nonlocal.f90
View File

@ -207,7 +207,7 @@ use IO, only: IO_lc, &
IO_floatValue, & IO_floatValue, &
IO_intValue, & IO_intValue, &
IO_error IO_error
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic debug_levelBasic
use mesh, only: mesh_NcpElems, & use mesh, only: mesh_NcpElems, &
@ -266,7 +266,7 @@ character(len=1024) line
maxNinstance = int(count(phase_plasticity == constitutive_nonlocal_label),pInt) maxNinstance = int(count(phase_plasticity == constitutive_nonlocal_label),pInt)
if (maxNinstance == 0) return ! we don't have to do anything if there's no instance for this constitutive law if (maxNinstance == 0) return ! we don't have to do anything if there's no instance for this constitutive law
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,'(a16,1x,i5)') '# instances:',maxNinstance
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
@ -952,7 +952,7 @@ use math, only: math_Mandel33to6, &
math_invert33, & math_invert33, &
math_transpose33, & math_transpose33, &
pi pi
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -1197,9 +1197,9 @@ state(g,ip,el)%p(12_pInt*ns+1:13_pInt*ns) = tauBack
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_microstructure at el ip g',el,ip,g write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_microstructure at el ip g',el,ip,g
write(6,*) write(6,*)
@ -1221,7 +1221,7 @@ subroutine constitutive_nonlocal_kinetics(v, tau, c, Temperature, state, g, ip,
use prec, only: pReal, & use prec, only: pReal, &
pInt, & pInt, &
p_vec p_vec
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -1361,9 +1361,9 @@ endif
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_kinetics at el ip g',el,ip,g write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_kinetics at el ip g',el,ip,g
write(6,*) write(6,*)
@ -1387,7 +1387,7 @@ use prec, only: pReal, &
p_vec p_vec
use math, only: math_Plain3333to99, & use math, only: math_Plain3333to99, &
math_mul6x6 math_mul6x6
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -1508,9 +1508,9 @@ dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt )) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then
write(6,*) write(6,*)
write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_LpandItsTangent at el ip g ',el,ip,g write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_LpandItsTangent at el ip g ',el,ip,g
write(6,*) write(6,*)
@ -1531,7 +1531,7 @@ subroutine constitutive_nonlocal_deltaState(deltaState, state, Tstar_v, Temperat
use prec, only: pReal, & use prec, only: pReal, &
pInt, & pInt, &
p_vec p_vec
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -1593,9 +1593,9 @@ real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_deltaState at el ip g ',el,ip,g write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_deltaState at el ip g ',el,ip,g
write(6,*) write(6,*)
@ -1714,9 +1714,9 @@ deltaState%p = reshape(deltaRho,(/10_pInt*ns/))
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt )) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8) write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(1:ns,1:8)
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by stress decrease', deltaRhoSingle2DipoleStress write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by stress decrease', deltaRhoSingle2DipoleStress
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress
@ -1739,7 +1739,7 @@ use prec, only: pReal, &
DAMASK_NaN DAMASK_NaN
use numerics, only: numerics_integrationMode use numerics, only: numerics_integrationMode
use IO, only: IO_error use IO, only: IO_error
use debug, only: debug_what, & use debug, only: debug_level, &
debug_constitutive, & debug_constitutive, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -1854,9 +1854,9 @@ logical considerEnteringFlux, &
considerLeavingFlux considerLeavingFlux
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_dotState at el ip g ',el,ip,g write(6,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_dotState at el ip g ',el,ip,g
write(6,*) write(6,*)
@ -1903,9 +1903,9 @@ forall (t = 1_pInt:4_pInt) &
gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * constitutive_nonlocal_burgers(1:ns,myInstance) * v(1:ns,t) gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * constitutive_nonlocal_burgers(1:ns,myInstance) * v(1:ns,t)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt )) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip
write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot
endif endif
@ -1918,7 +1918,7 @@ forall (t = 1_pInt:4_pInt) &
if (any(abs(gdot) > 0.0_pReal .and. 2.0_pReal * abs(v) * timestep > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! safety factor 2.0 (we use the reference volume and are for simplicity here) if (any(abs(gdot) > 0.0_pReal .and. 2.0_pReal * abs(v) * timestep > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! safety factor 2.0 (we use the reference volume and are for simplicity here)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ',maxval(abs(v)),' at a timestep of ',timestep write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ',maxval(abs(v)),' at a timestep of ',timestep
write(6,'(a)') '<< CONST >> enforcing cutback !!!' write(6,'(a)') '<< CONST >> enforcing cutback !!!'
@ -2170,7 +2170,7 @@ rhoDot = rhoDotFlux &
if ( any(rhoSgl(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < - constitutive_nonlocal_aTolRho(myInstance)) & if ( any(rhoSgl(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < - constitutive_nonlocal_aTolRho(myInstance)) &
.or. any(rhoDip(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < - constitutive_nonlocal_aTolRho(myInstance))) then .or. any(rhoDip(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < - constitutive_nonlocal_aTolRho(myInstance))) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip
write(6,'(a)') '<< CONST >> enforcing cutback !!!' write(6,'(a)') '<< CONST >> enforcing cutback !!!'
endif endif
@ -2184,9 +2184,9 @@ endif
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt &
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)& .and. ((debug_e == el .and. debug_i == ip .and. debug_g == g)&
.or. .not. iand(debug_what(debug_constitutive),debug_levelSelective) /= 0_pInt )) then .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then
write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', rhoDotMultiplication(1:ns,1:4) * timestep write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', rhoDotMultiplication(1:ns,1:4) * timestep
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', rhoDotFlux(1:ns,1:8) * timestep write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', rhoDotFlux(1:ns,1:8) * timestep
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', rhoDotSingle2DipoleGlide * timestep write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', rhoDotSingle2DipoleGlide * timestep

4
code/constitutive_phenopowerlaw.f90
View File

@ -169,7 +169,7 @@ subroutine constitutive_phenopowerlaw_init(myFile)
math_Voigt66to3333 math_Voigt66to3333
use IO use IO
use material use material
use debug, only: debug_what,& use debug, only: debug_level,&
debug_constitutive,& debug_constitutive,&
debug_levelBasic debug_levelBasic
use lattice, only: lattice_initializeStructure, lattice_symmetryType, & use lattice, only: lattice_initializeStructure, lattice_symmetryType, &
@ -199,7 +199,7 @@ subroutine constitutive_phenopowerlaw_init(myFile)
maxNinstance = int(count(phase_plasticity == constitutive_phenopowerlaw_label),pInt) maxNinstance = int(count(phase_plasticity == constitutive_phenopowerlaw_label),pInt)
if (maxNinstance == 0) return if (maxNinstance == 0) return
if (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,'(a16,1x,i5)') '# instances:',maxNinstance
write(6,*) write(6,*)

132
code/crystallite.f90
View File

@ -113,7 +113,7 @@ subroutine crystallite_init(Temperature)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: debug_info, & use debug, only: debug_info, &
debug_reset, & debug_reset, &
debug_what, & debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic debug_levelBasic
use math, only: math_I3, & use math, only: math_I3, &
@ -389,7 +389,7 @@ call crystallite_stressAndItsTangent(.true.,.false.) ! request
crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback
! *** Output to MARC output file *** ! *** Output to MARC output file ***
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a35,1x,7(i8,1x))') 'crystallite_Temperature: ', shape(crystallite_Temperature) write(6,'(a35,1x,7(i8,1x))') 'crystallite_Temperature: ', shape(crystallite_Temperature)
write(6,'(a35,1x,7(i8,1x))') 'crystallite_dotTemperature: ', shape(crystallite_dotTemperature) write(6,'(a35,1x,7(i8,1x))') 'crystallite_dotTemperature: ', shape(crystallite_dotTemperature)
@ -463,7 +463,7 @@ use numerics, only: subStepMinCryst, &
numerics_integrationMode, & numerics_integrationMode, &
relevantStrain, & relevantStrain, &
analyticJaco analyticJaco
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -552,7 +552,7 @@ real(pReal) :: counter
! --+>> INITIALIZE TO STARTING CONDITION <<+-- ! --+>> INITIALIZE TO STARTING CONDITION <<+--
if(iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt& if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt&
.and. debug_e > 0 .and. debug_e <= mesh_NcpElems & .and. debug_e > 0 .and. debug_e <= mesh_NcpElems &
.and. debug_i > 0 .and. debug_i <= mesh_maxNips & .and. debug_i > 0 .and. debug_i <= mesh_maxNips &
.and. debug_g > 0 .and. debug_g <= homogenization_maxNgrains) then .and. debug_g > 0 .and. debug_g <= homogenization_maxNgrains) then
@ -614,9 +614,9 @@ do while (any(crystallite_subStep(:,:,FEsolving_execELem(1):FEsolving_execElem(2
if (crystallite_converged(g,i,e)) then if (crystallite_converged(g,i,e)) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,f12.8,a,f12.8,a)') '<< CRYST >> winding forward from ', & write(6,'(a,f12.8,a,f12.8,a)') '<< CRYST >> winding forward from ', &
crystallite_subFrac(g,i,e),' to current crystallite_subfrac ', & crystallite_subFrac(g,i,e),' to current crystallite_subfrac ', &
crystallite_subFrac(g,i,e)+crystallite_subStep(g,i,e),' in crystallite_stressAndItsTangent' crystallite_subFrac(g,i,e)+crystallite_subStep(g,i,e),' in crystallite_stressAndItsTangent'
@ -639,7 +639,7 @@ do while (any(crystallite_subStep(:,:,FEsolving_execELem(1):FEsolving_execElem(2
crystallite_subTstar0_v(1:6,g,i,e) = crystallite_Tstar_v(1:6,g,i,e) ! ...2nd PK stress crystallite_subTstar0_v(1:6,g,i,e) = crystallite_Tstar_v(1:6,g,i,e) ! ...2nd PK stress
!$OMP FLUSH(crystallite_subF0) !$OMP FLUSH(crystallite_subF0)
elseif (formerSubStep > subStepMinCryst) then ! this crystallite just converged elseif (formerSubStep > subStepMinCryst) then ! this crystallite just converged
if (iand(debug_what(debug_crystallite),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionCrystallite) !$OMP CRITICAL (distributionCrystallite)
debug_CrystalliteLoopDistribution(min(nCryst+1_pInt,NiterationCrystallite)) = & debug_CrystalliteLoopDistribution(min(nCryst+1_pInt,NiterationCrystallite)) = &
debug_CrystalliteLoopDistribution(min(nCryst+1_pInt,NiterationCrystallite)) + 1_pInt debug_CrystalliteLoopDistribution(min(nCryst+1_pInt,NiterationCrystallite)) + 1_pInt
@ -660,9 +660,9 @@ do while (any(crystallite_subStep(:,:,FEsolving_execELem(1):FEsolving_execElem(2
! cant restore dotState here, since not yet calculated in first cutback after initialization ! cant restore dotState here, since not yet calculated in first cutback after initialization
!$OMP FLUSH(crystallite_invFp) !$OMP FLUSH(crystallite_invFp)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite),debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,f12.8)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent with new crystallite_subStep: ',& write(6,'(a,f12.8)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent with new crystallite_subStep: ',&
crystallite_subStep(g,i,e) crystallite_subStep(g,i,e)
write(6,*) write(6,*)
@ -720,7 +720,7 @@ enddo
do g = 1,myNgrains do g = 1,myNgrains
if (.not. crystallite_converged(g,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) if (.not. crystallite_converged(g,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway)
#ifndef _OPENMP #ifndef _OPENMP
if(iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> no convergence : respond fully elastic at el ip g ',e,i,g write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> no convergence : respond fully elastic at el ip g ',e,i,g
write (6,*) write (6,*)
endif endif
@ -732,9 +732,9 @@ enddo
endif endif
#ifndef _OPENMP #ifndef _OPENMP
if(iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt & if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then
write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g write (6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip g ',e,i,g
write (6,*) write (6,*)
write (6,'(a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal write (6,'(a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal
@ -793,7 +793,7 @@ if(updateJaco) then
myPert = -pert_Fg * (-1.0_pReal)**perturbation ! set perturbation step myPert = -pert_Fg * (-1.0_pReal)**perturbation ! set perturbation step
do k = 1,3; do l = 1,3 ! ...alter individual components do k = 1,3; do l = 1,3 ! ...alter individual components
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a,2(1x,i1),1x,a)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]' write(6,'(a,2(1x,i1),1x,a)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]'
write(6,*) write(6,*)
@ -1017,7 +1017,7 @@ subroutine crystallite_integrateStateRK4(gg,ii,ee)
use prec, only: pInt, & use prec, only: pInt, &
pReal pReal
use numerics, only: numerics_integrationMode use numerics, only: numerics_integrationMode
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -1150,9 +1150,9 @@ do n = 1_pInt,4_pInt
+ crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) * timeStepFraction(n) + crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) * timeStepFraction(n)
if (n == 4) then ! final integration step if (n == 4) then ! final integration step
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)&
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
mySizeDotState = constitutive_sizeDotState(g,i,e) mySizeDotState = constitutive_sizeDotState(g,i,e)
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g
write(6,*) write(6,*)
@ -1260,7 +1260,7 @@ enddo
if (crystallite_todo(g,i,e)) then if (crystallite_todo(g,i,e)) then
crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem
crystallite_todo(g,i,e) = .false. ! ... integration done crystallite_todo(g,i,e) = .false. ! ... integration done
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(6,numerics_integrationMode) = & debug_StateLoopDistribution(6,numerics_integrationMode) = &
debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt
@ -1293,7 +1293,7 @@ end subroutine crystallite_integrateStateRK4
subroutine crystallite_integrateStateRKCK45(gg,ii,ee) subroutine crystallite_integrateStateRKCK45(gg,ii,ee)
!*** variables and functions from other modules ***! !*** variables and functions from other modules ***!
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -1416,7 +1416,7 @@ endif
! --- FIRST RUNGE KUTTA STEP --- ! --- FIRST RUNGE KUTTA STEP ---
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',1 write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',1
endif endif
#endif #endif
@ -1551,7 +1551,7 @@ do n = 1_pInt,5_pInt
! --- dot state and RK dot state--- ! --- dot state and RK dot state---
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',n+1_pInt write(6,'(a,1x,i1)') '<< CRYST >> RUNGE KUTTA STEP',n+1_pInt
endif endif
#endif #endif
@ -1676,9 +1676,9 @@ relTemperatureResiduum = 0.0_pReal
.and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature ) .and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature )
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt& if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt&
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)&
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i3,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,'(a,i8,1x,i3,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g
write(6,*) write(6,*)
write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', & write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', &
@ -1752,7 +1752,7 @@ relTemperatureResiduum = 0.0_pReal
if (crystallite_todo(g,i,e)) then if (crystallite_todo(g,i,e)) then
crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem
crystallite_todo(g,i,e) = .false. ! ... integration done crystallite_todo(g,i,e) = .false. ! ... integration done
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(6,numerics_integrationMode) = & debug_StateLoopDistribution(6,numerics_integrationMode) = &
debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt
@ -1768,7 +1768,7 @@ relTemperatureResiduum = 0.0_pReal
! --- nonlocal convergence check --- ! --- nonlocal convergence check ---
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged'
write(6,*) write(6,*)
endif endif
@ -1791,7 +1791,7 @@ end subroutine crystallite_integrateStateRKCK45
subroutine crystallite_integrateStateAdaptiveEuler(gg,ii,ee) subroutine crystallite_integrateStateAdaptiveEuler(gg,ii,ee)
!*** variables and functions from other modules ***! !*** variables and functions from other modules ***!
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -2008,9 +2008,9 @@ relTemperatureResiduum = 0.0_pReal
!$OMP FLUSH(relStateResiduum,relTemperatureResiduum) !$OMP FLUSH(relStateResiduum,relTemperatureResiduum)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)&
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g
write(6,*) write(6,*)
write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', & write(6,'(a,/,(12x,12(f12.1,1x)))') '<< CRYST >> absolute residuum tolerance', &
@ -2033,7 +2033,7 @@ relTemperatureResiduum = 0.0_pReal
.or. abs(stateResiduum(1:mySizeDotState,g,i,e)) < constitutive_aTolState(g,i,e)%p(1:mySizeDotState)) & .or. abs(stateResiduum(1:mySizeDotState,g,i,e)) < constitutive_aTolState(g,i,e)%p(1:mySizeDotState)) &
.and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature ) then .and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature ) then
crystallite_converged(g,i,e) = .true. ! ... converged per definitionem crystallite_converged(g,i,e) = .true. ! ... converged per definitionem
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(2,numerics_integrationMode) = & debug_StateLoopDistribution(2,numerics_integrationMode) = &
debug_StateLoopDistribution(2,numerics_integrationMode) + 1_pInt debug_StateLoopDistribution(2,numerics_integrationMode) + 1_pInt
@ -2070,7 +2070,7 @@ relTemperatureResiduum = 0.0_pReal
! --- NONLOCAL CONVERGENCE CHECK --- ! --- NONLOCAL CONVERGENCE CHECK ---
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged'
write(6,*) write(6,*)
endif endif
@ -2093,7 +2093,7 @@ subroutine crystallite_integrateStateEuler(gg,ii,ee)
!*** variables and functions from other modules ***! !*** variables and functions from other modules ***!
use numerics, only: numerics_integrationMode use numerics, only: numerics_integrationMode
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -2191,9 +2191,9 @@ if (numerics_integrationMode < 2) then
crystallite_Temperature(g,i,e) = crystallite_subTemperature0(g,i,e) & crystallite_Temperature(g,i,e) = crystallite_subTemperature0(g,i,e) &
+ crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) + crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g
write(6,*) write(6,*)
write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState) write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> dotState', constitutive_dotState(g,i,e)%p(1:mySizeDotState)
@ -2260,7 +2260,7 @@ endif
if (crystallite_todo(g,i,e)) then if (crystallite_todo(g,i,e)) then
crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem
crystallite_todo(g,i,e) = .false. ! done with integration crystallite_todo(g,i,e) = .false. ! done with integration
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(1,numerics_integrationMode) = & debug_StateLoopDistribution(1,numerics_integrationMode) = &
debug_StateLoopDistribution(1,numerics_integrationMode) + 1_pInt debug_StateLoopDistribution(1,numerics_integrationMode) + 1_pInt
@ -2296,7 +2296,7 @@ subroutine crystallite_integrateStateFPI(gg,ii,ee)
use debug, only: debug_e, & use debug, only: debug_e, &
debug_i, & debug_i, &
debug_g, & debug_g, &
debug_what,& debug_level,&
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -2467,7 +2467,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState )
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after stress integration' write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after stress integration'
endif endif
#endif #endif
@ -2538,9 +2538,9 @@ do while (any(crystallite_todo) .and. NiterationState < nState )
- stateResiduum(1:mySizeDotState) - stateResiduum(1:mySizeDotState)
crystallite_Temperature(g,i,e) = crystallite_Temperature(g,i,e) - temperatureResiduum crystallite_Temperature(g,i,e) = crystallite_Temperature(g,i,e) - temperatureResiduum
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g
write(6,*) write(6,*)
write(6,'(a,f6.1)') '<< CRYST >> statedamper ',statedamper write(6,'(a,f6.1)') '<< CRYST >> statedamper ',statedamper
@ -2566,7 +2566,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState )
.and. (abs(temperatureResiduum) < rTol_crystalliteTemperature * crystallite_Temperature(g,i,e) & .and. (abs(temperatureResiduum) < rTol_crystalliteTemperature * crystallite_Temperature(g,i,e) &
.or. crystallite_Temperature(g,i,e) == 0.0_pReal) ) then .or. crystallite_Temperature(g,i,e) == 0.0_pReal) ) then
crystallite_converged(g,i,e) = .true. ! ... converged per definitionem crystallite_converged(g,i,e) = .true. ! ... converged per definitionem
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(NiterationState,numerics_integrationMode) = & debug_StateLoopDistribution(NiterationState,numerics_integrationMode) = &
debug_StateLoopDistribution(NiterationState,numerics_integrationMode) + 1_pInt debug_StateLoopDistribution(NiterationState,numerics_integrationMode) + 1_pInt
@ -2600,7 +2600,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState )
!$OMP END PARALLEL !$OMP END PARALLEL
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), &
' grains converged after state integration no. ', NiterationState ' grains converged after state integration no. ', NiterationState
write(6,*) write(6,*)
@ -2618,7 +2618,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState )
crystallite_todo = crystallite_todo .and. .not. crystallite_converged ! skip all converged crystallite_todo = crystallite_todo .and. .not. crystallite_converged ! skip all converged
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_converged(:,:,:)),' grains converged after non-local check' write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_converged(:,:,:)),' grains converged after non-local check'
write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after state integration no. ',& write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after state integration no. ',&
NiterationState NiterationState
@ -2640,7 +2640,7 @@ end subroutine crystallite_integrateStateFPI
function crystallite_stateJump(g,i,e) function crystallite_stateJump(g,i,e)
!*** variables and functions from other modules ***! !*** variables and functions from other modules ***!
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelExtensive, & debug_levelExtensive, &
debug_levelSelective, & debug_levelSelective, &
@ -2685,9 +2685,9 @@ constitutive_state(g,i,e)%p(1:mySizeDotState) = constitutive_state(g,i,e)%p(1:my
+ constitutive_deltaState(g,i,e)%p(1:mySizeDotState) + constitutive_deltaState(g,i,e)%p(1:mySizeDotState)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> update state at el ip g ',e,i,g
write(6,*) write(6,*)
write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> deltaState', constitutive_deltaState(g,i,e)%p(1:mySizeDotState) write(6,'(a,/,(12x,12(e12.5,1x)))') '<< CRYST >> deltaState', constitutive_deltaState(g,i,e)%p(1:mySizeDotState)
@ -2726,7 +2726,7 @@ use numerics, only: nStress, &
iJacoLpresiduum, & iJacoLpresiduum, &
relevantStrain, & relevantStrain, &
numerics_integrationMode numerics_integrationMode
use debug, only: debug_what, & use debug, only: debug_level, &
debug_crystallite, & debug_crystallite, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -2822,9 +2822,9 @@ integer(pLongInt) tick, &
crystallite_integrateStress = .false. crystallite_integrateStress = .false.
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress at el ip g ',e,i,g
endif endif
#endif #endif
@ -2853,11 +2853,11 @@ Lpguess = crystallite_Lp(1:3,1:3,g,i,e) ! ... and tak
invFp_current = math_inv33(Fp_current) invFp_current = math_inv33(Fp_current)
if (all(invFp_current == 0.0_pReal)) then ! ... failed? if (all(invFp_current == 0.0_pReal)) then ! ... failed?
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on invFp_current inversion at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on invFp_current inversion at el ip g ',e,i,g
if (iand(debug_what(debug_crystallite), debug_levelSelective) > 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelSelective) > 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new(1:3,1:3)) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new(1:3,1:3))
endif endif
@ -2884,7 +2884,7 @@ LpLoop: do
if (NiterationStress > nStress) then if (NiterationStress > nStress) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress reached loop limit at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress reached loop limit at el ip g ',e,i,g
write(6,*) write(6,*)
endif endif
@ -2905,11 +2905,11 @@ LpLoop: do
!* calculate plastic velocity gradient and its tangent according to constitutive law !* calculate plastic velocity gradient and its tangent according to constitutive law
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
endif endif
call constitutive_LpAndItsTangent(Lp_constitutive, dLp_dT_constitutive, Tstar_v, crystallite_Temperature(g,i,e), g, i, e) call constitutive_LpAndItsTangent(Lp_constitutive, dLp_dT_constitutive, Tstar_v, crystallite_Temperature(g,i,e), g, i, e)
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
!$OMP CRITICAL (debugTimingLpTangent) !$OMP CRITICAL (debugTimingLpTangent)
debug_cumLpCalls = debug_cumLpCalls + 1_pInt debug_cumLpCalls = debug_cumLpCalls + 1_pInt
@ -2920,9 +2920,9 @@ LpLoop: do
endif endif
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt) &
.and. numerics_integrationMode == 1_pInt) then .and. numerics_integrationMode == 1_pInt) then
write(6,'(a,i3)') '<< CRYST >> iteration ', NiterationStress write(6,'(a,i3)') '<< CRYST >> iteration ', NiterationStress
write(6,*) write(6,*)
@ -2949,7 +2949,7 @@ LpLoop: do
!* NaN occured at regular speed -> return !* NaN occured at regular speed -> return
if (steplength >= steplength0 .and. any(residuum /= residuum)) then if (steplength >= steplength0 .and. any(residuum /= residuum)) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el ip g ',e,i,g,& write(6,'(a,i8,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el ip g ',e,i,g,&
' ; iteration ', NiterationStress,& ' ; iteration ', NiterationStress,&
' >> returning..!' ' >> returning..!'
@ -2997,7 +2997,7 @@ LpLoop: do
!* something went wrong at accelerated speed? -> return to regular speed and try again !* something went wrong at accelerated speed? -> return to regular speed and try again
else else
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3,1x,a,i3)') '<< CRYST >> integrateStress encountered high-speed crash at el ip g ',e,i,g,& write(6,'(a,i8,1x,i2,1x,i3,1x,a,i3)') '<< CRYST >> integrateStress encountered high-speed crash at el ip g ',e,i,g,&
'; iteration ', NiterationStress '; iteration ', NiterationStress
endif endif
@ -3010,7 +3010,7 @@ LpLoop: do
steplength_max = steplength - 1.0_pReal ! limit acceleration steplength_max = steplength - 1.0_pReal ! limit acceleration
steplength = steplength0 ! grinding halt steplength = steplength0 ! grinding halt
jacoCounter = 0_pInt ! reset counter for Jacobian update (we want to do an update next time!) jacoCounter = 0_pInt ! reset counter for Jacobian update (we want to do an update next time!)
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionLeapfrogBreak) !$OMP CRITICAL (distributionLeapfrogBreak)
debug_LeapfrogBreakDistribution(NiterationStress,numerics_integrationMode) = & debug_LeapfrogBreakDistribution(NiterationStress,numerics_integrationMode) = &
debug_LeapfrogBreakDistribution(NiterationStress,numerics_integrationMode) + 1_pInt debug_LeapfrogBreakDistribution(NiterationStress,numerics_integrationMode) + 1_pInt
@ -3037,11 +3037,11 @@ LpLoop: do
call math_invert(9_pInt,dR_dLp,inv_dR_dLp,dummy,error) ! invert dR/dLp --> dLp/dR call math_invert(9_pInt,dR_dLp,inv_dR_dLp,dummy,error) ! invert dR/dLp --> dLp/dR
if (error) then if (error) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip g ',e,i,g write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip g ',e,i,g
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)&
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dR_dLp',transpose(dR_dLp) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dR_dLp',transpose(dR_dLp)
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(dFe_dLp) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(dFe_dLp)
@ -3084,12 +3084,12 @@ invFp_new = invFp_new/math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize
call math_invert33(invFp_new,Fp_new,det,error) call math_invert33(invFp_new,Fp_new,det,error)
if (error) then if (error) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip g ',& write(6,'(a,i8,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip g ',&
e,i,g, ' ; iteration ', NiterationStress e,i,g, ' ; iteration ', NiterationStress
if (iand(debug_what(debug_crystallite), debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,*) write(6,*)
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new)
endif endif
@ -3119,9 +3119,9 @@ crystallite_invFp(1:3,1:3,g,i,e) = invFp_new
crystallite_integrateStress = .true. crystallite_integrateStress = .true.
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_crystallite),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) &
.or. .not. iand(debug_what(debug_crystallite), debug_levelSelective) /= 0_pInt) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt) &
.and. numerics_integrationMode == 1_pInt) then .and. numerics_integrationMode == 1_pInt) then
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,g,i,e))/1.0e6_pReal
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', & write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', &
@ -3132,7 +3132,7 @@ if (iand(debug_what(debug_crystallite),debug_levelExtensive) /= 0_pInt &
endif endif
#endif #endif
if (iand(debug_what(debug_crystallite), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionStress) !$OMP CRITICAL (distributionStress)
debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) = & debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) = &
debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) + 1_pInt debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) + 1_pInt

109
code/debug.f90
View File

@ -34,11 +34,11 @@ module debug
debug_levelBasic = 2_pInt**1_pInt, & debug_levelBasic = 2_pInt**1_pInt, &
debug_levelExtensive = 2_pInt**2_pInt debug_levelExtensive = 2_pInt**2_pInt
integer(pInt), parameter, private :: & integer(pInt), parameter, private :: &
debug_maxForAll = debug_levelExtensive ! must be set to the last bitcode used by (potentially) all debug types debug_maxGeneral = debug_levelExtensive ! must be set to the last bitcode used by (potentially) all debug types
integer(pInt), parameter, public :: & integer(pInt), parameter, public :: &
debug_spectralRestart = debug_maxForAll*2_pInt**1_pInt, & debug_spectralRestart = debug_maxGeneral*2_pInt**1_pInt, &
debug_spectralFFTW = debug_maxForAll*2_pInt**2_pInt, & debug_spectralFFTW = debug_maxGeneral*2_pInt**2_pInt, &
debug_spectralDivergence = debug_maxForAll*2_pInt**3_pInt debug_spectralDivergence = debug_maxGeneral*2_pInt**3_pInt
integer(pInt), parameter, public :: & integer(pInt), parameter, public :: &
debug_debug = 1_pInt, & debug_debug = 1_pInt, &
@ -54,10 +54,10 @@ module debug
debug_spectral = 11_pInt, & debug_spectral = 11_pInt, &
debug_abaqus = 12_pInt debug_abaqus = 12_pInt
integer(pInt), parameter, private :: & integer(pInt), parameter, private :: &
debug_maxWhat = debug_abaqus ! must be set to the maximum defined debug type debug_maxNtype = debug_abaqus ! must be set to the maximum defined debug type
integer(pInt), dimension(debug_maxWhat+2_pInt), public :: & ! specific ones, and 2 for "all" and "other" integer(pInt), dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other"
debug_what = 0_pInt debug_level = 0_pInt
integer(pInt), public :: & integer(pInt), public :: &
debug_cumLpCalls = 0_pInt, & debug_cumLpCalls = 0_pInt, &
@ -128,7 +128,7 @@ subroutine debug_init
implicit none implicit none
integer(pInt), parameter :: fileunit = 300_pInt integer(pInt), parameter :: fileunit = 300_pInt
integer(pInt), parameter :: maxNchunks = 6_pInt integer(pInt), parameter :: maxNchunks = 7_pInt
integer(pInt) :: i, what integer(pInt) :: i, what
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
@ -201,37 +201,39 @@ subroutine debug_init
case ('abaqus') case ('abaqus')
what = debug_abaqus what = debug_abaqus
case ('all') case ('all')
what = debug_maxWhat + 1_pInt what = debug_maxNtype + 1_pInt
case ('other') case ('other')
what = debug_maxWhat + 2_pInt what = debug_maxNtype + 2_pInt
end select end select
if(what /= 0) then if(what /= 0) then
do i = 2_pInt, maxNchunks do i = 2_pInt, maxNchunks
select case(IO_lc(IO_stringValue(line,positions,i))) select case(IO_lc(IO_stringValue(line,positions,i)))
case('basic') case('basic')
debug_what(what) = ior(debug_what(what), debug_levelBasic) debug_level(what) = ior(debug_level(what), debug_levelBasic)
case('extensive') case('extensive')
debug_what(what) = ior(debug_what(what), debug_levelExtensive) debug_level(what) = ior(debug_level(what), debug_levelExtensive)
case('selective') case('selective')
debug_what(what) = ior(debug_what(what), debug_levelSelective) debug_level(what) = ior(debug_level(what), debug_levelSelective)
case('restart') case('restart')
debug_what(what) = ior(debug_what(what), debug_spectralRestart) debug_level(what) = ior(debug_level(what), debug_spectralRestart)
case('fft','fftw') case('fft','fftw')
debug_what(what) = ior(debug_what(what), debug_spectralFFTW) debug_level(what) = ior(debug_level(what), debug_spectralFFTW)
case('divergence') case('divergence')
debug_what(what) = ior(debug_what(what), debug_spectralDivergence) debug_level(what) = ior(debug_level(what), debug_spectralDivergence)
end select end select
enddo enddo
endif endif
enddo enddo
100 close(fileunit) 100 close(fileunit)
do i = 1_pInt, debug_maxWhat do i = 1_pInt, debug_maxNtype
if(debug_what(i) == 0) debug_what(i) = ior(debug_what(i), debug_what(debug_maxWhat + 2_pInt)) ! fill undefined debug types with levels specified by "other" if (debug_level(i) == 0) &
debug_what(i) = ior(debug_what(i), debug_what(debug_maxWhat + 1_pInt)) ! fill all debug types with levels specified by "all" debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 2_pInt)) ! fill undefined debug types with levels specified by "other"
debug_level(i) = ior(debug_level(i), debug_level(debug_maxNtype + 1_pInt)) ! fill all debug types with levels specified by "all"
enddo enddo
if (iand(debug_what(debug_debug),debug_levelBasic) /= 0) then if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) 'using values from config file' write(6,*) 'using values from config file'
write(6,*) write(6,*)
@ -240,7 +242,7 @@ subroutine debug_init
! no config file, so we use standard values ! no config file, so we use standard values
else else
if (iand(debug_what(debug_debug),debug_levelBasic) /= 0) then if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) 'using standard values' write(6,*) 'using standard values'
write(6,*) write(6,*)
@ -249,37 +251,52 @@ subroutine debug_init
endif endif
!output switched on (debug level for debug must be extensive) !output switched on (debug level for debug must be extensive)
if (iand(debug_what(debug_debug),debug_levelExtensive) /= 0) then if (iand(debug_level(debug_debug),debug_levelExtensive) /= 0) then
!$OMP CRITICAL (write2out) do i = 1_pInt, debug_maxNtype
do i = 1_pInt, 11_pInt select case(i)
if(debug_what(i) /= 0) then case (debug_debug)
if(i == debug_debug) write(6,'(a)') 'Debug debugging:' tag = 'Debug'
if(i == debug_math) write(6,'(a)') 'Math debugging:' case (debug_math)
if(i == debug_FEsolving) write(6,'(a)') 'FEsolving debugging:' tag = 'Math'
if(i == debug_mesh) write(6,'(a)') 'Mesh debugging:' case (debug_FEsolving)
if(i == debug_material) write(6,'(a)') 'Material debugging:' tag = 'FEsolving'
if(i == debug_lattice) write(6,'(a)') 'Lattice debugging:' case (debug_mesh)
if(i == debug_constitutive) write(6,'(a)') 'Constitutive debugging:' tag = 'Mesh'
if(i == debug_crystallite) write(6,'(a)') 'Crystallite debugging:' case (debug_material)
if(i == debug_homogenization) write(6,'(a)') 'Homogenization debugging:' tag = 'Material'
if(i == debug_CPFEM) write(6,'(a)') 'CPFEM debugging:' case (debug_lattice)
if(i == debug_spectral) write(6,'(a)') 'Spectral solver debugging:' tag = 'Lattice'
if(i == debug_abaqus) write(6,'(a)') 'ABAQUS FEM solver debugging:' case (debug_constitutive)
tag = 'Constitutive'
case (debug_crystallite)
tag = 'Crystallite'
case (debug_homogenization)
tag = 'Homogenizaiton'
case (debug_CPFEM)
tag = 'CPFEM'
case (debug_spectral)
tag = 'Spectral solver'
case (debug_abaqus)
tag = 'ABAQUS FEM solver'
end select
if(iand(debug_what(i),debug_levelBasic) /= 0) write(6,'(a)') ' basic' if(debug_level(i) /= 0) then
if(iand(debug_what(i),debug_levelExtensive) /= 0) write(6,'(a)') ' extensive' !$OMP CRITICAL (write2out)
if(iand(debug_what(i),debug_levelSelective) /= 0) then write(6,'(a,a)') tag,' debugging:'
if(iand(debug_level(i),debug_levelBasic) /= 0) write(6,'(a)') ' basic'
if(iand(debug_level(i),debug_levelExtensive) /= 0) write(6,'(a)') ' extensive'
if(iand(debug_level(i),debug_levelSelective) /= 0) then
write(6,'(a)') 'selective on:' write(6,'(a)') 'selective on:'
write(6,'(a24,1x,i8)') 'element: ',debug_e write(6,'(a24,1x,i8)') 'element: ',debug_e
write(6,'(a24,1x,i8)') 'ip: ',debug_i write(6,'(a24,1x,i8)') 'ip: ',debug_i
write(6,'(a24,1x,i8)') 'grain: ',debug_g write(6,'(a24,1x,i8)') 'grain: ',debug_g
endif endif
if(iand(debug_what(i),debug_spectralRestart) /= 0) write(6,'(a)') ' restart' if(iand(debug_level(i),debug_spectralRestart) /= 0) write(6,'(a)') ' restart'
if(iand(debug_what(i),debug_spectralFFTW) /= 0) write(6,'(a)') ' FFTW' if(iand(debug_level(i),debug_spectralFFTW) /= 0) write(6,'(a)') ' FFTW'
if(iand(debug_what(i),debug_spectralDivergence)/= 0) write(6,'(a)') ' divergence' if(iand(debug_level(i),debug_spectralDivergence)/= 0) write(6,'(a)') ' divergence'
!$OMP END CRITICAL (write2out)
endif endif
enddo enddo
!$OMP END CRITICAL (write2out)
endif endif
end subroutine debug_init end subroutine debug_init
@ -334,7 +351,7 @@ subroutine debug_info
call system_clock(count_rate=tickrate) call system_clock(count_rate=tickrate)
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
if (iand(debug_what(debug_crystallite),debug_levelBasic) /= 0) then if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then
write(6,*) write(6,*)
write(6,*) 'DEBUG Info (from previous cycle)' write(6,*) 'DEBUG Info (from previous cycle)'
write(6,*) write(6,*)
@ -418,7 +435,7 @@ subroutine debug_info
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution)
endif endif
if (iand(debug_what(debug_homogenization),debug_levelBasic) /= 0) then if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,*)
write(6,*) 'distribution_MaterialpointStateLoop :' write(6,*) 'distribution_MaterialpointStateLoop :'

20
code/homogenization.f90
View File

@ -75,7 +75,7 @@ CONTAINS
subroutine homogenization_init(Temperature) subroutine homogenization_init(Temperature)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use math, only: math_I3 use math, only: math_I3
use debug, only: debug_what, debug_homogenization, debug_levelBasic use debug, only: debug_level, debug_homogenization, debug_levelBasic
use IO, only: IO_error, IO_open_file, IO_open_jobFile_stat, IO_write_jobFile use IO, only: IO_error, IO_open_file, IO_open_jobFile_stat, IO_write_jobFile
use mesh, only: mesh_maxNips,mesh_NcpElems,mesh_element,FE_Nips use mesh, only: mesh_maxNips,mesh_NcpElems,mesh_element,FE_Nips
use material use material
@ -214,7 +214,7 @@ allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpEl
write(6,*) '<<<+- homogenization init -+>>>' write(6,*) '<<<+- homogenization init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0) write(6,'(a32,1x,7(i8,1x))') 'homogenization_state0: ', shape(homogenization_state0)
write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0) write(6,'(a32,1x,7(i8,1x))') 'homogenization_subState0: ', shape(homogenization_subState0)
write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state) write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state)
@ -294,7 +294,7 @@ subroutine materialpoint_stressAndItsTangent(&
crystallite_converged, & crystallite_converged, &
crystallite_stressAndItsTangent, & crystallite_stressAndItsTangent, &
crystallite_orientations crystallite_orientations
use debug, only: debug_what, & use debug, only: debug_level, &
debug_homogenization, & debug_homogenization, &
debug_levelBasic, & debug_levelBasic, &
debug_levelSelective, & debug_levelSelective, &
@ -314,7 +314,7 @@ use debug, only: debug_what, &
! ------ initialize to starting condition ------ ! ------ initialize to starting condition ------
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt &
.and. debug_e > 0 .and. debug_e <= mesh_NcpElems .and. debug_i > 0 .and. debug_i <= mesh_maxNips) then .and. debug_e > 0 .and. debug_e <= mesh_NcpElems .and. debug_i > 0 .and. debug_i <= mesh_maxNips) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write (6,*) write (6,*)
@ -367,9 +367,9 @@ use debug, only: debug_what, &
if ( materialpoint_converged(i,e) ) then if ( materialpoint_converged(i,e) ) then
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i) & .and. ((e == debug_e .and. i == debug_i) &
.or. .not. iand(debug_what(debug_homogenization),debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0_pInt)) then
write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,/)') '<< HOMOG >> winding forward from', & write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,/)') '<< HOMOG >> winding forward from', &
materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', &
materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent' materialpoint_subFrac(i,e)+materialpoint_subStep(i,e),'in materialpoint_stressAndItsTangent'
@ -399,7 +399,7 @@ use debug, only: debug_what, &
materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e) ! ...def grad
!$OMP FLUSH(materialpoint_subF0) !$OMP FLUSH(materialpoint_subF0)
elseif (materialpoint_requested(i,e)) then ! this materialpoint just converged ! already at final time (??) elseif (materialpoint_requested(i,e)) then ! this materialpoint just converged ! already at final time (??)
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionHomog) !$OMP CRITICAL (distributionHomog)
debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) = & debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) = &
debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) + 1 debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) + 1
@ -421,9 +421,9 @@ use debug, only: debug_what, &
!$OMP FLUSH(materialpoint_subStep) !$OMP FLUSH(materialpoint_subStep)
#ifndef _OPENMP #ifndef _OPENMP
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt & if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt &
.and. ((e == debug_e .and. i == debug_i) & .and. ((e == debug_e .and. i == debug_i) &
.or. .not. iand(debug_what(debug_homogenization), debug_levelSelective) /= 0_pInt)) then .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,1x,f12.8,/)') & write(6,'(a,1x,f12.8,/)') &
'<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',&
materialpoint_subStep(i,e) materialpoint_subStep(i,e)
@ -514,7 +514,7 @@ use debug, only: debug_what, &
endif endif
!$OMP FLUSH(materialpoint_converged) !$OMP FLUSH(materialpoint_converged)
if (materialpoint_converged(i,e)) then if (materialpoint_converged(i,e)) then
if (iand(debug_what(debug_homogenization), debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (distributionMPState) !$OMP CRITICAL (distributionMPState)
debug_MaterialpointStateLoopdistribution(NiterationMPstate) = & debug_MaterialpointStateLoopdistribution(NiterationMPstate) = &
debug_MaterialpointStateLoopdistribution(NiterationMPstate) + 1 debug_MaterialpointStateLoopdistribution(NiterationMPstate) + 1

42
code/homogenization_RGC.f90
View File

@ -67,7 +67,7 @@ subroutine homogenization_RGC_init(&
) )
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use debug, only: debug_what, & use debug, only: debug_level, &
debug_homogenization, & debug_homogenization, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive debug_levelExtensive
@ -179,7 +179,7 @@ subroutine homogenization_RGC_init(&
endif endif
enddo enddo
100 if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then 100 if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
do i = 1_pInt,maxNinstance do i = 1_pInt,maxNinstance
write(6,'(a15,1x,i4)') 'instance: ', i write(6,'(a15,1x,i4)') 'instance: ', i
@ -262,7 +262,7 @@ subroutine homogenization_RGC_partitionDeformation(&
el & ! my element el & ! my element
) )
use prec, only: p_vec use prec, only: p_vec
use debug, only: debug_what, & use debug, only: debug_level, &
debug_homogenization, & debug_homogenization, &
debug_levelExtensive debug_levelExtensive
use mesh, only: mesh_element use mesh, only: mesh_element
@ -287,7 +287,7 @@ subroutine homogenization_RGC_partitionDeformation(&
!* Debugging the overall deformation gradient !* Debugging the overall deformation gradient
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' ==========' write(6,'(1x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' =========='
write(6,'(1x,a32)')'Overall deformation gradient: ' write(6,'(1x,a32)')'Overall deformation gradient: '
@ -314,7 +314,7 @@ subroutine homogenization_RGC_partitionDeformation(&
F(:,:,iGrain) = F(:,:,iGrain) + avgF(:,:) ! resulting relaxed deformation gradient F(:,:,iGrain) = F(:,:,iGrain) + avgF(:,:) ! resulting relaxed deformation gradient
!* Debugging the grain deformation gradients !* Debugging the grain deformation gradients
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain
do i = 1_pInt,3_pInt do i = 1_pInt,3_pInt
@ -348,7 +348,7 @@ function homogenization_RGC_updateState(&
) )
use prec, only: pReal,pInt,p_vec use prec, only: pReal,pInt,p_vec
use debug, only: debug_what, & use debug, only: debug_level, &
debug_homogenization,& debug_homogenization,&
debug_levelExtensive, & debug_levelExtensive, &
debug_e, & debug_e, &
@ -404,7 +404,7 @@ function homogenization_RGC_updateState(&
drelax = state%p(1:3_pInt*nIntFaceTot) - state0%p(1:3_pInt*nIntFaceTot) drelax = state%p(1:3_pInt*nIntFaceTot) - state0%p(1:3_pInt*nIntFaceTot)
!* Debugging the obtained state !* Debugging the obtained state
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Obtained state: ' write(6,'(1x,a30)')'Obtained state: '
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -421,7 +421,7 @@ function homogenization_RGC_updateState(&
call homogenization_RGC_volumePenalty(D,volDiscrep,F,avgF,ip,el,homID) call homogenization_RGC_volumePenalty(D,volDiscrep,F,avgF,ip,el,homID)
!* Debugging the mismatch, stress and penalties of grains !* Debugging the mismatch, stress and penalties of grains
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
do iGrain = 1_pInt,nGrain do iGrain = 1_pInt,nGrain
write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain) write(6,'(1x,a30,1x,i3,1x,a4,3(1x,e15.8))')'Mismatch magnitude of grain(',iGrain,') :',NN(1,iGrain),NN(2,iGrain),NN(3,iGrain)
@ -470,7 +470,7 @@ function homogenization_RGC_updateState(&
enddo enddo
!* Debugging the residual stress !* Debugging the residual stress
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum write(6,'(1x,a30,1x,i3)')'Traction at interface: ',iNum
write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1_pInt,3_pInt) write(6,'(1x,3(e15.8,1x))')(tract(iNum,j), j = 1_pInt,3_pInt)
@ -488,7 +488,7 @@ function homogenization_RGC_updateState(&
residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual
!* Debugging the convergent criteria !* Debugging the convergent criteria
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt &
.and. debug_e == el .and. debug_i == ip) then .and. debug_e == el .and. debug_i == ip) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a)')' ' write(6,'(1x,a)')' '
@ -506,7 +506,7 @@ function homogenization_RGC_updateState(&
if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then
homogenization_RGC_updateState = .true. homogenization_RGC_updateState = .true.
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt &
.and. debug_e == el .and. debug_i == ip) then .and. debug_e == el .and. debug_i == ip) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a55)')'... done and happy' write(6,'(1x,a55)')'... done and happy'
@ -537,7 +537,7 @@ function homogenization_RGC_updateState(&
state%p(3*nIntFaceTot+7) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) ! the average rate of relaxation vectors state%p(3*nIntFaceTot+7) = sum(abs(drelax))/dt/real(3_pInt*nIntFaceTot,pReal) ! the average rate of relaxation vectors
state%p(3*nIntFaceTot+8) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors state%p(3*nIntFaceTot+8) = maxval(abs(drelax))/dt ! the maximum rate of relaxation vectors
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt &
.and. debug_e == el .and. debug_i == ip) then .and. debug_e == el .and. debug_i == ip) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30,1x,e15.8)')'Constitutive work: ',constitutiveWork write(6,'(1x,a30,1x,e15.8)')'Constitutive work: ',constitutiveWork
@ -562,7 +562,7 @@ function homogenization_RGC_updateState(&
!* Try to restart when residual blows up exceeding maximum bound !* Try to restart when residual blows up exceeding maximum bound
homogenization_RGC_updateState = (/.true.,.false./) ! with direct cut-back homogenization_RGC_updateState = (/.true.,.false./) ! with direct cut-back
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt &
.and. debug_e == el .and. debug_i == ip) then .and. debug_e == el .and. debug_i == ip) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a55)')'... broken' write(6,'(1x,a55)')'... broken'
@ -577,7 +577,7 @@ function homogenization_RGC_updateState(&
!* Otherwise, proceed with computing the Jacobian and state update !* Otherwise, proceed with computing the Jacobian and state update
else else
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt &
.and. debug_e == el .and. debug_i == ip) then .and. debug_e == el .and. debug_i == ip) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a55)')'... not yet done' write(6,'(1x,a55)')'... not yet done'
@ -634,7 +634,7 @@ function homogenization_RGC_updateState(&
enddo enddo
!* Debugging the global Jacobian matrix of stress tangent !* Debugging the global Jacobian matrix of stress tangent
if (iand(debug_what(debug_homogenization),debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Jacobian matrix of stress' write(6,'(1x,a30)')'Jacobian matrix of stress'
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -690,7 +690,7 @@ function homogenization_RGC_updateState(&
enddo enddo
!* Debugging the global Jacobian matrix of penalty tangent !* Debugging the global Jacobian matrix of penalty tangent
if (iand(debug_what(debug_homogenization), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -710,7 +710,7 @@ function homogenization_RGC_updateState(&
! only in the main diagonal term ! only in the main diagonal term
!* Debugging the global Jacobian matrix of numerical viscosity tangent !* Debugging the global Jacobian matrix of numerical viscosity tangent
if (iand(debug_what(debug_homogenization), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Jacobian matrix of penalty' write(6,'(1x,a30)')'Jacobian matrix of penalty'
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -724,7 +724,7 @@ function homogenization_RGC_updateState(&
!* The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix !* The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
if (iand(debug_what(debug_homogenization), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Jacobian matrix (total)' write(6,'(1x,a30)')'Jacobian matrix (total)'
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -743,7 +743,7 @@ function homogenization_RGC_updateState(&
call math_invert(3_pInt*nIntFaceTot,jmatrix,jnverse,ival,error) ! Compute the inverse of the overall Jacobian matrix call math_invert(3_pInt*nIntFaceTot,jmatrix,jnverse,ival,error) ! Compute the inverse of the overall Jacobian matrix
!* Debugging the inverse Jacobian matrix !* Debugging the inverse Jacobian matrix
if (iand(debug_what(debug_homogenization), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(1x,a30)')'Jacobian inverse' write(6,'(1x,a30)')'Jacobian inverse'
do i = 1_pInt,3_pInt*nIntFaceTot do i = 1_pInt,3_pInt*nIntFaceTot
@ -803,7 +803,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(&
) )
use prec, only: pReal,pInt,p_vec use prec, only: pReal,pInt,p_vec
use debug, only: debug_what, & use debug, only: debug_level, &
debug_homogenization,& debug_homogenization,&
debug_levelExtensive debug_levelExtensive
use mesh, only: mesh_element use mesh, only: mesh_element
@ -824,7 +824,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(&
Ngrains = homogenization_Ngrains(mesh_element(3,el)) Ngrains = homogenization_Ngrains(mesh_element(3,el))
!* Debugging the grain tangent !* Debugging the grain tangent
if (iand(debug_what(debug_homogenization), debug_levelExtensive) /= 0_pInt) then if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
do iGrain = 1_pInt,Ngrains do iGrain = 1_pInt,Ngrains
dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain))

4
code/lattice.f90
View File

@ -771,7 +771,7 @@ subroutine lattice_init
use material, only: material_configfile, & use material, only: material_configfile, &
material_localFileExt, & material_localFileExt, &
material_partPhase material_partPhase
use debug, only: debug_what, & use debug, only: debug_level, &
debug_lattice, & debug_lattice, &
debug_levelBasic debug_levelBasic
@ -794,7 +794,7 @@ subroutine lattice_init
! lattice_Nstructure = Nsections + 2_pInt ! most conservative assumption ! lattice_Nstructure = Nsections + 2_pInt ! most conservative assumption
close(fileunit) close(fileunit)
if (iand(debug_what(debug_lattice),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# phases:',Nsections write(6,'(a16,1x,i5)') '# phases:',Nsections
write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure

8
code/material.f90
View File

@ -130,7 +130,7 @@ subroutine material_init
use IO, only: IO_error, & use IO, only: IO_error, &
IO_open_file, & IO_open_file, &
IO_open_jobFile_stat IO_open_jobFile_stat
use debug, only: debug_what, & use debug, only: debug_level, &
debug_material, & debug_material, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive debug_levelExtensive
@ -140,7 +140,7 @@ subroutine material_init
integer(pInt), parameter :: fileunit = 200_pInt integer(pInt), parameter :: fileunit = 200_pInt
integer(pInt) :: i,j, myDebug integer(pInt) :: i,j, myDebug
myDebug = debug_what(debug_material) myDebug = debug_level(debug_material)
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
@ -676,7 +676,7 @@ subroutine material_populateGrains
use IO, only: IO_error, & use IO, only: IO_error, &
IO_hybridIA IO_hybridIA
use FEsolving, only: FEsolving_execIP use FEsolving, only: FEsolving_execIP
use debug, only: debug_what, & use debug, only: debug_level, &
debug_material, & debug_material, &
debug_levelBasic debug_levelBasic
@ -696,7 +696,7 @@ subroutine material_populateGrains
integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array
integer(pInt), dimension (:,:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array integer(pInt), dimension (:,:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array
myDebug = debug_what(debug_material) myDebug = debug_level(debug_material)
allocate(material_volume(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_volume = 0.0_pReal allocate(material_volume(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_volume = 0.0_pReal
allocate(material_phase(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_phase = 0_pInt allocate(material_phase(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_phase = 0_pInt

32
code/math.f90
View File

@ -2970,7 +2970,7 @@ subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch)
! cube and determinant of defgrad at the FP ! cube and determinant of defgrad at the FP
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -2986,7 +2986,7 @@ subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch)
integer(pInt) i,j,k integer(pInt) i,j,k
real(pReal) vol_initial real(pReal) vol_initial
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Calculating volume mismatch' print*, 'Calculating volume mismatch'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3025,7 +3025,7 @@ subroutine shape_compare(res,geomdim,defgrad,nodes,centroids,shape_mismatch)
! the initial volume element with the current deformation gradient ! the initial volume element with the current deformation gradient
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3041,7 +3041,7 @@ subroutine shape_compare(res,geomdim,defgrad,nodes,centroids,shape_mismatch)
real(pReal), dimension(8,3) :: coords_initial real(pReal), dimension(8,3) :: coords_initial
integer(pInt) i,j,k integer(pInt) i,j,k
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Calculating shape mismatch' print*, 'Calculating shape mismatch'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3104,7 +3104,7 @@ subroutine mesh_regular_grid(res,geomdim,defgrad_av,centroids,nodes)
! Routine to build mesh of (distorted) cubes for given coordinates (= center of the cubes) ! Routine to build mesh of (distorted) cubes for given coordinates (= center of the cubes)
! !
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3133,7 +3133,7 @@ subroutine mesh_regular_grid(res,geomdim,defgrad_av,centroids,nodes)
/), & /), &
(/3,8/)) (/3,8/))
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Meshing cubes around centroids' print*, 'Meshing cubes around centroids'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3178,7 +3178,7 @@ subroutine deformed_linear(res,geomdim,defgrad_av,defgrad,coord_avgCorner)
! using linear interpolation (blurres out high frequency defomation) ! using linear interpolation (blurres out high frequency defomation)
! !
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3228,7 +3228,7 @@ subroutine deformed_linear(res,geomdim,defgrad_av,defgrad,coord_avgCorner)
/), & /), &
(/3,6/)) (/3,6/))
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Restore geometry using linear integration' print*, 'Restore geometry using linear integration'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3296,7 +3296,7 @@ subroutine deformed_fft(res,geomdim,defgrad_av,scaling,defgrad,coords)
use IO, only: IO_error use IO, only: IO_error
use numerics, only: fftw_timelimit, fftw_planner_flag use numerics, only: fftw_timelimit, fftw_planner_flag
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3322,7 +3322,7 @@ subroutine deformed_fft(res,geomdim,defgrad_av,scaling,defgrad,coords)
integrator = geomdim / 2.0_pReal / pi ! see notes where it is used integrator = geomdim / 2.0_pReal / pi ! see notes where it is used
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Restore geometry using FFT-based integration' print*, 'Restore geometry using FFT-based integration'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3428,7 +3428,7 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl)
use IO, only: IO_error use IO, only: IO_error
use numerics, only: fftw_timelimit, fftw_planner_flag use numerics, only: fftw_timelimit, fftw_planner_flag
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3453,7 +3453,7 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl)
integer(pInt), dimension(3) :: k_s integer(pInt), dimension(3) :: k_s
real(pReal) :: wgt real(pReal) :: wgt
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Calculating curl of vector/tensor field' print*, 'Calculating curl of vector/tensor field'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3550,7 +3550,7 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence)
use IO, only: IO_error use IO, only: IO_error
use numerics, only: fftw_timelimit, fftw_planner_flag use numerics, only: fftw_timelimit, fftw_planner_flag
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3575,7 +3575,7 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence)
real(pReal) :: wgt real(pReal) :: wgt
integer(pInt), dimension(3) :: k_s integer(pInt), dimension(3) :: k_s
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print '(a)', 'Calculating divergence of tensor/vector field using FFT' print '(a)', 'Calculating divergence of tensor/vector field using FFT'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res
@ -3663,7 +3663,7 @@ subroutine divergence_fdm(res,geomdim,vec_tens,order,field,divergence)
! use vec_tes to decide if tensor (3) or vector (1) ! use vec_tes to decide if tensor (3) or vector (1)
use debug, only: debug_math, & use debug, only: debug_math, &
debug_what, & debug_level, &
debug_levelBasic debug_levelBasic
implicit none implicit none
@ -3684,7 +3684,7 @@ subroutine divergence_fdm(res,geomdim,vec_tens,order,field,divergence)
4.0_pReal/5.0_pReal,-1.0_pReal/ 5.0_pReal,4.0_pReal/105.0_pReal,-1.0_pReal/280.0_pReal/),& 4.0_pReal/5.0_pReal,-1.0_pReal/ 5.0_pReal,4.0_pReal/105.0_pReal,-1.0_pReal/280.0_pReal/),&
(/4,4/)) (/4,4/))
if (iand(debug_what(debug_math),debug_levelBasic) /= 0_pInt) then if (iand(debug_level(debug_math),debug_levelBasic) /= 0_pInt) then
print*, 'Calculating divergence of tensor/vector field using FDM' print*, 'Calculating divergence of tensor/vector field using FDM'
print '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(e12.5))', ' Dimension: ', geomdim
print '(a,3(i5))', ' Resolution:', res print '(a,3(i5))', ' Resolution:', res

4
code/mesh.f90
View File

@ -3006,7 +3006,7 @@ subroutine mesh_tell_statistics
use math, only: math_range use math, only: math_range
use IO, only: IO_error use IO, only: IO_error
use debug, only: debug_what, & use debug, only: debug_level, &
debug_mesh, & debug_mesh, &
debug_levelBasic, & debug_levelBasic, &
debug_levelExtensive, & debug_levelExtensive, &
@ -3019,7 +3019,7 @@ subroutine mesh_tell_statistics
character(len=64) :: myFmt character(len=64) :: myFmt
integer(pInt) :: i,e,n,f,t, myDebug integer(pInt) :: i,e,n,f,t, myDebug
myDebug = debug_what(debug_mesh) myDebug = debug_level(debug_mesh)
if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified
if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified