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

Spectral solver now fully parallel (parallel IO, domain decomposition, FFTs and restart). Working but not extensively tested so please report bugs to me

This commit is contained in:
Pratheek Shanthraj 2015-03-25 16:06:19 +00:00
parent 37a7364a3e
commit d44fce4a76
9 changed files with 1238 additions and 1038 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
code/CPFEM.f90
View File

@ -159,6 +159,7 @@ subroutine CPFEM_init
implicit none implicit none
integer(pInt) :: k,l,m,ph,homog integer(pInt) :: k,l,m,ph,homog
character(len=1024) :: rankStr
mainProcess: if (worldrank == 0) then mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
@ -180,40 +181,42 @@ subroutine CPFEM_init
write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files' write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from binary files'
flush(6) flush(6)
endif endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_intFile(777,'recordedPhase',modelName,size(material_phase)) call IO_read_intFile(777,'recordedPhase'//trim(rankStr),modelName,size(material_phase))
read (777,rec=1) material_phase read (777,rec=1) material_phase
close (777) close (777)
call IO_read_realFile(777,'convergedF',modelName,size(crystallite_F0)) call IO_read_realFile(777,'convergedF'//trim(rankStr),modelName,size(crystallite_F0))
read (777,rec=1) crystallite_F0 read (777,rec=1) crystallite_F0
close (777) close (777)
call IO_read_realFile(777,'convergedFp',modelName,size(crystallite_Fp0)) call IO_read_realFile(777,'convergedFp'//trim(rankStr),modelName,size(crystallite_Fp0))
read (777,rec=1) crystallite_Fp0 read (777,rec=1) crystallite_Fp0
close (777) close (777)
call IO_read_realFile(777,'convergedFi',modelName,size(crystallite_Fi0)) call IO_read_realFile(777,'convergedFi'//trim(rankStr),modelName,size(crystallite_Fi0))
read (777,rec=1) crystallite_Fi0 read (777,rec=1) crystallite_Fi0
close (777) close (777)
call IO_read_realFile(777,'convergedLp',modelName,size(crystallite_Lp0)) call IO_read_realFile(777,'convergedLp'//trim(rankStr),modelName,size(crystallite_Lp0))
read (777,rec=1) crystallite_Lp0 read (777,rec=1) crystallite_Lp0
close (777) close (777)
call IO_read_realFile(777,'convergedLi',modelName,size(crystallite_Li0)) call IO_read_realFile(777,'convergedLi'//trim(rankStr),modelName,size(crystallite_Li0))
read (777,rec=1) crystallite_Li0 read (777,rec=1) crystallite_Li0
close (777) close (777)
call IO_read_realFile(777,'convergeddPdF',modelName,size(crystallite_dPdF0)) call IO_read_realFile(777,'convergeddPdF'//trim(rankStr),modelName,size(crystallite_dPdF0))
read (777,rec=1) crystallite_dPdF0 read (777,rec=1) crystallite_dPdF0
close (777) close (777)
call IO_read_realFile(777,'convergedTstar',modelName,size(crystallite_Tstar0_v)) call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
read (777,rec=1) crystallite_Tstar0_v read (777,rec=1) crystallite_Tstar0_v
close (777) close (777)
call IO_read_realFile(777,'convergedStateConst',modelName) call IO_read_realFile(777,'convergedStateConst'//trim(rankStr),modelName)
m = 0_pInt m = 0_pInt
readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity) readPlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState do k = 1_pInt, plasticState(ph)%sizeState
@ -224,7 +227,7 @@ subroutine CPFEM_init
enddo readPlasticityInstances enddo readPlasticityInstances
close (777) close (777)
call IO_read_realFile(777,'convergedStateHomog',modelName) call IO_read_realFile(777,'convergedStateHomog'//trim(rankStr),modelName)
m = 0_pInt m = 0_pInt
readHomogInstances: do homog = 1_pInt, material_Nhomogenization readHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState do k = 1_pInt, homogState(homog)%sizeState
@ -265,7 +268,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature, dt, elFE, ip)
#endif #endif
use numerics, only: & use numerics, only: &
defgradTolerance, & defgradTolerance, &
iJacoStiffness iJacoStiffness, &
worldrank
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_CPFEM, & debug_CPFEM, &
@ -376,6 +380,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature, dt, elFE, ip)
integer(pInt) elCP, & ! crystal plasticity element number integer(pInt) elCP, & ! crystal plasticity element number
i, j, k, l, m, n, ph, homog i, j, k, l, m, n, ph, homog
logical updateJaco ! flag indicating if JAcobian has to be updated logical updateJaco ! flag indicating if JAcobian has to be updated
character(len=1024) :: rankStr
#if defined(Marc4DAMASK) || defined(Abaqus) #if defined(Marc4DAMASK) || defined(Abaqus)
elCP = mesh_FEasCP('elem',elFE) elCP = mesh_FEasCP('elem',elFE)
@ -442,40 +447,42 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature, dt, elFE, ip)
if (restartWrite) then if (restartWrite) then
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files'
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'recordedPhase',size(material_phase)) call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase))
write (777,rec=1) material_phase write (777,rec=1) material_phase
close (777) close (777)
call IO_write_jobRealFile(777,'convergedF',size(crystallite_F0)) call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0))
write (777,rec=1) crystallite_F0 write (777,rec=1) crystallite_F0
close (777) close (777)
call IO_write_jobRealFile(777,'convergedFp',size(crystallite_Fp0)) call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0))
write (777,rec=1) crystallite_Fp0 write (777,rec=1) crystallite_Fp0
close (777) close (777)
call IO_write_jobRealFile(777,'convergedFi',size(crystallite_Fi0)) call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0))
write (777,rec=1) crystallite_Fi0 write (777,rec=1) crystallite_Fi0
close (777) close (777)
call IO_write_jobRealFile(777,'convergedLp',size(crystallite_Lp0)) call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0))
write (777,rec=1) crystallite_Lp0 write (777,rec=1) crystallite_Lp0
close (777) close (777)
call IO_write_jobRealFile(777,'convergedLi',size(crystallite_Li0)) call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0))
write (777,rec=1) crystallite_Li0 write (777,rec=1) crystallite_Li0
close (777) close (777)
call IO_write_jobRealFile(777,'convergeddPdF',size(crystallite_dPdF0)) call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0))
write (777,rec=1) crystallite_dPdF0 write (777,rec=1) crystallite_dPdF0
close (777) close (777)
call IO_write_jobRealFile(777,'convergedTstar',size(crystallite_Tstar0_v)) call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
write (777,rec=1) crystallite_Tstar0_v write (777,rec=1) crystallite_Tstar0_v
close (777) close (777)
call IO_write_jobRealFile(777,'convergedStateConst') call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr))
m = 0_pInt m = 0_pInt
writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity)
do k = 1_pInt, plasticState(ph)%sizeState do k = 1_pInt, plasticState(ph)%sizeState
@ -486,7 +493,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature, dt, elFE, ip)
enddo writePlasticityInstances enddo writePlasticityInstances
close (777) close (777)
call IO_write_jobRealFile(777,'convergedStateHomog') call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr))
m = 0_pInt m = 0_pInt
writeHomogInstances: do homog = 1_pInt, material_Nhomogenization writeHomogInstances: do homog = 1_pInt, material_Nhomogenization
do k = 1_pInt, homogState(homog)%sizeState do k = 1_pInt, homogState(homog)%sizeState

327
code/DAMASK_spectral_driver.f90
View File

@ -41,12 +41,17 @@ program DAMASK_spectral_Driver
debug_spectral, & debug_spectral, &
debug_levelBasic debug_levelBasic
use math ! need to include the whole module for FFTW use math ! need to include the whole module for FFTW
use mesh, only: &
gridGlobal, &
geomSizeGlobal
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: &
worldrank, &
worldsize, &
maxCutBack, & maxCutBack, &
spectral_solver, & spectral_solver, &
continueCalculation continueCalculation
@ -54,17 +59,17 @@ program DAMASK_spectral_Driver
materialpoint_sizeResults, & materialpoint_sizeResults, &
materialpoint_results materialpoint_results
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
tBoundaryCondition, & tBoundaryCondition, &
tSolutionState, & tSolutionState, &
cutBack cutBack
use DAMASK_spectral_SolverBasic
use DAMASK_spectral_SolverBasicPETSC use DAMASK_spectral_SolverBasicPETSC
use DAMASK_spectral_SolverAL use DAMASK_spectral_SolverAL
use DAMASK_spectral_SolverPolarisation use DAMASK_spectral_SolverPolarisation
implicit none implicit none
#include <petsc-finclude/petscsys.h>
type tLoadCase type tLoadCase
real(pReal), dimension (3,3) :: rotation = math_I3 !< rotation of BC real(pReal), dimension (3,3) :: rotation = math_I3 !< rotation of BC
type(tBoundaryCondition) :: P, & !< stress BC type(tBoundaryCondition) :: P, & !< stress BC
@ -129,14 +134,19 @@ program DAMASK_spectral_Driver
character(len=1024) :: incInfo !< string parsed to solution with information about current load case character(len=1024) :: incInfo !< string parsed to solution with information about current load case
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState) solres type(tSolutionState) solres
integer(kind=MPI_OFFSET_KIND) :: my_offset
integer, dimension(:), allocatable :: outputSize
PetscErrorCode :: ierr
external :: quit external :: quit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init DAMASK (all modules) ! init DAMASK (all modules)
call CPFEM_initAll(temperature = 300.0_pReal, el = 1_pInt, ip = 1_pInt) call CPFEM_initAll(temperature = 300.0_pReal, el = 1_pInt, ip = 1_pInt)
write(6,'(/,a)') ' <<<+- DAMASK_spectral_driver init -+>>>' mainProcess: if (worldrank == 0) then
write(6,'(a)') ' $Id$' write(6,'(/,a)') ' <<<+- DAMASK_spectral_driver init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 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
@ -256,72 +266,72 @@ program DAMASK_spectral_Driver
! consistency checks and output of load case ! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt errorID = 0_pInt
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) if (worldrank == 0) then
write (loadcase_string, '(i6)' ) currentLoadCase checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase write (loadcase_string, '(i6)' ) currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
write(6,'(2x,a)') 'drop guessing along trajectory' if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
if (loadCases(currentLoadCase)%deformation%myType=='l') then write(6,'(2x,a)') 'drop guessing along trajectory'
do j = 1_pInt, 3_pInt if (loadCases(currentLoadCase)%deformation%myType=='l') then
if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & do j = 1_pInt, 3_pInt
any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) & if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
errorID = 832_pInt ! each row should be either fully or not at all defined any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) &
enddo errorID = 832_pInt ! each row should be either fully or not at all defined
write(6,'(2x,a)') 'velocity gradient:' enddo
else if (loadCases(currentLoadCase)%deformation%myType=='f') then write(6,'(2x,a)') 'velocity gradient:'
write(6,'(2x,a)') 'deformation gradient at end of load case:' else if (loadCases(currentLoadCase)%deformation%myType=='f') then
else write(6,'(2x,a)') 'deformation gradient at end of load case:'
write(6,'(2x,a)') 'deformation gradient rate:' else
endif write(6,'(2x,a)') 'deformation gradient rate:'
write(6,'(3(3(3x,f12.7,1x)/))',advance='no') & endif
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]), & ! print *** (huge) for undefined merge(math_transpose33(loadCases(currentLoadCase)%deformation%values), &
transpose(loadCases(currentLoadCase)%deformation%maskLogical)) reshape(spread(huge(1.0_pReal),1,9),[ 3,3]), & ! print *** (huge) for undefined
if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. & transpose(loadCases(currentLoadCase)%deformation%maskLogical))
loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. &
if (any(loadCases(currentLoadCase)%P%maskLogical .and. & loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
transpose(loadCases(currentLoadCase)%P%maskLogical) .and. & if (any(loadCases(currentLoadCase)%P%maskLogical .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & transpose(loadCases(currentLoadCase)%P%maskLogical) .and. &
errorID = 838_pInt ! no rotation is allowed by stress BC reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'stress / GPa:',& errorID = 838_pInt ! no rotation is allowed by stress BC
1e-9_pReal*merge(math_transpose33(loadCases(currentLoadCase)%P%values),& write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'stress / GPa:',&
reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),& 1e-9_pReal*merge(math_transpose33(loadCases(currentLoadCase)%P%values),&
transpose(loadCases(currentLoadCase)%P%maskLogical)) reshape(spread(huge(1.0_pReal),1,9),[ 3,3]),&
if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, & transpose(loadCases(currentLoadCase)%P%maskLogical))
math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) >& if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, &
reshape(spread(tol_math_check,1,9),[ 3,3]))& math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) >&
.or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > & reshape(spread(tol_math_check,1,9),[ 3,3]))&
1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain .or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > &
if (any(loadCases(currentLoadCase)%rotation /= math_I3)) & 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& if (any(loadCases(currentLoadCase)%rotation /= math_I3)) &
math_transpose33(loadCases(currentLoadCase)%rotation) write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
write(6,'(2x,a,f12.6)') 'temperature:', loadCases(currentLoadCase)%temperature math_transpose33(loadCases(currentLoadCase)%rotation)
write(6,'(2x,a,f12.6)') 'density: ', loadCases(currentLoadCase)%density write(6,'(2x,a,f12.6)') 'temperature:', loadCases(currentLoadCase)%temperature
if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment write(6,'(2x,a,f12.6)') 'density: ', loadCases(currentLoadCase)%density
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
write(6,'(2x,a,i5)') 'output frequency: ', & if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
loadCases(currentLoadCase)%outputfrequency write(6,'(2x,a,i5)') 'output frequency: ', &
write(6,'(2x,a,i5,/)') 'restart frequency: ', & loadCases(currentLoadCase)%outputfrequency
loadCases(currentLoadCase)%restartfrequency write(6,'(2x,a,i5,/)') 'restart frequency: ', &
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message loadCases(currentLoadCase)%restartfrequency
enddo checkLoadcases if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! doing initialization depending on selected solver ! doing initialization depending on selected solver
select case (spectral_solver) select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
call basic_init(loadCases(1)%temperature)
case (DAMASK_spectral_SolverBasicPETSc_label) case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init(loadCases(1)%temperature) call basicPETSc_init(loadCases(1)%temperature)
case (DAMASK_spectral_SolverAL_label) case (DAMASK_spectral_SolverAL_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0 .and. worldrank == 0_pInt) &
call IO_warning(42_pInt, ext_msg='debug Divergence') call IO_warning(42_pInt, ext_msg='debug Divergence')
call AL_init(loadCases(1)%temperature) call AL_init(loadCases(1)%temperature)
case (DAMASK_spectral_SolverPolarisation_label) case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0 .and. worldrank == 0_pInt) &
call IO_warning(42_pInt, ext_msg='debug Divergence') call IO_warning(42_pInt, ext_msg='debug Divergence')
call Polarisation_init(loadCases(1)%temperature) call Polarisation_init(loadCases(1)%temperature)
case default case default
@ -330,34 +340,52 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! write header of output file ! write header of output file
if (appendToOutFile) then ! after restart, append to existing results file if (.not. appendToOutFile) then ! after restart, append to existing results file
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& if (worldrank == 0) then
'.spectralOut',form='UNFORMATTED', position='APPEND', status='OLD') open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE')
'.sta',form='FORMATTED', position='APPEND', status='OLD') write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
else ! open new files ... write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName())
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& write(resUnit) 'geometry:', trim(geometryFile)
'.spectralOut',form='UNFORMATTED',status='REPLACE') write(resUnit) 'grid:', gridGlobal
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header write(resUnit) 'size:', geomSizeGlobal
write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName()) write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults
write(resUnit) 'geometry:', trim(geometryFile) write(resUnit) 'loadcases:', size(loadCases)
write(resUnit) 'grid:', grid write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per currentLoadCase
write(resUnit) 'size:', geomSize write(resUnit) 'times:', loadCases%time ! one entry per currentLoadCase
write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults write(resUnit) 'logscales:', loadCases%logscale
write(resUnit) 'loadcases:', size(loadCases) write(resUnit) 'increments:', loadCases%incs ! one entry per currentLoadCase
write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per currentLoadCase write(resUnit) 'startingIncrement:', restartInc - 1_pInt ! start with writing out the previous inc
write(resUnit) 'times:', loadCases%time ! one entry per currentLoadCase write(resUnit) 'eoh'
write(resUnit) 'logscales:', loadCases%logscale close(resUnit) ! end of header
write(resUnit) 'increments:', loadCases%incs ! one entry per currentLoadCase endif
write(resUnit) 'startingIncrement:', restartInc - 1_pInt ! start with writing out the previous inc endif
write(resUnit) 'eoh' ! end of header allocate(outputSize(worldsize), source = 0_pInt); outputSize(worldrank+1) = sizeof(materialpoint_results)
write(resUnit) materialpoint_results ! initial (non-deformed or read-in) results call MPI_Allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& call MPI_File_open(PETSC_COMM_WORLD, &
'.sta',form='FORMATTED',status='REPLACE') trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file MPI_MODE_WRONLY + MPI_MODE_APPEND, &
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & MPI_INFO_NULL, &
write(6,'(/,a)') ' header of result file written out' resUnit, &
flush(6) ierr)
call MPI_File_get_position(resUnit,my_offset,ierr)
my_offset = my_offset + sum(outputSize(1:worldrank))
call MPI_File_seek (resUnit,my_offset,MPI_SEEK_SET,ierr)
call MPI_File_write(resUnit, materialpoint_results, size(materialpoint_results), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0 .and. worldrank == 0_pInt) &
write(6,'(/,a)') ' header of result file written out'
flush(6)
if (worldrank == 0) then
if (appendToOutFile) then ! after restart, append to existing results file
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
else ! open new files ...
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
endif
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -405,7 +433,6 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! forward solution ! forward solution
select case(spectral_solver) select case(spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
case (DAMASK_spectral_SolverBasicPETSC_label) case (DAMASK_spectral_SolverBasicPETSC_label)
call BasicPETSC_forward (& call BasicPETSC_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, & guess,timeinc,timeIncOld,remainingLoadCaseTime, &
@ -430,31 +457,26 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new increment ! report begin of new increment
write(6,'(/,a)') ' ###########################################################################' if (worldrank == 0) then
write(6,'(1x,a,es12.5'//& write(6,'(/,a)') ' ###########################################################################'
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& write(6,'(1x,a,es12.5'//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//& ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
'Time', time, & ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& 'Time', time, &
'-', stepFraction, '/', subStepFactor**cutBackLevel,& 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
' of load case ', currentLoadCase,'/',size(loadCases) '-', stepFraction, '/', subStepFactor**cutBackLevel,&
flush(6) ' of load case ', currentLoadCase,'/',size(loadCases)
write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//& flush(6)
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//&
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
'-',stepFraction, '/', subStepFactor**cutBackLevel 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
select case(spectral_solver) '-',stepFraction, '/', subStepFactor**cutBackLevel
endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate solution ! calculate solution
case (DAMASK_spectral_SolverBasic_label) select case(spectral_solver)
solres = basic_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, &
P_BC = loadCases(currentLoadCase)%P, &
F_BC = loadCases(currentLoadCase)%deformation, &
temperature_bc = loadCases(currentLoadCase)%temperature, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverBasicPETSC_label) case (DAMASK_spectral_SolverBasicPETSC_label)
solres = BasicPETSC_solution (& solres = BasicPETSC_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, & incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, &
@ -486,7 +508,7 @@ program DAMASK_spectral_Driver
cutBack = .False. cutBack = .False.
if(solres%termIll .or. .not. solres%converged) then ! no solution found if(solres%termIll .or. .not. solres%converged) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back if (cutBackLevel < maxCutBack) then ! do cut back
write(6,'(/,a)') ' cut back detected' if (worldrank == 0) write(6,'(/,a)') ' cut back detected'
cutBack = .True. cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt cutBackLevel = cutBackLevel + 1_pInt
@ -505,28 +527,36 @@ program DAMASK_spectral_Driver
else else
guess = .true. ! start guessing after first converged (sub)inc guess = .true. ! start guessing after first converged (sub)inc
endif endif
if (.not. cutBack) & if (.not. cutBack) then
write(statUnit,*) totalIncsCounter, time, cutBackLevel, & if (worldrank == 0) then
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
flush(statUnit) solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
flush(statUnit)
endif
endif
enddo subIncLooping enddo subIncLooping
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
if(solres%converged) then ! report converged inc if(solres%converged) then ! report converged inc
convergedCounter = convergedCounter + 1_pInt convergedCounter = convergedCounter + 1_pInt
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & if (worldrank == 0) &
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') &
' increment ', totalIncsCounter, ' converged' ' increment ', totalIncsCounter, ' converged'
else else
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc if (worldrank == 0) &
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged' ' increment ', totalIncsCounter, ' NOT converged'
notConvergedCounter = notConvergedCounter + 1_pInt notConvergedCounter = notConvergedCounter + 1_pInt
endif; flush(6) endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
write(6,'(1/,a)') ' ... writing results to file ......................................' if (worldrank == 0) &
write(resUnit) materialpoint_results ! write result to file write(6,'(1/,a)') ' ... writing results to file ......................................'
flush(resUnit) my_offset = my_offset + sum(outputSize)
call MPI_File_seek (resUnit,my_offset,MPI_SEEK_SET,ierr)
call MPI_File_write(resUnit, materialpoint_results, size(materialpoint_results), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
endif endif
if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving
mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ToDo first call to CPFEM_general will write? mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! first call to CPFEM_general will write?
restartWrite = .true. restartWrite = .true.
lastRestartWritten = inc lastRestartWritten = inc
endif endif
@ -538,9 +568,20 @@ program DAMASK_spectral_Driver
enddo incLooping enddo incLooping
enddo loadCaseLooping enddo loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
if (worldrank == 0) then
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!'
endif
call MPI_file_close(resUnit,ierr)
close(statUnit)
select case (spectral_solver) select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
call basic_destroy()
case (DAMASK_spectral_SolverBasicPETSC_label) case (DAMASK_spectral_SolverBasicPETSC_label)
call BasicPETSC_destroy() call BasicPETSC_destroy()
case (DAMASK_spectral_SolverAL_label) case (DAMASK_spectral_SolverAL_label)
@ -549,16 +590,6 @@ program DAMASK_spectral_Driver
call Polarisation_destroy() call Polarisation_destroy()
end select end select
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!'
close(resUnit)
close(statUnit)
if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged
call quit(0_pInt) ! no complains ;) call quit(0_pInt) ! no complains ;)
@ -576,22 +607,28 @@ end program DAMASK_spectral_Driver
subroutine quit(stop_id) subroutine quit(stop_id)
use prec, only: & use prec, only: &
pInt pInt
use numerics, only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: stop_id integer(pInt), intent(in) :: stop_id
integer, dimension(8) :: dateAndTime ! type default integer integer, dimension(8) :: dateAndTime ! type default integer
call date_and_time(values = dateAndTime) if (worldrank == 0_pInt) then
write(6,'(/,a)') 'DAMASK terminated on:' call date_and_time(values = dateAndTime)
write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',& write(6,'(/,a)') 'DAMASK terminated on:'
dateAndTime(2),'/',& write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',&
dateAndTime(1) dateAndTime(2),'/',&
write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& dateAndTime(1)
dateAndTime(6),':',& write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',&
dateAndTime(7) dateAndTime(6),':',&
dateAndTime(7)
endif
if (stop_id == 0_pInt) stop 0 ! normal termination if (stop_id == 0_pInt) stop 0 ! normal termination
if (stop_id < 0_pInt) then ! trigger regridding if (stop_id < 0_pInt) then ! trigger regridding
write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) if (worldrank == 0_pInt) &
write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt)
stop 2 stop 2
endif endif
if (stop_id == 3_pInt) stop 3 ! not all incs converged if (stop_id == 3_pInt) stop 3 ! not all incs converged

4
code/DAMASK_spectral_interface.f90
View File

@ -84,7 +84,7 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! PETSc Init
#ifdef PETSc #ifdef PETSc
call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code
CHKERRQ(ierr) ! this is a macro definition, it is case sensitive CHKERRQ(ierr) ! this is a macro definition, it is case sensitive
open(6, encoding='UTF-8') ! modern fortran compilers (gfortran >4.4, ifort >11 support it) open(6, encoding='UTF-8') ! modern fortran compilers (gfortran >4.4, ifort >11 support it)
@ -161,7 +161,7 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn)
write(6,'(a)') ' Help:' write(6,'(a)') ' Help:'
write(6,'(/,a)')' --help' write(6,'(/,a)')' --help'
write(6,'(a,/)')' Prints this message and exits' write(6,'(a,/)')' Prints this message and exits'
call quit(0_pInt) ! normal Termination call quit(0_pInt) ! normal Termination
endif mainProcess2 endif mainProcess2
case ('-l', '--load', '--loadcase') case ('-l', '--load', '--loadcase')
loadcaseArg = IIO_stringValue(commandLine,positions,i+1_pInt) loadcaseArg = IIO_stringValue(commandLine,positions,i+1_pInt)

273
code/DAMASK_spectral_solverAL.f90
View File

@ -45,11 +45,9 @@ module DAMASK_spectral_solverAL
! common pointwise data ! common pointwise data
real(pReal), private, dimension(:,:,:,:,:), allocatable :: & real(pReal), private, dimension(:,:,:,:,:), allocatable :: &
F_lastInc, & !< field of previous compatible deformation gradients F_lastInc, & !< field of previous compatible deformation gradients
F_lastInc2, & !< field of 2nd previous compatible deformation gradients
F_lambda_lastInc, & !< field of previous incompatible deformation gradient F_lambda_lastInc, & !< field of previous incompatible deformation gradient
Fdot, & !< field of assumed rate of compatible deformation gradient Fdot, & !< field of assumed rate of compatible deformation gradient
F_lambdaDot !< field of assumed rate of incopatible deformation gradient F_lambdaDot !< field of assumed rate of incopatible deformation gradient
complex(pReal),private, dimension(:,:,:,:,:), allocatable :: inertiaField_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc. ! stress, stiffness and compliance average etc.
@ -70,7 +68,7 @@ module DAMASK_spectral_solverAL
S_scale = 0.0_pReal S_scale = 0.0_pReal
real(pReal), private :: & real(pReal), private :: &
err_BC, & !< deviation from stress BC err_BC, & !< deviation from stress BC
err_curl, & !< RMS of curl of F err_curl, & !< RMS of curl of F
err_div !< RMS of div of P err_div !< RMS of div of P
logical, private :: ForwardData logical, private :: ForwardData
@ -118,19 +116,21 @@ subroutine AL_init(temperature)
debug_spectralRestart debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use numerics, only: &
worldrank, &
worldsize
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverJobName getSolverJobName
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
Utilities_init, & Utilities_init, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
grid, & Utilities_updateIPcoords, &
grid1Red, & grid1Red, &
geomSize, &
wgt wgt
use mesh, only: & use mesh, only: &
mesh_ipCoordinates, & gridLocal, &
mesh_deformedCoordsFFT gridGlobal
use math, only: & use math, only: &
math_invSym3333 math_invSym3333
@ -144,30 +144,41 @@ subroutine AL_init(temperature)
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
character(len=1024) :: rankStr
call Utilities_init() call Utilities_init()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' if (worldrank == 0_pInt) then
write(6,'(a)') ' $Id$' write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif
allocate (P (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (P (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
allocate (F_lastInc (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_lastInc (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_lastInc2 (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (Fdot (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (Fdot (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_lambda_lastInc(3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_lambda_lastInc(3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_lambdaDot (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_lambdaDot (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
allocate (inertiaField_fourier (grid1Red,grid(2),grid(3),3,3),source = cmplx(0.0_pReal,0.0_pReal,pReal))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! PETSc Init
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call DMDACreate3d(PETSC_COMM_WORLD, & allocate(localK(worldsize), source = 0); localK(worldrank+1) = gridLocal(3)
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & do proc = 1, worldsize
DMDA_STENCIL_BOX,grid(1),grid(2),grid(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, & call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
18,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr) enddo
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
gridGlobal(1),gridGlobal(2),gridGlobal(3), & ! global grid
1 , 1, worldsize, &
18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
gridLocal (1),gridLocal (2),localK, & ! local grid
da,ierr) ! handle, error
CHKERRQ(ierr) CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,dummy,ierr) call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,dummy,ierr)
@ -183,53 +194,51 @@ subroutine AL_init(temperature)
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_lambda => xx_psc(9:17,:,:,:) F_lambda => xx_psc(9:17,:,:,:)
if (restartInc == 1_pInt) then ! no deformation (no restart) if (restartInc == 1_pInt) then ! no deformation (no restart)
F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity F_lastInc = spread(spread(spread(math_I3,3,gridLocal(1)),4,gridLocal(2)),5,gridLocal(3)) ! initialize to identity
F_lastInc2 = F_lastInc F = reshape(F_lastInc,[9,gridLocal(1),gridLocal(2),gridLocal(3)])
F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)])
F_lambda = F F_lambda = F
F_lambda_lastInc = F_lastInc F_lambda_lastInc = F_lastInc
elseif (restartInc > 1_pInt) then ! read in F to calculate coordinates and initialize CPFEM general elseif (restartInc > 1_pInt) then ! read in F to calculate coordinates and initialize CPFEM general
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 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'
flush(6) flush(6)
call IO_read_realFile(777,'F', trim(getSolverJobName()),size(F)) write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr), trim(getSolverJobName()),size(F))
read (777,rec=1) F read (777,rec=1) F
close (777) close (777)
call IO_read_realFile(777,'F_lastInc', trim(getSolverJobName()),size(F_lastInc)) call IO_read_realFile(777,'F_lastInc'//trim(rankStr), trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc read (777,rec=1) F_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_lastInc2', trim(getSolverJobName()),size(F_lastInc2)) call IO_read_realFile(777,'F_lambda'//trim(rankStr),trim(getSolverJobName()),size(F_lambda))
read (777,rec=1) F_lastInc2
close (777)
call IO_read_realFile(777,'F_lambda',trim(getSolverJobName()),size(F_lambda))
read (777,rec=1) F_lambda read (777,rec=1) F_lambda
close (777) close (777)
call IO_read_realFile(777,'F_lambda_lastInc',& call IO_read_realFile(777,'F_lambda_lastInc'//trim(rankStr),&
trim(getSolverJobName()),size(F_lambda_lastInc)) trim(getSolverJobName()),size(F_lambda_lastInc))
read (777,rec=1) F_lambda_lastInc read (777,rec=1) F_lambda_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim)) if (worldrank == 0_pInt) then
read (777,rec=1) F_aim call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim))
close (777) read (777,rec=1) F_aim
call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc)) close (777)
read (777,rec=1) F_aim_lastInc call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc))
close (777) read (777,rec=1) F_aim_lastInc
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) close (777)
read (777,rec=1) f_aimDot call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot))
close (777) read (777,rec=1) f_aimDot
close (777)
endif
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)]) call Utilities_constitutiveResponse(F_lastInc,F,&
call Utilities_constitutiveResponse(F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)]),& temperature,0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3)
temperature,0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3)
nullify(F) nullify(F)
nullify(F_lambda) nullify(F_lambda)
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc
if (restartInc > 1_pInt) then ! using old values from files if (restartInc > 1_pInt .and. worldrank == 0_pInt) then ! using old values from files
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -256,7 +265,8 @@ end subroutine AL_init
!> @brief solution for the AL scheme with internal iterations !> @brief solution for the AL scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function & type(tSolutionState) function &
AL_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc,rotation_BC,density) AL_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc, &
rotation_BC,density)
use numerics, only: & use numerics, only: &
update_gamma update_gamma
use math, only: & use math, only: &
@ -342,7 +352,10 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
itmax, & itmax, &
itmin, & itmin, &
polarAlpha, & polarAlpha, &
polarBeta polarBeta, &
worldrank
use mesh, only: &
gridLocal
use IO, only: & use IO, only: &
IO_intOut IO_intOut
use math, only: & use math, only: &
@ -353,11 +366,9 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
math_mul33x33, & math_mul33x33, &
PI PI
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
wgt, & wgt, &
field_real, & field_realMPI, &
field_fourier, & field_fourierMPI, &
Utilities_FFTforward, & Utilities_FFTforward, &
Utilities_fourierConvolution, & Utilities_fourierConvolution, &
Utilities_inverseLaplace, & Utilities_inverseLaplace, &
@ -371,6 +382,8 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
debug_spectralRotation debug_spectralRotation
use homogenization, only: & use homogenization, only: &
materialpoint_dPdF materialpoint_dPdF
use FEsolving, only: &
terminallyIll
implicit none implicit none
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -410,43 +423,30 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt
call MPI_Allreduce(MPI_IN_PLACE,F_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment
if(totalIter <= PETScIter) then ! new iteration if(totalIter <= PETScIter) then ! new iteration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & if (worldrank == 0_pInt) then
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
math_transpose33(F_aim) math_transpose33(F_aim)
endif
flush(6) flush(6)
endif endif
!--------------------------------------------------------------------------------------------------
! evaluate inertia
dynamic: if (params%density > 0.0_pReal) then
residual_F = ((F - F_lastInc)/params%timeinc - (F_lastInc - F_lastInc2)/params%timeincOld)/&
((params%timeinc + params%timeincOld)/2.0_pReal)
residual_F = params%density*product(geomSize/grid)*residual_F
field_real = 0.0_pReal
field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3) = reshape(residual_F,[grid(1),grid(2),grid(3),3,3],&
order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward()
call Utilities_inverseLaplace()
inertiaField_fourier = field_fourier
else dynamic
inertiaField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
endif dynamic
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! !
field_real = 0.0_pReal field_realMPI = 0.0_pReal
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
field_real(i,j,k,1:3,1:3) = & field_realMPI(1:3,1:3,i,j,k) = &
polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -& polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -&
polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), & polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), &
math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3)) math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3))
@ -456,26 +456,25 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! doing convolution in Fourier space ! doing convolution in Fourier space
call Utilities_FFTforward() call Utilities_FFTforward()
field_fourier = field_fourier + polarAlpha*inertiaField_fourier
call Utilities_fourierConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC)) call Utilities_fourierConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC))
call Utilities_FFTbackward() call Utilities_FFTbackward()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
residual_F_lambda = polarBeta*F - reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),& residual_F_lambda = polarBeta*F - field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3))
[3,3,grid(1),grid(2),grid(3)],order=[3,4,5,1,2])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! evaluate constitutive response ! evaluate constitutive response
P_avLastEval = P_av P_avLastEval = P_av
call Utilities_constitutiveResponse(F_lastInc,F - residual_F_lambda/polarBeta,params%temperature,params%timeinc, & call Utilities_constitutiveResponse(F_lastInc,F - residual_F_lambda/polarBeta,params%temperature,params%timeinc, &
residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr)
ForwardData = .False. ForwardData = .False.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate divergence ! calculate divergence
field_real = 0.0_pReal field_realMPI = 0.0_pReal
field_real = reshape(residual_F,[grid(1),grid(2),grid(3),3,3],order=[4,5,1,2,3]) field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3)) = residual_F
call Utilities_FFTforward() call Utilities_FFTforward()
err_div = Utilities_divergenceRMS() err_div = Utilities_divergenceRMS()
call Utilities_FFTbackward() call Utilities_FFTbackward()
@ -483,19 +482,19 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
e = 0_pInt e = 0_pInt
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
e = e + 1_pInt e = e + 1_pInt
residual_F(1:3,1:3,i,j,k) = math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & residual_F(1:3,1:3,i,j,k) = math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), &
residual_F(1:3,1:3,i,j,k) - & residual_F(1:3,1:3,i,j,k) - &
math_mul33x33(F(1:3,1:3,i,j,k), & math_mul33x33(F(1:3,1:3,i,j,k), &
math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3))) & math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3))) &
+ residual_F_lambda(1:3,1:3,i,j,k) + residual_F_lambda(1:3,1:3,i,j,k)
enddo; enddo; enddo enddo; enddo; enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculating curl ! calculating curl
field_real = 0.0_pReal field_realMPI = 0.0_pReal
field_real = reshape(F,[grid(1),grid(2),grid(3),3,3],order=[4,5,1,2,3]) field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3)) = F
call Utilities_FFTforward() call Utilities_FFTforward()
err_curl = Utilities_curlRMS() err_curl = Utilities_curlRMS()
call Utilities_FFTbackward() call Utilities_FFTbackward()
@ -515,7 +514,8 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
err_curl_tolRel, & err_curl_tolRel, &
err_curl_tolAbs, & err_curl_tolAbs, &
err_stress_tolAbs, & err_stress_tolAbs, &
err_stress_tolRel err_stress_tolRel, &
worldrank
use math, only: & use math, only: &
math_mul3333xx33 math_mul3333xx33
use FEsolving, only: & use FEsolving, only: &
@ -562,15 +562,17 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
write(6,'(1/,a)') ' ... reporting .............................................................' if (worldrank == 0_pInt) then
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')'
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')'
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')'
write(6,'(/,a)') ' ===========================================================================' write(6,'(/,a)') ' ==========================================================================='
flush(6) flush(6)
endif
end subroutine AL_converged end subroutine AL_converged
@ -583,16 +585,16 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
math_mul3333xx33, & math_mul3333xx33, &
math_transpose33, & math_transpose33, &
math_rotate_backward33 math_rotate_backward33
use numerics, only: &
worldrank
use mesh, only: &
gridLocal
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
Utilities_calculateRate, & Utilities_calculateRate, &
Utilities_forwardField, & Utilities_forwardField, &
Utilities_updateIPcoords, &
tBoundaryCondition, & tBoundaryCondition, &
cutBack cutBack
use mesh, only: &
mesh_ipCoordinates,&
mesh_deformedCoordsFFT
use IO, only: & use IO, only: &
IO_write_JobRealFile IO_write_JobRealFile
use FEsolving, only: & use FEsolving, only: &
@ -613,6 +615,7 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_lambda PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_lambda
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
real(pReal), dimension(3,3) :: F_lambda33 real(pReal), dimension(3,3) :: F_lambda33
character(len=1024) :: rankStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
@ -620,47 +623,48 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_lambda => xx_psc(9:17,:,:,:) F_lambda => xx_psc(9:17,:,:,:)
if (restartWrite) then if (restartWrite) then
write(6,'(/,a)') ' writing converged results for restart' if (worldrank == 0_pInt) then
flush(6) write(6,'(/,a)') ' writing converged results for restart'
call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc2',size(F_lastInc2)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lambda'//trim(rankStr),size(F_lambda)) ! writing deformation gradient field to file
write (777,rec=1) F_lastInc2
close (777)
call IO_write_jobRealFile(777,'F_lambda',size(F_lambda)) ! writing deformation gradient field to file
write (777,rec=1) F_lambda write (777,rec=1) F_lambda
close (777) close (777)
call IO_write_jobRealFile(777,'F_lambda_lastInc',size(F_lambda_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lambda_lastInc'//trim(rankStr),size(F_lambda_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lambda_lastInc write (777,rec=1) F_lambda_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_aim',size(F_aim)) if (worldrank == 0_pInt) then
write (777,rec=1) F_aim call IO_write_jobRealFile(777,'F_aim',size(F_aim))
close(777) write (777,rec=1) F_aim
call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc)) close(777)
write (777,rec=1) F_aim_lastInc call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc))
close(777) write (777,rec=1) F_aim_lastInc
call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) close(777)
write (777,rec=1) F_aimDot call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot))
close(777) write (777,rec=1) F_aimDot
call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) close(777)
write (777,rec=1) C_volAvg call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg))
close(777) write (777,rec=1) C_volAvg
call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) close(777)
write (777,rec=1) C_volAvgLastInc call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc))
close(777) write (777,rec=1) C_volAvgLastInc
close(777)
endif
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
if (cutBack) then if (cutBack) then
F_aim = F_aim_lastInc F_aim = F_aim_lastInc
F_lambda = reshape(F_lambda_lastInc,[9,grid(1),grid(2),grid(3)]) F_lambda = reshape(F_lambda_lastInc,[9,gridLocal(1),gridLocal(2),gridLocal(3)])
F = reshape(F_lastInc, [9,grid(1),grid(2),grid(3)]) F = reshape(F_lastInc, [9,gridLocal(1),gridLocal(2),gridLocal(3)])
C_volAvg = C_volAvgLastInc C_volAvg = C_volAvgLastInc
else else
ForwardData = .True. ForwardData = .True.
@ -679,25 +683,24 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), &
timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)])) timeinc_old,guess,F_lastInc,reshape(F,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)]))
F_lambdaDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & F_lambdaDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), &
timeinc_old,guess,F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid(3)])) timeinc_old,guess,F_lambda_lastInc,reshape(F_lambda,[3,3,gridLocal(1), &
F_lastInc2 = F_lastInc gridLocal(2),gridLocal(3)]))
F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid(3)]) F_lastInc = reshape(F, [3,3,gridLocal(1),gridLocal(2),gridLocal(3)])
F_lambda_lastInc = reshape(F_lambda,[3,3,grid(1),grid(2),grid(3)]) F_lambda_lastInc = reshape(F_lambda,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)])
endif endif
F_aim = F_aim + f_aimDot * timeinc F_aim = F_aim + f_aimDot * timeinc
F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim
math_rotate_backward33(F_aim,rotation_BC)), & math_rotate_backward33(F_aim,rotation_BC)), &
[9,grid(1),grid(2),grid(3)]) [9,gridLocal(1),gridLocal(2),gridLocal(3)])
F_lambda = reshape(Utilities_forwardField(timeinc,F_lambda_lastInc,F_lambdadot), & F_lambda = reshape(Utilities_forwardField(timeinc,F_lambda_lastInc,F_lambdadot), &
[9,grid(1),grid(2),grid(3)]) ! does not have any average value as boundary condition [9,gridLocal(1),gridLocal(2),gridLocal(3)]) ! does not have any average value as boundary condition
if (.not. guess) then ! large strain forwarding if (.not. guess) then ! large strain forwarding
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
F_lambda33 = reshape(F_lambda(1:9,i,j,k),[3,3]) F_lambda33 = reshape(F_lambda(1:9,i,j,k),[3,3])
F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, & F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, &
math_mul3333xx33(C_scale,& math_mul3333xx33(C_scale,&

210
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -42,8 +42,7 @@ module DAMASK_spectral_SolverBasicPETSc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
real(pReal), private, dimension(:,:,:,:,:), allocatable :: F_lastInc, Fdot, F_lastInc2 real(pReal), private, dimension(:,:,:,:,:), allocatable :: F_lastInc, Fdot
complex(pReal), private, dimension(:,:,:,:,:), allocatable :: inertiaField_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc. ! stress, stiffness and compliance average etc.
@ -105,6 +104,9 @@ subroutine basicPETSc_init(temperature)
debug_spectralRestart debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use numerics, only: &
worldrank, &
worldsize
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverJobName getSolverJobName
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
@ -112,10 +114,12 @@ subroutine basicPETSc_init(temperature)
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
utilities_updateIPcoords, & utilities_updateIPcoords, &
grid, &
grid1Red, & grid1Red, &
wgt, & wgt
geomSize use mesh, only: &
gridLocal, &
gridGlobal, &
mesh_ipCoordinates
use math, only: & use math, only: &
math_invSym3333 math_invSym3333
@ -128,33 +132,40 @@ subroutine basicPETSc_init(temperature)
PetscObject :: dummy PetscObject :: dummy
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
character(len=1024) :: rankStr
call Utilities_init() call Utilities_init()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' mainProcess: if (worldrank == 0_pInt) then
write(6,'(a)') ' $Id$' write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
allocate (P (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (P (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
allocate (F_lastInc (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_lastInc (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_lastInc2(3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (Fdot (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (Fdot (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
allocate (inertiaField_fourier (grid1Red,grid(2),grid(3),3,3),source = cmplx(0.0_pReal,0.0_pReal,pReal))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc ! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = gridLocal(3)
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! overall grid gridGlobal(1),gridGlobal(2),gridGlobal(3), & ! global grid
PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, & ! domain decomposition strategy (or local (per core) grid) 1, 1, worldsize, &
9,1, & ! #dof (F tensor), ghost boundary width (domain overlap) 9, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, & ! todo gridLocal (1),gridLocal (2),localK, & ! local grid
da,ierr) ! handle, error da,ierr) ! handle, error
CHKERRQ(ierr) CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,dummy,ierr) ! residual vector of same shape as solution vector call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,dummy,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr) CHKERRQ(ierr)
@ -168,33 +179,31 @@ subroutine basicPETSc_init(temperature)
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with
if (restartInc == 1_pInt) then ! no deformation (no restart) if (restartInc == 1_pInt) then ! no deformation (no restart)
F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity F_lastInc = spread(spread(spread(math_I3,3,gridLocal(1)),4,gridLocal(2)),5,gridLocal(3)) ! initialize to identity
F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)]) F = reshape(F_lastInc,[9,gridLocal(1),gridLocal(2),gridLocal(3)])
F_lastInc2 = F_lastInc
elseif (restartInc > 1_pInt) then ! using old values from file elseif (restartInc > 1_pInt) then ! using old values from file
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 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'
flush(6) flush(6)
call IO_read_realFile(777,'F',trim(getSolverJobName()),size(F)) write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
read (777,rec=1) F read (777,rec=1) F
close (777) close (777)
call IO_read_realFile(777,'F_lastInc',trim(getSolverJobName()),size(F_lastInc)) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc read (777,rec=1) F_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_lastInc2',trim(getSolverJobName()),size(F_lastInc2)) if (worldrank == 0_pInt) then
read (777,rec=1) F_lastInc2 call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot))
close (777) read (777,rec=1) f_aimDot
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) close (777)
read (777,rec=1) f_aimDot endif
close (777)
F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F
F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc
endif endif
call utilities_updateIPcoords(F) call Utilities_updateIPcoords(F)
call Utilities_constitutiveResponse(F_lastInc, & call Utilities_constitutiveResponse(F_lastInc, F, &
reshape(F(0:8,0:grid(1)-1_pInt,0:grid(2)-1_pInt,0:grid(3)-1_pInt),[3,3,grid(1),grid(2),grid(3)]), &
temperature, & temperature, &
0.0_pReal, & 0.0_pReal, &
P, & P, &
@ -204,7 +213,7 @@ subroutine basicPETSc_init(temperature)
math_I3) math_I3)
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc
if (restartInc > 1_pInt) then ! using old values from files if (restartInc > 1_pInt .and. worldrank == 0_pInt) then ! using old values from files
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -228,10 +237,11 @@ end subroutine basicPETSc_init
!> @brief solution for the Basic PETSC scheme with internal iterations !> @brief solution for the Basic PETSC scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function basicPETSc_solution( & type(tSolutionState) function basicPETSc_solution( &
incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc,rotation_BC,density) incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc,rotation_BC,density)
use numerics, only: & use numerics, only: &
update_gamma, & update_gamma, &
itmax itmax, &
worldrank
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
tBoundaryCondition, & tBoundaryCondition, &
Utilities_maskedCompliance, & Utilities_maskedCompliance, &
@ -305,6 +315,10 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
itmin itmin
use numerics, only: &
worldrank
use mesh, only: &
gridLocal
use math, only: & use math, only: &
math_rotate_backward33, & math_rotate_backward33, &
math_transpose33, & math_transpose33, &
@ -314,11 +328,9 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
debug_spectral, & debug_spectral, &
debug_spectralRotation debug_spectralRotation
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
wgt, & wgt, &
field_real, & field_realMPI, &
field_fourier, & field_fourierMPI, &
Utilities_FFTforward, & Utilities_FFTforward, &
Utilities_FFTbackward, & Utilities_FFTbackward, &
Utilities_fourierConvolution, & Utilities_fourierConvolution, &
@ -327,13 +339,18 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
Utilities_divergenceRMS Utilities_divergenceRMS
use IO, only: & use IO, only: &
IO_intOut IO_intOut
use FEsolving, only: &
terminallyIll
implicit none implicit none
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, dimension(3,3,grid(1),grid(2),grid(3)) :: & PetscScalar, dimension(3,3, &
x_scal, & XG_RANGE,YG_RANGE,ZG_RANGE) :: &
f_scal x_scal
PetscScalar, dimension(3,3, &
X_RANGE,Y_RANGE,Z_RANGE) :: &
f_scal
PetscInt :: & PetscInt :: &
PETScIter, & PETScIter, &
nfuncs nfuncs
@ -348,36 +365,23 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & if (worldrank == 0_pInt) then
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
math_transpose33(F_aim) math_transpose33(F_aim)
endif
flush(6) flush(6)
endif endif
!--------------------------------------------------------------------------------------------------
! evaluate inertia
if (params%density > 0.0_pReal) then
f_scal = ((x_scal - F_lastInc)/params%timeinc - (F_lastInc - F_lastInc2)/params%timeincOld)/&
((params%timeinc + params%timeincOld)/2.0_pReal)
f_scal = params%density*product(geomSize/grid)*f_scal
field_real = 0.0_pReal
field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3) = reshape(f_scal,[grid(1),grid(2),grid(3),3,3],&
order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward()
call Utilities_inverseLaplace()
inertiaField_fourier = field_fourier
else
inertiaField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! evaluate constitutive response ! evaluate constitutive response
call Utilities_constitutiveResponse(F_lastInc,x_scal,params%temperature,params%timeinc, & call Utilities_constitutiveResponse(F_lastInc,x_scal,params%temperature,params%timeinc, &
f_scal,C_volAvg,C_minmaxAvg,P_av,ForwardData,params%rotation_BC) f_scal,C_volAvg,C_minmaxAvg,P_av,ForwardData,params%rotation_BC)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr)
ForwardData = .false. ForwardData = .false.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -388,18 +392,16 @@ if (params%density > 0.0_pReal) then
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! updated deformation gradient using fix point algorithm of basic scheme ! updated deformation gradient using fix point algorithm of basic scheme
field_real = 0.0_pReal field_realMPI = 0.0_pReal
field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3) = reshape(f_scal,[grid(1),grid(2),grid(3),3,3],& field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3)) = f_scal
order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward() call Utilities_FFTforward()
field_fourier = field_fourier + inertiaField_fourier err_div = Utilities_divergenceRMS()
err_divDummy = Utilities_divergenceRMS()
call Utilities_fourierConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,params%rotation_BC)) call Utilities_fourierConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,params%rotation_BC))
call Utilities_FFTbackward() call Utilities_FFTbackward()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
f_scal = reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),shape(f_scal),order=[3,4,5,1,2]) f_scal = field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3))
end subroutine BasicPETSc_formResidual end subroutine BasicPETSc_formResidual
@ -414,7 +416,8 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
err_div_tolRel, & err_div_tolRel, &
err_div_tolAbs, & err_div_tolAbs, &
err_stress_tolRel, & err_stress_tolRel, &
err_stress_tolAbs err_stress_tolAbs, &
worldrank
use FEsolving, only: & use FEsolving, only: &
terminallyIll terminallyIll
@ -434,7 +437,6 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
divTol = max(maxval(abs(P_av))*err_div_tolRel,err_div_tolAbs) divTol = max(maxval(abs(P_av))*err_div_tolRel,err_div_tolAbs)
stressTol = max(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs) stressTol = max(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs)
err_divPrev = err_div; err_div = err_divDummy
converged: if ((totalIter >= itmin .and. & converged: if ((totalIter >= itmin .and. &
all([ err_div/divTol, & all([ err_div/divTol, &
@ -449,13 +451,15 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
write(6,'(1/,a)') ' ... reporting .............................................................' if (worldrank == 0_pInt) then
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
err_div/divTol, ' (',err_div,' / m, tol =',divTol,')' err_div/divTol, ' (',err_div,' / m, tol =',divTol,')'
write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', & write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', &
err_stress/stressTol, ' (',err_stress, ' Pa, tol =',stressTol,')' err_stress/stressTol, ' (',err_stress, ' Pa, tol =',stressTol,')'
write(6,'(/,a)') ' ===========================================================================' write(6,'(/,a)') ' ==========================================================================='
flush(6) flush(6)
endif
end subroutine BasicPETSc_converged end subroutine BasicPETSc_converged
@ -466,9 +470,9 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
use math, only: & use math, only: &
math_mul33x33 ,& math_mul33x33 ,&
math_rotate_backward33 math_rotate_backward33
use mesh, only: &
gridLocal
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
Utilities_calculateRate, & Utilities_calculateRate, &
Utilities_forwardField, & Utilities_forwardField, &
utilities_updateIPcoords, & utilities_updateIPcoords, &
@ -478,6 +482,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
IO_write_JobRealFile IO_write_JobRealFile
use FEsolving, only: & use FEsolving, only: &
restartWrite restartWrite
use numerics, only: &
worldrank
implicit none implicit none
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
@ -492,37 +498,40 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
guess guess
PetscScalar, pointer :: F(:,:,:,:) PetscScalar, pointer :: F(:,:,:,:)
PetscErrorCode :: ierr PetscErrorCode :: ierr
character(len=1024) :: rankStr
call DMDAVecGetArrayF90(da,solution_vec,F,ierr) call DMDAVecGetArrayF90(da,solution_vec,F,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! restart information for spectral solver ! restart information for spectral solver
if (restartWrite) then if (restartWrite) then
write(6,'(/,a)') ' writing converged results for restart' if (worldrank == 0_pInt) then
flush(6) write(6,'(/,a)') ' writing converged results for restart'
call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc2',size(F_lastInc2)) ! writing F_lastInc field to file if (worldrank == 0_pInt) then
write (777,rec=1) F_lastInc2 call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot))
close (777) write (777,rec=1) F_aimDot
call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) close(777)
write (777,rec=1) F_aimDot call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg))
close(777) write (777,rec=1) C_volAvg
call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) close(777)
write (777,rec=1) C_volAvg call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc))
close(777) write (777,rec=1) C_volAvgLastInc
call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) close(777)
write (777,rec=1) C_volAvgLastInc endif
close(777)
endif endif
call utilities_updateIPcoords(F) call utilities_updateIPcoords(F)
if (cutBack) then if (cutBack) then
F_aim = F_aim_lastInc F_aim = F_aim_lastInc
F = reshape(F_lastInc, [9,grid(1),grid(2),grid(3)]) F = reshape(F_lastInc, [9,gridLocal(1),gridLocal(2),gridLocal(3)])
C_volAvg = C_volAvgLastInc C_volAvg = C_volAvgLastInc
else else
ForwardData = .True. ForwardData = .True.
@ -543,16 +552,15 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
call utilities_updateIPcoords(F) call utilities_updateIPcoords(F)
Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), &
timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)])) timeinc_old,guess,F_lastInc,reshape(F,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)]))
F_lastInc2 = F_lastInc F_lastInc = reshape(F, [3,3,gridLocal(1),gridLocal(2),gridLocal(3)])
F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid(3)])
endif endif
F_aim = F_aim + f_aimDot * timeinc F_aim = F_aim + f_aimDot * timeinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update local deformation gradient ! update local deformation gradient
F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim
math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid(3)]) math_rotate_backward33(F_aim,rotation_BC)),[9,gridLocal(1),gridLocal(2),gridLocal(3)])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_forward end subroutine BasicPETSc_forward

275
code/DAMASK_spectral_solverPolarisation.f90
View File

@ -45,11 +45,9 @@ module DAMASK_spectral_solverPolarisation
! common pointwise data ! common pointwise data
real(pReal), private, dimension(:,:,:,:,:), allocatable :: & real(pReal), private, dimension(:,:,:,:,:), allocatable :: &
F_lastInc, & !< field of previous compatible deformation gradients F_lastInc, & !< field of previous compatible deformation gradients
F_lastInc2, & !< field of 2nd previous compatible deformation gradients
F_tau_lastInc, & !< field of previous incompatible deformation gradient F_tau_lastInc, & !< field of previous incompatible deformation gradient
Fdot, & !< field of assumed rate of compatible deformation gradient Fdot, & !< field of assumed rate of compatible deformation gradient
F_tauDot !< field of assumed rate of incopatible deformation gradient F_tauDot !< field of assumed rate of incopatible deformation gradient
complex(pReal),private, dimension(:,:,:,:,:), allocatable :: inertiaField_fourier
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc. ! stress, stiffness and compliance average etc.
@ -70,7 +68,7 @@ module DAMASK_spectral_solverPolarisation
S_scale = 0.0_pReal S_scale = 0.0_pReal
real(pReal), private :: & real(pReal), private :: &
err_BC, & !< deviation from stress BC err_BC, & !< deviation from stress BC
err_curl, & !< RMS of curl of F err_curl, & !< RMS of curl of F
err_div !< RMS of div of P err_div !< RMS of div of P
logical, private :: ForwardData logical, private :: ForwardData
@ -118,19 +116,21 @@ subroutine Polarisation_init(temperature)
debug_spectralRestart debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use numerics, only: &
worldrank, &
worldsize
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverJobName getSolverJobName
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
Utilities_init, & Utilities_init, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
grid, & Utilities_updateIPcoords, &
grid1Red, & grid1Red, &
geomSize, &
wgt wgt
use mesh, only: & use mesh, only: &
mesh_ipCoordinates, & gridLocal, &
mesh_deformedCoordsFFT gridGlobal
use math, only: & use math, only: &
math_invSym3333 math_invSym3333
@ -144,30 +144,41 @@ subroutine Polarisation_init(temperature)
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
character(len=1024) :: rankStr
call Utilities_init() call Utilities_init()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' if (worldrank == 0_pInt) then
write(6,'(a)') ' $Id$' write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif
allocate (P (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (P (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
allocate (F_lastInc (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_lastInc (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_lastInc2 (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (Fdot (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (Fdot (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_tau_lastInc(3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_tau_lastInc(3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) allocate (F_tauDot (3,3,gridLocal(1),gridLocal(2),gridLocal(3)),source = 0.0_pReal)
allocate (F_tauDot (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
allocate (inertiaField_fourier (grid1Red,grid(2),grid(3),3,3),source = cmplx(0.0_pReal,0.0_pReal,pReal))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! PETSc Init
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call DMDACreate3d(PETSC_COMM_WORLD, & allocate(localK(worldsize), source = 0); localK(worldrank+1) = gridLocal(3)
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & do proc = 1, worldsize
DMDA_STENCIL_BOX,grid(1),grid(2),grid(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, & call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
18,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr) enddo
call DMDACreate3d(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
gridGlobal(1),gridGlobal(2),gridGlobal(3), & ! global grid
1 , 1, worldsize, &
18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
gridLocal (1),gridLocal (2),localK, & ! local grid
da,ierr) ! handle, error
CHKERRQ(ierr) CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,dummy,ierr) call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,dummy,ierr)
@ -183,52 +194,50 @@ subroutine Polarisation_init(temperature)
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_tau => xx_psc(9:17,:,:,:) F_tau => xx_psc(9:17,:,:,:)
if (restartInc == 1_pInt) then ! no deformation (no restart) if (restartInc == 1_pInt) then ! no deformation (no restart)
F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity F_lastInc = spread(spread(spread(math_I3,3,gridLocal(1)),4,gridLocal(2)),5,gridLocal(3)) ! initialize to identity
F_lastInc2 = F_lastInc F = reshape(F_lastInc,[9,gridLocal(1),gridLocal(2),gridLocal(3)])
F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)])
F_tau = 2.0_pReal* F F_tau = 2.0_pReal* F
F_tau_lastInc = 2.0_pReal*F_lastInc F_tau_lastInc = 2.0_pReal*F_lastInc
elseif (restartInc > 1_pInt) then elseif (restartInc > 1_pInt) then
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 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'
flush(6) flush(6)
call IO_read_realFile(777,'F',trim(getSolverJobName()),size(F)) write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
read (777,rec=1) F read (777,rec=1) F
close (777) close (777)
call IO_read_realFile(777,'F_lastInc',trim(getSolverJobName()),size(F_lastInc)) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc read (777,rec=1) F_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_lastInc2',trim(getSolverJobName()),size(F_lastInc2)) call IO_read_realFile(777,'F_tau'//trim(rankStr),trim(getSolverJobName()),size(F_tau))
read (777,rec=1) F_lastInc2
close (777)
call IO_read_realFile(777,'F_tau',trim(getSolverJobName()),size(F_tau))
read (777,rec=1) F_tau read (777,rec=1) F_tau
close (777) close (777)
call IO_read_realFile(777,'F_tau_lastInc',& call IO_read_realFile(777,'F_tau_lastInc'//trim(rankStr),&
trim(getSolverJobName()),size(F_tau_lastInc)) trim(getSolverJobName()),size(F_tau_lastInc))
read (777,rec=1) F_tau_lastInc read (777,rec=1) F_tau_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim)) if (worldrank == 0_pInt) then
read (777,rec=1) F_aim call IO_read_realFile(777,'F_aim', trim(getSolverJobName()),size(F_aim))
close (777) read (777,rec=1) F_aim
call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc)) close (777)
read (777,rec=1) F_aim_lastInc call IO_read_realFile(777,'F_aim_lastInc', trim(getSolverJobName()),size(F_aim_lastInc))
close (777) read (777,rec=1) F_aim_lastInc
call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) close (777)
read (777,rec=1) f_aimDot call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot))
close (777) read (777,rec=1) f_aimDot
close (777)
endif
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call Utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)]) call Utilities_constitutiveResponse(F_lastInc,F,&
call Utilities_constitutiveResponse(F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)]),&
temperature,0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) temperature,0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3)
nullify(F) nullify(F)
nullify(F_tau) nullify(F_tau)
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc
if (restartInc > 1_pInt) then ! using old values from files if (restartInc > 1_pInt .and. worldrank == 0_pInt) then ! using old values from files
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -255,7 +264,8 @@ end subroutine Polarisation_init
!> @brief solution for the Polarisation scheme with internal iterations !> @brief solution for the Polarisation scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function & type(tSolutionState) function &
Polarisation_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc,rotation_BC,density) Polarisation_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,temperature_bc, &
rotation_BC,density)
use numerics, only: & use numerics, only: &
update_gamma update_gamma
use math, only: & use math, only: &
@ -267,6 +277,8 @@ type(tSolutionState) function &
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
terminallyIll terminallyIll
use numerics, only: &
worldrank
implicit none implicit none
@ -340,9 +352,12 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
itmax, & itmax, &
itmin, & itmin, &
polarAlpha, & polarAlpha, &
polarBeta polarBeta, &
worldrank
use IO, only: & use IO, only: &
IO_intOut IO_intOut
use mesh, only: &
gridLocal
use math, only: & use math, only: &
math_rotate_backward33, & math_rotate_backward33, &
math_transpose33, & math_transpose33, &
@ -351,11 +366,9 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
math_mul33x33, & math_mul33x33, &
PI PI
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
wgt, & wgt, &
field_real, & field_realMPI, &
field_fourier, & field_fourierMPI, &
Utilities_FFTforward, & Utilities_FFTforward, &
Utilities_fourierConvolution, & Utilities_fourierConvolution, &
Utilities_inverseLaplace, & Utilities_inverseLaplace, &
@ -369,6 +382,8 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
debug_spectralRotation debug_spectralRotation
use homogenization, only: & use homogenization, only: &
materialpoint_dPdF materialpoint_dPdF
use FEsolving, only: &
terminallyIll
implicit none implicit none
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -408,71 +423,57 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt
call MPI_Allreduce(MPI_IN_PLACE,F_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment
if (totalIter <= PETScIter) then ! new iteration if (totalIter <= PETScIter) then ! new iteration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & if (worldrank == 0_pInt) then
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
math_transpose33(F_aim) math_transpose33(F_aim)
endif
flush(6) flush(6)
endif endif
!--------------------------------------------------------------------------------------------------
! evaluate inertia
dynamic: if (params%density > 0.0_pReal) then
residual_F = ((F - F_lastInc)/params%timeinc - (F_lastInc - F_lastInc2)/params%timeincOld)/&
((params%timeinc + params%timeincOld)/2.0_pReal)
residual_F = params%density*product(geomSize/grid)*residual_F
field_real = 0.0_pReal
field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3) = reshape(residual_F,[grid(1),grid(2),grid(3),3,3],&
order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward()
call Utilities_inverseLaplace()
inertiaField_fourier = field_fourier
else dynamic
inertiaField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
endif dynamic
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! !
field_real = 0.0_pReal field_realMPI = 0.0_pReal
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
field_real(i,j,k,1:3,1:3) = & field_realMPI(1:3,1:3,i,j,k) = &
polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -& polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -&
polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), & polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), &
math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3)) math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))
enddo; enddo; enddo enddo; enddo; enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! doing convolution in Fourier space ! doing convolution in Fourier space
call Utilities_FFTforward() call Utilities_FFTforward()
field_fourier = field_fourier + polarAlpha*inertiaField_fourier
call Utilities_fourierConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC)) call Utilities_fourierConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC))
call Utilities_FFTbackward() call Utilities_FFTbackward()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
residual_F_tau = polarBeta*F - reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),& residual_F_tau = polarBeta*F - field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3))
[3,3,grid(1),grid(2),grid(3)],order=[3,4,5,1,2])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! evaluate constitutive response ! evaluate constitutive response
P_avLastEval = P_av P_avLastEval = P_av
call Utilities_constitutiveResponse(F_lastInc,F - residual_F_tau/polarBeta,params%temperature,params%timeinc, & call Utilities_constitutiveResponse(F_lastInc,F - residual_F_tau/polarBeta,params%temperature,params%timeinc, &
residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr)
ForwardData = .False. ForwardData = .False.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate divergence ! calculate divergence
field_real = 0.0_pReal field_realMPI = 0.0_pReal
field_real = reshape(residual_F,[grid(1),grid(2),grid(3),3,3],order=[4,5,1,2,3]) field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3)) = residual_F
call Utilities_FFTforward() call Utilities_FFTforward()
err_div = Utilities_divergenceRMS() err_div = Utilities_divergenceRMS()
call Utilities_FFTbackward() call Utilities_FFTbackward()
@ -480,19 +481,19 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
e = 0_pInt e = 0_pInt
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
e = e + 1_pInt e = e + 1_pInt
residual_F(1:3,1:3,i,j,k) = & residual_F(1:3,1:3,i,j,k) = &
math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), &
residual_F(1:3,1:3,i,j,k) - math_mul33x33(F(1:3,1:3,i,j,k), & residual_F(1:3,1:3,i,j,k) - math_mul33x33(F(1:3,1:3,i,j,k), &
math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) & math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) &
+ residual_F_tau(1:3,1:3,i,j,k) + residual_F_tau(1:3,1:3,i,j,k)
enddo; enddo; enddo enddo; enddo; enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculating curl ! calculating curl
field_real = 0.0_pReal field_realMPI = 0.0_pReal
field_real = reshape(F,[grid(1),grid(2),grid(3),3,3],order=[4,5,1,2,3]) field_realMPI(1:3,1:3,1:gridLocal(1),1:gridLocal(2),1:gridLocal(3)) = F
call Utilities_FFTforward() call Utilities_FFTforward()
err_curl = Utilities_curlRMS() err_curl = Utilities_curlRMS()
call Utilities_FFTbackward() call Utilities_FFTbackward()
@ -512,7 +513,8 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
err_curl_tolRel, & err_curl_tolRel, &
err_curl_tolAbs, & err_curl_tolAbs, &
err_stress_tolabs, & err_stress_tolabs, &
err_stress_tolrel err_stress_tolrel, &
worldrank
use math, only: & use math, only: &
math_mul3333xx33 math_mul3333xx33
use FEsolving, only: & use FEsolving, only: &
@ -559,15 +561,17 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
write(6,'(1/,a)') ' ... reporting .............................................................' if (worldrank == 0_pInt) then
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')'
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')'
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')'
write(6,'(/,a)') ' ===========================================================================' write(6,'(/,a)') ' ==========================================================================='
flush(6) flush(6)
endif
end subroutine Polarisation_converged end subroutine Polarisation_converged
@ -581,19 +585,19 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
math_transpose33, & math_transpose33, &
math_rotate_backward33 math_rotate_backward33
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
Utilities_calculateRate, & Utilities_calculateRate, &
Utilities_forwardField, & Utilities_forwardField, &
Utilities_updateIPcoords, &
tBoundaryCondition, & tBoundaryCondition, &
cutBack cutBack
use mesh, only: & use mesh, only: &
mesh_ipCoordinates,& gridLocal
mesh_deformedCoordsFFT
use IO, only: & use IO, only: &
IO_write_JobRealFile IO_write_JobRealFile
use FEsolving, only: & use FEsolving, only: &
restartWrite restartWrite
use numerics, only: &
worldrank
implicit none implicit none
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
@ -610,6 +614,7 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_tau PetscScalar, dimension(:,:,:,:), pointer :: xx_psc, F, F_tau
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
real(pReal), dimension(3,3) :: F_lambda33 real(pReal), dimension(3,3) :: F_lambda33
character(len=1024) :: rankStr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
@ -617,46 +622,46 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_tau => xx_psc(9:17,:,:,:) F_tau => xx_psc(9:17,:,:,:)
if (restartWrite) then if (restartWrite) then
write(6,'(/,a)') ' writing converged results for restart' if (worldrank == 0_pInt) write(6,'(/,a)') ' writing converged results for restart'
flush(6) flush(6)
call IO_write_jobRealFile(777,'F',size(F)) ! writing deformation gradient field to file write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc',size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc2',size(F_lastInc2)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file
write (777,rec=1) F_lastInc2
close (777)
call IO_write_jobRealFile(777,'F_tau',size(F_tau)) ! writing deformation gradient field to file
write (777,rec=1) F_tau write (777,rec=1) F_tau
close (777) close (777)
call IO_write_jobRealFile(777,'F_tau_lastInc',size(F_tau_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_tau_lastInc write (777,rec=1) F_tau_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_aim',size(F_aim)) if (worldrank == 0_pInt) then
write (777,rec=1) F_aim call IO_write_jobRealFile(777,'F_aim',size(F_aim))
close(777) write (777,rec=1) F_aim
call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc)) close(777)
write (777,rec=1) F_aim_lastInc call IO_write_jobRealFile(777,'F_aim_lastInc',size(F_aim_lastInc))
close (777) write (777,rec=1) F_aim_lastInc
call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) close (777)
write (777,rec=1) F_aimDot call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot))
close(777) write (777,rec=1) F_aimDot
call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) close(777)
write (777,rec=1) C_volAvg call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg))
close(777) write (777,rec=1) C_volAvg
call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) close(777)
write (777,rec=1) C_volAvgLastInc call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc))
close(777) write (777,rec=1) C_volAvgLastInc
close(777)
endif
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
if (cutBack) then if (cutBack) then
F_aim = F_aim_lastInc F_aim = F_aim_lastInc
F_tau= reshape(F_tau_lastInc,[9,grid(1),grid(2),grid(3)]) F_tau= reshape(F_tau_lastInc,[9,gridLocal(1),gridLocal(2),gridLocal(3)])
F = reshape(F_lastInc, [9,grid(1),grid(2),grid(3)]) F = reshape(F_lastInc, [9,gridLocal(1),gridLocal(2),gridLocal(3)])
C_volAvg = C_volAvgLastInc C_volAvg = C_volAvgLastInc
else else
ForwardData = .True. ForwardData = .True.
@ -675,25 +680,27 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(& call utilities_updateIPcoords(F)
F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), &
timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)])) timeinc_old,guess,F_lastInc, &
reshape(F,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)]))
F_tauDot = Utilities_calculateRate(math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC), & F_tauDot = Utilities_calculateRate(math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC), &
timeinc_old,guess,F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid(3)])) timeinc_old,guess,F_tau_lastInc, &
F_lastInc2 = F_lastInc reshape(F_tau,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)]))
F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid(3)]) F_lastInc = reshape(F, [3,3,gridLocal(1),gridLocal(2),gridLocal(3)])
F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid(3)]) F_tau_lastInc = reshape(F_tau,[3,3,gridLocal(1),gridLocal(2),gridLocal(3)])
endif endif
F_aim = F_aim + f_aimDot * timeinc F_aim = F_aim + f_aimDot * timeinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update local deformation gradient ! update local deformation gradient
F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim
math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid(3)]) math_rotate_backward33(F_aim,rotation_BC)), &
F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), [9,grid(1),grid(2),grid(3)]) ! does not have any average value as boundary condition [9,gridLocal(1),gridLocal(2),gridLocal(3)])
if (.not. guess) then ! large strain forwarding F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), & ! does not have any average value as boundary condition
do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) [9,gridLocal(1),gridLocal(2),gridLocal(3)])
if (.not. guess) then ! large strain forwarding
do k = 1_pInt, gridLocal(3); do j = 1_pInt, gridLocal(2); do i = 1_pInt, gridLocal(1)
F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3]) F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3])
F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, & F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, &
math_mul3333xx33(C_scale,& math_mul3333xx33(C_scale,&

822
code/DAMASK_spectral_utilities.f90
View File

File diff suppressed because it is too large Load Diff

17
code/Makefile
View File

@ -336,7 +336,7 @@ SPECTRAL_FILES = prec.o DAMASK_interface.o IO.o libs.o numerics.o debug.o math.o
FEsolving.o mesh.o material.o lattice.o \ FEsolving.o mesh.o material.o lattice.o \
$(DAMAGE_FILES) $(THERMAL_FILES) $(VACANCY_FILES) $(PLASTIC_FILES) \ $(DAMAGE_FILES) $(THERMAL_FILES) $(VACANCY_FILES) $(PLASTIC_FILES) \
crystallite.o $(HOMOGENIZATION_FILES) CPFEM.o \ crystallite.o $(HOMOGENIZATION_FILES) CPFEM.o \
DAMASK_spectral_utilities.o DAMASK_spectral_solverBasic.o \ DAMASK_spectral_utilities.o \
DAMASK_spectral_solverAL.o DAMASK_spectral_solverBasicPETSc.o DAMASK_spectral_solverPolarisation.o DAMASK_spectral_solverAL.o DAMASK_spectral_solverBasicPETSc.o DAMASK_spectral_solverPolarisation.o
DAMASK_spectral.exe: DAMASK_spectral_driver.o DAMASK_spectral.exe: DAMASK_spectral_driver.o
@ -345,18 +345,15 @@ DAMASK_spectral.exe: DAMASK_spectral_driver.o
$(SPECTRAL_FILES) $(LIBRARIES) $(SUFFIX) $(SPECTRAL_FILES) $(LIBRARIES) $(SUFFIX)
DAMASK_spectral_driver.o: DAMASK_spectral_driver.f90 DAMASK_spectral_solverBasic.o \ DAMASK_spectral_driver.o: DAMASK_spectral_driver.f90 \
DAMASK_spectral_solverAL.o \ DAMASK_spectral_solverAL.o \
DAMASK_spectral_solverBasicPETSc.o \ DAMASK_spectral_solverBasicPETSc.o \
DAMASK_spectral_solverPolarisation.o DAMASK_spectral_solverPolarisation.o
$(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c DAMASK_spectral_driver.f90 $(SUFFIX) $(PREFIX) $(COMPILERNAME) $(COMPILE_MAXOPTI) -c DAMASK_spectral_driver.f90 $(SUFFIX)
DAMASK_spectral_solverAL.o: DAMASK_spectral_solverAL.f90 \ DAMASK_spectral_solverAL.o: DAMASK_spectral_solverAL.f90 \
DAMASK_spectral_utilities.o DAMASK_spectral_utilities.o
DAMASK_spectral_solverBasic.o: DAMASK_spectral_solverBasic.f90 \
DAMASK_spectral_utilities.o
DAMASK_spectral_solverPolarisation.o: DAMASK_spectral_solverPolarisation.f90 \ DAMASK_spectral_solverPolarisation.o: DAMASK_spectral_solverPolarisation.f90 \
DAMASK_spectral_utilities.o DAMASK_spectral_utilities.o
@ -370,8 +367,8 @@ DAMASK_spectral_utilities.o: DAMASK_spectral_utilities.f90 \
# FEM Solver # FEM Solver
##################### #####################
VPATH := ../private/FEM/code VPATH := ../private/FEM/code
DAMASK_FEM.exe: COMPILE += -DFEM -DmultiphysicsOut DAMASK_FEM.exe: COMPILE += -DFEM
DAMASK_FEM.exe: COMPILE_MAXOPTI += -DFEM -DmultiphysicsOut DAMASK_FEM.exe: COMPILE_MAXOPTI += -DFEM
DAMASK_FEM.exe: MESHNAME := ../private/FEM/code/meshFEM.f90 DAMASK_FEM.exe: MESHNAME := ../private/FEM/code/meshFEM.f90
DAMASK_FEM.exe: INTERFACENAME := ../private/FEM/code/DAMASK_FEM_interface.f90 DAMASK_FEM.exe: INTERFACENAME := ../private/FEM/code/DAMASK_FEM_interface.f90
DAMASK_FEM.exe: INCLUDE_DIRS += -I./ DAMASK_FEM.exe: INCLUDE_DIRS += -I./

299
code/mesh.f90
View File

@ -15,7 +15,7 @@ module mesh
implicit none implicit none
private private
integer(pInt), public, protected :: & integer(pInt), public, protected :: &
mesh_NcpElems, & !< total number of CP elements in mesh mesh_NcpElems, & !< total number of CP elements in local mesh
mesh_NelemSets, & mesh_NelemSets, &
mesh_maxNelemInSet, & mesh_maxNelemInSet, &
mesh_Nmaterials, & mesh_Nmaterials, &
@ -29,6 +29,18 @@ module mesh
mesh_maxNcellnodes, & !< max number of cell nodes in any CP element mesh_maxNcellnodes, & !< max number of cell nodes in any CP element
mesh_Nelems !< total number of elements in mesh mesh_Nelems !< total number of elements in mesh
#ifdef Spectral
integer(pInt), public, protected :: &
mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh
gridGlobal(3), &
gridLocal (3), &
gridOffset
real(pReal), public, protected :: &
geomSizeGlobal(3), &
geomSizeLocal (3), &
geomSizeOffset
#endif
integer(pInt), dimension(:,:), allocatable, public, protected :: & integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element, & !< FEid, type(internal representation), material, texture, node indices as CP IDs mesh_element, & !< FEid, type(internal representation), material, texture, node indices as CP IDs
mesh_sharedElem, & !< entryCount and list of elements containing node mesh_sharedElem, & !< entryCount and list of elements containing node
@ -103,10 +115,15 @@ module mesh
logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information
#endif #endif
#ifdef Spectral #ifdef PETSc
include 'fftw3.f03' #include <petsc-finclude/petscsys.h>
#endif #endif
#ifdef Spectral
include 'fftw3-mpi.f03'
#endif
! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS)
! Hence, I suggest to prefix with "FE_" ! Hence, I suggest to prefix with "FE_"
@ -470,6 +487,9 @@ contains
!! Order and routines strongly depend on type of solver !! Order and routines strongly depend on type of solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_init(ip,el) subroutine mesh_init(ip,el)
#ifdef Spectral
use, intrinsic :: iso_c_binding
#endif
use DAMASK_interface use DAMASK_interface
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: & use IO, only: &
@ -503,6 +523,9 @@ subroutine mesh_init(ip,el)
modelName modelName
implicit none implicit none
#ifdef Spectral
integer(C_INTPTR_T) :: gridMPI(3), alloc_local, local_K, local_K_offset
#endif
integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), parameter :: FILEUNIT = 222_pInt
integer(pInt), intent(in) :: el, ip integer(pInt), intent(in) :: el, ip
integer(pInt) :: j integer(pInt) :: j
@ -540,8 +563,25 @@ subroutine mesh_init(ip,el)
myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt)
#ifdef Spectral #ifdef Spectral
call fftw_mpi_init()
call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file...
if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6)
gridGlobal = mesh_spectral_getGrid(fileUnit)
gridMPI = gridGlobal
alloc_local = fftw_mpi_local_size_3d(gridMPI(3), gridMPI(2), gridMPI(1)/2 +1, &
MPI_COMM_WORLD, local_K, local_K_offset)
gridLocal(1) = gridGlobal(1)
gridLocal(2) = gridGlobal(2)
gridLocal(3) = local_K
gridOffset = local_K_offset
geomSizeGlobal = mesh_spectral_getSize(fileUnit)
geomSizeLocal(1) = geomSizeGlobal(1)
geomSizeLocal(2) = geomSizeGlobal(2)
geomSizeLocal(3) = geomSizeGlobal(3)*real(gridLocal(3))/real(gridGlobal(3))
geomSizeOffset = geomSizeGlobal(3)*real(gridOffset) /real(gridGlobal(3))
if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6)
call mesh_spectral_count(FILEUNIT) call mesh_spectral_count(FILEUNIT)
if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6)
call mesh_spectral_mapNodesAndElems call mesh_spectral_mapNodesAndElems
@ -656,10 +696,12 @@ subroutine mesh_init(ip,el)
#endif #endif
close (FILEUNIT) close (FILEUNIT)
call mesh_tell_statistics if (worldrank == 0_pInt) then
call mesh_write_meshfile call mesh_tell_statistics
call mesh_write_cellGeom call mesh_write_meshfile
call mesh_write_elemGeom call mesh_write_cellGeom
call mesh_write_elemGeom
endif
if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) &
call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements
@ -1201,15 +1243,15 @@ end function mesh_spectral_getHomogenization
!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' !! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_count(fileUnit) subroutine mesh_spectral_count(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), dimension(3) :: grid
grid = mesh_spectral_getGrid(fileUnit) mesh_Nelems = product(gridLocal)
mesh_Nelems = product(grid) mesh_NcpElems= mesh_Nelems
mesh_NcpElems = mesh_Nelems mesh_Nnodes = product(gridLocal + 1_pInt)
mesh_Nnodes = product(grid+1_pInt)
mesh_NcpElemsGlobal = product(gridGlobal)
end subroutine mesh_spectral_count end subroutine mesh_spectral_count
@ -1262,27 +1304,18 @@ subroutine mesh_spectral_build_nodes(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt) :: n integer(pInt) :: n, i, j, k
integer(pInt), dimension(3) :: grid
real(pReal), dimension(3) :: geomSize
allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal)
allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal)
grid = mesh_spectral_getGrid(fileUnit) n = 0_pInt
geomSize = mesh_spectral_getSize(fileUnit) do k = 1, gridLocal(3); do j = 1, gridLocal(2); do i = 1, gridLocal(1)
n = n + 1_pInt
forall (n = 0_pInt:mesh_Nnodes-1_pInt) mesh_node0(1,n) = real(i)*geomSizeLocal(1)/real(gridLocal(1))
mesh_node0(1,n+1_pInt) = mesh_unitlength * & mesh_node0(2,n) = real(j)*geomSizeLocal(2)/real(gridLocal(2))
geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & mesh_node0(3,n) = real(k)*geomSizeLocal(3)/real(gridLocal(3)) + geomSizeOffset
/ real(grid(1),pReal) enddo; enddo; enddo
mesh_node0(2,n+1_pInt) = mesh_unitlength * &
geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) &
/ real(grid(2),pReal)
mesh_node0(3,n+1_pInt) = mesh_unitlength * &
geomSize(3)*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid(3)+1_pInt)),pReal) &
/ real(grid(3),pReal)
end forall
mesh_node = mesh_node0 mesh_node = mesh_node0
@ -1315,11 +1348,11 @@ subroutine mesh_spectral_build_elements(fileUnit)
headerLength = 0_pInt, & headerLength = 0_pInt, &
maxIntCount, & maxIntCount, &
homog, & homog, &
elemType elemType, &
elemOffset
integer(pInt), dimension(:), allocatable :: & integer(pInt), dimension(:), allocatable :: &
microstructures microstructures, &
integer(pInt), dimension(3) :: & mesh_microGlobal
grid
integer(pInt), dimension(1,1) :: & integer(pInt), dimension(1,1) :: &
dummySet = 0_pInt dummySet = 0_pInt
character(len=65536) :: & character(len=65536) :: &
@ -1328,7 +1361,6 @@ subroutine mesh_spectral_build_elements(fileUnit)
character(len=64), dimension(1) :: & character(len=64), dimension(1) :: &
dummyName = '' dummyName = ''
grid = mesh_spectral_getGrid(fileUnit)
homog = mesh_spectral_getHomogenization(fileUnit) homog = mesh_spectral_getHomogenization(fileUnit)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1358,7 +1390,8 @@ subroutine mesh_spectral_build_elements(fileUnit)
maxIntCount = max(maxIntCount, i) maxIntCount = max(maxIntCount, i)
enddo enddo
allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source = 0_pInt) allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source = 0_pInt)
allocate (microstructures (1_pInt+maxIntCount), source = 1_pInt) allocate (microstructures (1_pInt+maxIntCount), source = 1_pInt)
allocate (mesh_microGlobal(mesh_NcpElemsGlobal), source = 1_pInt)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read in microstructures ! read in microstructures
@ -1367,31 +1400,39 @@ subroutine mesh_spectral_build_elements(fileUnit)
read(fileUnit,'(a65536)') line read(fileUnit,'(a65536)') line
enddo enddo
elemType = FE_mapElemtype('C3D8R')
e = 0_pInt e = 0_pInt
do while (e < mesh_NcpElems .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!)
microstructures = IO_continuousIntValues(fileUnit,maxIntCount,dummyName,dummySet,0_pInt) ! get affected elements microstructures = IO_continuousIntValues(fileUnit,maxIntCount,dummyName,dummySet,0_pInt) ! get affected elements
do i = 1_pInt,microstructures(1_pInt) do i = 1_pInt,microstructures(1_pInt)
e = e+1_pInt ! valid element entry e = e+1_pInt ! valid element entry
mesh_element( 1,e) = e ! FE id mesh_microGlobal(e) = microstructures(1_pInt+i)
mesh_element( 2,e) = elemType ! elem type
mesh_element( 3,e) = homog ! homogenization
mesh_element( 4,e) = microstructures(1_pInt+i) ! microstructure
mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + &
((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node
mesh_element( 6,e) = mesh_element(5,e) + 1_pInt
mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt
mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt
mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node
mesh_element(10,e) = mesh_element(9,e) + 1_pInt
mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt
mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt
mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics
mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e))
enddo enddo
enddo enddo
elemType = FE_mapElemtype('C3D8R')
elemOffset = gridLocal(1)*gridLocal(2)*gridOffset
e = 0_pInt
do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!)
e = e+1_pInt ! valid element entry
mesh_element( 1,e) = e ! FE id
mesh_element( 2,e) = elemType ! elem type
mesh_element( 3,e) = homog ! homogenization
mesh_element( 4,e) = mesh_microGlobal(e+elemOffset) ! microstructure
mesh_element( 5,e) = e + (e-1_pInt)/gridLocal(1) + &
((e-1_pInt)/(gridLocal(1)*gridLocal(2)))*(gridLocal(1)+1_pInt) ! base node
mesh_element( 6,e) = mesh_element(5,e) + 1_pInt
mesh_element( 7,e) = mesh_element(5,e) + gridLocal(1) + 2_pInt
mesh_element( 8,e) = mesh_element(5,e) + gridLocal(1) + 1_pInt
mesh_element( 9,e) = mesh_element(5,e) +(gridLocal(1) + 1_pInt) * (gridLocal(2) + 1_pInt) ! second floor base node
mesh_element(10,e) = mesh_element(9,e) + 1_pInt
mesh_element(11,e) = mesh_element(9,e) + gridLocal(1) + 2_pInt
mesh_element(12,e) = mesh_element(9,e) + gridLocal(1) + 1_pInt
mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics
mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e))
enddo
deallocate(microstructures) deallocate(microstructures)
deallocate(mesh_microGlobal)
if (e /= mesh_NcpElems) call IO_error(880_pInt,e) if (e /= mesh_NcpElems) call IO_error(880_pInt,e)
end subroutine mesh_spectral_build_elements end subroutine mesh_spectral_build_elements
@ -1409,39 +1450,35 @@ subroutine mesh_spectral_build_ipNeighborhood(fileUnit)
integer(pInt) :: & integer(pInt) :: &
x,y,z, & x,y,z, &
e e
integer(pInt), dimension(3) :: &
grid
allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt)
grid = mesh_spectral_getGrid(fileUnit)
e = 0_pInt e = 0_pInt
do z = 0_pInt,grid(3)-1_pInt do z = 0_pInt,gridLocal(3)-1_pInt
do y = 0_pInt,grid(2)-1_pInt do y = 0_pInt,gridLocal(2)-1_pInt
do x = 0_pInt,grid(1)-1_pInt do x = 0_pInt,gridLocal(1)-1_pInt
e = e + 1_pInt e = e + 1_pInt
mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & mesh_ipNeighborhood(1,1,1,e) = z * gridLocal(1) * gridLocal(2) &
+ y * grid(1) & + y * gridLocal(1) &
+ modulo(x+1_pInt,grid(1)) & + modulo(x+1_pInt,gridLocal(1)) &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & mesh_ipNeighborhood(1,2,1,e) = z * gridLocal(1) * gridLocal(2) &
+ y * grid(1) & + y * gridLocal(1) &
+ modulo(x-1_pInt,grid(1)) & + modulo(x-1_pInt,gridLocal(1)) &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & mesh_ipNeighborhood(1,3,1,e) = z * gridLocal(1) * gridLocal(2) &
+ modulo(y+1_pInt,grid(2)) * grid(1) & + modulo(y+1_pInt,gridLocal(2)) * gridLocal(1) &
+ x & + x &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & mesh_ipNeighborhood(1,4,1,e) = z * gridLocal(1) * gridLocal(2) &
+ modulo(y-1_pInt,grid(2)) * grid(1) & + modulo(y-1_pInt,gridLocal(2)) * gridLocal(1) &
+ x & + x &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid(3)) * grid(1) * grid(2) & mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,gridLocal(3)) * gridLocal(1) * gridLocal(2) &
+ y * grid(1) & + y * gridLocal(1) &
+ x & + x &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid(3)) * grid(1) * grid(2) & mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,gridLocal(3)) * gridLocal(1) * gridLocal(2) &
+ y * grid(1) & + y * gridLocal(1) &
+ x & + x &
+ 1_pInt + 1_pInt
mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt
@ -1484,8 +1521,8 @@ function mesh_regrid(adaptive,resNewInput,minRes)
math_mul33x3 math_mul33x3
implicit none implicit none
logical, intent(in) :: adaptive ! if true, choose adaptive grid based on resNewInput, otherwise keep it constant logical, intent(in) :: adaptive ! if true, choose adaptive grid based on resNewInput, otherwise keep it constant
integer(pInt), dimension(3), optional, intent(in) :: resNewInput ! f2py cannot handle optional arguments correctly (they are always present) integer(pInt), dimension(3), optional, intent(in) :: resNewInput ! f2py cannot handle optional arguments correctly (they are always present)
integer(pInt), dimension(3), optional, intent(in) :: minRes integer(pInt), dimension(3), optional, intent(in) :: minRes
integer(pInt), dimension(3) :: mesh_regrid, ratio, grid integer(pInt), dimension(3) :: mesh_regrid, ratio, grid
integer(pInt), parameter :: FILEUNIT = 777_pInt integer(pInt), parameter :: FILEUNIT = 777_pInt
@ -1576,7 +1613,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
if (minRes(1) > 0_pInt .or. minRes(2) > 0_pInt) then if (minRes(1) > 0_pInt .or. minRes(2) > 0_pInt) then
if (minRes(3) /= 1_pInt .or. & if (minRes(3) /= 1_pInt .or. &
mod(minRes(1),2_pInt) /= 0_pInt .or. & mod(minRes(1),2_pInt) /= 0_pInt .or. &
mod(minRes(2),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '2D minRes') ! as f2py has problems with present, use pyf file for initialization to -1 mod(minRes(2),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '2D minRes') ! as f2py has problems with present, use pyf file for initialization to -1
endif; endif endif; endif
else else
spatialDim = 3_pInt spatialDim = 3_pInt
@ -1584,7 +1621,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
if (any(minRes > 0_pInt)) then if (any(minRes > 0_pInt)) then
if (mod(minRes(1),2_pInt) /= 0_pInt .or. & if (mod(minRes(1),2_pInt) /= 0_pInt .or. &
mod(minRes(2),2_pInt) /= 0_pInt .or. & mod(minRes(2),2_pInt) /= 0_pInt .or. &
mod(minRes(3),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '3D minRes') ! as f2py has problems with present, use pyf file for initialization to -1 mod(minRes(3),2_pInt) /= 0_pInt) call IO_error(890_pInt, ext_msg = '3D minRes') ! as f2py has problems with present, use pyf file for initialization to -1
endif; endif endif; endif
endif endif
@ -1601,12 +1638,12 @@ function mesh_regrid(adaptive,resNewInput,minRes)
else else
possibleResNew(i,1:2) = [ratio(i)-1_pInt, ratio(i) + 1_pInt] possibleResNew(i,1:2) = [ratio(i)-1_pInt, ratio(i) + 1_pInt]
endif endif
if (.not.present(minRes)) then ! calling from fortran, optional argument not given if (.not.present(minRes)) then ! calling from fortran, optional argument not given
possibleResNew = possibleResNew possibleResNew = possibleResNew
else ! optional argument is there else ! optional argument is there
if (any(minRes<1_pInt)) then if (any(minRes<1_pInt)) then
possibleResNew = possibleResNew ! f2py calling, but without specification (or choosing invalid values), standard from pyf = -1 possibleResNew = possibleResNew ! f2py calling, but without specification (or choosing invalid values), standard from pyf = -1
else ! given useful values else ! given useful values
forall(k = 1_pInt:3_pInt, j = 1_pInt:3_pInt) & forall(k = 1_pInt:3_pInt, j = 1_pInt:3_pInt) &
possibleResNew(j,k) = max(possibleResNew(j,k), minRes(j)) possibleResNew(j,k) = max(possibleResNew(j,k), minRes(j))
endif endif
@ -1656,7 +1693,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
N_Digits = adjustl(N_Digits) N_Digits = adjustl(N_Digits)
formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)'
call IO_write_jobFile(FILEUNIT,'IDX') ! make it a general open-write file call IO_write_jobFile(FILEUNIT,'IDX') ! make it a general open-write file
write(FILEUNIT, '(A)') '1 header' write(FILEUNIT, '(A)') '1 header'
write(FILEUNIT, '(A)') 'Numbered indices as per the large set' write(FILEUNIT, '(A)') 'Numbered indices as per the large set'
do i = 1_pInt, NpointsNew do i = 1_pInt, NpointsNew
@ -1675,7 +1712,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
N_Digits = adjustl(N_Digits) N_Digits = adjustl(N_Digits)
formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)'
call IO_write_jobFile(FILEUNIT,'idx') ! make it a general open-write file call IO_write_jobFile(FILEUNIT,'idx') ! make it a general open-write file
write(FILEUNIT, '(A)') '1 header' write(FILEUNIT, '(A)') '1 header'
write(FILEUNIT, '(A)') 'Numbered indices as per the small set' write(FILEUNIT, '(A)') 'Numbered indices as per the small set'
do i = 1_pInt, NpointsNew do i = 1_pInt, NpointsNew
@ -1841,7 +1878,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
deallocate(Tstar) deallocate(Tstar)
deallocate(TstarNew) deallocate(TstarNew)
! for the state, we first have to know the size------------------------------------------------------------------ ! for the state, we first have to know the size----------------------------------------------------
allocate(sizeStateConst(1,1,mesh_NcpElems)) allocate(sizeStateConst(1,1,mesh_NcpElems))
call IO_read_intFile(FILEUNIT,'sizeStateConst',trim(getSolverJobName()),size(sizeStateConst)) call IO_read_intFile(FILEUNIT,'sizeStateConst',trim(getSolverJobName()),size(sizeStateConst))
read (FILEUNIT,rec=1) sizeStateConst read (FILEUNIT,rec=1) sizeStateConst
@ -2641,7 +2678,7 @@ subroutine mesh_marc_map_elementSets(fileUnit)
elemSet = elemSet+1_pInt elemSet = elemSet+1_pInt
mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,myPos,4_pInt)) mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,myPos,4_pInt))
mesh_mapElemSet(:,elemSet) = & mesh_mapElemSet(:,elemSet) = &
IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets)
endif endif
enddo enddo
@ -2679,7 +2716,7 @@ subroutine mesh_marc_count_cpElements(fileUnit)
do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines
read (fileUnit,610,END=620) line read (fileUnit,610,END=620) line
enddo enddo
mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)?
exit exit
endif endif
enddo enddo
@ -2769,7 +2806,7 @@ subroutine mesh_marc_map_nodes(fileUnit)
read (fileUnit,610,END=650) line read (fileUnit,610,END=650) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then
read (fileUnit,610,END=650) line ! skip crap line read (fileUnit,610,END=650) line ! skip crap line
do i = 1_pInt,mesh_Nnodes do i = 1_pInt,mesh_Nnodes
read (fileUnit,610,END=650) line read (fileUnit,610,END=650) line
mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt)
@ -2816,7 +2853,7 @@ subroutine mesh_marc_build_nodes(fileUnit)
read (fileUnit,610,END=670) line read (fileUnit,610,END=670) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'coordinates' ) then
read (fileUnit,610,END=670) line ! skip crap line read (fileUnit,610,END=670) line ! skip crap line
do i=1_pInt,mesh_Nnodes do i=1_pInt,mesh_Nnodes
read (fileUnit,610,END=670) line read (fileUnit,610,END=670) line
m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt))
@ -2865,10 +2902,10 @@ subroutine mesh_marc_count_cpSizes(fileUnit)
read (fileUnit,610,END=630) line read (fileUnit,610,END=630) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then
read (fileUnit,610,END=630) line ! Garbage line read (fileUnit,610,END=630) line ! Garbage line
do i=1_pInt,mesh_Nelems ! read all elements do i=1_pInt,mesh_Nelems ! read all elements
read (fileUnit,610,END=630) line read (fileUnit,610,END=630) line
myPos = IO_stringPos(line,maxNchunks) ! limit to id and type myPos = IO_stringPos(line,maxNchunks) ! limit to id and type
e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt)) e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt))
if (e /= 0_pInt) then if (e /= 0_pInt) then
t = FE_mapElemtype(IO_stringValue(line,myPos,2_pInt)) t = FE_mapElemtype(IO_stringValue(line,myPos,2_pInt))
@ -2878,7 +2915,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit)
mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) mesh_maxNips = max(mesh_maxNips,FE_Nips(g))
mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c))
mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g))
call IO_skipChunks(fileUnit,FE_Nnodes(t)-(myPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line call IO_skipChunks(fileUnit,FE_Nnodes(t)-(myPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line
endif endif
enddo enddo
exit exit
@ -2905,7 +2942,7 @@ subroutine mesh_marc_build_elements(fileUnit)
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
integer(pInt), parameter :: maxNchunks = 66_pInt ! limit to 64 nodes max (plus ID, type) integer(pInt), parameter :: maxNchunks = 66_pInt ! limit to 64 nodes max (plus ID, type)
integer(pInt), dimension (1_pInt+2_pInt*maxNchunks) :: myPos integer(pInt), dimension (1_pInt+2_pInt*maxNchunks) :: myPos
character(len=300) line character(len=300) line
@ -2921,26 +2958,26 @@ subroutine mesh_marc_build_elements(fileUnit)
read (fileUnit,610,END=620) line read (fileUnit,610,END=620) line
myPos(1:1+2*1) = IO_stringPos(line,1_pInt) myPos(1:1+2*1) = IO_stringPos(line,1_pInt)
if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then if( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'connectivity' ) then
read (fileUnit,610,END=620) line ! garbage line read (fileUnit,610,END=620) line ! garbage line
do i = 1_pInt,mesh_Nelems do i = 1_pInt,mesh_Nelems
read (fileUnit,610,END=620) line read (fileUnit,610,END=620) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt)) e = mesh_FEasCP('elem',IO_intValue(line,myPos,1_pInt))
if (e /= 0_pInt) then ! disregard non CP elems if (e /= 0_pInt) then ! disregard non CP elems
mesh_element(1,e) = IO_IntValue (line,myPos,1_pInt) ! FE id mesh_element(1,e) = IO_IntValue (line,myPos,1_pInt) ! FE id
t = FE_mapElemtype(IO_StringValue(line,myPos,2_pInt)) ! elem type t = FE_mapElemtype(IO_StringValue(line,myPos,2_pInt)) ! elem type
mesh_element(2,e) = t mesh_element(2,e) = t
nNodesAlreadyRead = 0_pInt nNodesAlreadyRead = 0_pInt
do j = 1_pInt,myPos(1)-2_pInt do j = 1_pInt,myPos(1)-2_pInt
mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,myPos,j+2_pInt)) ! CP ids of nodes mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,myPos,j+2_pInt)) ! CP ids of nodes
enddo enddo
nNodesAlreadyRead = myPos(1) - 2_pInt nNodesAlreadyRead = myPos(1) - 2_pInt
do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line
read (fileUnit,610,END=620) line read (fileUnit,610,END=620) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
do j = 1_pInt,myPos(1) do j = 1_pInt,myPos(1)
mesh_element(4_pInt+nNodesAlreadyRead+j,e) & mesh_element(4_pInt+nNodesAlreadyRead+j,e) &
= mesh_FEasCP('node',IO_IntValue(line,myPos,j)) ! CP ids of nodes = mesh_FEasCP('node',IO_IntValue(line,myPos,j)) ! CP ids of nodes
enddo enddo
nNodesAlreadyRead = nNodesAlreadyRead + myPos(1) nNodesAlreadyRead = nNodesAlreadyRead + myPos(1)
enddo enddo
@ -2950,33 +2987,33 @@ subroutine mesh_marc_build_elements(fileUnit)
endif endif
enddo enddo
620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity"
read (fileUnit,610,END=620) line read (fileUnit,610,END=620) line
do do
myPos(1:1+2*2) = IO_stringPos(line,2_pInt) myPos(1:1+2*2) = IO_stringPos(line,2_pInt)
if( (IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'initial') .and. & if( (IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'initial') .and. &
(IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'state') ) then (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'state') ) then
if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style
read (fileUnit,610,END=630) line ! read line with index of state var read (fileUnit,610,END=630) line ! read line with index of state var
myPos(1:1+2*1) = IO_stringPos(line,1_pInt) myPos(1:1+2*1) = IO_stringPos(line,1_pInt)
sv = IO_IntValue(line,myPos,1_pInt) ! figure state variable index sv = IO_IntValue(line,myPos,1_pInt) ! figure state variable index
if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest
read (fileUnit,610,END=620) line ! read line with value of state var read (fileUnit,610,END=620) line ! read line with value of state var
myPos(1:1+2*1) = IO_stringPos(line,1_pInt) myPos(1:1+2*1) = IO_stringPos(line,1_pInt)
do while (scan(IO_stringValue(line,myPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? do while (scan(IO_stringValue(line,myPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value?
myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value
mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index
if (initialcondTableStyle == 2_pInt) then if (initialcondTableStyle == 2_pInt) then
read (fileUnit,610,END=630) line ! read extra line read (fileUnit,610,END=630) line ! read extra line
read (fileUnit,610,END=630) line ! read extra line read (fileUnit,610,END=630) line ! read extra line
endif endif
contInts = IO_continuousIntValues& ! get affected elements contInts = IO_continuousIntValues& ! get affected elements
(fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets)
do i = 1_pInt,contInts(1) do i = 1_pInt,contInts(1)
e = mesh_FEasCP('elem',contInts(1_pInt+i)) e = mesh_FEasCP('elem',contInts(1_pInt+i))
mesh_element(1_pInt+sv,e) = myVal mesh_element(1_pInt+sv,e) = myVal
enddo enddo
if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style
read (fileUnit,610,END=630) line read (fileUnit,610,END=630) line
myPos(1:1+2*1) = IO_stringPos(line,1_pInt) myPos(1:1+2*1) = IO_stringPos(line,1_pInt)
enddo enddo
@ -3368,7 +3405,7 @@ subroutine mesh_abaqus_map_elements(fileUnit)
endselect endselect
enddo enddo
660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems 660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems
if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt)
@ -3827,10 +3864,10 @@ subroutine mesh_build_nodeTwins
maximumNode, & maximumNode, &
n1, & n1, &
n2 n2
integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes
real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension
tolerance ! tolerance below which positions are assumed identical tolerance ! tolerance below which positions are assumed identical
real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates
logical, dimension(mesh_Nnodes) :: unpaired logical, dimension(mesh_Nnodes) :: unpaired
allocate(mesh_nodeTwins(3,mesh_Nnodes)) allocate(mesh_nodeTwins(3,mesh_Nnodes))
@ -3838,8 +3875,8 @@ subroutine mesh_build_nodeTwins
tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal
do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z
if (mesh_periodicSurface(dir)) then ! only if periodicity is requested if (mesh_periodicSurface(dir)) then ! only if periodicity is requested
!*** find out which nodes sit on the surface !*** find out which nodes sit on the surface
@ -3849,7 +3886,7 @@ subroutine mesh_build_nodeTwins
maximumNodes = 0_pInt maximumNodes = 0_pInt
minCoord = minval(mesh_node0(dir,:)) minCoord = minval(mesh_node0(dir,:))
maxCoord = maxval(mesh_node0(dir,:)) maxCoord = maxval(mesh_node0(dir,:))
do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes
if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then
minimumNodes(1) = minimumNodes(1) + 1_pInt minimumNodes(1) = minimumNodes(1) + 1_pInt
minimumNodes(minimumNodes(1)+1_pInt) = node minimumNodes(minimumNodes(1)+1_pInt) = node
@ -3869,10 +3906,10 @@ subroutine mesh_build_nodeTwins
do n2 = 1_pInt,maximumNodes(1) do n2 = 1_pInt,maximumNodes(1)
maximumNode = maximumNodes(n2+1_pInt) maximumNode = maximumNodes(n2+1_pInt)
distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode))
if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance)
mesh_nodeTwins(dir,minimumNode) = maximumNode mesh_nodeTwins(dir,minimumNode) = maximumNode
mesh_nodeTwins(dir,maximumNode) = minimumNode mesh_nodeTwins(dir,maximumNode) = minimumNode
unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again
exit exit
endif endif
enddo enddo
@ -4146,15 +4183,15 @@ subroutine mesh_tell_statistics
myDebug = debug_level(debug_mesh) myDebug = debug_level(debug_mesh)
if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified
if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified
allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2))); mesh_HomogMicro = 0_pInt allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2))); mesh_HomogMicro = 0_pInt
do e = 1_pInt,mesh_NcpElems do e = 1_pInt,mesh_NcpElems
if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified
if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified
mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = &
mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure
enddo enddo
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) then if (iand(myDebug,debug_levelBasic) /= 0_pInt) then
@ -4173,8 +4210,8 @@ enddo
write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))'
write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2))
write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))'
do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations
write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures
enddo enddo
write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS'
write(6,*) 'periodic surface : ', mesh_periodicSurface write(6,*) 'periodic surface : ', mesh_periodicSurface