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

documented utilities and structured, worked on the restart capabilities of the new basic solver

This commit is contained in:
Martin Diehl 2012-10-24 11:31:40 +00:00
parent aefe8d7e32
commit 13b55275b1
7 changed files with 592 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
code/CPFEM.f90
View File

@ -209,7 +209,7 @@ subroutine CPFEM_init
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) write(6,*)
write(6,*) '<<<+- cpfem init -+>>>' write(6,*) '<<<+- CPFEM init -+>>>'
write(6,*) '$Id$' write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then

6
code/DAMASK_spectral.f90
View File

@ -238,15 +238,9 @@ program DAMASK_spectral
complex(pReal), dimension(:,:,:), pointer :: scalarField_real complex(pReal), dimension(:,:,:), pointer :: scalarField_real
complex(pReal), dimension(:,:,:), pointer :: scalarField_fourier complex(pReal), dimension(:,:,:), pointer :: scalarField_fourier
integer(pInt) :: row, column integer(pInt) :: row, column
!################################################################################################## !##################################################################################################
! reading of information from load case file and geometry file ! reading of information from load case file and geometry file
!################################################################################################## !##################################################################################################
#ifdef PETSC
integer :: ierr_psc
call PetscInitialize(PETSC_NULL_CHARACTER, ierr_psc)
#endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialization of all related DAMASK modules (e.g. mesh.f90 reads in geometry) ! initialization of all related DAMASK modules (e.g. mesh.f90 reads in geometry)
call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt) call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt)

77
code/DAMASK_spectral_driver.f90
View File

@ -1,5 +1,5 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!* $Id$ ! $Id$
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
@ -15,12 +15,10 @@ program DAMASK_spectral_Driver
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
appendToOutFile appendToOutFile
use prec, only: & use prec, only: &
pInt, & pInt, &
pReal, & pReal, &
DAMASK_NaN DAMASK_NaN
use IO, only: & use IO, only: &
IO_isBlank, & IO_isBlank, &
IO_open_file, & IO_open_file, &
@ -33,36 +31,28 @@ program DAMASK_spectral_Driver
IO_read_jobBinaryFile, & IO_read_jobBinaryFile, &
IO_write_jobBinaryFile, & IO_write_jobBinaryFile, &
IO_intOut IO_intOut
use math ! need to include the whole module for FFTW
use math
use mesh, only : & use mesh, only : &
res, & res, &
geomdim, & geomdim, &
mesh_NcpElems mesh_NcpElems
use CPFEM, only: & use CPFEM, only: &
CPFEM_initAll CPFEM_initAll
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
restartInc restartInc
use numerics, only: & use numerics, only: &
maxCutBack, & maxCutBack, &
rotation_tol, & rotation_tol, &
mySpectralSolver mySpectralSolver
use homogenization, only: & use homogenization, only: &
materialpoint_sizeResults, & materialpoint_sizeResults, &
materialpoint_results materialpoint_results
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
tBoundaryCondition, & tBoundaryCondition, &
tSolutionState, & tSolutionState, &
debugGeneral, & debugGeneral, &
cutBack cutBack
use DAMASK_spectral_SolverBasic use DAMASK_spectral_SolverBasic
#ifdef PETSc #ifdef PETSc
use DAMASK_spectral_SolverBasicPETSC use DAMASK_spectral_SolverBasicPETSC
@ -96,12 +86,11 @@ program DAMASK_spectral_Driver
N_l = 0_pInt, & N_l = 0_pInt, &
N_t = 0_pInt, & N_t = 0_pInt, &
N_n = 0_pInt, & N_n = 0_pInt, &
N_Fdot = 0_pInt, & ! number of Fourier points N_Fdot = 0_pInt, & !
myUnit = 234_pInt myUnit = 234_pInt
character(len=1024) :: & character(len=1024) :: &
line line
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loop variables, convergence etc. ! loop variables, convergence etc.
real(pReal), dimension(3,3), parameter :: ones = 1.0_pReal, zeros = 0.0_pReal real(pReal), dimension(3,3), parameter :: ones = 1.0_pReal, zeros = 0.0_pReal
@ -120,11 +109,11 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init DAMASK (all modules) ! init DAMASK (all modules)
call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt) call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt)
write(6,'(a)') '' write(6,'(a)') ''
write(6,'(a)') ' <<<+- DAMASK_spectral_driver init -+>>>' write(6,'(a)') ' <<<+- DAMASK_spectral_driver init -+>>>'
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases ! reading basic information from load case file and allocate data structure containing load cases
call IO_open_file(myUnit,trim(loadCaseFile)) call IO_open_file(myUnit,trim(loadCaseFile))
@ -234,52 +223,59 @@ program DAMASK_spectral_Driver
write (loadcase_string, '(i6)' ) currentLoadCase write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory' if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
if (loadCases(currentLoadCase)%deformation%myType=='l') then if (loadCases(currentLoadCase)%deformation%myType=='l') then
do j = 1_pInt, 3_pInt do j = 1_pInt, 3_pInt
if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) &
errorID = 832_pInt ! each row should be either fully or not at all defined
enddo enddo
write(6,'(2x,a)') 'velocity gradient:' write(6,'(2x,a)') 'velocity gradient:'
else else
write(6,'(2x,a)') 'deformation gradient rate:' write(6,'(2x,a)') 'deformation gradient rate:'
endif endif
write(6,'(3(3(3x,f12.7,1x)/))',advance='no') merge(math_transpose33(loadCases(currentLoadCase)%deformation%values),& write(6,'(3(3(3x,f12.7,1x)/))',advance='no') &
reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),transpose(loadCases(currentLoadCase)%deformation%maskLogical)) merge(math_transpose33(loadCases(currentLoadCase)%deformation%values), &
reshape(spread(huge(1.0_pReal),1,9),[ 3,3]), &
transpose(loadCases(currentLoadCase)%deformation%maskLogical))
if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. &
loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(loadCases(currentLoadCase)%P%maskLogical .and. &
transpose(loadCases(currentLoadCase)%P%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'stress / GPa:',& write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'stress / GPa:',&
1e-9_pReal*merge(math_transpose33(loadCases(currentLoadCase)%P%values),& 1e-9_pReal*merge(math_transpose33(loadCases(currentLoadCase)%P%values),&
reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),transpose(loadCases(currentLoadCase)%P%maskLogical)) reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),&
transpose(loadCases(currentLoadCase)%P%maskLogical))
if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, &
math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) >&
reshape(spread(rotation_tol,1,9),[ 3,3]))&
.or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > &
1.0_pReal + rotation_tol) errorID = 846_pInt ! given rotation matrix contains strain
if (any(loadCases(currentLoadCase)%rotation /= math_I3)) & if (any(loadCases(currentLoadCase)%rotation /= math_I3)) &
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
math_transpose33(loadCases(currentLoadCase)%rotation) math_transpose33(loadCases(currentLoadCase)%rotation)
write(6,'(2x,a,f12.6)') 'temperature:', loadCases(currentLoadCase)%temperature write(6,'(2x,a,f12.6)') 'temperature:', loadCases(currentLoadCase)%temperature
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
write(6,'(2x,a,i5)') 'output frequency: ', loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', loadCases(currentLoadCase)%restartfrequency
if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(loadCases(currentLoadCase)%P%maskLogical .and. transpose(loadCases(currentLoadCase)%P%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC
if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation,math_transpose33(loadCases(currentLoadCase)%rotation))&
-math_I3) > reshape(spread(rotation_tol,1,9),[ 3,3]))&
.or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > 1.0_pReal + rotation_tol)&
errorID = 846_pInt ! given rotation matrix contains strain
if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', &
loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
loadCases(currentLoadCase)%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string)
enddo checkLoadcases enddo checkLoadcases
select case (myspectralsolver) select case (myspectralsolver)
case (DAMASK_spectral_SolverBasic_label) case (DAMASK_spectral_SolverBasic_label)
call basic_init() call basic_init()
#ifdef PETSc #ifdef PETSc
case (DAMASK_spectral_SolverBasicPETSc_label) case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init() call basicPETSc_init()
case (DAMASK_spectral_SolverAL_label) case (DAMASK_spectral_SolverAL_label)
call AL_init() call AL_init()
#endif #endif
@ -297,8 +293,6 @@ program DAMASK_spectral_Driver
else else
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE') '.spectralOut',form='UNFORMATTED',status='REPLACE')
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE')
write(resUnit) 'load', trim(loadCaseFile) write(resUnit) 'load', trim(loadCaseFile)
write(resUnit) 'workingdir', trim(getSolverWorkingDirectoryName()) write(resUnit) 'workingdir', trim(getSolverWorkingDirectoryName())
write(resUnit) 'geometry', trim(geometryFile) write(resUnit) 'geometry', trim(geometryFile)
@ -313,9 +307,11 @@ program DAMASK_spectral_Driver
write(resUnit) 'startingIncrement', restartInc - 1_pInt ! start with writing out the previous inc write(resUnit) 'startingIncrement', restartInc - 1_pInt ! start with writing out the previous inc
write(resUnit) 'eoh' ! end of header write(resUnit) 'eoh' ! end of header
write(resUnit) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:mesh_NcpElems) ! initial (non-deformed or read-in) results write(resUnit) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:mesh_NcpElems) ! initial (non-deformed or read-in) results
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded'
if (debugGeneral) write(6,'(a)') 'Header of result file written out' if (debugGeneral) write(6,'(a)') 'Header of result file written out'
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loopping over loadcases ! loopping over loadcases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
@ -435,8 +431,13 @@ program DAMASK_spectral_Driver
write(6,'(1/,a)') '... writing results to file ......................................' write(6,'(1/,a)') '... writing results to file ......................................'
write(resUnit) materialpoint_results ! write result to file write(resUnit) materialpoint_results ! write result to file
endif endif
if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. &
mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! at frequency of writing restart information set restart parameter for FEsolving (first call to CPFEM_general will write ToDo: true?)
restartWrite = .true.
endif
else !just time forwarding else !just time forwarding
time = time + timeinc time = time + timeinc
guessmode = 1.0_pReal
endif ! end calculation/forwarding endif ! end calculation/forwarding
enddo incLooping enddo incLooping

4
code/DAMASK_spectral_solverAL.f90
View File

@ -208,7 +208,7 @@ subroutine AL_init()
close (777) close (777)
endif endif
call Utilities_updateGamma(C) call Utilities_updateGamma(C,.True.)
C_scale = C C_scale = C
S_scale = math_invSym3333(C) S_scale = math_invSym3333(C)
@ -328,7 +328,7 @@ else
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C) S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C)
if (update_gamma) call Utilities_updateGamma(C) if (update_gamma) call Utilities_updateGamma(C,restartWrite)
ForwardData = .True. ForwardData = .True.
mask_stress = P_BC%maskFloat mask_stress = P_BC%maskFloat

68
code/DAMASK_spectral_solverBasic.f90
View File

@ -33,7 +33,8 @@ module DAMASK_spectral_SolverBasic
! stress, stiffness and compliance average etc. ! stress, stiffness and compliance average etc.
real(pReal), private, dimension(3,3) :: & real(pReal), private, dimension(3,3) :: &
F_aim = math_I3, & F_aim = math_I3, &
F_aim_lastInc = math_I3 F_aim_lastInc = math_I3, &
F_aimDot = 0.0_pReal
real(pReal), private,dimension(3,3,3,3) :: & real(pReal), private,dimension(3,3,3,3) :: &
C = 0.0_pReal, C_lastInc = 0.0_pReal C = 0.0_pReal, C_lastInc = 0.0_pReal
@ -69,6 +70,7 @@ subroutine basic_init()
implicit none implicit none
integer(pInt) :: i,j,k integer(pInt) :: i,j,k
real(pReal), dimension(3,3) :: temp33_Real real(pReal), dimension(3,3) :: temp33_Real
real(pReal), dimension(3,3,3,3) :: temp3333_Real
call Utilities_Init() call Utilities_Init()
@ -93,6 +95,7 @@ subroutine basic_init()
coordinates(i,j,k,1:3) = geomdim/real(res,pReal)*real([i,j,k],pReal) & coordinates(i,j,k,1:3) = geomdim/real(res,pReal)*real([i,j,k],pReal) &
- geomdim/real(2_pInt*res,pReal) - geomdim/real(2_pInt*res,pReal)
enddo; enddo; enddo enddo; enddo; enddo
elseif (restartInc > 1_pInt) then ! using old values from file elseif (restartInc > 1_pInt) then ! using old values from file
if (debugRestart) write(6,'(a,'//IO_intOut(restartInc-1_pInt)//',a)') & if (debugRestart) write(6,'(a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'Reading values of increment', restartInc - 1_pInt, 'from file' 'Reading values of increment', restartInc - 1_pInt, 'from file'
@ -110,26 +113,32 @@ subroutine basic_init()
call IO_read_jobBinaryFile(777,'F_aim_lastInc',trim(getSolverJobName()),size(F_aim_lastInc)) call IO_read_jobBinaryFile(777,'F_aim_lastInc',trim(getSolverJobName()),size(F_aim_lastInc))
read (777,rec=1) F_aim_lastInc read (777,rec=1) F_aim_lastInc
close (777) close (777)
call IO_read_jobBinaryFile(777,'C_lastInc',trim(getSolverJobName()),size(C_lastInc))
read (777,rec=1) C_lastInc
close (777)
call IO_read_jobBinaryFile(777,'C',trim(getSolverJobName()),size(C))
read (777,rec=1) C
close (777)
call IO_read_jobBinaryFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot))
read (777,rec=1) f_aimDot
close (777)
call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(temp3333_Real))
read (777,rec=1) temp3333_Real
close (777)
coordinates = 0.0 ! change it later!!! coordinates = 0.0 ! change it later!!!
endif endif
!no rotation bc call deformed_fft(res,geomdim,math_rotate_backward33(F_aim,rotation_BC),1.0_pReal,F_lastInc,coordinates) call Utilities_constitutiveResponse(coordinates,F,F,temperature,0.0_pReal,&
call Utilities_constitutiveResponse(coordinates,F,F_lastInc,temperature,0.0_pReal,&
P,C,temp33_Real,.false.,math_I3) P,C,temp33_Real,.false.,math_I3)
!no rotation bc call deformed_fft(res,geomdim,math_rotate_backward33(F_aim,rotation_BC),1.0_pReal,F_lastInc,coordinates)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! reference stiffness ! reference stiffness
if (restartInc == 1_pInt) then if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness
call IO_write_jobBinaryFile(777,'C_ref',size(C)) temp3333_Real = C
write (777,rec=1) C
close(777)
elseif (restartInc > 1_pInt) then
call IO_read_jobBinaryFile(777,'C_ref',trim(getSolverJobName()),size(C))
read (777,rec=1) C
close (777)
endif endif
call Utilities_updateGamma(C) call Utilities_updateGamma(temp3333_Real,.True.)
end subroutine basic_init end subroutine basic_init
@ -173,8 +182,11 @@ type(tSolutionState) function &
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
restartRead, &
terminallyIll terminallyIll
use DAMASK_spectral_Utilities, only: cutBack use DAMASK_spectral_Utilities, only: &
cutBack
implicit none implicit none
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! input data for solution ! input data for solution
@ -184,7 +196,6 @@ type(tSolutionState) function &
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
real(pReal), dimension(3,3,3,3) :: S real(pReal), dimension(3,3,3,3) :: S
real(pReal), dimension(3,3), save :: f_aimDot = 0.0_pReal
real(pReal), dimension(3,3) :: F_aim_lab, & real(pReal), dimension(3,3) :: F_aim_lab, &
F_aim_lab_lastIter, & F_aim_lab_lastIter, &
P_av P_av
@ -200,15 +211,29 @@ type(tSolutionState) function &
! restart information for spectral solver ! restart information for spectral solver
if (restartWrite) then if (restartWrite) then
write(6,'(a)') 'writing converged results for restart' write(6,'(a)') 'writing converged results for restart'
call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad',size(F_lastInc)) call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad',size(F)) ! writing deformation gradient field to file
write (777,rec=1) F_LastInc write (777,rec=1) F
close (777)
call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad_lastInc',size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc
close (777)
call IO_write_jobBinaryFile(777,'F_aim',size(F_aim))
write (777,rec=1) F_aim
close(777)
call IO_write_jobBinaryFile(777,'F_aim_lastInc',size(F_aim_lastInc))
write (777,rec=1) F_aim_lastInc
close(777) close(777)
call IO_write_jobBinaryFile(777,'C',size(C)) call IO_write_jobBinaryFile(777,'C',size(C))
write (777,rec=1) C write (777,rec=1) C
close(777) close(777)
call IO_write_jobBinaryFile(777,'C_lastInc',size(C_lastInc))
write (777,rec=1) C_lastInc
close(777)
call IO_write_jobBinaryFile(777,'F_aimDot',size(f_aimDot))
write (777,rec=1) f_aimDot
close(777)
endif endif
if ( cutBack) then if ( cutBack) then
F_aim = F_aim_lastInc F_aim = F_aim_lastInc
F = F_lastInc F = F_lastInc
@ -225,7 +250,8 @@ else
f_aimDot = f_aimDot & f_aimDot = f_aimDot &
+ guessmode * P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old + guessmode * P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old
F_aim_lastInc = F_aim F_aim_lastInc = F_aim
print*, 'F_aimDot', f_aimDot
print*, 'guessmode', guessmode
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
call deformed_fft(res,geomdim,math_rotate_backward33(F_aim_lastInc,rotation_BC), & call deformed_fft(res,geomdim,math_rotate_backward33(F_aim_lastInc,rotation_BC), &
@ -241,9 +267,9 @@ else
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C) S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C)
if (update_gamma) call Utilities_updateGamma(C) if (update_gamma) call Utilities_updateGamma(C,restartWrite)
ForwardData = .True. if (.not. restartRead) ForwardData = .True.
iter = 0_pInt iter = 0_pInt
convergenceLoop: do while(iter < itmax) convergenceLoop: do while(iter < itmax)

4
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -191,7 +191,7 @@ subroutine BasicPETSC_init()
close (777) close (777)
endif endif
call Utilities_updateGamma(C) call Utilities_updateGamma(C,.True.)
end subroutine BasicPETSC_init end subroutine BasicPETSC_init
@ -294,7 +294,7 @@ else
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C) S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C)
if (update_gamma) call Utilities_updateGamma(C) if (update_gamma) call Utilities_updateGamma(C,restartWrite)
ForwardData = .True. ForwardData = .True.
mask_stress = P_BC%maskFloat mask_stress = P_BC%maskFloat

509
code/DAMASK_spectral_utilities.f90
View File

@ -1,71 +1,82 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!* $Id$ ! $Id$
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Utilities used by the different spectral solver variants !> @brief Utilities used by the different spectral solver variants
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module DAMASK_spectral_Utilities module DAMASK_spectral_utilities
use, intrinsic :: iso_c_binding
use prec, only: & use prec, only: &
pReal, & pReal, &
pInt pInt
use mesh, only : &
res, &
res1_red, &
geomdim, &
mesh_NcpElems, &
wgt
use math
use IO, only: &
IO_error
implicit none implicit none
logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables storing information for spectral method and FFTW ! variables storing information for spectral method and FFTW
type(C_PTR), private :: plan_forward, plan_backward ! plans for fftw real(pReal), public, dimension(:,:,:,:,:), pointer :: field_real !< real representation (some stress of deformation) of field_fourier
real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat ! gamma operator (field) for spectral method type(C_PTR), private :: plan_forward, plan_backward !< plans for FFTW
real(pReal), private, dimension(:,:,:,:), allocatable :: xi ! wave vector field for divergence and for gamma operator real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method
complex(pReal),private, dimension(:,:,:,:,:), pointer :: field_fourier real(pReal), private, dimension(:,:,:,:), allocatable :: xi !< wave vector field for divergence and for gamma operator
real(pReal), private, dimension(3,3,3,3) :: C_ref complex(pReal),private, dimension(:,:,:,:,:), pointer :: field_fourier !< field on which the Fourier transform operates
real(pReal), private, dimension(3,3,3,3) :: C_ref !< reference stiffness
real(pReal), public, dimension(:,:,:,:,:), pointer :: field_real
logical, public :: cutBack =.false.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! debug fftw ! debug fftw
type(C_PTR), private :: plan_scalarField_forth, plan_scalarField_back type(C_PTR), private :: plan_scalarField_forth, plan_scalarField_back !< plans for FFTW in case of debugging the Fourier transform
complex(pReal),private, dimension(:,:,:), pointer :: scalarField_real complex(pReal),private, dimension(:,:,:), pointer :: scalarField_real !< scalar field real representation for debug of FFTW
complex(pReal),private, dimension(:,:,:), pointer :: scalarField_fourier complex(pReal),private, dimension(:,:,:), pointer :: scalarField_fourier !< scalar field complex representation for debug of FFTW
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! debug divergence ! debug divergence
type(C_PTR), private :: plan_divergence type(C_PTR), private :: plan_divergence !< plan for FFTW in case of debugging divergence calculation
real(pReal), private, dimension(:,:,:,:), pointer :: divergence_real real(pReal), private, dimension(:,:,:,:), pointer :: divergence_real !< scalar field real representation for debugging divergence calculation
complex(pReal), private, dimension(:,:,:,:), pointer :: divergence_fourier complex(pReal),private, dimension(:,:,:,:), pointer :: divergence_fourier !< scalar field real representation for debugging divergence calculation
real(pReal), private, dimension(:,:,:,:), allocatable :: divergence_post real(pReal), private, dimension(:,:,:,:), allocatable :: divergence_post !< data of divergence calculation using function from core modules (serves as a reference)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables controlling debugging ! variables controlling debugging
logical,public :: debugGeneral, debugDivergence, debugRestart, debugFFTW logical, public :: &
debugGeneral, & !< general debugging of spectral solver
debugDivergence, & !< debugging of divergence calculation (comparison to function used for post processing)
debugRestart, & !< debbuging of restart features
debugFFTW !< doing additional FFT on scalar field and compare to results of strided 3D FFT
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type tSolutionState type tSolutionState !< return type of solution from spectral solver variants
logical :: converged = .true. logical :: converged = .true.
logical :: regrid = .false. logical :: regrid = .false.
logical :: termIll = .false. logical :: termIll = .false.
integer(pInt) :: iterationsNeeded = 0_pInt integer(pInt) :: iterationsNeeded = 0_pInt
end type tSolutionState end type tSolutionState
type tBoundaryCondition type tBoundaryCondition !< set of parameters defining a boundary condition
real(pReal), dimension(3,3) :: values = 0.0_pReal real(pReal), dimension(3,3) :: values = 0.0_pReal
real(pReal), dimension(3,3) :: maskFloat = 0.0_pReal real(pReal), dimension(3,3) :: maskFloat = 0.0_pReal
logical, dimension(3,3) :: maskLogical = .false. logical, dimension(3,3) :: maskLogical = .false.
character(len=64) :: myType = 'None' character(len=64) :: myType = 'None'
end type tBoundaryCondition end type tBoundaryCondition
public :: &
utilities_init, &
utilities_updateGamma, &
utilities_FFTforward, &
utilities_FFTbackward, &
utilities_fourierConvolution, &
utilities_divergenceRMS, &
utilities_maskedCompliance, &
utilities_constitutiveResponse, &
utilities_calculateRate, &
utilities_forwardField, &
utilities_destroy
private :: &
utilities_getFilter
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -76,14 +87,15 @@ contains
!> level chosen. !> level chosen.
!> Initializes FFTW. !> Initializes FFTW.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Utilities_init() subroutine utilities_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use IO, only: &
IO_error
use numerics, only: & use numerics, only: &
DAMASK_NumThreadsInt, & DAMASK_NumThreadsInt, &
fftw_planner_flag, & fftw_planner_flag, &
fftw_timelimit, & fftw_timelimit, &
memory_efficient memory_efficient
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_spectral, & debug_spectral, &
@ -91,21 +103,22 @@ subroutine Utilities_init()
debug_spectralDivergence, & debug_spectralDivergence, &
debug_spectralRestart, & debug_spectralRestart, &
debug_spectralFFTW debug_spectralFFTW
use mesh, only: & use mesh, only: &
res, &
res1_red, &
virt_dim virt_dim
use math ! must use the whole module for use of FFTW
implicit none implicit none
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
integer(pInt), dimension(3) :: k_s integer(pInt), dimension(3) :: k_s
!$ integer(pInt) :: ierr type(C_PTR) :: &
type(C_PTR) :: tensorField ! field in real and fourier space tensorField, & !< field cotaining data for FFTW in real and fourier space (in place)
type(C_PTR) :: scalarField_realC, scalarField_fourierC scalarField_realC, & !< field cotaining data for FFTW in real space when debugging FFTW (no in place)
type(C_PTR) :: divergence scalarField_fourierC, & !< field cotaining data for FFTW in fourier space when debugging FFTW (no in place)
divergence !< field cotaining data for FFTW in real and fourier space when debugging divergence (in place)
write(6,'(/,a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
write(6,'(a)') ''
write(6,'(a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a)') '' write(6,'(a)') ''
@ -125,28 +138,28 @@ subroutine Utilities_init()
call c_f_pointer(tensorField, field_fourier, [ res1_red, res(2),res(3),3,3]) ! place a pointer for a complex representation on tensorField call c_f_pointer(tensorField, field_fourier, [ res1_red, res(2),res(3),3,3]) ! place a pointer for a complex representation on tensorField
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! general initialization of fftw (see manual on fftw.org for more details) ! general initialization of FFTW (see manual on fftw.org for more details)
if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=808_pInt) ! check for correct precision in C if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(error_ID=808_pInt) ! check for correct precision in C
!$ if(DAMASK_NumThreadsInt > 0_pInt) then !$ if(DAMASK_NumThreadsInt > 0_pInt) then
!$ ierr = fftw_init_threads() !$ i = fftw_init_threads() ! returns 0 in case of problem
!$ if (ierr == 0_pInt) call IO_error(error_ID = 809_pInt) !$ if (i == 0_pInt) call IO_error(error_ID = 809_pInt)
!$ call fftw_plan_with_nthreads(DAMASK_NumThreadsInt) !$ call fftw_plan_with_nthreads(DAMASK_NumThreadsInt)
!$ endif !$ endif
call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! creating plans ! creating plans
plan_forward = fftw_plan_many_dft_r2c(3,[ res(3),res(2) ,res(1)],9,& ! dimensions , length in each dimension in reversed order plan_forward = fftw_plan_many_dft_r2c(3, [res(3),res(2) ,res(1)], 9,& ! dimensions, logical length in each dimension in reversed order, no. of transforms
field_real, [res(3),res(2) ,res(1)+2_pInt],& ! input data, physical length in each dimension in reversed order field_real, [res(3),res(2) ,res(1)+2_pInt],& ! input data, physical length in each dimension in reversed order
1, res(3)*res(2)*(res(1)+2_pInt),& ! striding , product of physical lenght in the 3 dimensions 1, res(3)*res(2)*(res(1)+2_pInt),& ! striding, product of physical length in the 3 dimensions
field_fourier,[ res(3),res(2) ,res1_red],& field_fourier, [res(3),res(2) ,res1_red],& ! output data, physical length in each dimension in reversed order
1, res(3)*res(2)* res1_red,fftw_planner_flag) 1, res(3)*res(2)* res1_red, fftw_planner_flag) ! striding, product of physical length in the 3 dimensions, planner precision
plan_backward =fftw_plan_many_dft_c2r(3,[ res(3),res(2) ,res(1)],9,& plan_backward = fftw_plan_many_dft_c2r(3, [res(3),res(2) ,res(1)], 9,& ! dimensions, logical length in each dimension in reversed order, no. of transforms
field_fourier,[ res(3),res(2) ,res1_red],& field_fourier, [res(3),res(2) ,res1_red],& ! input data, physical length in each dimension in reversed order
1, res(3)*res(2)* res1_red,& 1, res(3)*res(2)* res1_red,& ! striding, product of physical length in the 3 dimensions
field_real,[ res(3),res(2) ,res(1)+2_pInt],& field_real, [res(3),res(2) ,res(1)+2_pInt],& ! output data, physical length in each dimension in reversed order
1, res(3)*res(2)*(res(1)+2_pInt),fftw_planner_flag) 1, res(3)*res(2)*(res(1)+2_pInt), fftw_planner_flag) ! striding, product of physical length in the 3 dimensions, planner precision
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! depending on (debug) options, allocate more memory and create additional plans ! depending on (debug) options, allocate more memory and create additional plans
@ -154,7 +167,7 @@ subroutine Utilities_init()
divergence = fftw_alloc_complex(int(res1_red*res(2)*res(3)*3_pInt,C_SIZE_T)) divergence = fftw_alloc_complex(int(res1_red*res(2)*res(3)*3_pInt,C_SIZE_T))
call c_f_pointer(divergence, divergence_real, [ res(1)+2_pInt,res(2),res(3),3]) call c_f_pointer(divergence, divergence_real, [ res(1)+2_pInt,res(2),res(3),3])
call c_f_pointer(divergence, divergence_fourier, [ res1_red, res(2),res(3),3]) call c_f_pointer(divergence, divergence_fourier, [ res1_red, res(2),res(3),3])
allocate (divergence_post(res(1),res(2),res(3),3)); divergence_post = 0.0_pReal allocate (divergence_post(res(1),res(2),res(3),3),source = 0.0_pReal)
plan_divergence = fftw_plan_many_dft_c2r(3,[ res(3),res(2) ,res(1)],3,& plan_divergence = fftw_plan_many_dft_c2r(3,[ res(3),res(2) ,res(1)],3,&
divergence_fourier,[ res(3),res(2) ,res1_red],& divergence_fourier,[ res(3),res(2) ,res1_red],&
1, res(3)*res(2)* res1_red,& 1, res(3)*res(2)* res1_red,&
@ -163,14 +176,14 @@ subroutine Utilities_init()
endif endif
if (debugFFTW) then if (debugFFTW) then
scalarField_realC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) ! do not do an inplace transform scalarField_realC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) ! allocate data for real representation (no in place transform)
scalarField_fourierC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) scalarField_fourierC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) ! allocate data for fourier representation (no in place transform)
call c_f_pointer(scalarField_realC, scalarField_real, [res(1),res(2),res(3)]) call c_f_pointer(scalarField_realC, scalarField_real, [res(1),res(2),res(3)]) ! place a pointer for a real representation
call c_f_pointer(scalarField_fourierC, scalarField_fourier, [res(1),res(2),res(3)]) call c_f_pointer(scalarField_fourierC, scalarField_fourier, [res(1),res(2),res(3)]) ! place a pointer for a fourier representation
plan_scalarField_forth = fftw_plan_dft_3d(res(3),res(2),res(1),& !reversed order plan_scalarField_forth = fftw_plan_dft_3d(res(3),res(2),res(1),& ! reversed order (C style)
scalarField_real,scalarField_fourier,-1,fftw_planner_flag) scalarField_real,scalarField_fourier,-1,fftw_planner_flag) ! input, output, forward FFT(-1), planner precision
plan_scalarField_back = fftw_plan_dft_3d(res(3),res(2),res(1),& !reversed order plan_scalarField_back = fftw_plan_dft_3d(res(3),res(2),res(1),& ! reversed order (C style)
scalarField_fourier,scalarField_real,+1,fftw_planner_flag) scalarField_fourier,scalarField_real,+1,fftw_planner_flag) ! input, output, backward (1), planner precision
endif endif
if (debugGeneral) write(6,'(a)') 'FFTW initialized' if (debugGeneral) write(6,'(a)') 'FFTW initialized'
@ -179,42 +192,60 @@ subroutine Utilities_init()
! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
do k = 1_pInt, res(3) do k = 1_pInt, res(3)
k_s(3) = k - 1_pInt k_s(3) = k - 1_pInt
if(k > res(3)/2_pInt + 1_pInt) k_s(3) = k_s(3) - res(3) if(k > res(3)/2_pInt + 1_pInt) k_s(3) = k_s(3) - res(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
do j = 1_pInt, res(2) do j = 1_pInt, res(2)
k_s(2) = j - 1_pInt k_s(2) = j - 1_pInt
if(j > res(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - res(2) if(j > res(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - res(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
do i = 1_pInt, res1_red do i = 1_pInt, res1_red
k_s(1) = i - 1_pInt k_s(1) = i - 1_pInt ! symmetry, junst running from 0,1,...,N/2,N/2+1
xi(1:3,i,j,k) = real(k_s, pReal)/virt_dim xi(1:3,i,j,k) = real(k_s, pReal)/virt_dim ! if divergence_correction is set, frequencies are calculated on unit length
enddo; enddo; enddo enddo; enddo; enddo
if(memory_efficient) then ! allocate just single fourth order tensor if(memory_efficient) then ! allocate just single fourth order tensor
allocate (gamma_hat(3,3,3,3,1,1,1), source = 0.0_pReal) allocate (gamma_hat(3,3,3,3,1,1,1), source = 0.0_pReal)
else ! precalculation of gamma_hat field else ! precalculation of gamma_hat field
allocate (gamma_hat(3,3,3,3,res1_red ,res(2),res(3)), source =0.0_pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 allocate (gamma_hat(3,3,3,3,res1_red ,res(2),res(3)), source =0.0_pReal)
endif endif
end subroutine Utilities_init end subroutine utilities_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief updates references stiffness and potentially precalculated gamma operator !> @brief updates references stiffness and potentially precalculated gamma operator
!> @details Sets the current reference stiffness to the stiffness given as an argument. !> @details Sets the current reference stiffness to the stiffness given as an argument.
!> If the gamma operator is precalculated, it is calculated with this stiffness. !> If the gamma operator is precalculated, it is calculated with this stiffness.
!> In case of a on-the-fly calculation, only the reference stiffness is updated. !> In case of a on-the-fly calculation, only the reference stiffness is updated.
!> The gamma operator is filtered depening on the filter selected in numerics !> The gamma operator is filtered depening on the filter selected in numerics.
!> Also writes out the current reference stiffness for restart.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Utilities_updateGamma(C) subroutine utilities_updateGamma(C,saveReference)
use IO, only: &
IO_write_jobBinaryFile
use numerics, only: & use numerics, only: &
memory_efficient memory_efficient
use math, only: &
math_inv33
use mesh, only: &
res, &
res1_red
implicit none implicit none
real(pReal), dimension(3,3,3,3), intent(in) :: C real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
logical , intent(in) :: saveReference !< save reference stiffness to file for restart
real(pReal), dimension(3,3) :: temp33_Real, xiDyad real(pReal), dimension(3,3) :: temp33_Real, xiDyad
real(pReal) :: filter real(pReal) :: filter !< weighting of current component
integer(pInt) :: i, j, k, l, m, n, o integer(pInt) :: &
i, j, k, &
l, m, n, o
C_ref = C C_ref = C
if (saveReference) then
write(6,'(a)') 'writing reference stiffness to file'
call IO_write_jobBinaryFile(777,'C_ref',size(C_ref))
write (777,rec=1) C_ref
close(777)
endif
if(.not. memory_efficient) then if(.not. memory_efficient) then
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red
if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
@ -223,14 +254,16 @@ subroutine Utilities_updateGamma(C)
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_Real(l,m) = sum(C_ref(l,m,1:3,1:3)*xiDyad) temp33_Real(l,m) = sum(C_ref(l,m,1:3,1:3)*xiDyad)
temp33_Real = math_inv33(temp33_Real) temp33_Real = math_inv33(temp33_Real)
filter = Utilities_getFilter(xi(1:3,i,j,k)) filter = utilities_getFilter(xi(1:3,i,j,k)) ! weighting factor computed by getFilter function
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt)& forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt)&
gamma_hat(l,m,n,o, i,j,k) = filter*temp33_Real(l,n)*xiDyad(m,o) gamma_hat(l,m,n,o, i,j,k) = filter*temp33_Real(l,n)*xiDyad(m,o)
endif endif
enddo; enddo; enddo enddo; enddo; enddo
gamma_hat(1:3,1:3,1:3,1:3, 1,1,1) = 0.0_pReal ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 gamma_hat(1:3,1:3,1:3,1:3, 1,1,1) = 0.0_pReal ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
endif endif
end subroutine Utilities_updateGamma
end subroutine utilities_updateGamma
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forward FFT of data in field_real to field_fourier with highest freqs. removed !> @brief forward FFT of data in field_real to field_fourier with highest freqs. removed
@ -238,14 +271,15 @@ end subroutine Utilities_updateGamma
!> In case of debugging the FFT, also one component of the tensor (specified by row and column) !> In case of debugging the FFT, also one component of the tensor (specified by row and column)
!> is independetly transformed complex to complex and compared to the whole tensor transform !> is independetly transformed complex to complex and compared to the whole tensor transform
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Utilities_FFTforward(row,column) subroutine utilities_FFTforward(row,column)
use math
use mesh, only : & use mesh, only : &
virt_dim virt_dim, &
use math, only: & res, &
math_divergenceFFT res1_red
implicit none implicit none
integer(pInt), intent(in), optional :: row, column integer(pInt), intent(in), optional :: row, column !< if debug FFTW, compare 3D array field of row and column
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! copy one component of the stress field to to a single FT and check for mismatch ! copy one component of the stress field to to a single FT and check for mismatch
@ -258,10 +292,10 @@ subroutine Utilities_FFTforward(row,column)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! call function to calculate divergence from math (for post processing) to check results ! call function to calculate divergence from math (for post processing) to check results
if (debugDivergence) & if (debugDivergence) &
divergence_post = math_divergenceFFT(virt_dim,field_real(1:res(1),1:res(2),1:res(3),1:3,1:3)) ! padding divergence_post = math_divergenceFFT(virt_dim,field_real(1:res(1),1:res(2),1:res(3),1:3,1:3)) ! some elements are padded
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! doing the FT ! doing the FFT
call fftw_execute_dft_r2c(plan_forward,field_real,field_fourier) call fftw_execute_dft_r2c(plan_forward,field_real,field_fourier)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -269,7 +303,7 @@ subroutine Utilities_FFTforward(row,column)
if (debugFFTW) then if (debugFFTW) then
call fftw_execute_dft(plan_scalarField_forth,scalarField_real,scalarField_fourier) call fftw_execute_dft(plan_scalarField_forth,scalarField_real,scalarField_fourier)
write(6,'(a,i1,1x,i1)') 'checking FT results of compontent ', row, column write(6,'(a,i1,1x,i1)') 'checking FT results of compontent ', row, column
write(6,'(a,2(es11.4,1x))') 'max FT relative error = ',& write(6,'(a,2(es11.4,1x))') 'max FT relative error = ',& ! print real and imaginary part seperately
maxval( real((scalarField_fourier(1:res1_red,1:res(2),1:res(3))-& maxval( real((scalarField_fourier(1:res1_red,1:res(2),1:res(3))-&
field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/& field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/&
scalarField_fourier(1:res1_red,1:res(2),1:res(3)))), & scalarField_fourier(1:res1_red,1:res(2),1:res(3)))), &
@ -277,16 +311,17 @@ subroutine Utilities_FFTforward(row,column)
field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/& field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/&
scalarField_fourier(1:res1_red,1:res(2),1:res(3)))) scalarField_fourier(1:res1_red,1:res(2),1:res(3))))
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! removing highest frequencies ! removing highest frequencies
field_fourier ( res1_red,1:res(2) , 1:res(3) ,1:3,1:3)& field_fourier ( res1_red,1:res(2) , 1:res(3) ,1:3,1:3)&
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
field_fourier (1:res1_red, res(2)/2_pInt+1_pInt,1:res(3) ,1:3,1:3)& field_fourier (1:res1_red, res(2)/2_pInt+1_pInt,1:res(3) ,1:3,1:3)&
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(3)>1_pInt) & if(res(3)>1_pInt) & ! do not delete the whole slice in case of 2D calculation
field_fourier (1:res1_red,1:res(2), res(3)/2_pInt+1_pInt,1:3,1:3)& field_fourier (1:res1_red,1:res(2), res(3)/2_pInt+1_pInt,1:3,1:3)&
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
end subroutine Utilities_FFTforward end subroutine utilities_FFTforward
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -296,17 +331,22 @@ end subroutine Utilities_FFTforward
!> is independetly transformed complex to complex and compared to the whole tensor transform !> is independetly transformed complex to complex and compared to the whole tensor transform
!> results is weighted by number of points stored in wgt !> results is weighted by number of points stored in wgt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Utilities_FFTbackward(row,column) subroutine utilities_FFTbackward(row,column)
use math !< must use the whole module for use of FFTW
use mesh, only: &
wgt, &
res, &
res1_red
implicit none implicit none
integer(pInt), intent(in), optional :: row, column integer(pInt), intent(in), optional :: row, column !< if debug FFTW, compare 3D array field of row and column
integer(pInt) :: i, j, k, m, n integer(pInt) :: i, j, k, m, n
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! comparing 1 and 3x3 inverse FT results ! unpack FFT data for conj complex symmetric part
if (debugFFTW) then if (debugFFTW) then
scalarField_fourier = field_fourier(1:res1_red,1:res(2),1:res(3),row,column) scalarField_fourier = field_fourier(1:res1_red,1:res(2),1:res(3),row,column)
do i = 0_pInt, res(1)/2_pInt-2_pInt ! unpack fft data for conj complex symmetric part do i = 0_pInt, res(1)/2_pInt-2_pInt
m = 1_pInt m = 1_pInt
do k = 1_pInt, res(3) do k = 1_pInt, res(3)
n = 1_pInt n = 1_pInt
@ -320,7 +360,8 @@ subroutine Utilities_FFTbackward(row,column)
enddo; enddo enddo; enddo
endif endif
!--------------------------------------------------------------------------------------------------
! doing the iFFT
call fftw_execute_dft_c2r(plan_backward,field_fourier,field_real) ! back transform of fluct deformation gradient call fftw_execute_dft_c2r(plan_backward,field_fourier,field_real) ! back transform of fluct deformation gradient
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -333,26 +374,33 @@ subroutine Utilities_FFTbackward(row,column)
field_real(1:res(1),1:res(2),1:res(3),row,column))/& field_real(1:res(1),1:res(2),1:res(3),row,column))/&
real(scalarField_real(1:res(1),1:res(2),1:res(3)))) real(scalarField_real(1:res(1),1:res(2),1:res(3))))
endif endif
field_real = field_real * wgt
end subroutine Utilities_FFTbackward field_real = field_real * wgt ! normalize the result by number of elements
end subroutine utilities_FFTbackward
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief doing convolution gamma_hat * field_real with average value given by fieldAim !> @brief doing convolution gamma_hat * field_real, ensuring that average value = fieldAim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Utilities_fourierConvolution(fieldAim) subroutine utilities_fourierConvolution(fieldAim)
use numerics, only: & use numerics, only: &
memory_efficient memory_efficient
use math, only: &
math_inv33
use mesh, only: &
mesh_NcpElems, &
res, &
res1_red
implicit none implicit none
real(pReal), dimension(3,3), intent(in) :: fieldAim real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
real(pReal), dimension(3,3) :: xiDyad, temp33_Real real(pReal), dimension(3,3) :: xiDyad, temp33_Real
real(pReal) :: filter real(pReal) :: filter !< weighting of current component
integer(pInt) :: i, j, k, l, m, n, o
complex(pReal), dimension(3,3) :: temp33_complex complex(pReal), dimension(3,3) :: temp33_complex
integer(pInt) :: &
i, j, k, &
l, m, n, o
write(6,'(/,a)') '... doing convolution .....................................................' write(6,'(/,a)') '... doing convolution .....................................................'
@ -366,7 +414,7 @@ subroutine Utilities_fourierConvolution(fieldAim)
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_Real(l,m) = sum(C_ref(l,m,1:3,1:3)*xiDyad) temp33_Real(l,m) = sum(C_ref(l,m,1:3,1:3)*xiDyad)
temp33_Real = math_inv33(temp33_Real) temp33_Real = math_inv33(temp33_Real)
filter = Utilities_getFilter(xi(1:3,i,j,k)) filter = utilities_getFilter(xi(1:3,i,j,k)) ! weighting factor computed by getFilter function
forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt)& forall(l=1_pInt:3_pInt, m=1_pInt:3_pInt, n=1_pInt:3_pInt, o=1_pInt:3_pInt)&
gamma_hat(l,m,n,o, 1,1,1) = filter*temp33_Real(l,n)*xiDyad(m,o) gamma_hat(l,m,n,o, 1,1,1) = filter*temp33_Real(l,n)*xiDyad(m,o)
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
@ -381,36 +429,45 @@ subroutine Utilities_fourierConvolution(fieldAim)
field_fourier(i,j,k, 1:3,1:3) = temp33_Complex field_fourier(i,j,k, 1:3,1:3) = temp33_Complex
enddo; enddo; enddo enddo; enddo; enddo
endif endif
field_fourier(1,1,1,1:3,1:3) = cmplx(fieldAim*real(mesh_NcpElems,pReal),0.0_pReal,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 field_fourier(1,1,1,1:3,1:3) = cmplx(fieldAim*real(mesh_NcpElems,pReal),0.0_pReal,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
end subroutine Utilities_fourierConvolution end subroutine utilities_fourierConvolution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief calculate root mean square of divergence of field_fourier !> @brief calculate root mean square of divergence of field_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function Utilities_divergenceRMS() real(pReal) function utilities_divergenceRMS()
use math !< must use the whole module for use of FFTW
use mesh, only: &
wgt, &
res, &
res1_red
implicit none implicit none
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
real(pReal) :: err_div_RMS, err_real_div_RMS, err_post_div_RMS,& real(pReal) :: &
err_div_max, err_real_div_max err_div_RMS, & !< RMS of divergence in Fourier space
err_real_div_RMS, & !< RMS of divergence in real space
err_post_div_RMS, & !< RMS of divergence in Fourier space, calculated using function for post processing
err_div_max, & !< maximum value of divergence in Fourier space
err_real_div_max !< maximum value of divergence in real space
complex(pReal), dimension(3) :: temp3_complex complex(pReal), dimension(3) :: temp3_complex
write(6,'(/,a)') '... calculating divergence ................................................' write(6,'(/,a)') '... calculating divergence ................................................'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculating RMS divergence criterion in Fourier space ! calculating RMS divergence criterion in Fourier space
Utilities_divergenceRMS = 0.0_pReal utilities_divergenceRMS = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2) do k = 1_pInt, res(3); do j = 1_pInt, res(2)
do i = 2_pInt, res1_red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice. do i = 2_pInt, res1_red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice.
Utilities_divergenceRMS = Utilities_divergenceRMS & utilities_divergenceRMS = utilities_divergenceRMS &
+ 2.0_pReal*(sum (real(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again + 2.0_pReal*(sum (real(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again
xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)& ! --> sum squared L_2 norm of vector xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)& ! --> sum squared L_2 norm of vector
+sum(aimag(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& +sum(aimag(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),&
xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)) xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal))
enddo enddo
Utilities_divergenceRMS = Utilities_divergenceRMS & ! Those two layers (DC and Nyquist) do not have a conjugate complex counterpart utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart
+ sum( real(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),& + sum( real(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),&
xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)& xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)&
+ sum(aimag(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),& + sum(aimag(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),&
@ -421,7 +478,7 @@ real(pReal) function Utilities_divergenceRMS()
xi(1:3,res1_red,j,k))*TWOPIIMG)**2.0_pReal) xi(1:3,res1_red,j,k))*TWOPIIMG)**2.0_pReal)
enddo; enddo enddo; enddo
Utilities_divergenceRMS = sqrt(Utilities_divergenceRMS) *wgt ! RMS in real space calculated with Parsevals theorem from Fourier space utilities_divergenceRMS = sqrt(utilities_divergenceRMS) *wgt ! RMS in real space calculated with Parsevals theorem from Fourier space
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate additional divergence criteria and report ! calculate additional divergence criteria and report
@ -437,7 +494,7 @@ real(pReal) function Utilities_divergenceRMS()
call fftw_execute_dft_c2r(plan_divergence,divergence_fourier,divergence_real) ! already weighted call fftw_execute_dft_c2r(plan_divergence,divergence_fourier,divergence_real) ! already weighted
err_real_div_RMS = sqrt(wgt*sum(divergence_real**2.0_pReal)) ! RMS in real space err_real_div_RMS = sqrt(wgt*sum(divergence_real**2.0_pReal)) ! RMS in real space
err_post_div_RMS = sqrt(wgt*sum(divergence_post**2.0_pReal)) ! RMS in real space err_post_div_RMS = sqrt(wgt*sum(divergence_post**2.0_pReal)) ! RMS in real space from funtion in math.f90
err_real_div_max = sqrt(maxval(sum(divergence_real**2.0_pReal,dim=4))) ! max in real space err_real_div_max = sqrt(maxval(sum(divergence_real**2.0_pReal,dim=4))) ! max in real space
err_div_max = sqrt( err_div_max) ! max in Fourier space err_div_max = sqrt( err_div_max) ! max in Fourier space
@ -448,25 +505,35 @@ real(pReal) function Utilities_divergenceRMS()
write(6,'(1x,a,es11.4)') 'error divergence Real max = ',err_real_div_max write(6,'(1x,a,es11.4)') 'error divergence Real max = ',err_real_div_max
endif endif
end function Utilities_divergenceRMS end function utilities_divergenceRMS
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief calculates mask compliance !> @brief calculates mask compliance tensor
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function Utilities_maskedCompliance(rot_BC,mask_stress,C) function utilities_maskedCompliance(rot_BC,mask_stress,C)
use IO, only: &
IO_error
use math, only: &
math_Plain3333to99, &
math_plain99to3333, &
math_rotate_forward3333, &
math_rotate_forward33, &
math_invert
implicit none implicit none
real(pReal), dimension(3,3,3,3) :: Utilities_maskedCompliance real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
real(pReal), dimension(3,3,3,3), intent(in) :: C real(pReal), intent(in) , dimension(3,3,3,3) :: C !< current average stiffness
real(pReal), intent(in) , dimension(3,3) :: rot_BC !< rotation of load frame
logical, intent(in), dimension(3,3) :: mask_stress !< mask of stress BC
integer(pInt) :: j, k, m, n integer(pInt) :: j, k, m, n
real(pReal), dimension(3,3), intent(in) :: rot_BC
logical, dimension(3,3), intent(in) :: mask_stress
logical, dimension(9) :: mask_stressVector logical, dimension(9) :: mask_stressVector
real(pReal), dimension(3,3,3,3) :: C_lastInc
real(pReal), dimension(9,9) :: temp99_Real real(pReal), dimension(9,9) :: temp99_Real
integer(pInt) :: size_reduced = 0_pInt integer(pInt) :: size_reduced = 0_pInt
real(pReal), dimension(:,:), allocatable :: s_reduced, c_reduced, sTimesC ! reduced compliance and stiffness (only for stress BC) real(pReal), dimension(:,:), allocatable :: &
s_reduced, & !< reduced compliance matrix (depending on number of stress BC)
c_reduced, & !< reduced stiffness (depending on number of stress BC)
sTimesC !< temp variable to check inversion
logical :: errmatinv logical :: errmatinv
character(len=1024):: formatString character(len=1024):: formatString
@ -477,11 +544,11 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal) allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal)
allocate (sTimesC(size_reduced,size_reduced), source =0.0_pReal) allocate (sTimesC(size_reduced,size_reduced), source =0.0_pReal)
C_lastInc = math_rotate_forward3333(C,rot_BC) ! calculate stiffness from former inc temp99_Real = math_Plain3333to99(math_rotate_forward3333(C,rot_BC))
print*,'C' if(debugGeneral) &
print*,C_lastInc write(6,'(a,/,9(9(2x,f12.7,1x)/))',advance='no') 'Stiffness C rotated / GPa =',&
temp99_Real = math_Plain3333to99(C_lastInc) transpose(temp99_Real)/1.e9_pReal
k = 0_pInt ! build reduced stiffness k = 0_pInt ! calculate reduced stiffness
do n = 1_pInt,9_pInt do n = 1_pInt,9_pInt
if(mask_stressVector(n)) then if(mask_stressVector(n)) then
k = k + 1_pInt k = k + 1_pInt
@ -493,7 +560,7 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
endif; enddo; endif; enddo endif; enddo; endif; enddo
call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness
if(errmatinv) call IO_error(error_ID=400_pInt) if(errmatinv) call IO_error(error_ID=400_pInt)
temp99_Real = 0.0_pReal ! build full compliance temp99_Real = 0.0_pReal ! fill up compliance with zeros
k = 0_pInt k = 0_pInt
do n = 1_pInt,9_pInt do n = 1_pInt,9_pInt
if(mask_stressVector(n)) then if(mask_stressVector(n)) then
@ -504,14 +571,16 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
j = j + 1_pInt j = j + 1_pInt
temp99_Real(n,m) = s_reduced(k,j) temp99_Real(n,m) = s_reduced(k,j)
endif; enddo; endif; enddo endif; enddo; endif; enddo
!--------------------------------------------------------------------------------------------------
! check if inversion was successfull
sTimesC = matmul(c_reduced,s_reduced) sTimesC = matmul(c_reduced,s_reduced)
do m=1_pInt, size_reduced do m=1_pInt, size_reduced
do n=1_pInt, size_reduced do n=1_pInt, size_reduced
if(m==n .and. abs(sTimesC(m,n)) > (1.0_pReal + 10.0e-12_pReal)) errmatinv = .true. if(m==n .and. abs(sTimesC(m,n)) > (1.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! diagonal elements of S*C should be 1
if(m/=n .and. abs(sTimesC(m,n)) > (0.0_pReal + 10.0e-12_pReal)) errmatinv = .true. if(m/=n .and. abs(sTimesC(m,n)) > (0.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! off diagonal elements of S*C should be 0
enddo enddo
enddo enddo
if(debugGeneral .or. errmatinv) then if(debugGeneral .or. errmatinv) then ! report
write(formatString, '(I16.16)') size_reduced write(formatString, '(I16.16)') size_reduced
formatString = '(a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' formatString = '(a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
write(6,trim(formatString),advance='no') 'C * S', transpose(matmul(c_reduced,s_reduced)) write(6,trim(formatString),advance='no') 'C * S', transpose(matmul(c_reduced,s_reduced))
@ -524,54 +593,70 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
else else
temp99_real = 0.0_pReal temp99_real = 0.0_pReal
endif endif
Utilities_maskedCompliance = math_Plain99to3333(temp99_Real) if(debugGeneral) & ! report
print*,'masked S' write(6,'(a,/,9(9(2x,f12.7,1x)/))',advance='no') 'Masked Compliance * GPa =', &
print*,Utilities_maskedCompliance transpose(temp99_Real*1.e9_pReal)
end function Utilities_maskedCompliance utilities_maskedCompliance = math_Plain99to3333(temp99_Real)
subroutine Utilities_constitutiveResponse(coordinates,F_lastInc,F,temperature,timeinc,& end function utilities_maskedCompliance
P,C,P_av,ForwardData,rotation_BC)
!--------------------------------------------------------------------------------------------------
!> @brief calculates constitutive response
!--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(coordinates,F_lastInc,F,temperature,timeinc,&
P,C,P_av,forwardData,rotation_BC)
use debug, only: & use debug, only: &
debug_reset, & debug_reset, &
debug_info debug_info
use math, only: &
math_transpose33, &
math_rotate_forward33
use FEsolving, only: &
restartWrite
use mesh, only: &
res, &
wgt
use CPFEM, only: & use CPFEM, only: &
CPFEM_general CPFEM_general
use FEsolving, only: restartWrite
implicit none implicit none
real(pReal), dimension(res(1),res(2),res(3)) :: temperature real(pReal), intent(inout), dimension(res(1),res(2),res(3)) :: temperature !< temperature field
real(pReal), dimension(res(1),res(2),res(3),3), intent(in) :: coordinates real(pReal), intent(in), dimension(res(1),res(2),res(3),3) :: coordinates !< coordinates field
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: &
F_lastInc, & !< target deformation gradient
F !< previous deformation gradient
real(pReal), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results
real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame
real(pReal), dimension(3,3,res(1),res(2),res(3)), intent(in) :: F,F_lastInc real(pReal),intent(out), dimension(3,3,3,3) :: C !< average stiffness
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: P real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
real(pReal),intent(in) :: timeinc real(pReal),intent(out), dimension(3,3,res(1),res(2),res(3)) :: P !< PK stress
logical, intent(in) :: forwardData
integer(pInt) :: i, j, k, ielem integer(pInt) :: &
integer(pInt) :: calcMode, collectMode i, j, k, &
real(pReal), dimension(3,3,3,3) :: dPdF ielem, &
real(pReal), dimension(3,3,3,3),intent(out) :: C calcMode, & !< CPFEM mode for calculation
real(pReal), dimension(6) :: sigma ! cauchy stress collectMode !< CPFEM mode for collection
real(pReal), dimension(6,6) :: dsde real(pReal), dimension(3,3,3,3) :: dPdF !< d P / d F
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(6) :: sigma !< cauchy stress in mandel notation
real(pReal), dimension(3,3),intent(out) :: P_av real(pReal), dimension(6,6) :: dsde !< d sigma / d Epsilon
write(6,'(/,a,/)') '... evaluating constitutive response ......................................' write(6,'(/,a,/)') '... evaluating constitutive response ......................................'
if (forwardData) then if (forwardData) then ! aging results
calcMode = 1_pInt calcMode = 1_pInt
collectMode = 4_pInt collectMode = 4_pInt
else else ! normal calculation
calcMode = 2_pInt calcMode = 2_pInt
collectMode = 3_pInt collectMode = 3_pInt
endif endif
if (cutBack) then if (cutBack) then ! restore saved variables
calcMode = 2_pInt calcMode = 2_pInt
collectMode = 5_pInt collectMode = 5_pInt
endif endif
if (DebugGeneral) then if (DebugGeneral) write(6,*) 'collect mode: ', collectMode,' calc mode: ', calcMode
write(6,*) 'collect mode', collectMode
write(6,*) 'calc mode', calcMode
endif
ielem = 0_pInt ielem = 0_pInt
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1)
@ -594,91 +679,115 @@ subroutine Utilities_constitutiveResponse(coordinates,F_lastInc,F,temperature,ti
calcMode = 2_pInt calcMode = 2_pInt
C = C + dPdF C = C + dPdF
enddo; enddo; enddo enddo; enddo; enddo
C = C * wgt
call debug_info() call debug_info()
P_av = math_rotate_forward33(sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt,rotation_BC) ! average of P rotated P_av = math_rotate_forward33(sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt,rotation_BC) ! average of P rotated
restartWrite = .false. restartWrite = .false. ! reset restartWrite status
cutBack = .false. cutBack = .false. ! reset cutBack status
write(6,'(a,/,3(3(2x,f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa =',& write(6,'(a,/,3(3(2x,f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa =',&
math_transpose33(P_av)/1.e6_pReal math_transpose33(P_av)/1.e6_pReal
end subroutine utilities_constitutiveResponse
C = C * wgt
end subroutine Utilities_constitutiveResponse
function Utilities_calculateRate(delta_aim,timeinc,timeinc_old,guessmode,field_lastInc,field) !--------------------------------------------------------------------------------------------------
!> @brief calculates forward rate, either guessing or just add delta/timeinc
!--------------------------------------------------------------------------------------------------
pure function utilities_calculateRate(delta_aim,timeinc,timeinc_old,guessmode,field_lastInc,field)
use mesh, only: &
res
implicit none implicit none
real(pReal), intent(in), dimension(3,3) :: delta_aim real(pReal), intent(in), dimension(3,3) :: delta_aim !< homogeneous addon
real(pReal), intent(in) :: timeinc, timeinc_old, guessmode real(pReal), intent(in) :: &
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: field_lastInc,field timeinc, & !< timeinc of current step
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: Utilities_calculateRate timeinc_old, & !< timeinc of last step
guessmode !< timeinc of current step
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: &
field_lastInc, & !< data of previous step
field !< data of current step
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: utilities_calculateRate
if (guessmode == 1.0_pReal) then if (guessmode == 1.0_pReal) then
Utilities_calculateRate = (field-field_lastInc) / timeinc_old utilities_calculateRate = (field-field_lastInc) / timeinc_old
else else
Utilities_calculateRate = spread(spread(spread(delta_aim,3,res(1)),4,res(2)),5,res(3))/timeinc utilities_calculateRate = spread(spread(spread(delta_aim,3,res(1)),4,res(2)),5,res(3))/timeinc
endif endif
end function Utilities_calculateRate end function utilities_calculateRate
function Utilities_forwardField(timeinc,aim,field_lastInc,rate) !--------------------------------------------------------------------------------------------------
!> @brief forwards a field with a pointwise given rate, ensures that the average matches the aim
!--------------------------------------------------------------------------------------------------
pure function utilities_forwardField(timeinc,aim,field_lastInc,rate)
use mesh, only: &
res, &
wgt
implicit none implicit none
real(pReal), intent(in) :: timeinc real(pReal), intent(in) :: timeinc !< timeinc of current step
real(pReal), intent(in), dimension(3,3) :: aim real(pReal), intent(in), dimension(3,3) :: aim !< average field value aim
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: field_lastInc,rate real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: &
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: Utilities_forwardField field_lastInc,& !< initial field
real(pReal), dimension(3,3) :: fieldDiff rate !< rate by which to forward
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: utilities_forwardField
real(pReal), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim
Utilities_forwardField = field_lastInc + rate*timeinc utilities_forwardField = field_lastInc + rate*timeinc
fieldDiff = sum(sum(sum(Utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim
Utilities_forwardField = Utilities_forwardField - & utilities_forwardField = utilities_forwardField - &
spread(spread(spread(fieldDiff,3,res(1)),4,res(2)),5,res(3)) spread(spread(spread(fieldDiff,3,res(1)),4,res(2)),5,res(3))
end function Utilities_forwardField end function utilities_forwardField
real(pReal) function Utilities_getFilter(k)
!--------------------------------------------------------------------------------------------------
!> @brief calculates filter for fourier convolution depending on type given in numerics.config
!--------------------------------------------------------------------------------------------------
real(pReal) function utilities_getFilter(k)
use IO, only: &
IO_error
use numerics, only: & use numerics, only: &
myfilter myfilter
use mesh, only: &
res
use math, only: &
PI
implicit none implicit none
real(pReal),intent(in), dimension(3) :: k !< indices of frequency
real(pReal), dimension(3),intent(in) :: k
select case (myfilter) select case (myfilter)
case ('none') case ('none')
Utilities_getFilter = 1.0_pReal utilities_getFilter = 1.0_pReal
case ('cosine') !< cosine curve with 1 for avg and zero for highest freq
case ('cosine') utilities_getFilter = (1.0_pReal + cos(PI*k(3)/res(3))) &
Utilities_getFilter = (1.0_pReal + cos(pi*k(3)/res(3))) & *(1.0_pReal + cos(PI*k(2)/res(2))) &
*(1.0_pReal + cos(pi*k(2)/res(2))) & *(1.0_pReal + cos(PI*k(1)/res(1)))/8.0_pReal
*(1.0_pReal + cos(pi*k(1)/res(1)))/8.0_pReal
case default case default
call IO_error(error_ID = 892_pInt, ext_msg = trim(myfilter)) call IO_error(error_ID = 892_pInt, ext_msg = trim(myfilter))
end select end select
end function Utilities_getFilter end function utilities_getFilter
subroutine Utilities_destroy() !--------------------------------------------------------------------------------------------------
!> @brief cleans up
!--------------------------------------------------------------------------------------------------
subroutine utilities_destroy()
use math
implicit none implicit none
if (debugDivergence) call fftw_destroy_plan(plan_divergence) if (debugDivergence) call fftw_destroy_plan(plan_divergence)
if (debugFFTW) then if (debugFFTW) call fftw_destroy_plan(plan_scalarField_forth)
call fftw_destroy_plan(plan_scalarField_forth) if (debugFFTW) call fftw_destroy_plan(plan_scalarField_back)
call fftw_destroy_plan(plan_scalarField_back)
endif
call fftw_destroy_plan(plan_forward) call fftw_destroy_plan(plan_forward)
call fftw_destroy_plan(plan_backward) call fftw_destroy_plan(plan_backward)
end subroutine Utilities_destroy end subroutine utilities_destroy
end module DAMASK_spectral_Utilities end module DAMASK_spectral_utilities