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

Merge branch 'Fortran-simplifications' into stress-ramp-loadcase

This commit is contained in:
Martin Diehl 2020-09-20 11:42:04 +02:00
parent 053c3f39ea 42186b9f87
commit 593a40b392
21 changed files with 243 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/DAMASK_interface.f90
View File

@ -14,7 +14,7 @@
#define PETSC_MINOR_MAX 13
module DAMASK_interface
use, intrinsic :: iso_fortran_env
use, intrinsic :: ISO_fortran_env
use PETScSys
@ -82,7 +82,7 @@ subroutine DAMASK_interface_init
print'(/,a)', ' <<<+- DAMASK_interface init -+>>>'
open(6, encoding='UTF-8') ! for special characters in output
open(OUTPUT_unit, encoding='UTF-8') ! for special characters in output
! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203
#ifdef DEBUG
@ -101,8 +101,8 @@ subroutine DAMASK_interface_init
#endif
print*, achar(27)//'[0m'
print'(a)', ' Roters et al., Computational Materials Science 158:420–478, 2019'
print'(a)', ' https://doi.org/10.1016/j.commatsci.2018.04.030'
print*, 'Roters et al., Computational Materials Science 158:420–478, 2019'
print*, 'https://doi.org/10.1016/j.commatsci.2018.04.030'
print'(/,a)', ' Version: '//DAMASKVERSION
@ -373,7 +373,7 @@ function makeRelativePath(a,b)
a_cleaned = rectifyPath(trim(a)//'/')
b_cleaned = rectifyPath(b)
do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned)))
do i = 1, min(len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned)))
if (a_cleaned(i:i) /= b_cleaned(i:i)) exit
if (a_cleaned(i:i) == '/') posLastCommonSlash = i
enddo
@ -395,7 +395,7 @@ subroutine catchSIGTERM(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGTERM = .true.
print'(a,i2.2,a)', ' received signal ',signal, ', set SIGTERM=TRUE'
print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE'
end subroutine catchSIGTERM
@ -420,7 +420,7 @@ subroutine catchSIGUSR1(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGUSR1 = .true.
print'(a,i2.2,a)', ' received signal ',signal, ', set SIGUSR1=TRUE'
print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE'
end subroutine catchSIGUSR1
@ -445,7 +445,7 @@ subroutine catchSIGUSR2(signal) bind(C)
integer(C_INT), value :: signal
interface_SIGUSR2 = .true.
print'(a,i2.2,a)', ' received signal ',signal, ', set SIGUSR2=TRUE'
print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE'
end subroutine catchSIGUSR2

2
src/DAMASK_marc.f90
View File

@ -30,7 +30,7 @@
module DAMASK_interface
use prec
#if __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
use, intrinsic :: ISO_fortran_env, only: &
compiler_version, &
compiler_options
#endif

57
src/IO.f90
View File

@ -6,6 +6,10 @@
!> @brief input/output functions
!--------------------------------------------------------------------------------------------------
module IO
use, intrinsic :: ISO_fortran_env, only: &
OUTPUT_UNIT, &
ERROR_UNIT
use prec
implicit none
@ -37,7 +41,8 @@ module IO
IO_stringAsFloat, &
IO_stringAsBool, &
IO_error, &
IO_warning
IO_warning, &
OUTPUT_UNIT
contains
@ -538,29 +543,29 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
end select
!$OMP CRITICAL (write2out)
write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(0,'(a,24x,a,40x,a)') ' │','error', '│'
write(0,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
write(0,'(a)') ' ├'//IO_DIVIDER//'┤'
write(ERROR_UNIT,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(ERROR_UNIT,'(a,24x,a,40x,a)') ' │','error', '│'
write(ERROR_UNIT,'(a,24x,i3,42x,a)') ' │',error_ID, '│'
write(ERROR_UNIT,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(0,formatString) '│ ',trim(msg), '│'
write(ERROR_UNIT,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(0,formatString) '│ ',trim(ext_msg), '│'
write(ERROR_UNIT,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
if (present(instance)) &
write(0,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
write(0,'(a,69x,a)') ' │', '│'
write(0,'(a)') ' └'//IO_DIVIDER//'┘'
flush(0)
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
write(ERROR_UNIT,'(a,69x,a)') ' │', '│'
write(ERROR_UNIT,'(a)') ' └'//IO_DIVIDER//'┘'
flush(ERROR_UNIT)
call quit(9000+error_ID)
!$OMP END CRITICAL (write2out)
@ -623,27 +628,27 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
end select
!$OMP CRITICAL (write2out)
write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(6,'(a,24x,a,38x,a)') ' │','warning', '│'
write(6,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
write(6,'(a)') ' ├'//IO_DIVIDER//'┤'
write(ERROR_UNIT,'(/,a)') ' ┌'//IO_DIVIDER//'┐'
write(ERROR_UNIT,'(a,24x,a,38x,a)') ' │','warning', '│'
write(ERROR_UNIT,'(a,24x,i3,42x,a)') ' │',warning_ID, '│'
write(ERROR_UNIT,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(6,formatString) '│ ',trim(msg), '│'
write(ERROR_UNIT,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(6,formatString) '│ ',trim(ext_msg), '│'
write(ERROR_UNIT,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(6,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(6,'(a,69x,a)') ' │', '│'
write(6,'(a)') ' └'//IO_DIVIDER//'┘'
flush(6)
write(ERROR_UNIT,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(ERROR_UNIT,'(a,69x,a)') ' │', '│'
write(ERROR_UNIT,'(a)') ' └'//IO_DIVIDER//'┘'
flush(ERROR_UNIT)
!$OMP END CRITICAL (write2out)
end subroutine IO_warning

26
src/constitutive_plastic_nonlocal.f90
View File

@ -199,7 +199,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
print*, 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL
print*, 'Kords, Dissertation RWTH Aachen, 2014'
print*, 'http://publications.rwth-aachen.de/record/229993'//IO_EOL
print*, 'http://publications.rwth-aachen.de/record/229993'
allocate(param(Ninstance))
allocate(state(Ninstance))
@ -741,10 +741,10 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
if (debugConstitutive%extensive &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debugConstitutive%selective)) then
write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip
write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', stt%rho_forest(:,of)
write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6
write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6
print'(/,a,i8,1x,i2,1x,i1,/)', '<< CONST >> nonlocal_microstructure at el ip ',el,ip
print'(a,/,12x,12(e10.3,1x))', '<< CONST >> rhoForest', stt%rho_forest(:,of)
print'(a,/,12x,12(f10.5,1x))', '<< CONST >> tauThreshold / MPa', dst%tau_pass(:,of)*1e-6
print'(a,/,12x,12(f10.5,1x),/)', '<< CONST >> tauBack / MPa', dst%tau_back(:,of)*1e-6
endif
#endif
@ -958,8 +958,8 @@ module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el)
if (debugConstitutive%extensive &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip)&
.or. .not. debugConstitutive%selective)) then
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8)
write(6,'(a,/,10(12x,12(e12.5,1x),/),/)') '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress
print'(a,/,8(12x,12(e12.5,1x),/))', '<< CONST >> dislocation remobilization', deltaRhoRemobilization(:,1:8)
print'(a,/,10(12x,12(e12.5,1x),/),/)', '<< CONST >> dipole dissociation by stress increase', deltaRhoDipole2SingleStress
endif
#endif
@ -1047,8 +1047,8 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
if (debugConstitutive%basic &
.and. ((debugConstitutive%element == el .and. debugConstitutive%ip == ip) &
.or. .not. debugConstitutive%selective)) 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
print'(a,/,10(12x,12(e12.5,1x),/))', '<< CONST >> rho / 1/m^2', rhoSgl, rhoDip
print'(a,/,4(12x,12(e12.5,1x),/))', '<< CONST >> gdot / 1/s',gdot
endif
#endif
@ -1156,8 +1156,8 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
.or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then
#ifdef DEBUG
if (debugConstitutive%extensive) 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 !!!'
print'(a,i5,a,i2)', '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip
print'(a)', '<< CONST >> enforcing cutback !!!'
endif
#endif
plasticState(ph)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN)
@ -1268,8 +1268,8 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el)
> IPvolume(ip,el) / maxval(IParea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
#ifdef DEBUG
if (debugConstitutive%extensive) 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 ', &
print'(a,i5,a,i2)', '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip
print'(a,e10.3,a,e10.3)', '<< CONST >> velocity is at ', &
maxval(abs(v0), abs(gdot) > 0.0_pReal &
.and. prm%CFLfactor * abs(v0) * timestep &
> IPvolume(ip,el) / maxval(IParea(:,ip,el))), &

45
src/grid/DAMASK_grid.f90
View File

@ -99,10 +99,10 @@ program DAMASK_grid
! init DAMASK (all modules)
call CPFEM_initAll
write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>'; flush(6)
print'(/,a)', ' <<<+- DAMASK_spectral init -+>>>'; flush(6)
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
print*, 'Shanthraj et al., Handbook of Mechanics of Materials, 2019'
print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
!--------------------------------------------------------------------------------------------------
! initialize field solver information
@ -263,19 +263,19 @@ program DAMASK_grid
reportAndCheck: if (worldrank == 0) then
write (loadcase_string, '(i0)' ) currentLoadCase
write(6,'(/,1x,a,i0)') 'load case: ', currentLoadCase
print'(/,a,i0)', ' load case: ', currentLoadCase
if (.not. newLoadCase%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
print*, ' drop guessing along trajectory'
if (newLoadCase%deformation%myType == 'l') then
do j = 1, 3
if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined
enddo
write(6,'(2x,a)') 'velocity gradient:'
print*, ' velocity gradient:'
else if (newLoadCase%deformation%myType == 'f') then
write(6,'(2x,a)') 'deformation gradient at end of load case:'
print*, ' deformation gradient at end of load case:'
else
write(6,'(2x,a)') 'deformation gradient rate:'
print*, ' deformation gradient rate:'
endif
do i = 1, 3; do j = 1, 3
if(newLoadCase%deformation%maskLogical(i,j)) then
@ -289,7 +289,7 @@ program DAMASK_grid
newLoadCase%deformation%maskLogical)) errorID = 831 ! exclusive or masking only
if (any(newLoadCase%stress%maskLogical .and. transpose(newLoadCase%stress%maskLogical) &
.and. (math_I3<1))) errorID = 838 ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:'
print*, ' stress / GPa:'
do i = 1, 3; do j = 1, 3
if(newLoadCase%stress%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal
@ -305,14 +305,14 @@ program DAMASK_grid
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
transpose(newLoadCase%rot%asMatrix())
if (newLoadCase%time < 0.0_pReal) errorID = 834 ! negative time increment
write(6,'(2x,a,f0.3)') 'time: ', newLoadCase%time
print'(a,f0.3)', ' time: ', newLoadCase%time
if (newLoadCase%incs < 1) errorID = 835 ! non-positive incs count
write(6,'(2x,a,i0)') 'increments: ', newLoadCase%incs
print'(a,i0)', ' increments: ', newLoadCase%incs
if (newLoadCase%outputfrequency < 1) errorID = 836 ! non-positive result frequency
write(6,'(2x,a,i0)') 'output frequency: ', newLoadCase%outputfrequency
print'(a,i0)', ' output frequency: ', newLoadCase%outputfrequency
if (newLoadCase%restartfrequency < 1) errorID = 839 ! non-positive restart frequency
if (newLoadCase%restartfrequency < huge(0)) &
write(6,'(2x,a,i0)') 'restart frequency: ', newLoadCase%restartfrequency
print'(a,i0)', ' restart frequency: ', newLoadCase%restartfrequency
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
endif reportAndCheck
loadCases = [loadCases,newLoadCase] ! load case is ok, append it
@ -341,8 +341,7 @@ program DAMASK_grid
writeHeader: if (interface_restartInc < 1) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (debug_grid%contains('basic')) &
write(6,'(/,a)') ' header of statistics file written out'
if (debug_grid%contains('basic')) print'(/,a)', ' header of statistics file written out'
flush(6)
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
@ -351,7 +350,7 @@ program DAMASK_grid
endif
writeUndeformed: if (interface_restartInc < 1) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
print'(/,a)', ' ... writing initial configuration to file ........................'
call CPFEM_results(0,0.0_pReal)
endif writeUndeformed
@ -397,8 +396,8 @@ program DAMASK_grid
!--------------------------------------------------------------------------------------------------
! report begin of new step
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,a,es12.5,6(a,i0))') &
print'(/,a)', ' ###########################################################################'
print'(1x,a,es12.5,6(a,i0))', &
'Time', time, &
's: Increment ', inc,'/',loadCases(currentLoadCase)%incs,&
'-', stepFraction,'/',subStepFactor**cutBackLevel,&
@ -469,7 +468,7 @@ program DAMASK_grid
cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time
timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep
write(6,'(/,a)') ' cutting back '
print'(/,a)', ' cutting back '
else ! no more options to continue
call IO_warning(850)
if (worldrank == 0) close(statUnit)
@ -481,13 +480,13 @@ program DAMASK_grid
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
write(6,'(/,a,i0,a)') ' increment ', totalIncsCounter, ' converged'
print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' converged'
else
write(6,'(/,a,i0,a)') ' increment ', totalIncsCounter, ' NOT converged'
print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' NOT converged'
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................'
print'(1/,a)', ' ... writing results to file ......................................'
flush(6)
call CPFEM_results(totalIncsCounter,time)
endif
@ -504,7 +503,7 @@ program DAMASK_grid
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
write(6,'(/,a)') ' ###########################################################################'
print'(/,a)', ' ###########################################################################'
if (worldrank == 0) close(statUnit)
call quit(0) ! no complains ;)

2
src/grid/discretization_grid.f90
View File

@ -65,7 +65,7 @@ subroutine discretization_grid_init(restart)
integer(C_INTPTR_T) :: &
devNull, z, z_offset
write(6,'(/,a)') ' <<<+- discretization_grid init -+>>>'; flush(6)
print'(/,a)', ' <<<+- discretization_grid init -+>>>'; flush(6)
if(index(interface_geomFile,'.vtr') /= 0) then
call readVTR(grid,geomSize,origin,microstructureAt)

38
src/grid/grid_damage_spectral.f90
View File

@ -22,42 +22,38 @@ module grid_damage_spectral
implicit none
private
type, private :: tNumerics
type :: tNumerics
integer :: &
itmax !< max number of iterations
itmax !< maximum number of iterations
real(pReal) :: &
residualStiffness, & !< non-zero residual damage
eps_damage_atol, & !< absolute tolerance for damage evolution
eps_damage_rtol !< relative tolerance for damage evolution
end type tNumerics
type(tNumerics), private :: num
!--------------------------------------------------------------------------------------------------
! derived types
type(tSolutionParams), private :: params
type(tNumerics) :: num
type(tSolutionParams) :: params
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES, private :: damage_snes
Vec, private :: solution_vec
PetscInt, private :: xstart, xend, ystart, yend, zstart, zend
real(pReal), private, dimension(:,:,:), allocatable :: &
SNES :: damage_snes
Vec :: solution_vec
PetscInt :: xstart, xend, ystart, yend, zstart, zend
real(pReal), dimension(:,:,:), allocatable :: &
phi_current, & !< field of current damage
phi_lastInc, & !< field of previous damage
phi_stagInc !< field of staggered damage
!--------------------------------------------------------------------------------------------------
! reference diffusion tensor, mobility etc.
integer, private :: totalIter = 0 !< total iteration in current increment
real(pReal), dimension(3,3), private :: K_ref
real(pReal), private :: mu_ref
integer :: totalIter = 0 !< total iteration in current increment
real(pReal), dimension(3,3) :: K_ref
real(pReal) :: mu_ref
public :: &
grid_damage_spectral_init, &
grid_damage_spectral_solution, &
grid_damage_spectral_forward
private :: &
formResidual
contains
@ -77,10 +73,10 @@ subroutine grid_damage_spectral_init
character(len=pStringLen) :: &
snes_type
write(6,'(/,a)') ' <<<+- grid_spectral_damage init -+>>>'
print'(/,a)', ' <<<+- grid_spectral_damage init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
print*, 'Shanthraj et al., Handbook of Mechanics of Materials, 2019'
print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
@ -152,8 +148,6 @@ subroutine grid_damage_spectral_init
allocate(phi_stagInc(grid(1),grid(2),grid3), source=1.0_pReal)
call VecSet(solution_vec,1.0_pReal,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! damage reference diffusion update
call updateReference
end subroutine grid_damage_spectral_init
@ -210,10 +204,10 @@ function grid_damage_spectral_solution(timeinc,timeinc_old) result(solution)
call VecMin(solution_vec,devNull,phi_min,ierr); CHKERRQ(ierr)
call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr)
if (solution%converged) &
write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
print'(/,a)', ' ... nonlocal damage converged .....................................'
write(6,'(/,a,f8.6,2x,f8.6,2x,e11.4,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
phi_min, phi_max, stagNorm
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end function grid_damage_spectral_solution

29
src/grid/grid_mech_FEM.f90
View File

@ -122,7 +122,7 @@ subroutine grid_mech_FEM_init
PetscScalar, pointer, dimension(:,:,:,:) :: &
u_current,u_lastInc
write(6,'(/,a)') ' <<<+- grid_mech_FEM init -+>>>'; flush(6)
print'(/,a)', ' <<<+- grid_mech_FEM init -+>>>'; flush(6)
!-----------------------------------------------------------------------------------------------
! debugging options
@ -130,13 +130,12 @@ subroutine grid_mech_FEM_init
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameter and do sanity checks
! read numerical parameters and do sanity checks
num_grid => config_numerics%get('grid',defaultVal=emptyDict)
num%eps_div_atol = num_grid%get_asFloat ('eps_div_atol', defaultVal=1.0e-4_pReal)
num%eps_div_rtol = num_grid%get_asFloat ('eps_div_rtol', defaultVal=5.0e-4_pReal)
num%eps_stress_atol = num_grid%get_asFloat ('eps_stress_atol', defaultVal=1.0e3_pReal)
num%eps_stress_rtol = num_grid%get_asFloat ('eps_stress_rtol', defaultVal=0.01_pReal)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
@ -225,7 +224,7 @@ subroutine grid_mech_FEM_init
!--------------------------------------------------------------------------------------------------
! init fields
restartRead: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading restart data of increment ', interface_restartInc, ' from file'
print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName)
@ -254,7 +253,7 @@ subroutine grid_mech_FEM_init
CHKERRQ(ierr)
restartRead2: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading more restart data of increment ', interface_restartInc, ' from file'
print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
call HDF5_read(groupHandle,C_volAvg, 'C_volAvg')
call HDF5_read(groupHandle,C_volAvgLastInc,'C_volAvgLastInc')
@ -290,11 +289,11 @@ function grid_mech_FEM_solution(incInfoIn) result(solution)
!--------------------------------------------------------------------------------------------------
! solve BVP
call SNESsolve(mech_snes,PETSC_NULL_VEC,solution_current,ierr);CHKERRQ(ierr)
call SNESsolve(mech_snes,PETSC_NULL_VEC,solution_current,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! check convergence
call SNESGetConvergedReason(mech_snes,reason,ierr);CHKERRQ(ierr)
call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr)
solution%converged = reason > 0
solution%iterationsNeeded = totalIter
@ -348,7 +347,7 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
F_aimDot = merge(stress_BC%maskFloat*(F_aim-F_aim_lastInc)/timeinc_old, 0.0_pReal, guess)
F_aim_lastInc = F_aim
!--------------------------------------------------------------------------------------------------
!-----------------------------------------------------------------------------------------------
! calculate rate for aim
if (deformation_BC%myType=='l') then ! calculate F_aimDot from given L and current F
F_aimDot = &
@ -409,7 +408,7 @@ subroutine grid_mech_FEM_restartWrite
call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr)
call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr)
write(6,'(a)') ' writing solver data required for restart to file'; flush(6)
print*, 'writing solver data required for restart to file'; flush(6)
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName,'w')
@ -471,12 +470,12 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,i
!--------------------------------------------------------------------------------------------------
! report
write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
print'(1/,a)', ' ... reporting .............................................................'
print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
err_div/divTol, ' (',err_div,' / m, tol = ',divTol,')'
write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', &
print'(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC = ', &
err_BC/BCTol, ' (',err_BC, ' Pa, tol = ',BCTol,')'
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end subroutine converged
@ -511,7 +510,7 @@ subroutine formResidual(da_local,x_local, &
! begin of new iteration
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
if (debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
@ -536,7 +535,7 @@ subroutine formResidual(da_local,x_local, &
!--------------------------------------------------------------------------------------------------
! evaluate constitutive response
call Utilities_constitutiveResponse(P_current,&
call utilities_constitutiveResponse(P_current,&
P_av,C_volAvg,devNull, &
F,params%timeinc,params%rotation_BC)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr)

30
src/grid/grid_mech_spectral_basic.f90
View File

@ -42,8 +42,7 @@ module grid_mech_spectral_basic
type(tNumerics) :: num ! numerics parameters. Better name?
logical, private:: &
debugRotation
logical, private :: debugRotation
!--------------------------------------------------------------------------------------------------
! PETSc data
@ -110,13 +109,13 @@ subroutine grid_mech_spectral_basic_init
character(len=pStringLen) :: &
fileName
write(6,'(/,a)') ' <<<+- grid_mech_spectral_basic init -+>>>'; flush(6)
print'(/,a)', ' <<<+- grid_mech_spectral_basic init -+>>>'; flush(6)
write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
print*, 'Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
print*, 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
print*, 'Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006'
!-------------------------------------------------------------------------------------------------
! debugging options
@ -132,7 +131,6 @@ subroutine grid_mech_spectral_basic_init
num%eps_div_rtol = num_grid%get_asFloat ('eps_div_rtol', defaultVal=5.0e-4_pReal)
num%eps_stress_atol = num_grid%get_asFloat ('eps_stress_atol',defaultVal=1.0e3_pReal)
num%eps_stress_rtol = num_grid%get_asFloat ('eps_stress_rtol',defaultVal=0.01_pReal)
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
@ -186,7 +184,7 @@ subroutine grid_mech_spectral_basic_init
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! places pointer on PETSc data
restartRead: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading restart data of increment ', interface_restartInc, ' from file'
print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName)
@ -211,7 +209,7 @@ subroutine grid_mech_spectral_basic_init
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! deassociate pointer
restartRead2: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading more restart data of increment ', interface_restartInc, ' from file'
print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
call HDF5_read(groupHandle,C_volAvg, 'C_volAvg')
call HDF5_read(groupHandle,C_volAvgLastInc,'C_volAvgLastInc')
@ -370,7 +368,7 @@ subroutine grid_mech_spectral_basic_restartWrite
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
write(6,'(a)') ' writing solver data required for restart to file'; flush(6)
print'(a)', ' writing solver data required for restart to file'; flush(6)
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName,'w')
@ -430,12 +428,12 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
!--------------------------------------------------------------------------------------------------
! report
write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
print'(1/,a)', ' ... reporting .............................................................'
print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
err_div/divTol, ' (',err_div,' / m, tol = ',divTol,')'
write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', &
print'(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC = ', &
err_BC/BCTol, ' (',err_BC, ' Pa, tol = ',BCTol,')'
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end subroutine converged
@ -468,7 +466,7 @@ subroutine formResidual(in, F, &
! begin of new iteration
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if (debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))

27
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -123,10 +123,10 @@ subroutine grid_mech_spectral_polarisation_init
character(len=pStringLen) :: &
fileName
write(6,'(/,a)') ' <<<+- grid_mech_spectral_polarisation init -+>>>'; flush(6)
print'(/,a)', ' <<<+- grid_mech_spectral_polarisation init -+>>>'; flush(6)
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
write(6,'(a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
print*, 'Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006'
!------------------------------------------------------------------------------------------------
! debugging options
@ -134,9 +134,8 @@ subroutine grid_mech_spectral_polarisation_init
debugRotation = debug_grid%contains('rotation')
!-------------------------------------------------------------------------------------------------
! read numerical parameters
! read numerical parameters and do sanity checks
num_grid => config_numerics%get('grid',defaultVal=emptyDict)
num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.)
num%eps_div_atol = num_grid%get_asFloat ('eps_div_atol', defaultVal=1.0e-4_pReal)
num%eps_div_rtol = num_grid%get_asFloat ('eps_div_rtol', defaultVal=5.0e-4_pReal)
@ -207,7 +206,7 @@ subroutine grid_mech_spectral_polarisation_init
F_tau => FandF_tau(9:17,:,:,:)
restartRead: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading restart data of increment ', interface_restartInc, ' from file'
print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName)
@ -236,7 +235,7 @@ subroutine grid_mech_spectral_polarisation_init
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! deassociate pointer
restartRead2: if (interface_restartInc > 0) then
write(6,'(/,a,i0,a)') ' reading more restart data of increment ', interface_restartInc, ' from file'
print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
call HDF5_read(groupHandle,C_volAvg, 'C_volAvg')
call HDF5_read(groupHandle,C_volAvgLastInc,'C_volAvgLastInc')
@ -427,7 +426,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite
F => FandF_tau(0: 8,:,:,:)
F_tau => FandF_tau(9:17,:,:,:)
write(6,'(a)') ' writing solver data required for restart to file'; flush(6)
print*, 'writing solver data required for restart to file'; flush(6)
write(fileName,'(a,a,i0,a)') trim(getSolverJobName()),'_',worldrank,'.hdf5'
fileHandle = HDF5_openFile(fileName,'w')
@ -491,14 +490,14 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
!--------------------------------------------------------------------------------------------------
! report
write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
print'(1/,a)', ' ... reporting .............................................................'
print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
err_div/divTol, ' (',err_div, ' / m, tol = ',divTol,')'
write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
print '(a,f12.2,a,es8.2,a,es9.2,a)', ' error curl = ', &
err_curl/curlTol,' (',err_curl,' -, tol = ',curlTol,')'
write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
print '(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC = ', &
err_BC/BCTol, ' (',err_BC, ' Pa, tol = ',BCTol,')'
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end subroutine converged
@ -551,7 +550,7 @@ subroutine formResidual(in, FandF_tau, &
! begin of new iteration
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
write(6,'(1x,a,3(a,i0))') trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
if(debugRotation) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))

30
src/grid/grid_thermal_spectral.f90
View File

@ -23,20 +23,17 @@ module grid_thermal_spectral
implicit none
private
!--------------------------------------------------------------------------------------------------
! derived types
type(tSolutionParams) :: params
type :: tNumerics
integer :: &
itmax !< maximum number of iterations
itmax !< maximum number of iterations
real(pReal) :: &
eps_thermal_atol, & !< absolute tolerance for thermal equilibrium
eps_thermal_rtol !< relative tolerance for thermal equilibrium
eps_thermal_atol, & !< absolute tolerance for thermal equilibrium
eps_thermal_rtol !< relative tolerance for thermal equilibrium
end type tNumerics
type(tNumerics) :: num
type(tSolutionParams) :: params
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES :: thermal_snes
@ -74,13 +71,13 @@ subroutine grid_thermal_spectral_init
class(tNode), pointer :: &
num_grid
write(6,'(/,a)') ' <<<+- grid_thermal_spectral init -+>>>'
print'(/,a)', ' <<<+- grid_thermal_spectral init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, 2019'
write(6,'(a)') ' https://doi.org/10.1007/978-981-10-6855-3_80'
print*, 'Shanthraj et al., Handbook of Mechanics of Materials, 2019'
print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
!-------------------------------------------------------------------------------------------------
! read numerical parameter and do sanity checks
! read numerical parameters and do sanity checks
num_grid => config_numerics%get('grid',defaultVal=emptyDict)
num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
num%eps_thermal_atol = num_grid%get_asFloat ('eps_thermal_atol',defaultVal=1.0e-2_pReal)
@ -94,8 +91,7 @@ subroutine grid_thermal_spectral_init
! set default and user defined options for PETSc
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,'-thermal_snes_type ngmres',ierr)
CHKERRQ(ierr)
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,&
num_grid%get_asString('petsc_options',defaultVal=''),ierr)
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),ierr)
CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
@ -110,7 +106,7 @@ subroutine grid_thermal_spectral_init
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! global grid
1, 1, worldsize, &
1, 0, & ! #dof (thermal phase field), ghost boundary width (domain overlap)
1, 0, & ! #dof (T field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & ! local grid
thermal_grid,ierr) ! handle, error
CHKERRQ(ierr)
@ -159,8 +155,6 @@ function grid_thermal_spectral_solution(timeinc,timeinc_old) result(solution)
timeinc_old !< increment in time of last increment
integer :: i, j, k, cell
type(tSolutionState) :: solution
class(tNode), pointer :: &
num_grid
PetscInt :: devNull
PetscReal :: T_min, T_max, stagNorm, solnNorm
@ -204,10 +198,10 @@ function grid_thermal_spectral_solution(timeinc,timeinc_old) result(solution)
call VecMin(solution_vec,devNull,T_min,ierr); CHKERRQ(ierr)
call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr)
if (solution%converged) &
write(6,'(/,a)') ' ... thermal conduction converged ..................................'
print'(/,a)', ' ... thermal conduction converged ..................................'
write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
T_min, T_max, stagNorm
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end function grid_thermal_spectral_solution

16
src/grid/spectral_utilities.f90
View File

@ -208,7 +208,7 @@ subroutine spectral_utilities_init
debugPETSc = debug_grid%contains('petsc')
if(debugPETSc) write(6,'(3(/,a),/)') &
if(debugPETSc) print'(3(/,a),/)', &
' Initializing PETSc with debug options: ', &
trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.yaml '; flush(6)
@ -280,7 +280,7 @@ subroutine spectral_utilities_init
if (pReal /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
call fftw_set_timelimit(num_grid%get_asFloat('fftw_timelimit',defaultVal=-1.0_pReal))
if (debugGeneral) write(6,'(/,a)') ' FFTW initialized'; flush(6)
print*, 'FFTW initialized'; flush(6)
!--------------------------------------------------------------------------------------------------
! MPI allocation
@ -506,7 +506,7 @@ subroutine utilities_fourierGammaConvolution(fieldAim)
logical :: err
write(6,'(/,a)') ' ... doing gamma convolution ...............................................'
print'(/,a)', ' ... doing gamma convolution ...............................................'
flush(6)
!--------------------------------------------------------------------------------------------------
@ -576,7 +576,7 @@ real(pReal) function utilities_divergenceRMS()
integer :: i, j, k, ierr
complex(pReal), dimension(3) :: rescaledGeom
write(6,'(/,a)') ' ... calculating divergence ................................................'
print'(/,a)', ' ... calculating divergence ................................................'
flush(6)
rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
@ -620,7 +620,7 @@ real(pReal) function utilities_curlRMS()
complex(pReal), dimension(3,3) :: curl_fourier
complex(pReal), dimension(3) :: rescaledGeom
write(6,'(/,a)') ' ... calculating curl ......................................................'
print'(/,a)', ' ... calculating curl ......................................................'
flush(6)
rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
@ -700,7 +700,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
temp99_real = math_3333to99(rot_BC%rotate(C))
if(debugGeneral) then
write(6,'(/,a)') ' ... updating masked compliance ............................................'
print'(/,a)', ' ... updating masked compliance ............................................'
write(6,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',&
transpose(temp99_Real)*1.0e-9_pReal
flush(6)
@ -822,7 +822,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
real(pReal) :: dPdF_norm_max, dPdF_norm_min
real(pReal), dimension(2) :: valueAndRank !< pair of min/max norm of dPdF to synchronize min/max of dPdF
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
print'(/,a)', ' ... evaluating constitutive response ......................................'
flush(6)
materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field
@ -1095,7 +1095,7 @@ subroutine utilities_saveReferenceStiffness
fileUnit,ierr
if (worldrank == 0) then
write(6,'(a)') ' writing reference stiffness data required for restart to file'; flush(6)
print'(a)', ' writing reference stiffness data required for restart to file'; flush(6)
open(newunit=fileUnit, file=getSolverJobName()//'.C_ref',&
status='replace',access='stream',action='write',iostat=ierr)
if(ierr /=0) call IO_error(100,ext_msg='could not open file '//getSolverJobName()//'.C_ref')

9
src/marc/discretization_marc.f90
View File

@ -70,7 +70,7 @@ subroutine discretization_marc_init
class(tNode), pointer :: &
num_commercialFEM
write(6,'(/,a)') ' <<<+- discretization_marc init -+>>>'; flush(6)
print'(/,a)', ' <<<+- discretization_marc init -+>>>'; flush(6)
!---------------------------------------------------------------------------------
! read debug parameters
@ -1030,10 +1030,9 @@ pure function IPareaNormal(elem,nElem,connectivity,node)
IPareaNormal(1:3,f,i,e) = math_cross(nodePos(1:3,2) - nodePos(1:3,1), &
nodePos(1:3,3) - nodePos(1:3,1))
case (4) ! 3D 8node
! for this cell type we get the normal of the quadrilateral face as an average of
! four normals of triangular subfaces; since the face consists only of two triangles,
! the sum has to be divided by two; this whole prcedure tries to compensate for
! probable non-planar cell surfaces
! Get the normal of the quadrilateral face as the average of four normals of triangular
! subfaces. Since the face consists only of two triangles, the sum has to be divided
! by two. This procedure tries to compensate for probable non-planar cell surfaces
IPareaNormal(1:3,f,i,e) = 0.0_pReal
do n = 1, m
IPareaNormal(1:3,f,i,e) = IPareaNormal(1:3,f,i,e) &

125
src/material.f90
View File

@ -181,10 +181,10 @@ subroutine material_init(restart)
enddo
call material_parseMicrostructure
print*, ' Microstructure parsed'
print*, 'Microstructure parsed'
call material_parseHomogenization
print*, ' Homogenization parsed'
print*, 'Homogenization parsed'
if(homogenization_maxNgrains > size(material_phaseAt,1)) call IO_error(148)
@ -227,6 +227,7 @@ end subroutine material_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the homogenization part from the material configuration
! ToDo: This should be done in homogenization
!--------------------------------------------------------------------------------------------------
subroutine material_parseHomogenization
@ -320,100 +321,78 @@ end subroutine material_parseHomogenization
!--------------------------------------------------------------------------------------------------
subroutine material_parseMicrostructure
class(tNode), pointer :: microstructure, & !> pointer to microstructure list
constituentsInMicrostructure, & !> pointer to a microstructure list item
constituents, & !> pointer to constituents list
constituent, & !> pointer to each constituent
class(tNode), pointer :: microstructures, & !> list of microstructures
microstructure, & !> microstructure definition
constituents, & !> list of constituents
constituent, & !> constituent definition
phases, &
homogenization
integer, dimension(:), allocatable :: &
CounterPhase, &
CounterHomogenization
real(pReal), dimension(:,:), allocatable :: &
microstructure_fraction !< vol fraction of each constituent in microstrcuture
counterPhase, &
counterHomogenization
real(pReal) :: &
frac
integer :: &
e, &
i, &
m, &
c, &
microstructure_maxNconstituents
maxNconstituents
real(pReal), dimension(4) :: phase_orientation
microstructures => config_material%get('microstructure')
if(any(discretization_microstructureAt > microstructures%length)) &
call IO_error(155,ext_msg='More microstructures requested than found in material.yaml')
homogenization => config_material%get('homogenization')
phases => config_material%get('phase')
microstructure => config_material%get('microstructure')
allocate(microstructure_Nconstituents(microstructure%length), source = 0)
if(any(discretization_microstructureAt > microstructure%length)) &
call IO_error(155,ext_msg='More microstructures in geometry than sections in material.yaml')
do m = 1, microstructure%length
constituentsInMicrostructure => microstructure%get(m)
constituents => constituentsInMicrostructure%get('constituents')
allocate(microstructure_Nconstituents(microstructures%length),source=0)
do m = 1, microstructures%length
microstructure => microstructures%get(m)
constituents => microstructure%get('constituents')
microstructure_Nconstituents(m) = constituents%length
enddo
microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
allocate(microstructure_fraction(microstructure_maxNconstituents,microstructure%length), source =0.0_pReal)
allocate(material_phaseAt(microstructure_maxNconstituents,discretization_nElem), source =0)
allocate(material_orientation0(microstructure_maxNconstituents,discretization_nIP,discretization_nElem))
allocate(material_homogenizationAt(discretization_nElem))
maxNconstituents = maxval(microstructure_Nconstituents)
allocate(material_homogenizationAt(discretization_nElem),source=0)
allocate(material_homogenizationMemberAt(discretization_nIP,discretization_nElem),source=0)
allocate(material_phaseMemberAt(microstructure_maxNconstituents,discretization_nIP,discretization_nElem),source=0)
allocate(material_phaseAt(maxNconstituents,discretization_nElem),source=0)
allocate(material_phaseMemberAt(maxNconstituents,discretization_nIP,discretization_nElem),source=0)
allocate(CounterPhase(phases%length),source=0)
allocate(CounterHomogenization(homogenization%length),source=0)
allocate(material_orientation0(maxNconstituents,discretization_nIP,discretization_nElem))
phases => config_material%get('phase')
allocate(counterPhase(phases%length),source=0)
homogenization => config_material%get('homogenization')
allocate(counterHomogenization(homogenization%length),source=0)
do m = 1, microstructure%length
constituentsInMicrostructure => microstructure%get(m)
constituents => constituentsInMicrostructure%get('constituents')
do e = 1, discretization_nElem
microstructure => microstructures%get(discretization_microstructureAt(e))
constituents => microstructure%get('constituents')
material_homogenizationAt(e) = homogenization%getIndex(microstructure%get_asString('homogenization'))
do i = 1, discretization_nIP
counterHomogenization(material_homogenizationAt(e)) = counterHomogenization(material_homogenizationAt(e)) + 1
material_homogenizationMemberAt(i,e) = counterHomogenization(material_homogenizationAt(e))
enddo
frac = 0.0_pReal
do c = 1, constituents%length
constituent => constituents%get(c)
microstructure_fraction(c,m) = constituent%get_asFloat('fraction')
enddo
if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) call IO_error(153,ext_msg='constituent')
enddo
do e = 1, discretization_nElem
do i = 1, discretization_nIP
constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e))
constituents => constituentsInMicrostructure%get('constituents')
do c = 1, constituents%length
constituent => constituents%get(c)
material_phaseAt(c,e) = phases%getIndex(constituent%get_asString('phase'))
phase_orientation = constituent%get_asFloats('orientation')
call material_orientation0(c,i,e)%fromQuaternion(phase_orientation)
frac = frac + constituent%get_asFloat('fraction')
material_phaseAt(c,e) = phases%getIndex(constituent%get_asString('phase'))
do i = 1, discretization_nIP
counterPhase(material_phaseAt(c,e)) = counterPhase(material_phaseAt(c,e)) + 1
material_phaseMemberAt(c,i,e) = counterPhase(material_phaseAt(c,e))
call material_orientation0(c,i,e)%fromQuaternion(constituent%get_asFloats('orientation',requiredSize=4))
enddo
enddo
if (dNeq(frac,1.0_pReal)) call IO_error(153,ext_msg='constituent')
enddo
do e = 1, discretization_nElem
do i = 1, discretization_nIP
constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e))
material_homogenizationAt(e) = homogenization%getIndex(constituentsInMicrostructure%get_asString('homogenization'))
CounterHomogenization(material_homogenizationAt(e)) = CounterHomogenization(material_homogenizationAt(e)) + 1
material_homogenizationMemberAt(i,e) = CounterHomogenization(material_homogenizationAt(e))
enddo
enddo
do e = 1, discretization_nElem
do i = 1, discretization_nIP
constituentsInMicrostructure => microstructure%get(discretization_microstructureAt(e))
constituents => constituentsInMicrostructure%get('constituents')
do c = 1, constituents%length
CounterPhase(material_phaseAt(c,e)) = &
CounterPhase(material_phaseAt(c,e)) + 1
material_phaseMemberAt(c,i,e) = CounterPhase(material_phaseAt(c,e))
enddo
enddo
enddo
end subroutine material_parseMicrostructure

30
src/mesh/DAMASK_mesh.f90
View File

@ -78,7 +78,7 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
call CPFEM_initAll
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'; flush(6)
print'(/,a)', ' <<<+- DAMASK_mesh init -+>>>'; flush(6)
!---------------------------------------------------------------------
! reading field information from numerics file and do sanity checks
@ -208,30 +208,30 @@ program DAMASK_mesh
errorID = 0
checkLoadcases: do currentLoadCase = 1, size(loadCases)
write (loadcase_string, '(i0)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
print'(a,i0)', ' load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
print'(a)', ' drop guessing along trajectory'
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
print'(a)', ' Field '//trim(FIELD_MECH_label)
end select
do faceSet = 1, mesh_Nboundaries
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
print'(a,i2,a,i2,a,f12.7)', ' Face ', mesh_boundaries(faceSet), &
' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
componentBC(component)%Value(faceSet)
enddo
enddo
enddo
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
print'(a,f12.6)', ' time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
print'(a,i5)', ' increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1) errorID = 836 ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', &
print'(a,i5)', ' output frequency: ', &
loadCases(currentLoadCase)%outputfrequency
if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
@ -290,8 +290,8 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! report begin of new step
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,a,es12.5,6(a,i0))')&
print'(/,a)', ' ###########################################################################'
print'(1x,a,es12.5,6(a,i0))',&
'Time', time, &
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
@ -338,7 +338,7 @@ program DAMASK_mesh
cutBack = .False.
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back
write(6,'(/,a)') ' cut back detected'
print'(/,a)', ' cut back detected'
cutBack = .True.
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
@ -360,13 +360,13 @@ program DAMASK_mesh
cutBackLevel = max(0, cutBackLevel - 1) ! try half number of subincs next inc
if (all(solres(:)%converged)) then
write(6,'(/,a,i0,a)') ' increment ', totalIncsCounter, ' converged'
print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' converged'
else
write(6,'(/,a,i0,a)') ' increment ', totalIncsCounter, ' NOT converged'
print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' NOT converged'
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................'
print'(/,a)', ' ... writing results to file ......................................'
call CPFEM_results(totalIncsCounter,time)
endif
@ -378,7 +378,7 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
write(6,'(/,a)') ' ###########################################################################'
print'(/,a)', ' ###########################################################################'
if (worldrank == 0) close(statUnit)
call quit(0) ! no complains ;)

2
src/mesh/FEM_quadrature.f90
View File

@ -37,7 +37,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine FEM_quadrature_init
write(6,'(/,a)') ' <<<+- FEM_quadrature init -+>>>'; flush(6)
print'(/,a)', ' <<<+- FEM_quadrature init -+>>>'; flush(6)
!--------------------------------------------------------------------------------------------------
! 2D linear

6
src/mesh/FEM_utilities.f90
View File

@ -110,7 +110,7 @@ subroutine FEM_utilities_init
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- FEM_utilities init -+>>>'
print'(/,a)', ' <<<+- FEM_utilities init -+>>>'
num_mesh => config_numerics%get('mesh',defaultVal=emptyDict)
structOrder = num_mesh%get_asInt('structOrder', defaultVal = 2)
@ -118,7 +118,7 @@ subroutine FEM_utilities_init
debug_mesh => config_debug%get('mesh',defaultVal=emptyList)
debugPETSc = debug_mesh%contains('petsc')
if(debugPETSc) write(6,'(3(/,a),/)') &
if(debugPETSc) print'(3(/,a),/)', &
' Initializing PETSc with debug options: ', &
trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.yaml '
@ -158,7 +158,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
PetscErrorCode :: ierr
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
print'(/,a)', ' ... evaluating constitutive response ......................................'
call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field

2
src/mesh/discretization_mesh.f90
View File

@ -83,7 +83,7 @@ subroutine discretization_mesh_init(restart)
num_mesh
integer :: integrationOrder !< order of quadrature rule required
write(6,'(/,a)') ' <<<+- discretization_mesh init -+>>>'
print'(/,a)', ' <<<+- discretization_mesh init -+>>>'
!--------------------------------------------------------------------------------
! read numerics parameter

6
src/mesh/mesh_mech_FEM.f90
View File

@ -110,7 +110,7 @@ subroutine FEM_mech_init(fieldBC)
class(tNode), pointer :: &
num_mesh
write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>'; flush(6)
print'(/,a)', ' <<<+- FEM_mech init -+>>>'; flush(6)
!-----------------------------------------------------------------------------
! read numerical parametes and do sanity checks
@ -318,7 +318,7 @@ type(tSolutionState) function FEM_mech_solution( &
CHKERRQ(ierr)
endif
write(6,'(/,a)') ' ==========================================================================='
print'(/,a)', ' ==========================================================================='
flush(6)
end function FEM_mech_solution
@ -679,7 +679,7 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm
call SNESConvergedDefault(snes_local,PETScIter,xnorm,snorm,fnorm/divTol,reason,dummy,ierr)
CHKERRQ(ierr)
if (terminallyIll) reason = SNES_DIVERGED_FUNCTION_DOMAIN
write(6,'(1/,1x,a,a,i0,a,i0,f0.3)') trim(incInfo), &
print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), &
' @ Iteration ',PETScIter,' mechanical residual norm = ', &
int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol)
write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',&

22
src/parallelization.f90
View File

@ -3,8 +3,8 @@
!> @brief Inquires variables related to parallelization (openMP, MPI)
!--------------------------------------------------------------------------------------------------
module parallelization
use prec
use, intrinsic :: iso_fortran_env
use, intrinsic :: ISO_fortran_env, only: &
OUTPUT_UNIT
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
@ -12,6 +12,8 @@ module parallelization
#endif
!$ use OMP_LIB
use prec
implicit none
private
@ -29,14 +31,14 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine parallelization_init
integer :: err, typeSize
integer :: err, typeSize
!$ integer :: got_env, DAMASK_NUM_THREADS, threadLevel
!$ character(len=6) NumThreadsString
#ifdef PETSc
PetscErrorCode :: petsc_err
#else
print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(6)
print'(/,a)', ' <<<+- parallelization init -+>>>'; flush(OUTPUT_UNIT)
#endif
#ifdef PETSc
@ -69,14 +71,10 @@ subroutine parallelization_init
if (typeSize*8 /= storage_size(0.0_pReal)) error stop 'Mismatch between MPI and DAMASK real'
#endif
mainProcess: if (worldrank == 0) then
if (output_unit /= 6) error stop 'STDOUT != 6'
if (error_unit /= 0) error stop 'STDERR != 0'
else mainProcess
close(6) ! disable output for non-master processes (open 6 to rank specific file for debug)
open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd
endif mainProcess
if (worldrank /= 0) then
close(OUTPUT_UNIT) ! disable output
open(OUTPUT_UNIT,file='/dev/null',status='replace') ! close() alone will leave some temp files in cwd
endif
!$ call get_environment_variable(name='DAMASK_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
!$ if(got_env /= 0) then

2
src/prec.f90
View File

@ -8,7 +8,7 @@
!--------------------------------------------------------------------------------------------------
module prec
use, intrinsic :: IEEE_arithmetic
use, intrinsic :: ISO_C_Binding
use, intrinsic :: ISO_C_binding
implicit none
public