documented utilities and structured, worked on the restart capabilities of the new basic solver
This commit is contained in:
Martin Diehl
parent
aefe8d7e32
commit
13b55275b1
|
|
@ -209,7 +209,7 @@ subroutine CPFEM_init
|
|||
|
||||
!$OMP CRITICAL (write2out)
|
||||
write(6,*)
|
||||
write(6,*) '<<<+- cpfem init -+>>>'
|
||||
write(6,*) '<<<+- CPFEM init -+>>>'
|
||||
write(6,*) '$Id$'
|
||||
#include "compilation_info.f90"
|
||||
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
|
||||
|
|
|
|||
|
|
@ -238,15 +238,9 @@ program DAMASK_spectral
|
|||
complex(pReal), dimension(:,:,:), pointer :: scalarField_real
|
||||
complex(pReal), dimension(:,:,:), pointer :: scalarField_fourier
|
||||
integer(pInt) :: row, column
|
||||
|
||||
!##################################################################################################
|
||||
! 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)
|
||||
call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!* $Id$
|
||||
! $Id$
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Pratheek Shanthraj, 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, &
|
||||
getSolverJobName, &
|
||||
appendToOutFile
|
||||
|
||||
use prec, only: &
|
||||
pInt, &
|
||||
pReal, &
|
||||
DAMASK_NaN
|
||||
|
||||
use IO, only: &
|
||||
IO_isBlank, &
|
||||
IO_open_file, &
|
||||
|
|
@ -33,36 +31,28 @@ program DAMASK_spectral_Driver
|
|||
IO_read_jobBinaryFile, &
|
||||
IO_write_jobBinaryFile, &
|
||||
IO_intOut
|
||||
|
||||
use math
|
||||
|
||||
use math ! need to include the whole module for FFTW
|
||||
use mesh, only : &
|
||||
res, &
|
||||
geomdim, &
|
||||
mesh_NcpElems
|
||||
|
||||
use CPFEM, only: &
|
||||
CPFEM_initAll
|
||||
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
restartInc
|
||||
|
||||
use numerics, only: &
|
||||
maxCutBack, &
|
||||
rotation_tol, &
|
||||
mySpectralSolver
|
||||
|
||||
use homogenization, only: &
|
||||
materialpoint_sizeResults, &
|
||||
materialpoint_results
|
||||
|
||||
use DAMASK_spectral_Utilities, only: &
|
||||
tBoundaryCondition, &
|
||||
tSolutionState, &
|
||||
debugGeneral, &
|
||||
cutBack
|
||||
|
||||
use DAMASK_spectral_SolverBasic
|
||||
#ifdef PETSc
|
||||
use DAMASK_spectral_SolverBasicPETSC
|
||||
|
|
@ -96,12 +86,11 @@ program DAMASK_spectral_Driver
|
|||
N_l = 0_pInt, &
|
||||
N_t = 0_pInt, &
|
||||
N_n = 0_pInt, &
|
||||
N_Fdot = 0_pInt, & ! number of Fourier points
|
||||
N_Fdot = 0_pInt, & !
|
||||
myUnit = 234_pInt
|
||||
character(len=1024) :: &
|
||||
line
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! loop variables, convergence etc.
|
||||
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)
|
||||
call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt)
|
||||
|
||||
write(6,'(a)') ''
|
||||
write(6,'(a)') ' <<<+- DAMASK_spectral_driver init -+>>>'
|
||||
write(6,'(a)') ' $Id$'
|
||||
#include "compilation_info.f90"
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! reading basic information from load case file and allocate data structure containing load cases
|
||||
call IO_open_file(myUnit,trim(loadCaseFile))
|
||||
|
|
@ -234,52 +223,59 @@ program DAMASK_spectral_Driver
|
|||
write (loadcase_string, '(i6)' ) 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
|
||||
do j = 1_pInt, 3_pInt
|
||||
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
|
||||
write(6,'(2x,a)') 'velocity gradient:'
|
||||
else
|
||||
write(6,'(2x,a)') 'deformation gradient rate:'
|
||||
endif
|
||||
write(6,'(3(3(3x,f12.7,1x)/))',advance='no') merge(math_transpose33(loadCases(currentLoadCase)%deformation%values),&
|
||||
reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),transpose(loadCases(currentLoadCase)%deformation%maskLogical))
|
||||
write(6,'(3(3(3x,f12.7,1x)/))',advance='no') &
|
||||
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:',&
|
||||
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)) &
|
||||
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
|
||||
math_transpose33(loadCases(currentLoadCase)%rotation)
|
||||
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
|
||||
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
|
||||
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
|
||||
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)
|
||||
enddo checkLoadcases
|
||||
|
||||
select case (myspectralsolver)
|
||||
|
||||
case (DAMASK_spectral_SolverBasic_label)
|
||||
call basic_init()
|
||||
|
||||
#ifdef PETSc
|
||||
case (DAMASK_spectral_SolverBasicPETSc_label)
|
||||
call basicPETSc_init()
|
||||
|
||||
case (DAMASK_spectral_SolverAL_label)
|
||||
call AL_init()
|
||||
#endif
|
||||
|
|
@ -297,8 +293,6 @@ program DAMASK_spectral_Driver
|
|||
else
|
||||
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
|
||||
'.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) 'workingdir', trim(getSolverWorkingDirectoryName())
|
||||
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) 'eoh' ! end of header
|
||||
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'
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! loopping over 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(resUnit) materialpoint_results ! write result to file
|
||||
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
|
||||
time = time + timeinc
|
||||
guessmode = 1.0_pReal
|
||||
endif ! end calculation/forwarding
|
||||
|
||||
enddo incLooping
|
||||
|
|
|
|||
|
|
@ -208,7 +208,7 @@ subroutine AL_init()
|
|||
close (777)
|
||||
endif
|
||||
|
||||
call Utilities_updateGamma(C)
|
||||
call Utilities_updateGamma(C,.True.)
|
||||
C_scale = C
|
||||
S_scale = math_invSym3333(C)
|
||||
|
||||
|
|
@ -328,7 +328,7 @@ else
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! update stiffness (and gamma operator)
|
||||
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.
|
||||
mask_stress = P_BC%maskFloat
|
||||
|
|
|
|||
|
|
@ -33,7 +33,8 @@ module DAMASK_spectral_SolverBasic
|
|||
! stress, stiffness and compliance average etc.
|
||||
real(pReal), private, dimension(3,3) :: &
|
||||
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) :: &
|
||||
C = 0.0_pReal, C_lastInc = 0.0_pReal
|
||||
|
||||
|
|
@ -69,6 +70,7 @@ subroutine basic_init()
|
|||
implicit none
|
||||
integer(pInt) :: i,j,k
|
||||
real(pReal), dimension(3,3) :: temp33_Real
|
||||
real(pReal), dimension(3,3,3,3) :: temp3333_Real
|
||||
|
||||
|
||||
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) &
|
||||
- geomdim/real(2_pInt*res,pReal)
|
||||
enddo; enddo; enddo
|
||||
|
||||
elseif (restartInc > 1_pInt) then ! using old values from file
|
||||
if (debugRestart) write(6,'(a,'//IO_intOut(restartInc-1_pInt)//',a)') &
|
||||
'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))
|
||||
read (777,rec=1) F_aim_lastInc
|
||||
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!!!
|
||||
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_lastInc,temperature,0.0_pReal,&
|
||||
call Utilities_constitutiveResponse(coordinates,F,F,temperature,0.0_pReal,&
|
||||
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
|
||||
if (restartInc == 1_pInt) then
|
||||
call IO_write_jobBinaryFile(777,'C_ref',size(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)
|
||||
if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness
|
||||
temp3333_Real = C
|
||||
endif
|
||||
|
||||
call Utilities_updateGamma(C)
|
||||
call Utilities_updateGamma(temp3333_Real,.True.)
|
||||
|
||||
end subroutine basic_init
|
||||
|
||||
|
|
@ -173,8 +182,11 @@ type(tSolutionState) function &
|
|||
|
||||
use FEsolving, only: &
|
||||
restartWrite, &
|
||||
restartRead, &
|
||||
terminallyIll
|
||||
use DAMASK_spectral_Utilities, only: cutBack
|
||||
use DAMASK_spectral_Utilities, only: &
|
||||
cutBack
|
||||
|
||||
implicit none
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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,3,3) :: S
|
||||
real(pReal), dimension(3,3), save :: f_aimDot = 0.0_pReal
|
||||
real(pReal), dimension(3,3) :: F_aim_lab, &
|
||||
F_aim_lab_lastIter, &
|
||||
P_av
|
||||
|
|
@ -200,15 +211,29 @@ type(tSolutionState) function &
|
|||
! restart information for spectral solver
|
||||
if (restartWrite) then
|
||||
write(6,'(a)') 'writing converged results for restart'
|
||||
call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad',size(F_lastInc))
|
||||
write (777,rec=1) F_LastInc
|
||||
call IO_write_jobBinaryFile(777,'convergedSpectralDefgrad',size(F)) ! writing deformation gradient field to file
|
||||
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)
|
||||
call IO_write_jobBinaryFile(777,'C',size(C))
|
||||
write (777,rec=1) C
|
||||
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
|
||||
|
||||
|
||||
if ( cutBack) then
|
||||
F_aim = F_aim_lastInc
|
||||
F = F_lastInc
|
||||
|
|
@ -225,7 +250,8 @@ else
|
|||
f_aimDot = f_aimDot &
|
||||
+ guessmode * P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old
|
||||
F_aim_lastInc = F_aim
|
||||
|
||||
print*, 'F_aimDot', f_aimDot
|
||||
print*, 'guessmode', guessmode
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! update coordinates and rate and forward last inc
|
||||
call deformed_fft(res,geomdim,math_rotate_backward33(F_aim_lastInc,rotation_BC), &
|
||||
|
|
@ -241,9 +267,9 @@ else
|
|||
! update stiffness (and gamma operator)
|
||||
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
|
||||
convergenceLoop: do while(iter < itmax)
|
||||
|
||||
|
|
|
|||
|
|
@ -191,7 +191,7 @@ subroutine BasicPETSC_init()
|
|||
close (777)
|
||||
endif
|
||||
|
||||
call Utilities_updateGamma(C)
|
||||
call Utilities_updateGamma(C,.True.)
|
||||
|
||||
end subroutine BasicPETSC_init
|
||||
|
||||
|
|
@ -294,7 +294,7 @@ else
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! update stiffness (and gamma operator)
|
||||
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.
|
||||
mask_stress = P_BC%maskFloat
|
||||
|
|
|
|||
|
|
@ -1,71 +1,82 @@
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
!* $Id$
|
||||
! $Id$
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @author Pratheek Shanthraj, 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
|
||||
!> @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: &
|
||||
pReal, &
|
||||
pInt
|
||||
use mesh, only : &
|
||||
res, &
|
||||
res1_red, &
|
||||
geomdim, &
|
||||
mesh_NcpElems, &
|
||||
wgt
|
||||
|
||||
use math
|
||||
|
||||
use IO, only: &
|
||||
IO_error
|
||||
|
||||
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
|
||||
type(C_PTR), private :: plan_forward, plan_backward ! plans for fftw
|
||||
real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat ! gamma operator (field) for spectral method
|
||||
real(pReal), private, dimension(:,:,:,:), allocatable :: xi ! wave vector field for divergence and for gamma operator
|
||||
complex(pReal),private, dimension(:,:,:,:,:), pointer :: field_fourier
|
||||
real(pReal), private, dimension(3,3,3,3) :: C_ref
|
||||
real(pReal), public, dimension(:,:,:,:,:), pointer :: field_real !< real representation (some stress of deformation) of field_fourier
|
||||
type(C_PTR), private :: plan_forward, plan_backward !< plans for FFTW
|
||||
real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method
|
||||
real(pReal), private, dimension(:,:,:,:), allocatable :: xi !< wave vector field for divergence and for gamma operator
|
||||
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
|
||||
type(C_PTR), private :: plan_scalarField_forth, plan_scalarField_back
|
||||
complex(pReal),private, dimension(:,:,:), pointer :: scalarField_real
|
||||
complex(pReal),private, dimension(:,:,:), pointer :: scalarField_fourier
|
||||
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 !< scalar field real representation for debug of FFTW
|
||||
complex(pReal),private, dimension(:,:,:), pointer :: scalarField_fourier !< scalar field complex representation for debug of FFTW
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! debug divergence
|
||||
type(C_PTR), private :: plan_divergence
|
||||
real(pReal), private, dimension(:,:,:,:), pointer :: divergence_real
|
||||
complex(pReal), private, dimension(:,:,:,:), pointer :: divergence_fourier
|
||||
real(pReal), private, dimension(:,:,:,:), allocatable :: divergence_post
|
||||
type(C_PTR), private :: plan_divergence !< plan for FFTW in case of debugging divergence calculation
|
||||
real(pReal), private, dimension(:,:,:,:), pointer :: divergence_real !< scalar field real representation for debugging divergence calculation
|
||||
complex(pReal),private, dimension(:,:,:,:), pointer :: divergence_fourier !< scalar field real representation for debugging divergence calculation
|
||||
real(pReal), private, dimension(:,:,:,:), allocatable :: divergence_post !< data of divergence calculation using function from core modules (serves as a reference)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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
|
||||
type tSolutionState
|
||||
type tSolutionState !< return type of solution from spectral solver variants
|
||||
logical :: converged = .true.
|
||||
logical :: regrid = .false.
|
||||
logical :: termIll = .false.
|
||||
integer(pInt) :: iterationsNeeded = 0_pInt
|
||||
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) :: maskFloat = 0.0_pReal
|
||||
logical, dimension(3,3) :: maskLogical = .false.
|
||||
character(len=64) :: myType = 'None'
|
||||
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
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -76,14 +87,15 @@ contains
|
|||
!> level chosen.
|
||||
!> 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 IO, only: &
|
||||
IO_error
|
||||
use numerics, only: &
|
||||
DAMASK_NumThreadsInt, &
|
||||
fftw_planner_flag, &
|
||||
fftw_timelimit, &
|
||||
memory_efficient
|
||||
|
||||
use debug, only: &
|
||||
debug_level, &
|
||||
debug_spectral, &
|
||||
|
|
@ -91,21 +103,22 @@ subroutine Utilities_init()
|
|||
debug_spectralDivergence, &
|
||||
debug_spectralRestart, &
|
||||
debug_spectralFFTW
|
||||
|
||||
use mesh, only: &
|
||||
res, &
|
||||
res1_red, &
|
||||
virt_dim
|
||||
use math ! must use the whole module for use of FFTW
|
||||
|
||||
implicit none
|
||||
integer(pInt) :: i, j, k
|
||||
integer(pInt), dimension(3) :: k_s
|
||||
!$ integer(pInt) :: ierr
|
||||
type(C_PTR) :: tensorField ! field in real and fourier space
|
||||
type(C_PTR) :: scalarField_realC, scalarField_fourierC
|
||||
type(C_PTR) :: divergence
|
||||
type(C_PTR) :: &
|
||||
tensorField, & !< field cotaining data for FFTW in real and fourier space (in place)
|
||||
scalarField_realC, & !< field cotaining data for FFTW in real space when debugging FFTW (no in place)
|
||||
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)') ''
|
||||
write(6,'(a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
|
||||
write(6,'(/,a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
|
||||
write(6,'(a)') ' $Id$'
|
||||
#include "compilation_info.f90"
|
||||
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
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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(DAMASK_NumThreadsInt > 0_pInt) then
|
||||
!$ ierr = fftw_init_threads()
|
||||
!$ if (ierr == 0_pInt) call IO_error(error_ID = 809_pInt)
|
||||
!$ i = fftw_init_threads() ! returns 0 in case of problem
|
||||
!$ if (i == 0_pInt) call IO_error(error_ID = 809_pInt)
|
||||
!$ call fftw_plan_with_nthreads(DAMASK_NumThreadsInt)
|
||||
!$ endif
|
||||
call fftw_set_timelimit(fftw_timelimit) ! set timelimit for plan creation
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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
|
||||
1, res(3)*res(2)*(res(1)+2_pInt),& ! striding , product of physical lenght in the 3 dimensions
|
||||
field_fourier,[ res(3),res(2) ,res1_red],&
|
||||
1, res(3)*res(2)* res1_red,fftw_planner_flag)
|
||||
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],& ! output data, physical length in each dimension in reversed order
|
||||
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,&
|
||||
field_fourier,[ res(3),res(2) ,res1_red],&
|
||||
1, res(3)*res(2)* res1_red,&
|
||||
field_real,[ res(3),res(2) ,res(1)+2_pInt],&
|
||||
1, res(3)*res(2)*(res(1)+2_pInt),fftw_planner_flag)
|
||||
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],& ! input data, physical length in each dimension in reversed order
|
||||
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],& ! output data, physical length in each dimension in reversed order
|
||||
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
|
||||
|
|
@ -154,7 +167,7 @@ subroutine Utilities_init()
|
|||
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_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,&
|
||||
divergence_fourier,[ res(3),res(2) ,res1_red],&
|
||||
1, res(3)*res(2)* res1_red,&
|
||||
|
|
@ -163,14 +176,14 @@ subroutine Utilities_init()
|
|||
endif
|
||||
|
||||
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_fourierC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T))
|
||||
call c_f_pointer(scalarField_realC, scalarField_real, [res(1),res(2),res(3)])
|
||||
call c_f_pointer(scalarField_fourierC, scalarField_fourier, [res(1),res(2),res(3)])
|
||||
plan_scalarField_forth = fftw_plan_dft_3d(res(3),res(2),res(1),& !reversed order
|
||||
scalarField_real,scalarField_fourier,-1,fftw_planner_flag)
|
||||
plan_scalarField_back = fftw_plan_dft_3d(res(3),res(2),res(1),& !reversed order
|
||||
scalarField_fourier,scalarField_real,+1,fftw_planner_flag)
|
||||
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)) ! allocate data for fourier representation (no in place transform)
|
||||
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)]) ! place a pointer for a fourier representation
|
||||
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) ! input, output, forward FFT(-1), planner precision
|
||||
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) ! input, output, backward (1), planner precision
|
||||
endif
|
||||
|
||||
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)
|
||||
do k = 1_pInt, res(3)
|
||||
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)
|
||||
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
|
||||
k_s(1) = i - 1_pInt
|
||||
xi(1:3,i,j,k) = real(k_s, pReal)/virt_dim
|
||||
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 ! if divergence_correction is set, frequencies are calculated on unit length
|
||||
enddo; enddo; enddo
|
||||
|
||||
if(memory_efficient) then ! allocate just single fourth order tensor
|
||||
allocate (gamma_hat(3,3,3,3,1,1,1), source = 0.0_pReal)
|
||||
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
|
||||
|
||||
end subroutine Utilities_init
|
||||
end subroutine utilities_init
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief updates references stiffness and potentially precalculated gamma operator
|
||||
!> @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.
|
||||
!> 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: &
|
||||
memory_efficient
|
||||
use math, only: &
|
||||
math_inv33
|
||||
use mesh, only: &
|
||||
res, &
|
||||
res1_red
|
||||
|
||||
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) :: filter
|
||||
integer(pInt) :: i, j, k, l, m, n, o
|
||||
real(pReal) :: filter !< weighting of current component
|
||||
integer(pInt) :: &
|
||||
i, j, k, &
|
||||
l, m, n, o
|
||||
|
||||
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
|
||||
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
|
||||
|
|
@ -223,14 +254,16 @@ subroutine Utilities_updateGamma(C)
|
|||
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 = 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)&
|
||||
gamma_hat(l,m,n,o, i,j,k) = filter*temp33_Real(l,n)*xiDyad(m,o)
|
||||
endif
|
||||
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
|
||||
endif
|
||||
end subroutine Utilities_updateGamma
|
||||
|
||||
end subroutine utilities_updateGamma
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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)
|
||||
!> 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 : &
|
||||
virt_dim
|
||||
use math, only: &
|
||||
math_divergenceFFT
|
||||
virt_dim, &
|
||||
res, &
|
||||
res1_red
|
||||
|
||||
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
|
||||
|
|
@ -258,10 +292,10 @@ subroutine Utilities_FFTforward(row,column)
|
|||
!--------------------------------------------------------------------------------------------------
|
||||
! call function to calculate divergence from math (for post processing) to check results
|
||||
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)
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -269,7 +303,7 @@ subroutine Utilities_FFTforward(row,column)
|
|||
if (debugFFTW) then
|
||||
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,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))-&
|
||||
field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/&
|
||||
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))/&
|
||||
scalarField_fourier(1:res1_red,1:res(2),1:res(3))))
|
||||
endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! removing highest frequencies
|
||||
field_fourier ( res1_red,1:res(2) , 1:res(3) ,1:3,1:3)&
|
||||
= 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)&
|
||||
= 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)&
|
||||
= 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
|
||||
!> 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
|
||||
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
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! comparing 1 and 3x3 inverse FT results
|
||||
! unpack FFT data for conj complex symmetric part
|
||||
if (debugFFTW) then
|
||||
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
|
||||
do k = 1_pInt, res(3)
|
||||
n = 1_pInt
|
||||
|
|
@ -320,7 +360,8 @@ subroutine Utilities_FFTbackward(row,column)
|
|||
enddo; enddo
|
||||
endif
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! doing the iFFT
|
||||
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))/&
|
||||
real(scalarField_real(1:res(1),1:res(2),1:res(3))))
|
||||
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: &
|
||||
memory_efficient
|
||||
use math, only: &
|
||||
math_inv33
|
||||
use mesh, only: &
|
||||
mesh_NcpElems, &
|
||||
res, &
|
||||
res1_red
|
||||
|
||||
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) :: filter
|
||||
integer(pInt) :: i, j, k, l, m, n, o
|
||||
real(pReal) :: filter !< weighting of current component
|
||||
complex(pReal), dimension(3,3) :: temp33_complex
|
||||
|
||||
integer(pInt) :: &
|
||||
i, j, k, &
|
||||
l, m, n, o
|
||||
|
||||
write(6,'(/,a)') '... doing convolution .....................................................'
|
||||
|
||||
|
|
@ -366,7 +414,7 @@ subroutine Utilities_fourierConvolution(fieldAim)
|
|||
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 = 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)&
|
||||
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) &
|
||||
|
|
@ -381,36 +429,45 @@ subroutine Utilities_fourierConvolution(fieldAim)
|
|||
field_fourier(i,j,k, 1:3,1:3) = temp33_Complex
|
||||
enddo; enddo; enddo
|
||||
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
|
||||
|
||||
end subroutine Utilities_fourierConvolution
|
||||
end subroutine utilities_fourierConvolution
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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
|
||||
integer(pInt) :: i, j, k
|
||||
real(pReal) :: err_div_RMS, err_real_div_RMS, err_post_div_RMS,&
|
||||
err_div_max, err_real_div_max
|
||||
real(pReal) :: &
|
||||
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
|
||||
|
||||
write(6,'(/,a)') '... calculating divergence ................................................'
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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 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
|
||||
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),&
|
||||
xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal))
|
||||
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),&
|
||||
xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)&
|
||||
+ 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)
|
||||
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
|
||||
|
|
@ -437,7 +494,7 @@ real(pReal) function Utilities_divergenceRMS()
|
|||
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_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_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
|
||||
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
|
||||
real(pReal), dimension(3,3,3,3) :: Utilities_maskedCompliance
|
||||
real(pReal), dimension(3,3,3,3), intent(in) :: C
|
||||
real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
|
||||
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
|
||||
real(pReal), dimension(3,3), intent(in) :: rot_BC
|
||||
logical, dimension(3,3), intent(in) :: mask_stress
|
||||
logical, dimension(9) :: mask_stressVector
|
||||
real(pReal), dimension(3,3,3,3) :: C_lastInc
|
||||
real(pReal), dimension(9,9) :: temp99_Real
|
||||
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
|
||||
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 (sTimesC(size_reduced,size_reduced), source =0.0_pReal)
|
||||
|
||||
C_lastInc = math_rotate_forward3333(C,rot_BC) ! calculate stiffness from former inc
|
||||
print*,'C'
|
||||
print*,C_lastInc
|
||||
temp99_Real = math_Plain3333to99(C_lastInc)
|
||||
k = 0_pInt ! build reduced stiffness
|
||||
temp99_Real = math_Plain3333to99(math_rotate_forward3333(C,rot_BC))
|
||||
if(debugGeneral) &
|
||||
write(6,'(a,/,9(9(2x,f12.7,1x)/))',advance='no') 'Stiffness C rotated / GPa =',&
|
||||
transpose(temp99_Real)/1.e9_pReal
|
||||
k = 0_pInt ! calculate reduced stiffness
|
||||
do n = 1_pInt,9_pInt
|
||||
if(mask_stressVector(n)) then
|
||||
k = k + 1_pInt
|
||||
|
|
@ -493,7 +560,7 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
|
|||
endif; enddo; endif; enddo
|
||||
call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness
|
||||
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
|
||||
do n = 1_pInt,9_pInt
|
||||
if(mask_stressVector(n)) then
|
||||
|
|
@ -504,14 +571,16 @@ function Utilities_maskedCompliance(rot_BC,mask_stress,C)
|
|||
j = j + 1_pInt
|
||||
temp99_Real(n,m) = s_reduced(k,j)
|
||||
endif; enddo; endif; enddo
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! check if inversion was successfull
|
||||
sTimesC = matmul(c_reduced,s_reduced)
|
||||
do m=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)) > (0.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. ! off diagonal elements of S*C should be 0
|
||||
enddo
|
||||
enddo
|
||||
if(debugGeneral .or. errmatinv) then
|
||||
if(debugGeneral .or. errmatinv) then ! report
|
||||
write(formatString, '(I16.16)') size_reduced
|
||||
formatString = '(a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
|
||||
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
|
||||
temp99_real = 0.0_pReal
|
||||
endif
|
||||
Utilities_maskedCompliance = math_Plain99to3333(temp99_Real)
|
||||
print*,'masked S'
|
||||
print*,Utilities_maskedCompliance
|
||||
end function Utilities_maskedCompliance
|
||||
if(debugGeneral) & ! report
|
||||
write(6,'(a,/,9(9(2x,f12.7,1x)/))',advance='no') 'Masked Compliance * GPa =', &
|
||||
transpose(temp99_Real*1.e9_pReal)
|
||||
utilities_maskedCompliance = math_Plain99to3333(temp99_Real)
|
||||
|
||||
subroutine Utilities_constitutiveResponse(coordinates,F_lastInc,F,temperature,timeinc,&
|
||||
P,C,P_av,ForwardData,rotation_BC)
|
||||
end function utilities_maskedCompliance
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief calculates constitutive response
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_constitutiveResponse(coordinates,F_lastInc,F,temperature,timeinc,&
|
||||
P,C,P_av,forwardData,rotation_BC)
|
||||
use debug, only: &
|
||||
debug_reset, &
|
||||
debug_info
|
||||
use math, only: &
|
||||
math_transpose33, &
|
||||
math_rotate_forward33
|
||||
use FEsolving, only: &
|
||||
restartWrite
|
||||
use mesh, only: &
|
||||
res, &
|
||||
wgt
|
||||
use CPFEM, only: &
|
||||
CPFEM_general
|
||||
use FEsolving, only: restartWrite
|
||||
|
||||
implicit none
|
||||
real(pReal), dimension(res(1),res(2),res(3)) :: temperature
|
||||
real(pReal), dimension(res(1),res(2),res(3),3), intent(in) :: coordinates
|
||||
real(pReal), intent(inout), dimension(res(1),res(2),res(3)) :: temperature !< temperature field
|
||||
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), dimension(3,3,res(1),res(2),res(3)) :: P
|
||||
real(pReal),intent(in) :: timeinc
|
||||
logical, intent(in) :: forwardData
|
||||
integer(pInt) :: i, j, k, ielem
|
||||
integer(pInt) :: calcMode, collectMode
|
||||
real(pReal), dimension(3,3,3,3) :: dPdF
|
||||
real(pReal), dimension(3,3,3,3),intent(out) :: C
|
||||
real(pReal), dimension(6) :: sigma ! cauchy stress
|
||||
real(pReal), dimension(6,6) :: dsde
|
||||
real(pReal), dimension(3,3), intent(in) :: rotation_BC
|
||||
real(pReal), dimension(3,3),intent(out) :: P_av
|
||||
real(pReal),intent(out), dimension(3,3,3,3) :: C !< average stiffness
|
||||
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
|
||||
real(pReal),intent(out), dimension(3,3,res(1),res(2),res(3)) :: P !< PK stress
|
||||
|
||||
integer(pInt) :: &
|
||||
i, j, k, &
|
||||
ielem, &
|
||||
calcMode, & !< CPFEM mode for calculation
|
||||
collectMode !< CPFEM mode for collection
|
||||
real(pReal), dimension(3,3,3,3) :: dPdF !< d P / d F
|
||||
real(pReal), dimension(6) :: sigma !< cauchy stress in mandel notation
|
||||
real(pReal), dimension(6,6) :: dsde !< d sigma / d Epsilon
|
||||
|
||||
write(6,'(/,a,/)') '... evaluating constitutive response ......................................'
|
||||
if (forwardData) then
|
||||
if (forwardData) then ! aging results
|
||||
calcMode = 1_pInt
|
||||
collectMode = 4_pInt
|
||||
else
|
||||
else ! normal calculation
|
||||
calcMode = 2_pInt
|
||||
collectMode = 3_pInt
|
||||
endif
|
||||
if (cutBack) then
|
||||
if (cutBack) then ! restore saved variables
|
||||
calcMode = 2_pInt
|
||||
collectMode = 5_pInt
|
||||
endif
|
||||
|
||||
if (DebugGeneral) then
|
||||
write(6,*) 'collect mode', collectMode
|
||||
write(6,*) 'calc mode', calcMode
|
||||
endif
|
||||
if (DebugGeneral) write(6,*) 'collect mode: ', collectMode,' calc mode: ', calcMode
|
||||
|
||||
ielem = 0_pInt
|
||||
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
|
||||
C = C + dPdF
|
||||
enddo; enddo; enddo
|
||||
C = C * wgt
|
||||
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
|
||||
restartWrite = .false.
|
||||
cutBack = .false.
|
||||
restartWrite = .false. ! reset restartWrite status
|
||||
cutBack = .false. ! reset cutBack status
|
||||
|
||||
write(6,'(a,/,3(3(2x,f12.7,1x)/))',advance='no') 'Piola-Kirchhoff stress / MPa =',&
|
||||
math_transpose33(P_av)/1.e6_pReal
|
||||
|
||||
C = C * wgt
|
||||
end subroutine Utilities_constitutiveResponse
|
||||
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
|
||||
real(pReal), intent(in), dimension(3,3) :: delta_aim
|
||||
real(pReal), intent(in) :: timeinc, timeinc_old, guessmode
|
||||
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: field_lastInc,field
|
||||
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: Utilities_calculateRate
|
||||
real(pReal), intent(in), dimension(3,3) :: delta_aim !< homogeneous addon
|
||||
real(pReal), intent(in) :: &
|
||||
timeinc, & !< timeinc of current step
|
||||
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
|
||||
Utilities_calculateRate = (field-field_lastInc) / timeinc_old
|
||||
utilities_calculateRate = (field-field_lastInc) / timeinc_old
|
||||
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
|
||||
|
||||
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
|
||||
real(pReal), intent(in) :: timeinc
|
||||
real(pReal), intent(in), dimension(3,3) :: aim
|
||||
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: field_lastInc,rate
|
||||
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: Utilities_forwardField
|
||||
real(pReal), dimension(3,3) :: fieldDiff
|
||||
real(pReal), intent(in) :: timeinc !< timeinc of current step
|
||||
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,& !< initial field
|
||||
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
|
||||
fieldDiff = sum(sum(sum(Utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim
|
||||
Utilities_forwardField = Utilities_forwardField - &
|
||||
utilities_forwardField = field_lastInc + rate*timeinc
|
||||
fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim
|
||||
utilities_forwardField = utilities_forwardField - &
|
||||
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: &
|
||||
myfilter
|
||||
use mesh, only: &
|
||||
res
|
||||
use math, only: &
|
||||
PI
|
||||
|
||||
implicit none
|
||||
|
||||
real(pReal), dimension(3),intent(in) :: k
|
||||
real(pReal),intent(in), dimension(3) :: k !< indices of frequency
|
||||
|
||||
select case (myfilter)
|
||||
|
||||
case ('none')
|
||||
Utilities_getFilter = 1.0_pReal
|
||||
|
||||
case ('cosine')
|
||||
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(1)/res(1)))/8.0_pReal
|
||||
|
||||
utilities_getFilter = 1.0_pReal
|
||||
case ('cosine') !< cosine curve with 1 for avg and zero for highest freq
|
||||
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(1)/res(1)))/8.0_pReal
|
||||
case default
|
||||
call IO_error(error_ID = 892_pInt, ext_msg = trim(myfilter))
|
||||
|
||||
end select
|
||||
|
||||
end function Utilities_getFilter
|
||||
end function utilities_getFilter
|
||||
|
||||
|
||||
subroutine Utilities_destroy()
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @brief cleans up
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine utilities_destroy()
|
||||
use math
|
||||
implicit none
|
||||
if (debugDivergence) call fftw_destroy_plan(plan_divergence)
|
||||
|
||||
if (debugFFTW) then
|
||||
call fftw_destroy_plan(plan_scalarField_forth)
|
||||
call fftw_destroy_plan(plan_scalarField_back)
|
||||
endif
|
||||
if (debugFFTW) call fftw_destroy_plan(plan_scalarField_forth)
|
||||
if (debugFFTW) call fftw_destroy_plan(plan_scalarField_back)
|
||||
|
||||
call fftw_destroy_plan(plan_forward)
|
||||
call fftw_destroy_plan(plan_backward)
|
||||
|
||||
end subroutine Utilities_destroy
|
||||
end subroutine utilities_destroy
|
||||
|
||||
|
||||
end module DAMASK_spectral_Utilities
|
||||
end module DAMASK_spectral_utilities
|
||||
|
|
|
|||
Loading…
Reference in New Issue