diff --git a/code/CPFEM.f90 b/code/CPFEM.f90 index aebdd32cf..787095df1 100644 --- a/code/CPFEM.f90 +++ b/code/CPFEM.f90 @@ -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 prec, only: pInt - use debug, only: debug_what, & + use debug, only: debug_level, & debug_CPFEM, & debug_levelBasic 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 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) write(6,'(a)') '<< CPFEM >> Restored state variables of last converged step from binary files' !$OMP END CRITICAL (write2out) @@ -207,7 +207,7 @@ subroutine CPFEM_init write(6,*) '<<<+- cpfem init -+>>>' write(6,*) '$Id$' #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_dcsdE: ', shape(CPFEM_dcsdE) 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 numerics, only: defgradTolerance, & iJacoStiffness - use debug, only: debug_what, & + use debug, only: debug_level, & debug_CPFEM, & debug_levelBasic, & debug_levelSelective, & @@ -357,7 +357,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, 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) write(6,*) write(6,'(a)') '#############################################' @@ -394,7 +394,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, j = 1:mesh_maxNips, & k = 1:mesh_NcpElems ) & 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) write(6,'(a)') '<< CPFEM >> Aging states' 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 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) write(6,'(a)') '<< CPFEM >> Writing state variables of last converged step to binary files' !$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 (.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) 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)) @@ -512,7 +512,7 @@ subroutine CPFEM_general(mode, coords, ffn, ffn1, Temperature, dt, element, IP, FEsolving_execElem(2) = cp_en FEsolving_execIP(1,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) write(6,'(a,i8,1x,i2)') '<< CPFEM >> Calculation for element ip ',cp_en,IP !$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 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) write(6,'(a,i8,a,i8)') '<< CPFEM >> Calculation for elements ',FEsolving_execElem(1),' to ',FEsolving_execElem(2) !$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_ipCoordinates() ! update ip coordinates #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) write(6,'(a,i8,a,i8)') '<< CPFEM >> Start stress and tangent ',FEsolving_execElem(1),' to ',FEsolving_execElem(2) !$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. 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) & - .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) 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 diff --git a/code/DAMASK_abaqus_exp.f b/code/DAMASK_abaqus_exp.f index 5d1f23634..01c37b7ce 100644 --- a/code/DAMASK_abaqus_exp.f +++ b/code/DAMASK_abaqus_exp.f @@ -170,7 +170,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & use debug, only: debug_info, & debug_reset, & debug_levelBasic, & - debug_what, & + debug_level, & debug_abaqus use mesh, only: mesh_FEasCP 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)) 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) write(6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'first call special case..!'; call flush(6) !$OMP END CRITICAL (write2out) @@ -219,7 +219,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & else if (theTime < totalTime) then ! reached convergence 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) write (6,'(i8,x,i2,x,a)') nElement(n),nMatPoint(n),'lastIncConverged + outdated'; call flush(6) !$OMP END CRITICAL (write2out) @@ -241,7 +241,7 @@ subroutine vumat (jblock, ndir, nshr, nstatev, nfieldv, nprops, lanneal, & 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) write(6,'(a16,x,i2,x,a,i8,x,i5,a)') 'computationMode',computationMode,'(',nElement(n),nMatPoint(n),')'; call flush(6) !$OMP END CRITICAL (write2out) diff --git a/code/DAMASK_abaqus_std.f b/code/DAMASK_abaqus_std.f index fcb26351e..60cac810e 100644 --- a/code/DAMASK_abaqus_std.f +++ b/code/DAMASK_abaqus_std.f @@ -137,7 +137,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& use debug, only: debug_info, & debug_reset, & debug_levelBasic, & - debug_what, & + debug_level, & debug_abaqus use mesh, only: mesh_FEasCP 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 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) write(6,*) 'el',noel,'ip',npt write(6,*) 'got kinc as',kinc @@ -251,7 +251,7 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& theInc = kinc ! record current increment number 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) 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) diff --git a/code/DAMASK_spectral.f90 b/code/DAMASK_spectral.f90 index 9ed6ae101..5e7e354e5 100644 --- a/code/DAMASK_spectral.f90 +++ b/code/DAMASK_spectral.f90 @@ -65,7 +65,7 @@ program DAMASK_spectral IO_write_jobBinaryFile use debug, only: & - debug_what, & + debug_level, & debug_spectral, & debug_levelBasic, & debug_spectralDivergence, & @@ -282,7 +282,7 @@ program DAMASK_spectral N_Fdot = N_Fdot + 1_pInt case('t','time','delta') 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 end select enddo ! count all identifiers to allocate memory and do sanity check @@ -443,10 +443,10 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! debugging parameters - debugGeneral = iand(debug_what(debug_spectral),debug_levelBasic) /= 0 - debugDivergence = iand(debug_what(debug_spectral),debug_spectralDivergence) /= 0 - debugRestart = iand(debug_what(debug_spectral),debug_spectralRestart) /= 0 - debugFFTW = iand(debug_what(debug_spectral),debug_spectralFFTW) /= 0 + debugGeneral = iand(debug_level(debug_spectral),debug_levelBasic) /= 0 + debugDivergence = iand(debug_level(debug_spectral),debug_spectralDivergence) /= 0 + debugRestart = iand(debug_level(debug_spectral),debug_spectralRestart) /= 0 + debugFFTW = iand(debug_level(debug_spectral),debug_spectralFFTW) /= 0 !################################################################################################## ! initialization diff --git a/code/DAMASK_spectral_AL.f90 b/code/DAMASK_spectral_AL.f90 index 5ffe91c98..589ee3635 100644 --- a/code/DAMASK_spectral_AL.f90 +++ b/code/DAMASK_spectral_AL.f90 @@ -64,7 +64,7 @@ program DAMASK_spectral_AL IO_write_jobBinaryFile use debug, only: & - debug_what, & + debug_level, & debug_spectral, & debug_levelBasic, & debug_spectralDivergence, & diff --git a/code/FEsolving.f90 b/code/FEsolving.f90 index 4ab91954b..aa7d9028e 100644 --- a/code/FEsolving.f90 +++ b/code/FEsolving.f90 @@ -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 debug, only: & - debug_what, & + debug_level, & debug_FEsolving, & debug_levelBasic @@ -176,7 +176,7 @@ subroutine FE_init write(6,*) '<<<+- FEsolving init -+>>>' write(6,*) '$Id$' #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 reading: ', restartRead if (restartRead) write(6,*) 'restart Job: ', trim(modelName) diff --git a/code/constitutive.f90 b/code/constitutive.f90 index 7d82fc6c5..8ef95ab00 100644 --- a/code/constitutive.f90 +++ b/code/constitutive.f90 @@ -82,7 +82,7 @@ contains !************************************** 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 debug, only: debug_what, & + use debug, only: debug_level, & debug_constitutive, & debug_levelBasic use numerics, only: numerics_integrator @@ -428,7 +428,7 @@ constitutive_maxSizePostResults = maxval(constitutive_sizePostResults) write(6,*) '<<<+- constitutive init -+>>>' write(6,*) '$Id$' #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_partionedState0: ', shape(constitutive_partionedState0) 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 debug, only: debug_cumDotStateCalls, & debug_cumDotStateTicks, & - debug_what, & + debug_level, & debug_constitutive, & debug_levelBasic use mesh, only: mesh_NcpElems, & @@ -794,7 +794,7 @@ integer(pLongInt) tick, tock, & tickrate, & 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) endif @@ -821,7 +821,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) 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) !$OMP CRITICAL (debugTimingDotState) 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 debug, only: debug_cumDeltaStateCalls, & debug_cumDeltaStateTicks, & - debug_what, & + debug_level, & debug_constitutive, & debug_levelBasic use mesh, only: mesh_NcpElems, & @@ -878,7 +878,7 @@ integer(pLongInt) tick, tock, & tickrate, & 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) endif @@ -904,7 +904,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) 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) !$OMP CRITICAL (debugTimingDeltaState) 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 debug, only: debug_cumDotTemperatureCalls, & debug_cumDotTemperatureTicks, & - debug_what, & + debug_level, & debug_constitutive, & debug_levelBasic use material, only: phase_plasticity, & @@ -963,7 +963,7 @@ integer(pLongInt) tick, tock, & 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) endif @@ -989,7 +989,7 @@ select case (phase_plasticity(material_phase(ipc,ip,el))) 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) !$OMP CRITICAL (debugTimingDotTemperature) debug_cumDotTemperatureCalls = debug_cumDotTemperatureCalls + 1_pInt diff --git a/code/constitutive_j2.f90 b/code/constitutive_j2.f90 index 80de05fe4..4ec712520 100644 --- a/code/constitutive_j2.f90 +++ b/code/constitutive_j2.f90 @@ -117,7 +117,7 @@ subroutine constitutive_j2_init(myFile) IO_error use material use debug, only: & - debug_what, & + debug_level, & debug_constitutive, & debug_levelBasic @@ -141,7 +141,7 @@ subroutine constitutive_j2_init(myFile) maxNinstance = int(count(phase_plasticity == constitutive_j2_label),pInt) 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) write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,*) diff --git a/code/constitutive_none.f90 b/code/constitutive_none.f90 index 784400041..30d22871a 100644 --- a/code/constitutive_none.f90 +++ b/code/constitutive_none.f90 @@ -97,7 +97,7 @@ subroutine constitutive_none_init(myFile) IO_error use material use debug, only: & - debug_what, & + debug_level, & debug_constitutive, & debug_levelBasic 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) 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) write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,*) diff --git a/code/constitutive_nonlocal.f90 b/code/constitutive_nonlocal.f90 index 11c72e4e7..991e1ed0d 100644 --- a/code/constitutive_nonlocal.f90 +++ b/code/constitutive_nonlocal.f90 @@ -207,7 +207,7 @@ use IO, only: IO_lc, & IO_floatValue, & IO_intValue, & IO_error -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic use mesh, only: mesh_NcpElems, & @@ -266,7 +266,7 @@ character(len=1024) line 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 (iand(debug_what(debug_constitutive),debug_levelBasic) /= 0_pInt) then +if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then !$OMP CRITICAL (write2out) write(6,'(a16,1x,i5)') '# instances:',maxNinstance !$OMP END CRITICAL (write2out) @@ -952,7 +952,7 @@ use math, only: math_Mandel33to6, & math_invert33, & math_transpose33, & pi -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelSelective, & @@ -1197,9 +1197,9 @@ state(g,ip,el)%p(12_pInt*ns+1:13_pInt*ns) = tauBack #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)& - .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,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_microstructure at el ip g',el,ip,g write(6,*) @@ -1221,7 +1221,7 @@ subroutine constitutive_nonlocal_kinetics(v, tau, c, Temperature, state, g, ip, use prec, only: pReal, & pInt, & p_vec -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelSelective, & @@ -1361,9 +1361,9 @@ endif #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)& - .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,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_kinetics at el ip g',el,ip,g write(6,*) @@ -1387,7 +1387,7 @@ use prec, only: pReal, & p_vec use math, only: math_Plain3333to99, & math_mul6x6 -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelSelective, & @@ -1508,9 +1508,9 @@ dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) #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)& - .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,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_LpandItsTangent at el ip g ',el,ip,g write(6,*) @@ -1531,7 +1531,7 @@ subroutine constitutive_nonlocal_deltaState(deltaState, state, Tstar_v, Temperat use prec, only: pReal, & pInt, & p_vec -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelSelective, & @@ -1593,9 +1593,9 @@ real(pReal), dimension(constitutive_nonlocal_totalNslip(phase_plasticityInstance #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)& - .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,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_deltaState at el ip g ',el,ip,g write(6,*) @@ -1714,9 +1714,9 @@ deltaState%p = reshape(deltaRho,(/10_pInt*ns/)) #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)& - .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,/,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 @@ -1739,7 +1739,7 @@ use prec, only: pReal, & DAMASK_NaN use numerics, only: numerics_integrationMode use IO, only: IO_error -use debug, only: debug_what, & +use debug, only: debug_level, & debug_constitutive, & debug_levelBasic, & debug_levelSelective, & @@ -1854,9 +1854,9 @@ logical considerEnteringFlux, & considerLeavingFlux #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)& - .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,'(a,i8,1x,i2,1x,i1)') '<< CONST >> nonlocal_dotState at el ip g ',el,ip,g 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) #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)& - .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,/,4(12x,12(e12.5,1x),/))') '<< CONST >> gdot / 1/s',gdot 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) #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,e10.3,a,e10.3)') '<< CONST >> velocity is at ',maxval(abs(v)),' at a timestep of ',timestep 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)) & .or. any(rhoDip(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < - constitutive_nonlocal_aTolRho(myInstance))) then #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)') '<< CONST >> enforcing cutback !!!' endif @@ -2184,9 +2184,9 @@ endif #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)& - .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,/,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 diff --git a/code/constitutive_phenopowerlaw.f90 b/code/constitutive_phenopowerlaw.f90 index 189975733..5a8d39910 100644 --- a/code/constitutive_phenopowerlaw.f90 +++ b/code/constitutive_phenopowerlaw.f90 @@ -169,7 +169,7 @@ subroutine constitutive_phenopowerlaw_init(myFile) math_Voigt66to3333 use IO use material - use debug, only: debug_what,& + use debug, only: debug_level,& debug_constitutive,& debug_levelBasic 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) 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) write(6,'(a16,1x,i5)') '# instances:',maxNinstance write(6,*) diff --git a/code/crystallite.f90 b/code/crystallite.f90 index 57ae00cc1..be0b0d989 100644 --- a/code/crystallite.f90 +++ b/code/crystallite.f90 @@ -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 debug, only: debug_info, & debug_reset, & - debug_what, & + debug_level, & debug_crystallite, & debug_levelBasic 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 ! *** 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) write(6,'(a35,1x,7(i8,1x))') 'crystallite_Temperature: ', shape(crystallite_Temperature) write(6,'(a35,1x,7(i8,1x))') 'crystallite_dotTemperature: ', shape(crystallite_dotTemperature) @@ -463,7 +463,7 @@ use numerics, only: subStepMinCryst, & numerics_integrationMode, & relevantStrain, & analyticJaco -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -552,7 +552,7 @@ real(pReal) :: counter ! --+>> 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_i > 0 .and. debug_i <= mesh_maxNips & .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 #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) & - .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 ', & crystallite_subFrac(g,i,e),' to current crystallite_subfrac ', & 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 !$OMP FLUSH(crystallite_subF0) 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) debug_CrystalliteLoopDistribution(min(nCryst+1_pInt,NiterationCrystallite)) = & 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 !$OMP FLUSH(crystallite_invFp) #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) & - .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: ',& crystallite_subStep(g,i,e) write(6,*) @@ -720,7 +720,7 @@ enddo 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) #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,*) endif @@ -732,9 +732,9 @@ enddo endif #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) & - .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,*) 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 do k = 1,3; do l = 1,3 ! ...alter individual components #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) write(6,'(a,2(1x,i1),1x,a)') '<< CRYST >> [[[[[[ Stiffness perturbation',k,l,']]]]]]' write(6,*) @@ -1017,7 +1017,7 @@ subroutine crystallite_integrateStateRK4(gg,ii,ee) use prec, only: pInt, & pReal use numerics, only: numerics_integrationMode -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -1150,9 +1150,9 @@ do n = 1_pInt,4_pInt + crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) * timeStepFraction(n) if (n == 4) then ! final integration step #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)& - .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) write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> updateState at el ip g ',e,i,g write(6,*) @@ -1260,7 +1260,7 @@ enddo if (crystallite_todo(g,i,e)) then crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem 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) debug_StateLoopDistribution(6,numerics_integrationMode) = & debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt @@ -1293,7 +1293,7 @@ end subroutine crystallite_integrateStateRK4 subroutine crystallite_integrateStateRKCK45(gg,ii,ee) !*** variables and functions from other modules ***! -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -1416,7 +1416,7 @@ endif ! --- FIRST RUNGE KUTTA STEP --- #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 endif #endif @@ -1551,7 +1551,7 @@ do n = 1_pInt,5_pInt ! --- dot state and RK dot state--- #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 endif #endif @@ -1676,9 +1676,9 @@ relTemperatureResiduum = 0.0_pReal .and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature ) #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)& - .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,*) 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 crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem 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) debug_StateLoopDistribution(6,numerics_integrationMode) = & debug_StateLoopDistribution(6,numerics_integrationMode) + 1_pInt @@ -1768,7 +1768,7 @@ relTemperatureResiduum = 0.0_pReal ! --- nonlocal convergence check --- #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,*) endif @@ -1791,7 +1791,7 @@ end subroutine crystallite_integrateStateRKCK45 subroutine crystallite_integrateStateAdaptiveEuler(gg,ii,ee) !*** variables and functions from other modules ***! -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -2008,9 +2008,9 @@ relTemperatureResiduum = 0.0_pReal !$OMP FLUSH(relStateResiduum,relTemperatureResiduum) #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)& - .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,*) 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)) & .and. abs(relTemperatureResiduum(g,i,e)) < rTol_crystalliteTemperature ) then 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) debug_StateLoopDistribution(2,numerics_integrationMode) = & debug_StateLoopDistribution(2,numerics_integrationMode) + 1_pInt @@ -2070,7 +2070,7 @@ relTemperatureResiduum = 0.0_pReal ! --- NONLOCAL CONVERGENCE CHECK --- #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,*) endif @@ -2093,7 +2093,7 @@ subroutine crystallite_integrateStateEuler(gg,ii,ee) !*** variables and functions from other modules ***! use numerics, only: numerics_integrationMode -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -2191,9 +2191,9 @@ if (numerics_integrationMode < 2) then crystallite_Temperature(g,i,e) = crystallite_subTemperature0(g,i,e) & + crystallite_dotTemperature(g,i,e) * crystallite_subdt(g,i,e) #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) & - .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,*) 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 crystallite_converged(g,i,e) = .true. ! if still "to do" then converged per definitionem 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) debug_StateLoopDistribution(1,numerics_integrationMode) = & debug_StateLoopDistribution(1,numerics_integrationMode) + 1_pInt @@ -2296,7 +2296,7 @@ subroutine crystallite_integrateStateFPI(gg,ii,ee) use debug, only: debug_e, & debug_i, & debug_g, & - debug_what,& + debug_level,& debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -2467,7 +2467,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) #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' endif #endif @@ -2538,9 +2538,9 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) - stateResiduum(1:mySizeDotState) crystallite_Temperature(g,i,e) = crystallite_Temperature(g,i,e) - temperatureResiduum #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) & - .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,*) 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) & .or. crystallite_Temperature(g,i,e) == 0.0_pReal) ) then 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) debug_StateLoopDistribution(NiterationState,numerics_integrationMode) = & debug_StateLoopDistribution(NiterationState,numerics_integrationMode) + 1_pInt @@ -2600,7 +2600,7 @@ do while (any(crystallite_todo) .and. NiterationState < nState ) !$OMP END PARALLEL #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 after state integration no. ', NiterationState 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 #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,i2)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after state integration no. ',& NiterationState @@ -2640,7 +2640,7 @@ end subroutine crystallite_integrateStateFPI function crystallite_stateJump(g,i,e) !*** variables and functions from other modules ***! -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelExtensive, & 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) #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) & - .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,*) 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, & relevantStrain, & numerics_integrationMode -use debug, only: debug_what, & +use debug, only: debug_level, & debug_crystallite, & debug_levelBasic, & debug_levelExtensive, & @@ -2822,9 +2822,9 @@ integer(pLongInt) tick, & crystallite_integrateStress = .false. #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) & - .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 endif #endif @@ -2853,11 +2853,11 @@ Lpguess = crystallite_Lp(1:3,1:3,g,i,e) ! ... and tak invFp_current = math_inv33(Fp_current) if (all(invFp_current == 0.0_pReal)) then ! ... failed? #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 - 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) & - .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,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new(1:3,1:3)) endif @@ -2884,7 +2884,7 @@ LpLoop: do if (NiterationStress > nStress) then #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,*) endif @@ -2905,11 +2905,11 @@ LpLoop: do !* 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) endif 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) !$OMP CRITICAL (debugTimingLpTangent) debug_cumLpCalls = debug_cumLpCalls + 1_pInt @@ -2920,9 +2920,9 @@ LpLoop: do endif #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) & - .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 write(6,'(a,i3)') '<< CRYST >> iteration ', NiterationStress write(6,*) @@ -2949,7 +2949,7 @@ LpLoop: do !* NaN occured at regular speed -> return if (steplength >= steplength0 .and. any(residuum /= residuum)) then #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,& ' ; iteration ', NiterationStress,& ' >> returning..!' @@ -2997,7 +2997,7 @@ LpLoop: do !* something went wrong at accelerated speed? -> return to regular speed and try again else #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,& '; iteration ', NiterationStress endif @@ -3010,7 +3010,7 @@ LpLoop: do steplength_max = steplength - 1.0_pReal ! limit acceleration steplength = steplength0 ! grinding halt 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) debug_LeapfrogBreakDistribution(NiterationStress,numerics_integrationMode) = & 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 if (error) then #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 - 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)& - .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,'(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) @@ -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) if (error) then #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 ',& 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) & - .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,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new) endif @@ -3119,9 +3119,9 @@ crystallite_invFp(1:3,1:3,g,i,e) = invFp_new crystallite_integrateStress = .true. #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) & - .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 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', & @@ -3132,7 +3132,7 @@ if (iand(debug_what(debug_crystallite),debug_levelExtensive) /= 0_pInt & 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) debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) = & debug_StressLoopDistribution(NiterationStress,numerics_integrationMode) + 1_pInt diff --git a/code/debug.f90 b/code/debug.f90 index 1fcffe7ff..02a03c784 100644 --- a/code/debug.f90 +++ b/code/debug.f90 @@ -34,11 +34,11 @@ module debug debug_levelBasic = 2_pInt**1_pInt, & debug_levelExtensive = 2_pInt**2_pInt 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 :: & - debug_spectralRestart = debug_maxForAll*2_pInt**1_pInt, & - debug_spectralFFTW = debug_maxForAll*2_pInt**2_pInt, & - debug_spectralDivergence = debug_maxForAll*2_pInt**3_pInt + debug_spectralRestart = debug_maxGeneral*2_pInt**1_pInt, & + debug_spectralFFTW = debug_maxGeneral*2_pInt**2_pInt, & + debug_spectralDivergence = debug_maxGeneral*2_pInt**3_pInt integer(pInt), parameter, public :: & debug_debug = 1_pInt, & @@ -54,10 +54,10 @@ module debug debug_spectral = 11_pInt, & debug_abaqus = 12_pInt 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" - debug_what = 0_pInt + integer(pInt), dimension(debug_maxNtype+2_pInt), public :: & ! specific ones, and 2 for "all" and "other" + debug_level = 0_pInt integer(pInt), public :: & debug_cumLpCalls = 0_pInt, & @@ -128,7 +128,7 @@ subroutine debug_init implicit none integer(pInt), parameter :: fileunit = 300_pInt - integer(pInt), parameter :: maxNchunks = 6_pInt + integer(pInt), parameter :: maxNchunks = 7_pInt integer(pInt) :: i, what integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -201,37 +201,39 @@ subroutine debug_init case ('abaqus') what = debug_abaqus case ('all') - what = debug_maxWhat + 1_pInt + what = debug_maxNtype + 1_pInt case ('other') - what = debug_maxWhat + 2_pInt + what = debug_maxNtype + 2_pInt end select if(what /= 0) then do i = 2_pInt, maxNchunks select case(IO_lc(IO_stringValue(line,positions,i))) case('basic') - debug_what(what) = ior(debug_what(what), debug_levelBasic) + debug_level(what) = ior(debug_level(what), debug_levelBasic) case('extensive') - debug_what(what) = ior(debug_what(what), debug_levelExtensive) + debug_level(what) = ior(debug_level(what), debug_levelExtensive) case('selective') - debug_what(what) = ior(debug_what(what), debug_levelSelective) + debug_level(what) = ior(debug_level(what), debug_levelSelective) case('restart') - debug_what(what) = ior(debug_what(what), debug_spectralRestart) + debug_level(what) = ior(debug_level(what), debug_spectralRestart) case('fft','fftw') - debug_what(what) = ior(debug_what(what), debug_spectralFFTW) + debug_level(what) = ior(debug_level(what), debug_spectralFFTW) case('divergence') - debug_what(what) = ior(debug_what(what), debug_spectralDivergence) + debug_level(what) = ior(debug_level(what), debug_spectralDivergence) end select enddo endif enddo 100 close(fileunit) - do i = 1_pInt, debug_maxWhat - 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" - debug_what(i) = ior(debug_what(i), debug_what(debug_maxWhat + 1_pInt)) ! fill all debug types with levels specified by "all" + do i = 1_pInt, debug_maxNtype + if (debug_level(i) == 0) & + 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 - if (iand(debug_what(debug_debug),debug_levelBasic) /= 0) then + if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write(6,*) 'using values from config file' write(6,*) @@ -240,7 +242,7 @@ subroutine debug_init ! no config file, so we use standard values else - if (iand(debug_what(debug_debug),debug_levelBasic) /= 0) then + if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) then !$OMP CRITICAL (write2out) write(6,*) 'using standard values' write(6,*) @@ -249,37 +251,52 @@ subroutine debug_init endif !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 + do i = 1_pInt, debug_maxNtype + select case(i) + case (debug_debug) + tag = 'Debug' + case (debug_math) + tag = 'Math' + case (debug_FEsolving) + tag = 'FEsolving' + case (debug_mesh) + tag = 'Mesh' + case (debug_material) + tag = 'Material' + case (debug_lattice) + tag = 'Lattice' + 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(debug_level(i) /= 0) then !$OMP CRITICAL (write2out) - do i = 1_pInt, 11_pInt - if(debug_what(i) /= 0) then - if(i == debug_debug) write(6,'(a)') 'Debug debugging:' - if(i == debug_math) write(6,'(a)') 'Math debugging:' - if(i == debug_FEsolving) write(6,'(a)') 'FEsolving debugging:' - if(i == debug_mesh) write(6,'(a)') 'Mesh debugging:' - if(i == debug_material) write(6,'(a)') 'Material debugging:' - if(i == debug_lattice) write(6,'(a)') 'Lattice debugging:' - if(i == debug_constitutive) write(6,'(a)') 'Constitutive debugging:' - if(i == debug_crystallite) write(6,'(a)') 'Crystallite debugging:' - if(i == debug_homogenization) write(6,'(a)') 'Homogenization debugging:' - if(i == debug_CPFEM) write(6,'(a)') 'CPFEM debugging:' - if(i == debug_spectral) write(6,'(a)') 'Spectral solver debugging:' - if(i == debug_abaqus) write(6,'(a)') 'ABAQUS FEM solver debugging:' - - if(iand(debug_what(i),debug_levelBasic) /= 0) write(6,'(a)') ' basic' - if(iand(debug_what(i),debug_levelExtensive) /= 0) write(6,'(a)') ' extensive' - 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,'(a24,1x,i8)') 'element: ',debug_e write(6,'(a24,1x,i8)') 'ip: ',debug_i write(6,'(a24,1x,i8)') 'grain: ',debug_g endif - if(iand(debug_what(i),debug_spectralRestart) /= 0) write(6,'(a)') ' restart' - if(iand(debug_what(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_spectralRestart) /= 0) write(6,'(a)') ' restart' + if(iand(debug_level(i),debug_spectralFFTW) /= 0) write(6,'(a)') ' FFTW' + if(iand(debug_level(i),debug_spectralDivergence)/= 0) write(6,'(a)') ' divergence' + !$OMP END CRITICAL (write2out) endif enddo - !$OMP END CRITICAL (write2out) endif end subroutine debug_init @@ -334,7 +351,7 @@ subroutine debug_info call system_clock(count_rate=tickrate) !$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,*) 'DEBUG Info (from previous cycle)' write(6,*) @@ -418,7 +435,7 @@ subroutine debug_info write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) endif - if (iand(debug_what(debug_homogenization),debug_levelBasic) /= 0) then + if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then integral = 0_pInt write(6,*) write(6,*) 'distribution_MaterialpointStateLoop :' diff --git a/code/homogenization.f90 b/code/homogenization.f90 index 92166f2aa..a9be3673a 100644 --- a/code/homogenization.f90 +++ b/code/homogenization.f90 @@ -75,7 +75,7 @@ CONTAINS 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 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 mesh, only: mesh_maxNips,mesh_NcpElems,mesh_element,FE_Nips use material @@ -214,7 +214,7 @@ allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpEl write(6,*) '<<<+- homogenization init -+>>>' write(6,*) '$Id$' #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_subState0: ', shape(homogenization_subState0) write(6,'(a32,1x,7(i8,1x))') 'homogenization_state: ', shape(homogenization_state) @@ -294,7 +294,7 @@ subroutine materialpoint_stressAndItsTangent(& crystallite_converged, & crystallite_stressAndItsTangent, & crystallite_orientations -use debug, only: debug_what, & +use debug, only: debug_level, & debug_homogenization, & debug_levelBasic, & debug_levelSelective, & @@ -314,7 +314,7 @@ use debug, only: debug_what, & ! ------ 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 !$OMP CRITICAL (write2out) write (6,*) @@ -367,9 +367,9 @@ use debug, only: debug_what, & if ( materialpoint_converged(i,e) ) then #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) & - .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', & materialpoint_subFrac(i,e), 'to current materialpoint_subFrac', & 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 !$OMP FLUSH(materialpoint_subF0) 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) debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) = & debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) + 1 @@ -421,9 +421,9 @@ use debug, only: debug_what, & !$OMP FLUSH(materialpoint_subStep) #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) & - .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,/)') & '<< HOMOG >> cutback step in materialpoint_stressAndItsTangent with new materialpoint_subStep:',& materialpoint_subStep(i,e) @@ -514,7 +514,7 @@ use debug, only: debug_what, & endif !$OMP FLUSH(materialpoint_converged) 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) debug_MaterialpointStateLoopdistribution(NiterationMPstate) = & debug_MaterialpointStateLoopdistribution(NiterationMPstate) + 1 diff --git a/code/homogenization_RGC.f90 b/code/homogenization_RGC.f90 index cea1f3ae3..7d8278800 100644 --- a/code/homogenization_RGC.f90 +++ b/code/homogenization_RGC.f90 @@ -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 debug, only: debug_what, & + use debug, only: debug_level, & debug_homogenization, & debug_levelBasic, & debug_levelExtensive @@ -179,7 +179,7 @@ subroutine homogenization_RGC_init(& endif 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) do i = 1_pInt,maxNinstance write(6,'(a15,1x,i4)') 'instance: ', i @@ -262,7 +262,7 @@ subroutine homogenization_RGC_partitionDeformation(& el & ! my element ) use prec, only: p_vec - use debug, only: debug_what, & + use debug, only: debug_level, & debug_homogenization, & debug_levelExtensive use mesh, only: mesh_element @@ -287,7 +287,7 @@ subroutine homogenization_RGC_partitionDeformation(& !* 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) write(6,'(1x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' ==========' write(6,'(1x,a32)')'Overall deformation gradient: ' @@ -314,7 +314,7 @@ subroutine homogenization_RGC_partitionDeformation(& F(:,:,iGrain) = F(:,:,iGrain) + avgF(:,:) ! resulting relaxed deformation gradient !* 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) write(6,'(1x,a32,1x,i3)')'Deformation gradient of grain: ',iGrain do i = 1_pInt,3_pInt @@ -348,7 +348,7 @@ function homogenization_RGC_updateState(& ) use prec, only: pReal,pInt,p_vec - use debug, only: debug_what, & + use debug, only: debug_level, & debug_homogenization,& debug_levelExtensive, & debug_e, & @@ -404,7 +404,7 @@ function homogenization_RGC_updateState(& drelax = state%p(1:3_pInt*nIntFaceTot) - state0%p(1:3_pInt*nIntFaceTot) !* 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) write(6,'(1x,a30)')'Obtained state: ' 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) !* 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) 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) @@ -470,7 +470,7 @@ function homogenization_RGC_updateState(& enddo !* 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) 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) @@ -488,7 +488,7 @@ function homogenization_RGC_updateState(& residLoc = int(maxloc(abs(tract)),pInt) ! get the position of the maximum residual !* 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 !$OMP CRITICAL (write2out) write(6,'(1x,a)')' ' @@ -506,7 +506,7 @@ function homogenization_RGC_updateState(& if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then 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 !$OMP CRITICAL (write2out) 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+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 !$OMP CRITICAL (write2out) 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 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 !$OMP CRITICAL (write2out) write(6,'(1x,a55)')'... broken' @@ -577,7 +577,7 @@ function homogenization_RGC_updateState(& !* Otherwise, proceed with computing the Jacobian and state update 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 !$OMP CRITICAL (write2out) write(6,'(1x,a55)')'... not yet done' @@ -634,7 +634,7 @@ function homogenization_RGC_updateState(& enddo !* 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) write(6,'(1x,a30)')'Jacobian matrix of stress' do i = 1_pInt,3_pInt*nIntFaceTot @@ -690,7 +690,7 @@ function homogenization_RGC_updateState(& enddo !* 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) write(6,'(1x,a30)')'Jacobian matrix of penalty' do i = 1_pInt,3_pInt*nIntFaceTot @@ -710,7 +710,7 @@ function homogenization_RGC_updateState(& ! only in the main diagonal term !* 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) write(6,'(1x,a30)')'Jacobian matrix of penalty' 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 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) write(6,'(1x,a30)')'Jacobian matrix (total)' 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 !* 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) write(6,'(1x,a30)')'Jacobian inverse' do i = 1_pInt,3_pInt*nIntFaceTot @@ -803,7 +803,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(& ) use prec, only: pReal,pInt,p_vec - use debug, only: debug_what, & + use debug, only: debug_level, & debug_homogenization,& debug_levelExtensive use mesh, only: mesh_element @@ -824,7 +824,7 @@ subroutine homogenization_RGC_averageStressAndItsTangent(& Ngrains = homogenization_Ngrains(mesh_element(3,el)) !* 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) do iGrain = 1_pInt,Ngrains dPdF99 = math_Plain3333to99(dPdF(1:3,1:3,1:3,1:3,iGrain)) diff --git a/code/lattice.f90 b/code/lattice.f90 index 25836f33c..0a70d0c82 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -771,7 +771,7 @@ subroutine lattice_init use material, only: material_configfile, & material_localFileExt, & material_partPhase - use debug, only: debug_what, & + use debug, only: debug_level, & debug_lattice, & debug_levelBasic @@ -794,7 +794,7 @@ subroutine lattice_init ! lattice_Nstructure = Nsections + 2_pInt ! most conservative assumption 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) write(6,'(a16,1x,i5)') '# phases:',Nsections write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure diff --git a/code/material.f90 b/code/material.f90 index 477de1aad..91dfeb3e6 100644 --- a/code/material.f90 +++ b/code/material.f90 @@ -130,7 +130,7 @@ subroutine material_init use IO, only: IO_error, & IO_open_file, & IO_open_jobFile_stat - use debug, only: debug_what, & + use debug, only: debug_level, & debug_material, & debug_levelBasic, & debug_levelExtensive @@ -140,7 +140,7 @@ subroutine material_init integer(pInt), parameter :: fileunit = 200_pInt integer(pInt) :: i,j, myDebug - myDebug = debug_what(debug_material) + myDebug = debug_level(debug_material) !$OMP CRITICAL (write2out) write(6,*) @@ -676,7 +676,7 @@ subroutine material_populateGrains use IO, only: IO_error, & IO_hybridIA use FEsolving, only: FEsolving_execIP - use debug, only: debug_what, & + use debug, only: debug_level, & debug_material, & 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 :: 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_phase(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; material_phase = 0_pInt diff --git a/code/math.f90 b/code/math.f90 index 89036429d..e3ddabe21 100644 --- a/code/math.f90 +++ b/code/math.f90 @@ -2970,7 +2970,7 @@ subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch) ! cube and determinant of defgrad at the FP use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -2986,7 +2986,7 @@ subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch) integer(pInt) i,j,k 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 '(a,3(e12.5))', ' Dimension: ', geomdim 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 use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -3041,7 +3041,7 @@ subroutine shape_compare(res,geomdim,defgrad,nodes,centroids,shape_mismatch) real(pReal), dimension(8,3) :: coords_initial 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 '(a,3(e12.5))', ' Dimension: ', geomdim 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) ! use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -3133,7 +3133,7 @@ subroutine mesh_regular_grid(res,geomdim,defgrad_av,centroids,nodes) /), & (/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 '(a,3(e12.5))', ' Dimension: ', geomdim 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) ! use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -3228,7 +3228,7 @@ subroutine deformed_linear(res,geomdim,defgrad_av,defgrad,coord_avgCorner) /), & (/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 '(a,3(e12.5))', ' Dimension: ', geomdim 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 numerics, only: fftw_timelimit, fftw_planner_flag use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic 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 - 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 '(a,3(e12.5))', ' Dimension: ', geomdim 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 numerics, only: fftw_timelimit, fftw_planner_flag use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -3453,7 +3453,7 @@ subroutine curl_fft(res,geomdim,vec_tens,field,curl) integer(pInt), dimension(3) :: k_s 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 '(a,3(e12.5))', ' Dimension: ', geomdim 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 numerics, only: fftw_timelimit, fftw_planner_flag use debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic implicit none @@ -3575,7 +3575,7 @@ subroutine divergence_fft(res,geomdim,vec_tens,field,divergence) real(pReal) :: wgt 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,3(e12.5))', ' Dimension: ', geomdim 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 debug, only: debug_math, & - debug_what, & + debug_level, & debug_levelBasic 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,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 '(a,3(e12.5))', ' Dimension: ', geomdim print '(a,3(i5))', ' Resolution:', res diff --git a/code/mesh.f90 b/code/mesh.f90 index 0e0bf7711..4747a36a1 100644 --- a/code/mesh.f90 +++ b/code/mesh.f90 @@ -3006,7 +3006,7 @@ subroutine mesh_tell_statistics use math, only: math_range use IO, only: IO_error - use debug, only: debug_what, & + use debug, only: debug_level, & debug_mesh, & debug_levelBasic, & debug_levelExtensive, & @@ -3019,7 +3019,7 @@ subroutine mesh_tell_statistics character(len=64) :: myFmt 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(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified