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

moved public data res,size and homog from mesh to DAMASK_spectral_utilities (as grid and geomSize)

This commit is contained in:
Martin Diehl 2013-05-08 15:52:29 +00:00
parent 7ef0ba688a
commit 85d4a37d95
9 changed files with 533 additions and 537 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
code/DAMASK_spectral_driver.f90
View File

@ -51,12 +51,13 @@ program DAMASK_spectral_Driver
IO_read_jobBinaryFile, & IO_read_jobBinaryFile, &
IO_write_jobBinaryFile, & IO_write_jobBinaryFile, &
IO_intOut, & IO_intOut, &
IO_warning IO_warning, &
IO_timeStamp
use debug, only: &
debug_level, &
debug_spectral, &
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 : &
res, &
geomdim, &
mesh_NcpElems
use CPFEM, only: & use CPFEM, only: &
CPFEM_initAll CPFEM_initAll
use FEsolving, only: & use FEsolving, only: &
@ -71,10 +72,10 @@ 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, &
debugGeneral, &
debugDivergence, &
cutBack cutBack
use DAMASK_spectral_SolverBasic use DAMASK_spectral_SolverBasic
#ifdef PETSc #ifdef PETSc
@ -150,8 +151,9 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init DAMASK (all modules) ! init DAMASK (all modules)
call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt) call CPFEM_initAll(temperature = 300.0_pReal, element = 1_pInt, IP= 1_pInt)
write(6,'(/,a)') ' <<<+- DAMASK_spectral_driver init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_spectral_driver init -+>>>'
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -327,7 +329,8 @@ program DAMASK_spectral_Driver
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(debugDivergence) call IO_warning(42_pInt, ext_msg='debug Divergence') if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call AL_init(loadCases(1)%temperature) call AL_init(loadCases(1)%temperature)
#endif #endif
case default case default
@ -349,10 +352,10 @@ program DAMASK_spectral_Driver
write(resUnit) 'load', trim(loadCaseFile) ! ... and write header write(resUnit) 'load', trim(loadCaseFile) ! ... and write header
write(resUnit) 'workingdir', trim(getSolverWorkingDirectoryName()) write(resUnit) 'workingdir', trim(getSolverWorkingDirectoryName())
write(resUnit) 'geometry', trim(geometryFile) write(resUnit) 'geometry', trim(geometryFile)
!write(resUnit) 'grid', res !write(resUnit) 'grid', grid
!write(resUnit) 'size', geomdim !write(resUnit) 'size', geomSize
write(resUnit) 'resolution', res write(resUnit) 'resolution', grid
write(resUnit) 'dimension', geomdim write(resUnit) 'dimension', geomSize
write(resUnit) 'materialpoint_sizeResults', materialpoint_sizeResults write(resUnit) 'materialpoint_sizeResults', materialpoint_sizeResults
write(resUnit) 'loadcases', size(loadCases) write(resUnit) 'loadcases', size(loadCases)
write(resUnit) 'frequencies', loadCases%outputfrequency ! one entry per currentLoadCase write(resUnit) 'frequencies', loadCases%outputfrequency ! one entry per currentLoadCase
@ -361,11 +364,12 @@ program DAMASK_spectral_Driver
write(resUnit) 'increments', loadCases%incs ! one entry per currentLoadCase write(resUnit) 'increments', loadCases%incs ! one entry per currentLoadCase
write(resUnit) 'startingIncrement', restartInc - 1_pInt ! start with writing out the previous inc write(resUnit) 'startingIncrement', restartInc - 1_pInt ! start with writing out the previous inc
write(resUnit) 'eoh' ! end of header write(resUnit) 'eoh' ! end of header
write(resUnit) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:mesh_NcpElems) ! initial (non-deformed or read-in) results write(resUnit) materialpoint_results(1_pInt:materialpoint_sizeResults,1,1_pInt:product(grid)) ! initial (non-deformed or read-in) results
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE') '.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (debugGeneral) write(6,'(/,a)') ' header of result file written out' if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result file written out'
flush(6) flush(6)
endif endif

6
code/DAMASK_spectral_interface.f90
View File

@ -250,7 +250,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
endif endif
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it
/= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep
!here check if exists and use chdir! !> @ToDO here check if exists and use chdir!
else ! using path to geometry file as working dir else ! using path to geometry file as working dir
if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.))
@ -383,8 +383,8 @@ function rectifyPath(path)
l = len_trim(path) l = len_trim(path)
rectifyPath = path rectifyPath = path
do i = l,3,-1 do i = l,3,-1
if ( rectifyPath(i-1:i) == '.'//pathSep .and. rectifyPath(i-2:i-2) /= '.' ) & if ( rectifyPath(i-1:i) == '.'//pathSep .and. rectifyPath(i-2:i-2) /= '.' ) &
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
enddo enddo
!remove ../ and corresponding directory from rectifyPath !remove ../ and corresponding directory from rectifyPath

127
code/DAMASK_spectral_solverAL.f90
View File

@ -94,22 +94,22 @@ module DAMASK_spectral_solverAL
AL_solution, & AL_solution, &
AL_destroy AL_destroy
external :: & external :: &
VecDestroy, & VecDestroy, &
DMDestroy, & DMDestroy, &
DMDACreate3D, & DMDACreate3D, &
DMCreateGlobalVector, & DMCreateGlobalVector, &
DMDASetLocalFunction, & DMDASetLocalFunction, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, & SNESDestroy, &
SNESGetNumberFunctionEvals, & SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, & SNESGetIterationNumber, &
SNESSolve, & SNESSolve, &
SNESSetDM, & SNESSetDM, &
SNESGetConvergedReason, & SNESGetConvergedReason, &
SNESSetConvergenceTest, & SNESSetConvergenceTest, &
SNESSetFromOptions, & SNESSetFromOptions, &
SNESCreate, & SNESCreate, &
MPI_Abort MPI_Abort
contains contains
@ -119,9 +119,14 @@ contains
subroutine AL_init(temperature) subroutine AL_init(temperature)
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: &
IO_intOut, &
IO_read_JobBinaryFile, & IO_read_JobBinaryFile, &
IO_write_JobBinaryFile, & IO_write_JobBinaryFile, &
IO_timeStamp IO_timeStamp
use debug, only : &
debug_level, &
debug_spectral, &
debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use DAMASK_interface, only: & use DAMASK_interface, only: &
@ -130,14 +135,12 @@ subroutine AL_init(temperature)
Utilities_init, & Utilities_init, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
debugRestart grid, &
geomSize, &
wgt
use numerics, only: & use numerics, only: &
petsc_options petsc_options
use mesh, only: & use mesh, only: &
res, &
geomdim, &
wgt, &
mesh_NcpElems, &
mesh_ipCoordinates, & mesh_ipCoordinates, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
use math, only: & use math, only: &
@ -148,7 +151,7 @@ subroutine AL_init(temperature)
temperature temperature
#include <finclude/petscdmda.h90> #include <finclude/petscdmda.h90>
#include <finclude/petscsnes.h90> #include <finclude/petscsnes.h90>
real(pReal), dimension(3,3, res(1), res(2),res(3)) :: P real(pReal), dimension(:,:,:,:,:), allocatable :: P
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
real(pReal), dimension(3,3,3,3) :: & real(pReal), dimension(3,3,3,3) :: &
@ -164,18 +167,21 @@ subroutine AL_init(temperature)
write(6,'(a)') ' $Id: DAMASK_spectral_SolverAL.f90 1654 2012-08-03 09:25:48Z MPIE\m.diehl $' write(6,'(a)') ' $Id: DAMASK_spectral_SolverAL.f90 1654 2012-08-03 09:25:48Z MPIE\m.diehl $'
write(6,'(a16,a)') ' Current time : ',IO_timeStamp() write(6,'(a16,a)') ' Current time : ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
allocate (F_lastInc (3,3, res(1), res(2),res(3)), source = 0.0_pReal) allocate (P (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
allocate (Fdot (3,3, res(1), res(2),res(3)), source = 0.0_pReal) !< @Todo sourced allocation allocate(Fdot,source = F_lastInc) !--------------------------------------------------------------------------------------------------
allocate (F_tau_lastInc(3,3, res(1), res(2),res(3)), source = 0.0_pReal) ! allocate global fields
allocate (F_tauDot(3,3, res(1), res(2),res(3)), source = 0.0_pReal) allocate (F_lastInc (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal) !< @Todo sourced allocation allocate(Fdot,source = F_lastInc)
allocate (Fdot (3,3,grid(1),grid(2),grid(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,grid(1),grid(2),grid(3)),source = 0.0_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, & call DMDACreate3d(PETSC_COMM_WORLD, &
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, & DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, &
DMDA_STENCIL_BOX,res(1),res(2),res(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, & DMDA_STENCIL_BOX,grid(1),grid(2),grid(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, &
18,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr) 18,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
@ -191,13 +197,14 @@ subroutine AL_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,res(1)),4,res(2)),5,res(3)) ! initialize to identity F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity
F_tau_lastInc = F_lastInc F_tau_lastInc = F_lastInc
F = reshape(F_lastInc,[9,res(1),res(2),res(3)]) F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)])
F_tau = F F_tau = F
elseif (restartInc > 1_pInt) then ! using old values from file elseif (restartInc > 1_pInt) then
if (debugRestart) write(6,'(/,a,i6,a)') ' reading values of increment ',& if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
restartInc - 1_pInt,' from file' write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading values of increment', restartInc - 1_pInt, 'from file'
flush(6) flush(6)
call IO_read_jobBinaryFile(777,'F',& call IO_read_jobBinaryFile(777,'F',&
trim(getSolverJobName()),size(F)) trim(getSolverJobName()),size(F))
@ -230,8 +237,8 @@ subroutine AL_init(temperature)
read (777,rec=1) C_minmaxAvg read (777,rec=1) C_minmaxAvg
close (777) close (777)
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(&
F,[3,3,res(1),res(2),res(3)])),[3,1,mesh_NcpElems]) F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
call Utilities_constitutiveResponse(F,F,temperature,0.0_pReal,P,temp3333_Real,temp3333_Real2,& call Utilities_constitutiveResponse(F,F,temperature,0.0_pReal,P,temp3333_Real,temp3333_Real2,&
temp33_Real,.false.,math_I3) temp33_Real,.false.,math_I3)
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr)
@ -263,14 +270,13 @@ type(tSolutionState) function &
math_rotate_backward33, & math_rotate_backward33, &
math_invSym3333 math_invSym3333
use mesh, only: & use mesh, only: &
res, &
geomdim, &
mesh_NcpElems, &
mesh_ipCoordinates, & mesh_ipCoordinates, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
use IO, only: & use IO, only: &
IO_write_JobBinaryFile IO_write_JobBinaryFile
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
tBoundaryCondition, & tBoundaryCondition, &
Utilities_forwardField, & Utilities_forwardField, &
Utilities_calculateRate, & Utilities_calculateRate, &
@ -342,8 +348,8 @@ use mesh, only: &
if ( cutBack) then if ( cutBack) then
F_aim = F_aim_lastInc F_aim = F_aim_lastInc
F_tau= reshape(F_tau_lastInc,[9,res(1),res(2),res(3)]) F_tau= reshape(F_tau_lastInc,[9,grid(1),grid(2),grid(3)])
F = reshape(F_lastInc,[9,res(1),res(2),res(3)]) F = reshape(F_lastInc, [9,grid(1),grid(2),grid(3)])
C = C_lastInc C = C_lastInc
else else
C_lastInc = C C_lastInc = C
@ -359,23 +365,23 @@ use mesh, only: &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update coordinates and rate and forward last inc ! update coordinates and rate and forward last inc
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(&
F,[3,3,res(1),res(2),res(3)])),[3,1,mesh_NcpElems]) 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,res(1),res(2),res(3)])) timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)]))
F_tauDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & F_tauDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), &
timeinc_old,guess,F_tau_lastInc,reshape(F_tau,[3,3,res(1),res(2),res(3)])) timeinc_old,guess,F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid(3)]))
F_lastInc = reshape(F, [3,3,res(1),res(2),res(3)]) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid(3)])
F_tau_lastInc = reshape(F_tau,[3,3,res(1),res(2),res(3)]) F_tau_lastInc = reshape(F_tau,[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,res(1),res(2),res(3)]) math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid(3)])
F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), [9,res(1),res(2),res(3)]) ! does not have any average value as boundary condition 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
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
@ -422,22 +428,25 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
itmin, & itmin, &
polarAlpha, & polarAlpha, &
polarBeta polarBeta
use IO, only: &
IO_intOut
use math, only: & use math, only: &
math_rotate_backward33, & math_rotate_backward33, &
math_transpose33, & math_transpose33, &
math_mul3333xx33, & math_mul3333xx33, &
math_invSym3333 math_invSym3333
use mesh, only: &
res, &
wgt
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
wgt, &
field_real, & field_real, &
Utilities_FFTforward, & Utilities_FFTforward, &
Utilities_fourierConvolution, & Utilities_fourierConvolution, &
Utilities_FFTbackward, & Utilities_FFTbackward, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse
debugRotation use debug, only: &
use IO, only: IO_intOut debug_level, &
debug_spectral, &
debug_spectralRotation
use homogenization, only: & use homogenization, only: &
materialpoint_P, & materialpoint_P, &
materialpoint_dPdF materialpoint_dPdF
@ -490,7 +499,7 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
if (callNo == 0 .or. mod(callNo,2) == 1_pInt) then if (callNo == 0 .or. mod(callNo,2) == 1_pInt) then
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',reportIter, '≤', itmax ' @ Iteration ', itmin, '≤',reportIter, '≤', itmax
if (debugRotation) & 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 =', &
@ -503,7 +512,7 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! !
field_real = 0.0_pReal field_real = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1)
field_real(i,j,k,1:3,1:3) = math_mul3333xx33(C_scale,(polarAlpha + polarBeta)*F(1:3,1:3,i,j,k) - & field_real(i,j,k,1:3,1:3) = math_mul3333xx33(C_scale,(polarAlpha + polarBeta)*F(1:3,1:3,i,j,k) - &
(polarAlpha)*F_tau(1:3,1:3,i,j,k)) (polarAlpha)*F_tau(1:3,1:3,i,j,k))
enddo; enddo; enddo enddo; enddo; enddo
@ -516,8 +525,8 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
residual_F_tau = polarBeta*F - reshape(field_real(1:res(1),1:res(2),1:res(3),1:3,1:3),& residual_F_tau = polarBeta*F - reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),&
[3,3,res(1),res(2),res(3)],order=[3,4,5,1,2]) [3,3,grid(1),grid(2),grid(3)],order=[3,4,5,1,2])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! evaluate constitutive response ! evaluate constitutive response
@ -534,7 +543,7 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
! constructing residual ! constructing residual
n_ele = 0_pInt n_ele = 0_pInt
err_p = 0.0_pReal err_p = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1) do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid(1)
n_ele = n_ele + 1_pInt n_ele = n_ele + 1_pInt
err_p = err_p + sum((math_mul3333xx33(S_scale,residual_F(1:3,1:3,i,j,k)) - & err_p = err_p + sum((math_mul3333xx33(S_scale,residual_F(1:3,1:3,i,j,k)) - &
(F_tau(1:3,1:3,i,j,k) - & (F_tau(1:3,1:3,i,j,k) - &

61
code/DAMASK_spectral_solverBasic.f90
View File

@ -73,6 +73,10 @@ subroutine basic_init(temperature)
IO_write_JobBinaryFile, & IO_write_JobBinaryFile, &
IO_intOut, & IO_intOut, &
IO_timeStamp IO_timeStamp
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use DAMASK_interface, only: & use DAMASK_interface, only: &
@ -81,20 +85,17 @@ subroutine basic_init(temperature)
Utilities_init, & Utilities_init, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
debugRestart grid, &
use mesh, only: &
res, &
wgt, & wgt, &
geomdim, & geomSize
scaledDim, & use mesh, only: &
mesh_ipCoordinates, & mesh_ipCoordinates, &
mesh_NcpElems, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
implicit none implicit none
real(pReal), intent(inout) :: & real(pReal), intent(inout) :: &
temperature temperature
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: P real(pReal), dimension(:,:,:,:,:), allocatable :: P
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
real(pReal), dimension(3,3,3,3) :: & real(pReal), dimension(3,3,3,3) :: &
@ -105,22 +106,23 @@ subroutine basic_init(temperature)
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,3(f12.5)/)') ' scaledDim x y z:', scaledDim
allocate (P (3,3,grid(1), grid(2),grid(3)), source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
allocate (F (3,3,res(1), res(2),res(3)), source = 0.0_pReal) allocate (F (3,3,grid(1), grid(2),grid(3)), source = 0.0_pReal)
allocate (F_lastInc (3,3,res(1), res(2),res(3)), source = 0.0_pReal) allocate (F_lastInc (3,3,grid(1), grid(2),grid(3)), source = 0.0_pReal)
allocate (Fdot (3,3,res(1), res(2),res(3)), source = 0.0_pReal) allocate (Fdot (3,3,grid(1), grid(2),grid(3)), source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! init fields and average quantities ! init fields and average quantities
if (restartInc == 1_pInt) then ! no deformation (no restart) if (restartInc == 1_pInt) then ! no deformation (no restart)
F = spread(spread(spread(math_I3,3,res(1)),4,res(2)),5,res(3)) ! initialize to identity F = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity
F_lastInc = F F_lastInc = F
elseif (restartInc > 1_pInt) then ! using old values from file elseif (restartInc > 1_pInt) then ! using old values from file
if (debugRestart) write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
'reading values of increment', restartInc - 1_pInt, 'from file' write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading values of increment', restartInc - 1_pInt, 'from file'
flush(6) flush(6)
call IO_read_jobBinaryFile(777,'F',& call IO_read_jobBinaryFile(777,'F',&
trim(getSolverJobName()),size(F)) trim(getSolverJobName()),size(F))
@ -147,8 +149,9 @@ subroutine basic_init(temperature)
read (777,rec=1) temp3333_Real read (777,rec=1) temp3333_Real
close (777) close (777)
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,F),[3,1,mesh_NcpElems]) mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,F),[3,1,product(grid)])
call Utilities_constitutiveResponse(F,F,temperature,0.0_pReal,P,C,C_minmaxAvg,temp33_Real,.false.,math_I3) ! constitutive response with no deformation in no time to get reference stiffness call Utilities_constitutiveResponse(F,F,temperature,0.0_pReal,P,C,C_minmaxAvg,&
temp33_Real,.false.,math_I3) ! constitutive response with no deformation in no time to get reference stiffness
if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness
temp3333_Real = C_minmaxAvg temp3333_Real = C_minmaxAvg
endif endif
@ -173,15 +176,15 @@ type(tSolutionState) function &
math_transpose33, & math_transpose33, &
math_mul3333xx33 math_mul3333xx33
use mesh, only: & use mesh, only: &
res,&
geomdim, &
wgt, &
mesh_ipCoordinates,& mesh_ipCoordinates,&
mesh_NcpElems, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
use IO, only: & use IO, only: &
IO_write_JobBinaryFile, & IO_write_JobBinaryFile, &
IO_intOut IO_intOut
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRotation
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
tBoundaryCondition, & tBoundaryCondition, &
field_real, & field_real, &
@ -194,7 +197,9 @@ type(tSolutionState) function &
Utilities_updateGamma, & Utilities_updateGamma, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_calculateRate, & Utilities_calculateRate, &
debugRotation grid,&
geomSize, &
wgt
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
restartRead, & restartRead, &
@ -224,7 +229,7 @@ type(tSolutionState) function &
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
F_aim_lastIter, & !< aim of last iteration F_aim_lastIter, & !< aim of last iteration
P_av P_av
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: P real(pReal), dimension(3,3,grid(1),grid(2),grid(3)) :: P
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! loop variables, convergence etc. ! loop variables, convergence etc.
real(pReal) :: err_div, err_stress real(pReal) :: err_div, err_stress
@ -261,7 +266,7 @@ type(tSolutionState) function &
C = C_lastInc C = C_lastInc
else else
C_lastInc = C C_lastInc = C
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,F),[3,1,mesh_NcpElems]) mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,F),[3,1,product(grid)])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate rate for aim ! calculate rate for aim
@ -298,7 +303,7 @@ type(tSolutionState) function &
! report begin of new iteration ! report begin of new iteration
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',iter, '≤', itmax ' @ Iteration ', itmin, '≤',iter, '≤', itmax
if (debugRotation) & 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,rotation_BC)) math_transpose33(math_rotate_backward33(F_aim,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 =', &
@ -322,13 +327,13 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 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_real = 0.0_pReal
field_real(1:res(1),1:res(2),1:res(3),1:3,1:3) = reshape(P,[res(1),res(2),res(3),3,3],& field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3) = reshape(P,[grid(1),grid(2),grid(3),3,3],&
order=[4,5,1,2,3]) ! field real has a different order order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward() call Utilities_FFTforward()
err_div = Utilities_divergenceRMS() err_div = Utilities_divergenceRMS()
call Utilities_fourierConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,rotation_BC)) call Utilities_fourierConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,rotation_BC))
call Utilities_FFTbackward() call Utilities_FFTbackward()
F = F - reshape(field_real(1:res(1),1:res(2),1:res(3),1:3,1:3),shape(F),order=[3,4,5,1,2]) ! F(x)^(n+1) = F(x)^(n) + correction; *wgt: correcting for missing normalization F = F - reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),shape(F),order=[3,4,5,1,2]) ! F(x)^(n+1) = F(x)^(n) + correction; *wgt: correcting for missing normalization
basic_solution%converged = basic_Converged(err_div,P_av,err_stress,P_av) basic_solution%converged = basic_Converged(err_div,P_av,err_stress,P_av)
write(6,'(/,a)') ' ==========================================================================' write(6,'(/,a)') ' =========================================================================='
flush(6) flush(6)
@ -368,7 +373,7 @@ logical function basic_Converged(err_div,pAvgDiv,err_stress,pAvgStress)
err_stress_tol, & err_stress_tol, &
pAvgDivL2 pAvgDivL2
pAvgDivL2 = sqrt(maxval(math_eigenvalues33(math_mul33x33(pAvgDiv,math_transpose33(pAvgDiv))))) ! L_2 norm of average stress (http://mathworld.wolfram.com/SpectralNorm.html) pAvgDivL2 = sqrt(maxval(math_eigenvalues33(math_mul33x33(pAvgDiv,math_transpose33(pAvgDiv))))) ! L_2 norm of average stress (http://mathworld.wolfram.com/SpectralNorm.html)
err_stress_tol = max(maxval(abs(pAvgStress))*err_stress_tolrel,err_stress_tolabs) err_stress_tol = max(maxval(abs(pAvgStress))*err_stress_tolrel,err_stress_tolabs)
basic_Converged = all([ err_div/pAvgDivL2/err_div_tol,& basic_Converged = all([ err_div/pAvgDivL2/err_div_tol,&

119
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -84,22 +84,22 @@ module DAMASK_spectral_SolverBasicPETSc
basicPETSc_solution ,& basicPETSc_solution ,&
basicPETSc_destroy basicPETSc_destroy
external :: & external :: &
VecDestroy, & VecDestroy, &
DMDestroy, & DMDestroy, &
DMDACreate3D, & DMDACreate3D, &
DMCreateGlobalVector, & DMCreateGlobalVector, &
DMDASetLocalFunction, & DMDASetLocalFunction, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, & SNESDestroy, &
SNESGetNumberFunctionEvals, & SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, & SNESGetIterationNumber, &
SNESSolve, & SNESSolve, &
SNESSetDM, & SNESSetDM, &
SNESGetConvergedReason, & SNESGetConvergedReason, &
SNESSetConvergenceTest, & SNESSetConvergenceTest, &
SNESSetFromOptions, & SNESSetFromOptions, &
SNESCreate, & SNESCreate, &
MPI_Abort MPI_Abort
contains contains
@ -111,7 +111,12 @@ subroutine basicPETSc_init(temperature)
use IO, only: & use IO, only: &
IO_read_JobBinaryFile, & IO_read_JobBinaryFile, &
IO_write_JobBinaryFile, & IO_write_JobBinaryFile, &
IO_intOut, &
IO_timeStamp IO_timeStamp
use debug, only: &
debug_level, &
debug_spectral, &
debug_spectralRestart
use FEsolving, only: & use FEsolving, only: &
restartInc restartInc
use DAMASK_interface, only: & use DAMASK_interface, only: &
@ -120,15 +125,12 @@ subroutine basicPETSc_init(temperature)
Utilities_init, & Utilities_init, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
debugRestart grid, &
wgt, &
geomSize
use numerics, only: & use numerics, only: &
petsc_options petsc_options
use mesh, only: & use mesh, only: &
res, &
wgt, &
geomdim, &
scaledDim, &
mesh_NcpElems, &
mesh_ipCoordinates, & mesh_ipCoordinates, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
use math, only: & use math, only: &
@ -139,7 +141,7 @@ subroutine basicPETSc_init(temperature)
temperature temperature
#include <finclude/petscdmda.h90> #include <finclude/petscdmda.h90>
#include <finclude/petscsnes.h90> #include <finclude/petscsnes.h90>
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: P real(pReal), dimension(:,:,:,:,:), allocatable :: P
PetscScalar, dimension(:,:,:,:), pointer :: F PetscScalar, dimension(:,:,:,:), pointer :: F
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
@ -153,19 +155,19 @@ subroutine basicPETSc_init(temperature)
write(6,'(a)') ' $Id: DAMASK_spectral_SolverBasicPETSC.f90 1654 2012-08-03 09:25:48Z MPIE\m.diehl $' write(6,'(a)') ' $Id: DAMASK_spectral_SolverBasicPETSC.f90 1654 2012-08-03 09:25:48Z MPIE\m.diehl $'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,3(f12.5)/)') ' scaledDim x y z:', scaledDim
allocate (P (3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
allocate (F_lastInc(3,3,res(1),res(2),res(3)), source = 0.0_pReal) allocate (F_lastInc(3,3,grid(1),grid(2),grid(3)),source = 0.0_pReal)
allocate (Fdot (3,3,res(1),res(2),res(3)), source = 0.0_pReal) allocate (Fdot (3,3,grid(1),grid(2),grid(3)),source = 0.0_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)
call DMDACreate3d(PETSC_COMM_WORLD, & call DMDACreate3d(PETSC_COMM_WORLD, &
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, & DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, &
DMDA_STENCIL_BOX,res(1),res(2),res(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, & DMDA_STENCIL_BOX,grid(1),grid(2),grid(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, &
9,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr) 9,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
@ -180,11 +182,12 @@ 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,res(1)),4,res(2)),5,res(3)) ! initialize to identity F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid(3)) ! initialize to identity
F = reshape(F_lastInc,[9,res(1),res(2),res(3)]) F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)])
elseif (restartInc > 1_pInt) then ! using old values from file elseif (restartInc > 1_pInt) then ! using old values from file
if (debugRestart) write(6,'(/,a,i6,a)') ' reading values of increment ',& if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
restartInc - 1_pInt,' from file' write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading values of increment', restartInc - 1_pInt, 'from file'
flush(6) flush(6)
call IO_read_jobBinaryFile(777,'F',& call IO_read_jobBinaryFile(777,'F',&
trim(getSolverJobName()),size(F)) trim(getSolverJobName()),size(F))
@ -210,12 +213,12 @@ subroutine basicPETSc_init(temperature)
read (777,rec=1) temp3333_Real read (777,rec=1) temp3333_Real
close (777) close (777)
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(&
F,[3,3,res(1),res(2),res(3)])),[3,1,mesh_NcpElems]) F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
call Utilities_constitutiveResponse(& call Utilities_constitutiveResponse(&
reshape(F(0:8,0:res(1)-1_pInt,0:res(2)-1_pInt,0:res(3)-1_pInt),[3,3,res(1),res(2),res(3)]),& 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)]),&
reshape(F(0:8,0:res(1)-1_pInt,0:res(2)-1_pInt,0:res(3)-1_pInt),[3,3,res(1),res(2),res(3)]),& 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,0.0_pReal,P,C,C_minmaxAvg,temp33_Real,.false.,math_I3) temperature,0.0_pReal,P,C,C_minmaxAvg,temp33_Real,.false.,math_I3)
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back into PETSc call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back into PETSc
if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness
temp3333_Real = C_minmaxAvg temp3333_Real = C_minmaxAvg
@ -237,14 +240,13 @@ type(tSolutionState) function &
math_mul33x33 ,& math_mul33x33 ,&
math_rotate_backward33 math_rotate_backward33
use mesh, only: & use mesh, only: &
res,&
geomdim,&
mesh_ipCoordinates,& mesh_ipCoordinates,&
mesh_NcpElems, &
mesh_deformedCoordsFFT mesh_deformedCoordsFFT
use IO, only: & use IO, only: &
IO_write_JobBinaryFile IO_write_JobBinaryFile
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
geomSize, &
tBoundaryCondition, & tBoundaryCondition, &
Utilities_calculateRate, & Utilities_calculateRate, &
Utilities_forwardField, & Utilities_forwardField, &
@ -295,16 +297,16 @@ type(tSolutionState) function &
write (777,rec=1) C_lastInc write (777,rec=1) C_lastInc
close(777) close(777)
endif endif
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(&
F,[3,3,res(1),res(2),res(3)])),[3,1,mesh_NcpElems]) 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 = reshape(F_lastInc,[9,res(1),res(2),res(3)]) F = reshape(F_lastInc,[9,grid(1),grid(2),grid(3)])
C = C_lastInc C = C_lastInc
else else
C_lastInc = C C_lastInc = C
mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(& mesh_ipCoordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(&
F,[3,3,res(1),res(2),res(3)])),[3,1,mesh_NcpElems]) F,[3,3,grid(1),grid(2),grid(3)])),[3,1,product(grid)])
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate rate for aim ! calculate rate for aim
@ -319,13 +321,13 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update rate and forward last inc ! update rate and forward last inc
Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,params%rotation_BC), & Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,params%rotation_BC), &
timeinc_old,guess,F_lastInc,reshape(F,[3,3,res(1),res(2),res(3)])) timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid(3)]))
F_lastInc = reshape(F,[3,3,res(1),res(2),res(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
F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot,math_rotate_backward33(F_aim, & F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot,math_rotate_backward33(F_aim, &
rotation_BC)),[9,res(1),res(2),res(3)]) rotation_BC)),[9,grid(1),grid(2),grid(3)])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -370,23 +372,26 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
math_rotate_backward33, & math_rotate_backward33, &
math_transpose33, & math_transpose33, &
math_mul3333xx33 math_mul3333xx33
use mesh, only: & use debug, only: &
res, & debug_level, &
wgt debug_spectral, &
debug_spectralRotation
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
grid, &
wgt, &
field_real, & field_real, &
Utilities_FFTforward, & Utilities_FFTforward, &
Utilities_FFTbackward, & Utilities_FFTbackward, &
Utilities_fourierConvolution, & Utilities_fourierConvolution, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_divergenceRMS, & Utilities_divergenceRMS
debugRotation use IO, only: &
use IO, only : IO_intOut IO_intOut
implicit none implicit none
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, dimension(3,3,res(1),res(2),res(3)) :: & PetscScalar, dimension(3,3,grid(1),grid(2),grid(3)) :: &
x_scal, & x_scal, &
f_scal f_scal
PetscInt :: & PetscInt :: &
@ -408,7 +413,7 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
if (callNo == 0 .or. mod(callNo,2) == 1_pInt) then if (callNo == 0 .or. mod(callNo,2) == 1_pInt) then
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
' @ Iteration ', itmin, '≤',reportIter, '≤', itmax ' @ Iteration ', itmin, '≤',reportIter, '≤', itmax
if (debugRotation) & 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 =', &
@ -433,7 +438,7 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! 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_real = 0.0_pReal
field_real(1:res(1),1:res(2),1:res(3),1:3,1:3) = reshape(f_scal,[res(1),res(2),res(3),3,3],& 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 order=[4,5,1,2,3]) ! field real has a different order
call Utilities_FFTforward() call Utilities_FFTforward()
err_div = Utilities_divergenceRMS() err_div = Utilities_divergenceRMS()
@ -442,7 +447,7 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! constructing residual ! constructing residual
f_scal = reshape(field_real(1:res(1),1:res(2),1:res(3),1:3,1:3),shape(x_scal),order=[3,4,5,1,2]) f_scal = reshape(field_real(1:grid(1),1:grid(2),1:grid(3),1:3,1:3),shape(x_scal),order=[3,4,5,1,2])
end subroutine BasicPETSc_formResidual end subroutine BasicPETSc_formResidual

295
code/DAMASK_spectral_utilities.f90
View File

@ -36,14 +36,21 @@ module DAMASK_spectral_utilities
#include <finclude/petscsys.h> #include <finclude/petscsys.h>
#endif #endif
logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
!--------------------------------------------------------------------------------------------------
! grid related information information
integer(pInt), public, dimension(3) :: grid !< grid points as specified in geometry file
real(pReal), public :: wgt !< weighting factor 1/Nelems
real(pReal), public, dimension(3) :: geomSize !< size of geometry as specified in geometry file
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables storing information for spectral method and FFTW ! variables storing information for spectral method and FFTW
integer(pInt), public :: grid1Red !< grid(1)/2
real(pReal), public, dimension(:,:,:,:,:), pointer :: field_real !< real representation (some stress or deformation) of field_fourier real(pReal), public, dimension(:,:,:,:,:), pointer :: field_real !< real representation (some stress or deformation) of field_fourier
complex(pReal),private, dimension(:,:,:,:,:), pointer :: field_fourier !< field on which the Fourier transform operates complex(pReal),private, dimension(:,:,:,:,:), pointer :: field_fourier !< field on which the Fourier transform operates
real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method real(pReal), private, dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method
real(pReal), private, dimension(:,:,:,:), allocatable :: xi !< wave vector field for divergence and for gamma operator real(pReal), private, dimension(:,:,:,:), allocatable :: xi !< wave vector field for divergence and for gamma operator
real(pReal), private, dimension(3,3,3,3) :: C_ref !< reference stiffness real(pReal), private, dimension(3,3,3,3) :: C_ref !< reference stiffness
real(pReal), private, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence (Basic, Basic PETSc)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! debug fftw ! debug fftw
@ -66,10 +73,9 @@ module DAMASK_spectral_utilities
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables controlling debugging ! variables controlling debugging
logical, public :: & logical, private :: &
debugGeneral, & !< general debugging of spectral solver debugGeneral, & !< general debugging of spectral solver
debugDivergence, & !< debugging of divergence calculation (comparison to function used for post processing) debugDivergence, & !< debugging of divergence calculation (comparison to function used for post processing)
debugRestart, & !< debbuging of restart features
debugFFTW, & !< doing additional FFT on scalar field and compare to results of strided 3D FFT debugFFTW, & !< doing additional FFT on scalar field and compare to results of strided 3D FFT
debugRotation, & !< also printing out results in lab frame debugRotation, & !< also printing out results in lab frame
debugPETSc !< use some in debug defined options for more verbose PETSc solution debugPETSc !< use some in debug defined options for more verbose PETSc solution
@ -118,22 +124,25 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_init() subroutine utilities_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use DAMASK_interface, only: &
geometryFile
use IO, only: & use IO, only: &
IO_error, & IO_error, &
IO_warning, & IO_warning, &
IO_timeStamp IO_timeStamp, &
IO_open_file
use numerics, only: & use numerics, only: &
DAMASK_NumThreadsInt, & DAMASK_NumThreadsInt, &
fftw_planner_flag, & fftw_planner_flag, &
fftw_timelimit, & fftw_timelimit, &
memory_efficient, & memory_efficient, &
petsc_options petsc_options, &
divergence_correction
use debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_spectral, & debug_spectral, &
debug_levelBasic, & debug_levelBasic, &
debug_spectralDivergence, & debug_spectralDivergence, &
debug_spectralRestart, &
debug_spectralFFTW, & debug_spectralFFTW, &
debug_spectralPETSc, & debug_spectralPETSc, &
debug_spectralRotation debug_spectralRotation
@ -142,11 +151,10 @@ subroutine utilities_init()
debug_spectralPETSc, & debug_spectralPETSc, &
PETScDebug PETScDebug
#endif #endif
use mesh, only: &
res, &
res1_red, &
scaledDim
use math ! must use the whole module for use of FFTW use math ! must use the whole module for use of FFTW
use mesh, only: &
mesh_spectral_getSize, &
mesh_spectral_getGrid
implicit none implicit none
#ifdef PETSc #ifdef PETSc
@ -157,6 +165,7 @@ subroutine utilities_init()
PetscErrorCode :: ierr PetscErrorCode :: ierr
#endif #endif
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
integer(pInt), parameter :: fileUnit = 228_pInt
integer(pInt), dimension(3) :: k_s integer(pInt), dimension(3) :: k_s
type(C_PTR) :: & type(C_PTR) :: &
tensorField, & !< field cotaining data for FFTW in real and fourier space (in place) tensorField, & !< field cotaining data for FFTW in real and fourier space (in place)
@ -172,7 +181,6 @@ subroutine utilities_init()
! set debugging parameters ! set debugging parameters
debugGeneral = iand(debug_level(debug_spectral),debug_levelBasic) /= 0 debugGeneral = iand(debug_level(debug_spectral),debug_levelBasic) /= 0
debugDivergence = iand(debug_level(debug_spectral),debug_spectralDivergence) /= 0 debugDivergence = iand(debug_level(debug_spectral),debug_spectralDivergence) /= 0
debugRestart = iand(debug_level(debug_spectral),debug_spectralRestart) /= 0
debugFFTW = iand(debug_level(debug_spectral),debug_spectralFFTW) /= 0 debugFFTW = iand(debug_level(debug_spectral),debug_spectralFFTW) /= 0
debugRotation = iand(debug_level(debug_spectral),debug_spectralRotation) /= 0 debugRotation = iand(debug_level(debug_spectral),debug_spectralRotation) /= 0
debugPETSc = iand(debug_level(debug_spectral),debug_spectralPETSc) /= 0 debugPETSc = iand(debug_level(debug_spectral),debug_spectralPETSc) /= 0
@ -187,12 +195,41 @@ subroutine utilities_init()
call IO_warning(41_pInt, ext_msg='debug PETSc') call IO_warning(41_pInt, ext_msg='debug PETSc')
#endif #endif
call IO_open_file(fileUnit,geometryFile) ! parse info from geometry file...
grid = mesh_spectral_getGrid(fileUnit)
grid1Red = grid(1)/2_pInt + 1_pInt
wgt = 1.0/real(product(grid),pReal)
geomSize = mesh_spectral_getSize(fileUnit)
close(fileUnit)
write(6,'(a,3(i12 ))') ' grid a b c: ', grid
write(6,'(a,3(f12.5))') ' size x y z: ', geomSize
!--------------------------------------------------------------------------------------------------
! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and reso-
! lution-independent divergence
if (divergence_correction == 1_pInt) then
do j = 1_pInt, 3_pInt
if (j /= minloc(geomSize,1) .and. j /= maxloc(geomSize,1)) &
scaledGeomSize = geomSize/geomSize(j)
enddo
elseif (divergence_correction == 2_pInt) then
do j = 1_pInt, 3_pInt
if (j /= minloc(geomSize/grid,1) .and. j /= maxloc(geomSize/grid,1)) &
scaledGeomSize = geomSize/geomSize(j)*grid(j)
enddo
else
scaledGeomSize = geomSize
endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocation ! allocation
allocate (xi(3,res1_red,res(2),res(3)),source = 0.0_pReal) ! frequencies, only half the size for first dimension allocate (xi(3,grid1Red,grid(2),grid(3)),source = 0.0_pReal) ! frequencies, only half the size for first dimension
tensorField = fftw_alloc_complex(int(res1_red*res(2)*res(3)*9_pInt,C_SIZE_T)) ! allocate aligned data using a C function, C_SIZE_T is of type integer(8) tensorField = fftw_alloc_complex(int(grid1Red*grid(2)*grid(3)*9_pInt,C_SIZE_T)) ! allocate aligned data using a C function, C_SIZE_T is of type integer(8)
call c_f_pointer(tensorField, field_real, [res(1)+2_pInt-mod(res(1),2_pInt),res(2),res(3),3,3]) ! place a pointer for a real representation on tensorField call c_f_pointer(tensorField, field_real, [grid(1)+2_pInt-mod(grid(1),2_pInt),grid(2),grid(3),3,3])! place a pointer for a real representation on tensorField
call c_f_pointer(tensorField, field_fourier,[res1_red, res(2),res(3),3,3]) ! place a pointer for a complex representation on tensorField call c_f_pointer(tensorField, field_fourier,[grid1Red, grid(2),grid(3),3,3])! place a pointer for a complex representation on tensorField
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! general initialization of FFTW (see manual on fftw.org for more details) ! general initialization of FFTW (see manual on fftw.org for more details)
@ -206,41 +243,41 @@ subroutine utilities_init()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! creating plans for the convolution ! creating plans for the convolution
planForth = fftw_plan_many_dft_r2c(3,[res(3),res(2) ,res(1)], 9, & ! dimensions, logical length in each dimension in reversed order, no. of transforms planForth = fftw_plan_many_dft_r2c(3,[grid(3),grid(2) ,grid(1)], 9, & ! dimensions, logical length in each dimension in reversed order, no. of transforms
field_real,[res(3),res(2) ,res(1)+2_pInt-mod(res(1),2_pInt)], & ! input data, physical length in each dimension in reversed order field_real,[grid(3),grid(2) ,grid(1)+2_pInt-mod(grid(1),2_pInt)], & ! input data, physical length in each dimension in reversed order
1, res(3)*res(2)*(res(1)+2_pInt-mod(res(1),2_pInt)), & ! striding, product of physical length in the 3 dimensions 1, grid(3)*grid(2)*(grid(1)+2_pInt-mod(grid(1),2_pInt)), & ! striding, product of physical length in the 3 dimensions
field_fourier,[res(3),res(2) ,res1_red], & ! output data, physical length in each dimension in reversed order field_fourier,[grid(3),grid(2) ,grid1Red], & ! output data, physical length in each dimension in reversed order
1, res(3)*res(2)* res1_red, fftw_planner_flag) ! striding, product of physical length in the 3 dimensions, planner precision 1, grid(3)*grid(2)* grid1Red, fftw_planner_flag) ! striding, product of physical length in the 3 dimensions, planner precision
planBack = fftw_plan_many_dft_c2r(3,[res(3),res(2) ,res(1)], 9, & ! dimensions, logical length in each dimension in reversed order, no. of transforms planBack = fftw_plan_many_dft_c2r(3,[grid(3),grid(2) ,grid(1)], 9, & ! dimensions, logical length in each dimension in reversed order, no. of transforms
field_fourier,[res(3),res(2) ,res1_red], & ! input data, physical length in each dimension in reversed order field_fourier,[grid(3),grid(2) ,grid1Red], & ! input data, physical length in each dimension in reversed order
1, res(3)*res(2)* res1_red, & ! striding, product of physical length in the 3 dimensions 1, grid(3)*grid(2)* grid1Red, & ! striding, product of physical length in the 3 dimensions
field_real,[res(3),res(2) ,res(1)+2_pInt-mod(res(1),2_pInt)], & ! output data, physical length in each dimension in reversed order field_real,[grid(3),grid(2) ,grid(1)+2_pInt-mod(grid(1),2_pInt)], & ! output data, physical length in each dimension in reversed order
1, res(3)*res(2)*(res(1)+2_pInt-mod(res(1),2_pInt)), & ! striding, product of physical length in the 3 dimensions 1, grid(3)*grid(2)*(grid(1)+2_pInt-mod(grid(1),2_pInt)), & ! striding, product of physical length in the 3 dimensions
fftw_planner_flag) ! planner precision fftw_planner_flag) ! planner precision
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! depending on debug options, allocate more memory and create additional plans ! depending on debug options, allocate more memory and create additional plans
if (debugDivergence) then if (debugDivergence) then
div = fftw_alloc_complex(int(res1_red*res(2)*res(3)*3_pInt,C_SIZE_T)) div = fftw_alloc_complex(int(grid1Red*grid(2)*grid(3)*3_pInt,C_SIZE_T))
call c_f_pointer(div,divReal, [res(1)+2_pInt-mod(res(1),2_pInt),res(2),res(3),3]) call c_f_pointer(div,divReal, [grid(1)+2_pInt-mod(grid(1),2_pInt),grid(2),grid(3),3])
call c_f_pointer(div,divFourier,[res1_red, res(2),res(3),3]) call c_f_pointer(div,divFourier,[grid1Red, grid(2),grid(3),3])
planDiv = fftw_plan_many_dft_c2r(3,[res(3),res(2) ,res(1)],3,& planDiv = fftw_plan_many_dft_c2r(3,[grid(3),grid(2) ,grid(1)],3,&
divFourier,[res(3),res(2) ,res1_red],& divFourier,[grid(3),grid(2) ,grid1Red],&
1, res(3)*res(2)* res1_red,& 1, grid(3)*grid(2)* grid1Red,&
divReal,[res(3),res(2) ,res(1)+2_pInt-mod(res(1),2_pInt)], & divReal,[grid(3),grid(2) ,grid(1)+2_pInt-mod(grid(1),2_pInt)], &
1, res(3)*res(2)*(res(1)+2_pInt-mod(res(1),2_pInt)), & 1, grid(3)*grid(2)*(grid(1)+2_pInt-mod(grid(1),2_pInt)), &
fftw_planner_flag) fftw_planner_flag)
endif endif
if (debugFFTW) then if (debugFFTW) then
scalarField_realC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) ! allocate data for real representation (no in place transform) scalarField_realC = fftw_alloc_complex(int(product(grid),C_SIZE_T)) ! allocate data for real representation (no in place transform)
scalarField_fourierC = fftw_alloc_complex(int(res(1)*res(2)*res(3),C_SIZE_T)) ! allocate data for fourier representation (no in place transform) scalarField_fourierC = fftw_alloc_complex(int(product(grid),C_SIZE_T)) ! allocate data for fourier representation (no in place transform)
call c_f_pointer(scalarField_realC, scalarField_real, [res(1),res(2),res(3)]) ! place a pointer for a real representation call c_f_pointer(scalarField_realC, scalarField_real, grid) ! place a pointer for a real representation
call c_f_pointer(scalarField_fourierC, scalarField_fourier, [res(1),res(2),res(3)]) ! place a pointer for a fourier representation call c_f_pointer(scalarField_fourierC, scalarField_fourier, grid) ! place a pointer for a fourier representation
planDebugForth = fftw_plan_dft_3d(res(3),res(2),res(1),& ! reversed order (C style) planDebugForth = fftw_plan_dft_3d(grid(3),grid(2),grid(1),& ! reversed order (C style)
scalarField_real,scalarField_fourier,-1,fftw_planner_flag) ! input, output, forward FFT(-1), planner precision scalarField_real,scalarField_fourier,-1,fftw_planner_flag) ! input, output, forward FFT(-1), planner precision
planDebugBack = fftw_plan_dft_3d(res(3),res(2),res(1),& ! reversed order (C style) planDebugBack = fftw_plan_dft_3d(grid(3),grid(2),grid(1),& ! reversed order (C style)
scalarField_fourier,scalarField_real,+1,fftw_planner_flag) ! input, output, backward (1), planner precision scalarField_fourier,scalarField_real,+1,fftw_planner_flag) ! input, output, backward (1), planner precision
endif endif
@ -249,21 +286,21 @@ subroutine utilities_init()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculation of discrete angular frequencies, ordered as in FFTW (wrap around) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
do k = 1_pInt, res(3) do k = 1_pInt, grid(3)
k_s(3) = k - 1_pInt k_s(3) = k - 1_pInt
if(k > res(3)/2_pInt + 1_pInt) k_s(3) = k_s(3) - res(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 if(k > grid(3)/2_pInt + 1_pInt) k_s(3) = k_s(3) - grid(3) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
do j = 1_pInt, res(2) do j = 1_pInt, grid(2)
k_s(2) = j - 1_pInt k_s(2) = j - 1_pInt
if(j > res(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - res(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1 if(j > grid(2)/2_pInt + 1_pInt) k_s(2) = k_s(2) - grid(2) ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
do i = 1_pInt, res1_red do i = 1_pInt, grid1Red
k_s(1) = i - 1_pInt ! symmetry, junst running from 0,1,...,N/2,N/2+1 k_s(1) = i - 1_pInt ! symmetry, junst running from 0,1,...,N/2,N/2+1
xi(1:3,i,j,k) = real(k_s, pReal)/scaledDim ! if divergence_correction is set, frequencies are calculated on unit length xi(1:3,i,j,k) = real(k_s, pReal)/scaledGeomSize ! if divergence_correction is set, frequencies are calculated on unit length
enddo; enddo; enddo enddo; enddo; enddo
if(memory_efficient) then ! allocate just single fourth order tensor if(memory_efficient) then ! allocate just single fourth order tensor
allocate (gamma_hat(3,3,3,3,1,1,1), source = 0.0_pReal) allocate (gamma_hat(3,3,3,3,1,1,1), source = 0.0_pReal)
else ! precalculation of gamma_hat field else ! precalculation of gamma_hat field
allocate (gamma_hat(3,3,3,3,res1_red ,res(2),res(3)), source =0.0_pReal) allocate (gamma_hat(3,3,3,3,grid1Red ,grid(2),grid(3)), source = 0.0_pReal)
endif endif
end subroutine utilities_init end subroutine utilities_init
@ -284,9 +321,6 @@ subroutine utilities_updateGamma(C,saveReference)
memory_efficient memory_efficient
use math, only: & use math, only: &
math_inv33 math_inv33
use mesh, only: &
res, &
res1_red
implicit none implicit none
real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
@ -307,7 +341,7 @@ subroutine utilities_updateGamma(C,saveReference)
endif endif
if(.not. memory_efficient) then if(.not. memory_efficient) then
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red
if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k) xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
@ -333,10 +367,6 @@ end subroutine utilities_updateGamma
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_FFTforward() !< @ToDo make row and column between randomly between 1 and 3 subroutine utilities_FFTforward() !< @ToDo make row and column between randomly between 1 and 3
use math use math
use mesh, only : &
scaledDim, &
res, &
res1_red
implicit none implicit none
integer(pInt) :: row, column ! if debug FFTW, compare 3D array field of row and column integer(pInt) :: row, column ! if debug FFTW, compare 3D array field of row and column
@ -349,7 +379,7 @@ subroutine utilities_FFTforward()
call random_number(myRand) ! two numbers: 0 <= x < 1 call random_number(myRand) ! two numbers: 0 <= x < 1
row = nint(myRand(1)*2_pReal + 1_pReal,pInt) row = nint(myRand(1)*2_pReal + 1_pReal,pInt)
column = nint(myRand(2)*2_pReal + 1_pReal,pInt) column = nint(myRand(2)*2_pReal + 1_pReal,pInt)
scalarField_real = cmplx(field_real(1:res(1),1:res(2),1:res(3),row,column),0.0_pReal,pReal) ! store the selected component scalarField_real = cmplx(field_real(1:grid(1),1:grid(2),1:grid(3),row,column),0.0_pReal,pReal) ! store the selected component
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -360,34 +390,34 @@ subroutine utilities_FFTforward()
! comparing 1 and 3x3 FT results ! comparing 1 and 3x3 FT results
if (debugFFTW) then if (debugFFTW) then
call fftw_execute_dft(planDebugForth,scalarField_real,scalarField_fourier) call fftw_execute_dft(planDebugForth,scalarField_real,scalarField_fourier)
where(abs(scalarField_fourier(1:res1_red,1:res(2),1:res(3))) > tiny(1.0_pReal)) ! avoid division by zero where(abs(scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3))) > tiny(1.0_pReal)) ! avoid division by zero
scalarField_fourier(1:res1_red,1:res(2),1:res(3)) = & scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3)) = &
(scalarField_fourier(1:res1_red,1:res(2),1:res(3))-& (scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3))-&
field_fourier(1:res1_red,1:res(2),1:res(3),row,column))/& field_fourier(1:grid1Red,1:grid(2),1:grid(3),row,column))/&
scalarField_fourier(1:res1_red,1:res(2),1:res(3)) scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3))
else where else where
scalarField_real = cmplx(0.0,0.0,pReal) scalarField_real = cmplx(0.0,0.0,pReal)
end where end where
write(6,'(/,a,i1,1x,i1,a)') ' .. checking FT results of compontent ', row, column, ' ..' write(6,'(/,a,i1,1x,i1,a)') ' .. checking FT results of compontent ', row, column, ' ..'
write(6,'(/,a,2(es11.4,1x))') ' max FT relative error = ',& ! print real and imaginary part seperately write(6,'(/,a,2(es11.4,1x))') ' max FT relative error = ',& ! print real and imaginary part seperately
maxval(real (scalarField_fourier(1:res1_red,1:res(2),1:res(3)))),& maxval(real (scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3)))),&
maxval(aimag(scalarField_fourier(1:res1_red,1:res(2),1:res(3)))) maxval(aimag(scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3))))
flush(6) flush(6)
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! removing highest frequencies ! removing highest frequencies
Nyquist(2,1:2) = [res(2)/2_pInt + 1_pInt, res(2)/2_pInt + 1_pInt + mod(res(2),2_pInt)] Nyquist(2,1:2) = [grid(2)/2_pInt + 1_pInt, grid(2)/2_pInt + 1_pInt + mod(grid(2),2_pInt)]
Nyquist(3,1:2) = [res(3)/2_pInt + 1_pInt, res(3)/2_pInt + 1_pInt + mod(res(3),2_pInt)] Nyquist(3,1:2) = [grid(3)/2_pInt + 1_pInt, grid(3)/2_pInt + 1_pInt + mod(grid(3),2_pInt)]
if(res(1)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation if(grid(1)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
field_fourier (res1_red, 1:res(2), 1:res(3), 1:3,1:3) & field_fourier (grid1Red, 1:grid(2), 1:grid(3), 1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(2)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation if(grid(2)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
field_fourier (1:res1_red,Nyquist(2,1):Nyquist(2,2),1:res(3), 1:3,1:3) & field_fourier (1:grid1Red,Nyquist(2,1):Nyquist(2,2),1:grid(3), 1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(res(3)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation if(grid(3)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
field_fourier (1:res1_red,1:res(2), Nyquist(3,1):Nyquist(3,2),1:3,1:3) & field_fourier (1:grid1Red,1:grid(2), Nyquist(3,1):Nyquist(3,2),1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal) = cmplx(0.0_pReal,0.0_pReal,pReal)
end subroutine utilities_FFTforward end subroutine utilities_FFTforward
@ -401,10 +431,6 @@ end subroutine utilities_FFTforward
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine utilities_FFTbackward() subroutine utilities_FFTbackward()
use math !< must use the whole module for use of FFTW use math !< must use the whole module for use of FFTW
use mesh, only: &
wgt, &
res, &
res1_red
implicit none implicit none
integer(pInt) :: row, column !< if debug FFTW, compare 3D array field of row and column integer(pInt) :: row, column !< if debug FFTW, compare 3D array field of row and column
@ -417,18 +443,18 @@ subroutine utilities_FFTbackward()
call random_number(myRand) ! two numbers: 0 <= x < 1 call random_number(myRand) ! two numbers: 0 <= x < 1
row = nint(myRand(1)*2_pReal + 1_pReal,pInt) row = nint(myRand(1)*2_pReal + 1_pReal,pInt)
column = nint(myRand(2)*2_pReal + 1_pReal,pInt) column = nint(myRand(2)*2_pReal + 1_pReal,pInt)
scalarField_fourier(1:res1_red,1:res(2),1:res(3)) & scalarField_fourier(1:grid1Red,1:grid(2),1:grid(3)) &
= field_fourier(1:res1_red,1:res(2),1:res(3),row,column) = field_fourier(1:grid1Red,1:grid(2),1:grid(3),row,column)
do i = 0_pInt, res(1)/2_pInt-2_pInt + mod(res(1),2_pInt) do i = 0_pInt, grid(1)/2_pInt-2_pInt + mod(grid(1),2_pInt)
m = 1_pInt m = 1_pInt
do k = 1_pInt, res(3) do k = 1_pInt, grid(3)
n = 1_pInt n = 1_pInt
do j = 1_pInt, res(2) do j = 1_pInt, grid(2)
scalarField_fourier(res(1)-i,j,k) = conjg(scalarField_fourier(2+i,n,m)) scalarField_fourier(grid(1)-i,j,k) = conjg(scalarField_fourier(2+i,n,m))
if(n == 1_pInt) n = res(2) + 1_pInt if(n == 1_pInt) n = grid(2) + 1_pInt
n = n-1_pInt n = n-1_pInt
enddo enddo
if(m == 1_pInt) m = res(3) + 1_pInt if(m == 1_pInt) m = grid(3) + 1_pInt
m = m -1_pInt m = m -1_pInt
enddo; enddo enddo; enddo
endif endif
@ -443,7 +469,7 @@ subroutine utilities_FFTbackward()
call fftw_execute_dft(planDebugBack,scalarField_fourier,scalarField_real) call fftw_execute_dft(planDebugBack,scalarField_fourier,scalarField_real)
where(abs(real(scalarField_real,pReal)) > tiny(1.0_pReal)) ! avoid division by zero where(abs(real(scalarField_real,pReal)) > tiny(1.0_pReal)) ! avoid division by zero
scalarField_real = (scalarField_real & scalarField_real = (scalarField_real &
- cmplx(field_real(1:res(1),1:res(2),1:res(3),row,column), 0.0, pReal))/ & - cmplx(field_real(1:grid(1),1:grid(2),1:grid(3),row,column), 0.0, pReal))/ &
scalarField_real scalarField_real
else where else where
scalarField_real = cmplx(0.0,0.0,pReal) scalarField_real = cmplx(0.0,0.0,pReal)
@ -466,10 +492,6 @@ subroutine utilities_fourierConvolution(fieldAim)
memory_efficient memory_efficient
use math, only: & use math, only: &
math_inv33 math_inv33
use mesh, only: &
mesh_NcpElems, &
res, &
res1_red
implicit none implicit none
real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
@ -486,7 +508,7 @@ subroutine utilities_fourierConvolution(fieldAim)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! do the actual spectral method calculation (mechanical equilibrium) ! do the actual spectral method calculation (mechanical equilibrium)
if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat
do k = 1_pInt, res(3); do j = 1_pInt, res(2) ;do i = 1_pInt, res1_red do k = 1_pInt, grid(3); do j = 1_pInt, grid(2) ;do i = 1_pInt, grid1Red
if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 if(any([i,j,k] /= 1_pInt)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k) xiDyad(l,m) = xi(l, i,j,k)*xi(m, i,j,k)
@ -502,13 +524,13 @@ subroutine utilities_fourierConvolution(fieldAim)
endif endif
enddo; enddo; enddo enddo; enddo; enddo
else ! use precalculated gamma-operator else ! use precalculated gamma-operator
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt,res1_red do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt,grid1Red
forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) & forall(l = 1_pInt:3_pInt, m = 1_pInt:3_pInt) &
temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3, i,j,k) * field_fourier(i,j,k,1:3,1:3)) temp33_Complex(l,m) = sum(gamma_hat(l,m,1:3,1:3, i,j,k) * field_fourier(i,j,k,1:3,1:3))
field_fourier(i,j,k, 1:3,1:3) = temp33_Complex field_fourier(i,j,k, 1:3,1:3) = temp33_Complex
enddo; enddo; enddo enddo; enddo; enddo
endif endif
field_fourier(1,1,1,1:3,1:3) = cmplx(fieldAim*real(mesh_NcpElems,pReal),0.0_pReal,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1 field_fourier(1,1,1,1:3,1:3) = cmplx(fieldAim*real(product(grid),pReal),0.0_pReal,pReal) ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
end subroutine utilities_fourierConvolution end subroutine utilities_fourierConvolution
@ -518,10 +540,6 @@ end subroutine utilities_fourierConvolution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function utilities_divergenceRMS() real(pReal) function utilities_divergenceRMS()
use math !< must use the whole module for use of FFTW use math !< must use the whole module for use of FFTW
use mesh, only: &
wgt, &
res, &
res1_red
implicit none implicit none
integer(pInt) :: i, j, k integer(pInt) :: i, j, k
@ -537,32 +555,32 @@ real(pReal) function utilities_divergenceRMS()
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculating RMS divergence criterion in Fourier space ! calculating RMS divergence criterion in Fourier space
utilities_divergenceRMS = 0.0_pReal utilities_divergenceRMS = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2) do k = 1_pInt, grid(3); do j = 1_pInt, grid(2)
do i = 2_pInt, res1_red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice. do i = 2_pInt, grid1Red -1_pInt ! Has somewhere a conj. complex counterpart. Therefore count it twice.
utilities_divergenceRMS = utilities_divergenceRMS & utilities_divergenceRMS = utilities_divergenceRMS &
+ 2.0_pReal*(sum (real(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again + 2.0_pReal*(sum (real(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2. do not take square root and square again
xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)& ! --> sum squared L_2 norm of vector xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)& ! --> sum squared L_2 norm of vector
+sum(aimag(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),& +sum(aimag(math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3),&
xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal)) xi(1:3,i,j,k))*TWOPIIMG)**2.0_pReal))
enddo enddo
utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if res(1) /= 1) utilities_divergenceRMS = utilities_divergenceRMS & ! these two layers (DC and Nyquist) do not have a conjugate complex counterpart (if grid(1) /= 1)
+ sum( real(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),& + sum( real(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),&
xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)& xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)&
+ sum(aimag(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),& + sum(aimag(math_mul33x3_complex(field_fourier(1 ,j,k,1:3,1:3),&
xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)& xi(1:3,1 ,j,k))*TWOPIIMG)**2.0_pReal)&
+ sum( real(math_mul33x3_complex(field_fourier(res1_red,j,k,1:3,1:3),& + sum( real(math_mul33x3_complex(field_fourier(grid1Red,j,k,1:3,1:3),&
xi(1:3,res1_red,j,k))*TWOPIIMG)**2.0_pReal)& xi(1:3,grid1Red,j,k))*TWOPIIMG)**2.0_pReal)&
+ sum(aimag(math_mul33x3_complex(field_fourier(res1_red,j,k,1:3,1:3),& + sum(aimag(math_mul33x3_complex(field_fourier(grid1Red,j,k,1:3,1:3),&
xi(1:3,res1_red,j,k))*TWOPIIMG)**2.0_pReal) xi(1:3,grid1Red,j,k))*TWOPIIMG)**2.0_pReal)
enddo; enddo enddo; enddo
if(res(1) == 1_pInt) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of res(1) == 1 if(grid(1) == 1_pInt) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of grid(1) == 1
utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate additional divergence criteria and report ! calculate additional divergence criteria and report
if (debugDivergence) then ! calculate divergence again if (debugDivergence) then ! calculate divergence again
err_div_max = 0.0_pReal err_div_max = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res1_red do k = 1_pInt, grid(3); do j = 1_pInt, grid(2); do i = 1_pInt, grid1Red
temp3_Complex = math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3)*wgt,& ! weighting P_fourier temp3_Complex = math_mul33x3_complex(field_fourier(i,j,k,1:3,1:3)*wgt,& ! weighting P_fourier
xi(1:3,i,j,k))*TWOPIIMG xi(1:3,i,j,k))*TWOPIIMG
err_div_max = max(err_div_max,sum(abs(temp3_Complex)**2.0_pReal)) err_div_max = max(err_div_max,sum(abs(temp3_Complex)**2.0_pReal))
@ -590,10 +608,6 @@ end function utilities_divergenceRMS
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
real(pReal) function utilities_curlRMS() real(pReal) function utilities_curlRMS()
use math !< must use the whole module for use of FFTW use math !< must use the whole module for use of FFTW
use mesh, only: &
res, &
res1_red, &
wgt
implicit none implicit none
integer(pInt) :: i, j, k, l integer(pInt) :: i, j, k, l
@ -605,8 +619,8 @@ real(pReal) function utilities_curlRMS()
! calculating max curl criterion in Fourier space ! calculating max curl criterion in Fourier space
utilities_curlRMS = 0.0_pReal utilities_curlRMS = 0.0_pReal
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do k = 1_pInt, grid(3); do j = 1_pInt, grid(2);
do i = 2_pInt, res1_red - 1_pInt do i = 2_pInt, grid1Red - 1_pInt
do l = 1_pInt, 3_pInt do l = 1_pInt, 3_pInt
curl_fourier(l,1) = (field_fourier(i,j,k,l,3)*xi(2,i,j,k)& curl_fourier(l,1) = (field_fourier(i,j,k,l,3)*xi(2,i,j,k)&
- field_fourier(i,j,k,l,2)*xi(3,i,j,k))*TWOPIIMG - field_fourier(i,j,k,l,2)*xi(3,i,j,k))*TWOPIIMG
@ -629,12 +643,12 @@ real(pReal) function utilities_curlRMS()
utilities_curlRMS = utilities_curlRMS + & utilities_curlRMS = utilities_curlRMS + &
2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal) 2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)
do l = 1_pInt, 3_pInt do l = 1_pInt, 3_pInt
curl_fourier = (field_fourier(res1_red,j,k,l,3)*xi(2,res1_red,j,k)& curl_fourier = ( field_fourier(grid1Red,j,k,l,3)*xi(2,grid1Red,j,k)&
- field_fourier(res1_red,j,k,l,2)*xi(3,res1_red,j,k))*TWOPIIMG -field_fourier(grid1Red,j,k,l,2)*xi(3,grid1Red,j,k))*TWOPIIMG
curl_fourier = (-field_fourier(res1_red,j,k,l,3)*xi(1,res1_red,j,k)& curl_fourier = (-field_fourier(grid1Red,j,k,l,3)*xi(1,grid1Red,j,k)&
+field_fourier(res1_red,j,k,l,1)*xi(3,res1_red,j,k) )*TWOPIIMG +field_fourier(grid1Red,j,k,l,1)*xi(3,grid1Red,j,k))*TWOPIIMG
curl_fourier = ( field_fourier(res1_red,j,k,l,2)*xi(1,res1_red,j,k)& curl_fourier = ( field_fourier(grid1Red,j,k,l,2)*xi(1,grid1Red,j,k)&
-field_fourier(res1_red,j,k,l,1)*xi(2,res1_red,j,k) )*TWOPIIMG -field_fourier(grid1Red,j,k,l,1)*xi(2,grid1Red,j,k))*TWOPIIMG
enddo enddo
utilities_curlRMS = utilities_curlRMS + & utilities_curlRMS = utilities_curlRMS + &
2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal) 2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)
@ -758,10 +772,6 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
math_det33 math_det33
use FEsolving, only: & use FEsolving, only: &
restartWrite restartWrite
use mesh, only: &
res, &
wgt, &
mesh_NcpElems
use CPFEM, only: & use CPFEM, only: &
CPFEM_general, & CPFEM_general, &
CPFEM_COLLECT, & CPFEM_COLLECT, &
@ -778,16 +788,16 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
implicit none implicit none
real(pReal), intent(inout) :: temperature !< temperature (no field) real(pReal), intent(inout) :: temperature !< temperature (no field)
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: & real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid(3)) :: &
F_lastInc, & !< target deformation gradient F_lastInc, & !< target deformation gradient
F !< previous deformation gradient F !< previous deformation gradient
real(pReal), intent(in) :: timeinc !< loading time real(pReal), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results logical, intent(in) :: forwardData !< age results
real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame
real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
real(pReal),intent(out), dimension(3,3,res(1),res(2),res(3)) :: P !< PK stress real(pReal),intent(out), dimension(3,3,grid(1),grid(2),grid(3)) :: P !< PK stress
integer(pInt) :: & integer(pInt) :: &
calcMode, & !< CPFEM mode for calculation calcMode, & !< CPFEM mode for calculation
@ -812,8 +822,8 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
call CPFEM_general(collectMode,F_lastInc(1:3,1:3,1,1,1),F(1:3,1:3,1,1,1), & ! collect mode handles Jacobian backup / restoration call CPFEM_general(collectMode,F_lastInc(1:3,1:3,1,1,1),F(1:3,1:3,1,1,1), & ! collect mode handles Jacobian backup / restoration
temperature,timeinc,1_pInt,1_pInt) temperature,timeinc,1_pInt,1_pInt)
materialpoint_F0 = reshape(F_lastInc, [3,3,1,mesh_NcpElems]) materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid)])
materialpoint_F = reshape(F, [3,3,1,mesh_NcpElems]) materialpoint_F = reshape(F, [3,3,1,product(grid)])
materialpoint_Temperature = temperature materialpoint_Temperature = temperature
call debug_reset() call debug_reset()
@ -823,7 +833,7 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
if(debugGeneral) then if(debugGeneral) then
defgradDetMax = -huge(1.0_pReal) defgradDetMax = -huge(1.0_pReal)
defgradDetMin = +huge(1.0_pReal) defgradDetMin = +huge(1.0_pReal)
do j = 1_pInt, mesh_NcpElems do j = 1_pInt, product(grid)
defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j)) defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j))
defgradDetMax = max(defgradDetMax,defgradDet) defgradDetMax = max(defgradDetMax,defgradDet)
defgradDetMin = min(defgradDetMin,defgradDet) defgradDetMin = min(defgradDetMin,defgradDet)
@ -840,7 +850,7 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
max_dPdF_norm = 0.0_pReal max_dPdF_norm = 0.0_pReal
min_dPdF = huge(1.0_pReal) min_dPdF = huge(1.0_pReal)
min_dPdF_norm = huge(1.0_pReal) min_dPdF_norm = huge(1.0_pReal)
do k = 1_pInt, mesh_NcpElems do k = 1_pInt, product(grid)
if (max_dPdF_norm < sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal)) then if (max_dPdF_norm < sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal)) then
max_dPdF = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k) max_dPdF = materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)
max_dPdF_norm = sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal) max_dPdF_norm = sum(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,k)**2.0_pReal)
@ -851,7 +861,7 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,temperature,timeinc,&
endif endif
end do end do
P = reshape(materialpoint_P, [3,3,res(1),res(2),res(3)]) P = reshape(materialpoint_P, [3,3,grid(1),grid(2),grid(3)])
C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt
C_minmaxAvg = 0.5_pReal*(max_dPdF + min_dPdF) C_minmaxAvg = 0.5_pReal*(max_dPdF + min_dPdF)
@ -875,24 +885,22 @@ end subroutine utilities_constitutiveResponse
!> @brief calculates forward rate, either guessing or just add delta/timeinc !> @brief calculates forward rate, either guessing or just add delta/timeinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,field) pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,field)
use mesh, only: &
res
implicit none implicit none
real(pReal), intent(in), dimension(3,3) :: avRate !< homogeneous addon real(pReal), intent(in), dimension(3,3) :: avRate !< homogeneous addon
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc_old !< timeinc of last step timeinc_old !< timeinc of last step
logical, intent(in) :: & logical, intent(in) :: &
guess !< guess along former trajectory guess !< guess along former trajectory
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: & real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid(3)) :: &
field_lastInc, & !< data of previous step field_lastInc, & !< data of previous step
field !< data of current step field !< data of current step
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: utilities_calculateRate real(pReal), dimension(3,3,grid(1),grid(2),grid(3)) :: utilities_calculateRate
if(guess) then if(guess) then
utilities_calculateRate = (field-field_lastInc) / timeinc_old utilities_calculateRate = (field-field_lastInc) / timeinc_old
else else
utilities_calculateRate = spread(spread(spread(avRate,3,res(1)),4,res(2)),5,res(3)) utilities_calculateRate = spread(spread(spread(avRate,3,grid(1)),4,grid(2)),5,grid(3))
endif endif
end function utilities_calculateRate end function utilities_calculateRate
@ -903,26 +911,23 @@ end function utilities_calculateRate
!> ensures that the average matches the aim !> ensures that the average matches the aim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function utilities_forwardField(timeinc,field_lastInc,rate,aim) pure function utilities_forwardField(timeinc,field_lastInc,rate,aim)
use mesh, only: &
res, &
wgt
implicit none implicit none
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc !< timeinc of current step timeinc !< timeinc of current step
real(pReal), intent(in), dimension(3,3,res(1),res(2),res(3)) :: & real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid(3)) :: &
field_lastInc, & !< initial field field_lastInc, & !< initial field
rate !< rate by which to forward rate !< rate by which to forward
real(pReal), intent(in), optional, dimension(3,3) :: & real(pReal), intent(in), optional, dimension(3,3) :: &
aim !< average field value aim aim !< average field value aim
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: utilities_forwardField real(pReal), dimension(3,3,grid(1),grid(2),grid(3)) :: utilities_forwardField
real(pReal), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim real(pReal), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim
utilities_forwardField = field_lastInc + rate*timeinc utilities_forwardField = field_lastInc + rate*timeinc
if (present(aim)) then !< correct to match average if (present(aim)) then !< correct to match average
fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt - aim
utilities_forwardField = utilities_forwardField - & utilities_forwardField = utilities_forwardField - &
spread(spread(spread(fieldDiff,3,res(1)),4,res(2)),5,res(3)) spread(spread(spread(fieldDiff,3,grid(1)),4,grid(2)),5,grid(3))
endif endif
end function utilities_forwardField end function utilities_forwardField
@ -936,8 +941,6 @@ real(pReal) function utilities_getFilter(k)
IO_error IO_error
use numerics, only: & use numerics, only: &
myfilter myfilter
use mesh, only: &
res
use math, only: & use math, only: &
PI PI
@ -949,9 +952,9 @@ real(pReal) function utilities_getFilter(k)
select case (myfilter) select case (myfilter)
case ('none') !< default is already nothing (1.0_pReal) case ('none') !< default is already nothing (1.0_pReal)
case ('cosine') !< cosine curve with 1 for avg and zero for highest freq case ('cosine') !< cosine curve with 1 for avg and zero for highest freq
utilities_getFilter = (1.0_pReal + cos(PI*k(3)/res(3))) & utilities_getFilter = (1.0_pReal + cos(PI*k(3)/grid(3))) &
*(1.0_pReal + cos(PI*k(2)/res(2))) & *(1.0_pReal + cos(PI*k(2)/grid(2))) &
*(1.0_pReal + cos(PI*k(1)/res(1)))/8.0_pReal *(1.0_pReal + cos(PI*k(1)/grid(1)))/8.0_pReal
case default case default
call IO_error(error_ID = 892_pInt, ext_msg = trim(myfilter)) call IO_error(error_ID = 892_pInt, ext_msg = trim(myfilter))
end select end select

3
code/lattice.f90
View File

@ -1018,7 +1018,8 @@ pure function lattice_symmetrizeC66(structName,C66)
! TwinTwinInteraction ! TwinTwinInteraction
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function lattice_configNchunks(struct) function lattice_configNchunks(struct)
use prec, only: pReal,pInt use prec, only: &
pInt
implicit none implicit none
integer(pInt), dimension(6) :: lattice_configNchunks integer(pInt), dimension(6) :: lattice_configNchunks

10
code/math.f90
View File

@ -727,14 +727,14 @@ pure function math_exp33(A,n)
order = 5 order = 5
if (present(n)) order = n if (present(n)) order = n
B = math_identity2nd(3) ! init B = math_identity2nd(3) ! init
invfac = 1.0_pReal ! 0! invfac = 1.0_pReal ! 0!
math_exp33 = B ! A^0 = eye2 math_exp33 = B ! A^0 = eye2
do i = 1_pInt,n do i = 1_pInt,n
invfac = invfac/real(i) ! invfac = 1/i! invfac = invfac/real(i) ! invfac = 1/i!
B = math_mul33x33(B,A) B = math_mul33x33(B,A)
math_exp33 = math_exp33 + invfac*B ! exp = SUM (A^i)/i! math_exp33 = math_exp33 + invfac*B ! exp = SUM (A^i)/i!
enddo enddo
end function math_exp33 end function math_exp33

413
code/mesh.f90
View File

@ -121,16 +121,6 @@ module mesh
#ifdef Spectral #ifdef Spectral
include 'fftw3.f03' include 'fftw3.f03'
real(pReal), dimension(3), public, protected :: &
geomdim, & !< physical dimension of volume element per direction
scaledDim !< scaled dimension of volume element, depending on selected divergence calculation
integer(pInt), dimension(3), public, protected :: &
res !< resolution, e.g. number of Fourier points in each direction
real(pReal), public, protected :: &
wgt
integer(pInt), public, protected :: &
res1_red, &
homog
#endif #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)
@ -428,6 +418,8 @@ module mesh
mesh_get_nodeAtIP mesh_get_nodeAtIP
#ifdef Spectral #ifdef Spectral
public :: & public :: &
mesh_spectral_getGrid, &
mesh_spectral_getSize, &
mesh_regrid, & mesh_regrid, &
mesh_nodesAroundCentres, & mesh_nodesAroundCentres, &
mesh_deformedCoordsFFT, & mesh_deformedCoordsFFT, &
@ -438,13 +430,9 @@ module mesh
private :: & private :: &
#ifdef Spectral #ifdef Spectral
mesh_spectral_getGrid, &
mesh_spectral_getSize, &
mesh_spectral_getHomogenization, & mesh_spectral_getHomogenization, &
mesh_spectral_count_nodesAndElements, & mesh_spectral_count, &
mesh_spectral_count_cpElements, & mesh_spectral_mapNodesAndElems, &
mesh_spectral_map_elements, &
mesh_spectral_map_nodes, &
mesh_spectral_count_cpSizes, & mesh_spectral_count_cpSizes, &
mesh_spectral_build_nodes, & mesh_spectral_build_nodes, &
mesh_spectral_build_elements, & mesh_spectral_build_elements, &
@ -554,51 +542,23 @@ subroutine mesh_init(ip,el)
if (allocated(FE_ipNeighbor)) deallocate(FE_ipNeighbor) if (allocated(FE_ipNeighbor)) deallocate(FE_ipNeighbor)
if (allocated(FE_cellnodeParentnodeWeights)) deallocate(FE_cellnodeParentnodeWeights) if (allocated(FE_cellnodeParentnodeWeights)) deallocate(FE_cellnodeParentnodeWeights)
if (allocated(FE_subNodeOnIPFace)) deallocate(FE_subNodeOnIPFace) if (allocated(FE_subNodeOnIPFace)) deallocate(FE_subNodeOnIPFace)
call mesh_build_FEdata ! get properties of the different types of elements call mesh_build_FEdata ! get properties of the different types of elements
mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh
#ifdef Spectral #ifdef Spectral
call IO_open_file(fileUnit,geometryFile) ! parse info from geometry file... call IO_open_file(fileUnit,geometryFile) ! parse info from geometry file...
res = mesh_spectral_getGrid(fileUnit) call mesh_spectral_count(fileUnit)
res1_red = res(1)/2_pInt + 1_pInt call mesh_spectral_mapNodesAndElems
wgt = 1.0/real(product(res),pReal)
geomdim = mesh_spectral_getSize(fileUnit)
homog = mesh_spectral_getHomogenization(fileUnit)
!--------------------------------------------------------------------------------------------------
! scale dimension to calculate either uncorrected, dimension-independent, or dimension- and reso-
! lution-independent divergence
if (divergence_correction == 1_pInt) then
do j = 1_pInt, 3_pInt
if (j /= minloc(geomdim,1) .and. j /= maxloc(geomdim,1)) scaledDim = geomdim/geomdim(j)
enddo
elseif (divergence_correction == 2_pInt) then
do j = 1_pInt, 3_pInt
if (j /= minloc(geomdim/res,1) .and. j /= maxloc(geomdim/res,1)) scaledDim = geomdim/geomdim(j)*res(j)
enddo
else
scaledDim = geomdim
endif
write(6,'(a,3(i12 ))') ' grid a b c: ', res
write(6,'(a,3(f12.5))') ' size x y z: ', geomdim
write(6,'(a,i5,/)') ' homogenization: ', homog
call mesh_spectral_count_nodesAndElements
call mesh_spectral_count_cpElements
call mesh_spectral_map_elements
call mesh_spectral_map_nodes
call mesh_spectral_count_cpSizes call mesh_spectral_count_cpSizes
call mesh_spectral_build_nodes call mesh_spectral_build_nodes(fileUnit)
call mesh_spectral_build_elements(fileUnit) call mesh_spectral_build_elements(fileUnit)
call mesh_get_damaskOptions(fileUnit) call mesh_get_damaskOptions(fileUnit)
close (fileUnit)
call mesh_build_cellconnectivity call mesh_build_cellconnectivity
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes)
call mesh_build_ipCoordinates call mesh_build_ipCoordinates
call mesh_build_ipVolumes call mesh_build_ipVolumes
call mesh_build_ipAreas call mesh_build_ipAreas
call mesh_spectral_build_ipNeighborhood call mesh_spectral_build_ipNeighborhood(fileUnit)
#endif #endif
#ifdef Marc4DAMASK #ifdef Marc4DAMASK
call IO_open_inputFile(fileUnit,modelName) ! parse info from input file... call IO_open_inputFile(fileUnit,modelName) ! parse info from input file...
@ -613,7 +573,6 @@ subroutine mesh_init(ip,el)
call mesh_marc_count_cpSizes(fileunit) call mesh_marc_count_cpSizes(fileunit)
call mesh_marc_build_elements(fileUnit) call mesh_marc_build_elements(fileUnit)
call mesh_get_damaskOptions(fileUnit) call mesh_get_damaskOptions(fileUnit)
close (fileUnit)
call mesh_build_cellconnectivity call mesh_build_cellconnectivity
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes)
call mesh_build_ipCoordinates call mesh_build_ipCoordinates
@ -638,7 +597,6 @@ subroutine mesh_init(ip,el)
call mesh_abaqus_count_cpSizes(fileunit) call mesh_abaqus_count_cpSizes(fileunit)
call mesh_abaqus_build_elements(fileUnit) call mesh_abaqus_build_elements(fileUnit)
call mesh_get_damaskOptions(fileUnit) call mesh_get_damaskOptions(fileUnit)
close (fileUnit)
call mesh_build_cellconnectivity call mesh_build_cellconnectivity
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes)
call mesh_build_ipCoordinates call mesh_build_ipCoordinates
@ -649,6 +607,7 @@ subroutine mesh_init(ip,el)
call mesh_build_ipNeighborhood call mesh_build_ipNeighborhood
#endif #endif
close (fileUnit)
call mesh_tell_statistics call mesh_tell_statistics
call mesh_write_meshfile call mesh_write_meshfile
call mesh_write_cellGeom call mesh_write_cellGeom
@ -950,25 +909,24 @@ end subroutine mesh_build_ipCoordinates
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function mesh_cellCenterCoordinates(ip,el) pure function mesh_cellCenterCoordinates(ip,el)
implicit none implicit none
integer(pInt), intent(in) :: el, & !< element number
ip !< integration point number
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell
integer(pInt), intent(in) :: el, & !< element number integer(pInt) :: t,g,c,n
ip !< integration point number
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell
integer(pInt) :: t,g,c,n
t = mesh_element(2_pInt,el) ! get element type t = mesh_element(2_pInt,el) ! get element type
g = FE_geomtype(t) ! get geometry type g = FE_geomtype(t) ! get geometry type
c = FE_celltype(g) ! get cell type c = FE_celltype(g) ! get cell type
mesh_cellCenterCoordinates = 0.0_pReal mesh_cellCenterCoordinates = 0.0_pReal
do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el))
enddo enddo
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / FE_NcellnodesPerCell(c) mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / FE_NcellnodesPerCell(c)
endfunction mesh_cellCenterCoordinates end function mesh_cellCenterCoordinates
#ifdef Spectral #ifdef Spectral
@ -1189,61 +1147,39 @@ end function mesh_spectral_getHomogenization
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Count overall number of nodes and elements in mesh and stores them in !> @brief Count overall number of nodes and elements in mesh and stores them in
!! 'mesh_Nelems' and 'mesh_Nnodes' !! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_count_nodesAndElements() subroutine mesh_spectral_count(myUnit)
implicit none implicit none
mesh_Nelems = product(res) integer(pInt), intent(in) :: myUnit
mesh_Nnodes = product(res+1_pInt) integer(pInt), dimension(3) :: grid
end subroutine mesh_spectral_count_nodesAndElements
!--------------------------------------------------------------------------------------------------
!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_count_cpElements
implicit none
grid = mesh_spectral_getGrid(myUnit)
mesh_Nelems = product(grid)
mesh_NcpElems = mesh_Nelems mesh_NcpElems = mesh_Nelems
mesh_Nnodes = product(grid+1_pInt)
end subroutine mesh_spectral_count_cpElements
end subroutine mesh_spectral_count
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Maps elements from FE ID to internal (consecutive) representation. !> @brief fake map node from FE ID to internal (consecutive) representation for node and element
!! Allocates global array 'mesh_mapFEtoCPelem' !! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_map_elements subroutine mesh_spectral_mapNodesAndElems
use math, only: &
math_range
implicit none implicit none
integer(pInt) :: i
allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems)) ; mesh_mapFEtoCPelem = 0_pInt allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt)
allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt)
forall (i = 1_pInt:mesh_NcpElems) & mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2)
mesh_mapFEtoCPelem(1:2,i) = i mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2)
end subroutine mesh_spectral_map_elements end subroutine mesh_spectral_mapNodesAndElems
!--------------------------------------------------------------------------------------------------
!> @brief Maps node from FE ID to internal (consecutive) representation.
!! Allocates global array 'mesh_mapFEtoCPnode'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_map_nodes
implicit none
integer(pInt) :: i
allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes)) ; mesh_mapFEtoCPnode = 0_pInt
forall (i = 1_pInt:mesh_Nnodes) &
mesh_mapFEtoCPnode(1:2,i) = i
end subroutine mesh_spectral_map_nodes
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1272,24 +1208,30 @@ end subroutine mesh_spectral_count_cpSizes
!> @brief Store x,y,z coordinates of all nodes in mesh. !> @brief Store x,y,z coordinates of all nodes in mesh.
!! Allocates global arrays 'mesh_node0' and 'mesh_node' !! Allocates global arrays 'mesh_node0' and 'mesh_node'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_nodes() subroutine mesh_spectral_build_nodes(myUnit)
implicit none implicit none
integer(pInt) :: n integer(pInt), intent(in) :: myUnit
integer(pInt) :: n
integer(pInt), dimension(3) :: grid
real(pReal), dimension(3) :: geomSize
allocate ( mesh_node0 (3,mesh_Nnodes) ); mesh_node0 = 0.0_pReal allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal)
allocate ( mesh_node (3,mesh_Nnodes) ); mesh_node = 0.0_pReal allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal)
grid = mesh_spectral_getGrid(myUnit)
geomSize = mesh_spectral_getSize(myUnit)
forall (n = 0_pInt:mesh_Nnodes-1_pInt) forall (n = 0_pInt:mesh_Nnodes-1_pInt)
mesh_node0(1,n+1_pInt) = mesh_unitlength * & mesh_node0(1,n+1_pInt) = mesh_unitlength * &
geomdim(1) * real(mod(n,(res(1)+1_pInt) ),pReal) & geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) &
/ real(res(1),pReal) / real(grid(1),pReal)
mesh_node0(2,n+1_pInt) = mesh_unitlength * & mesh_node0(2,n+1_pInt) = mesh_unitlength * &
geomdim(2) * real(mod(n/(res(1)+1_pInt),(res(2)+1_pInt)),pReal) & geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) &
/ real(res(2),pReal) / real(grid(2),pReal)
mesh_node0(3,n+1_pInt) = mesh_unitlength * & mesh_node0(3,n+1_pInt) = mesh_unitlength * &
geomdim(3) * real(mod(n/(res(1)+1_pInt)/(res(2)+1_pInt),(res(3)+1_pInt)),pReal) & geomSize(3)*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid(3)+1_pInt)),pReal) &
/ real(res(3),pReal) / real(grid(3),pReal)
end forall end forall
mesh_node = mesh_node0 mesh_node = mesh_node0
@ -1314,15 +1256,29 @@ subroutine mesh_spectral_build_elements(myUnit)
IO_countContinuousIntValues IO_countContinuousIntValues
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: &
myUnit
integer(pInt), dimension (1_pInt+7_pInt*2_pInt) :: myPos integer(pInt), dimension(1_pInt+7_pInt*2_pInt) :: &
integer(pInt) :: e, i, headerLength = 0_pInt, maxIntCount myPos
integer(pInt), dimension(:), allocatable :: microstructures integer(pInt) :: &
integer(pInt), dimension(1,1) :: dummySet = 0_pInt e, i, &
character(len=65536) :: line,keyword headerLength = 0_pInt, &
character(len=64), dimension(1) :: dummyName = '' maxIntCount, &
homog
integer(pInt), dimension(:), allocatable :: &
microstructures
integer(pInt), dimension(3) :: &
grid
integer(pInt), dimension(1,1) :: &
dummySet = 0_pInt
character(len=65536) :: &
line, &
keyword
character(len=64), dimension(1) :: &
dummyName = ''
grid = mesh_spectral_getGrid(myUnit)
homog = mesh_spectral_getHomogenization(myUnit)
call IO_checkAndRewind(myUnit) call IO_checkAndRewind(myUnit)
read(myUnit,'(a65536)') line read(myUnit,'(a65536)') line
@ -1364,15 +1320,15 @@ subroutine mesh_spectral_build_elements(myUnit)
mesh_element( 2,e) = FE_mapElemtype('C3D8R') ! elem type mesh_element( 2,e) = FE_mapElemtype('C3D8R') ! elem type
mesh_element( 3,e) = homog ! homogenization mesh_element( 3,e) = homog ! homogenization
mesh_element( 4,e) = microstructures(1_pInt+i) ! microstructure mesh_element( 4,e) = microstructures(1_pInt+i) ! microstructure
mesh_element( 5,e) = e + (e-1_pInt)/res(1) + & mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + &
((e-1_pInt)/(res(1)*res(2)))*(res(1)+1_pInt) ! base node ((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( 6,e) = mesh_element(5,e) + 1_pInt
mesh_element( 7,e) = mesh_element(5,e) + res(1) + 2_pInt mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt
mesh_element( 8,e) = mesh_element(5,e) + res(1) + 1_pInt mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt
mesh_element( 9,e) = mesh_element(5,e) +(res(1) + 1_pInt) * (res(2) + 1_pInt) ! second floor base node 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(10,e) = mesh_element(9,e) + 1_pInt
mesh_element(11,e) = mesh_element(9,e) + res(1) + 2_pInt mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt
mesh_element(12,e) = mesh_element(9,e) + res(1) + 1_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(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) !needed for statistics
mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e))
enddo enddo
@ -1388,56 +1344,59 @@ end subroutine mesh_spectral_build_elements
!> @brief build neighborhood relations for spectral !> @brief build neighborhood relations for spectral
!> @details assign globals: mesh_ipNeighborhood !> @details assign globals: mesh_ipNeighborhood
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_ipNeighborhood subroutine mesh_spectral_build_ipNeighborhood(myUnit)
implicit none implicit none
integer(pInt) x,y,z, & integer(pInt), intent(in) :: &
e myUnit
integer(pInt) :: &
allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) x,y,z, &
mesh_ipNeighborhood = 0_pInt e
integer(pInt), dimension(3) :: &
grid
e = 0_pInt allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt)
do z = 0_pInt,res(3)-1_pInt
do y = 0_pInt,res(2)-1_pInt grid = mesh_spectral_getGrid(myUnit)
do x = 0_pInt,res(1)-1_pInt
e = e + 1_pInt
mesh_ipNeighborhood(1,1,1,e) = z * res(1) * res(2) &
+ y * res(1) &
+ modulo(x+1_pInt,res(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,2,1,e) = z * res(1) * res(2) &
+ y * res(1) &
+ modulo(x-1_pInt,res(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,3,1,e) = z * res(1) * res(2) &
+ modulo(y+1_pInt,res(2)) * res(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,4,1,e) = z * res(1) * res(2) &
+ modulo(y-1_pInt,res(2)) * res(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,res(3)) * res(1) * res(2) &
+ y * res(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,res(3)) * res(1) * res(2) &
+ y * res(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt
mesh_ipNeighborhood(3,1,1,e) = 2_pInt
mesh_ipNeighborhood(3,2,1,e) = 1_pInt
mesh_ipNeighborhood(3,3,1,e) = 4_pInt
mesh_ipNeighborhood(3,4,1,e) = 3_pInt
mesh_ipNeighborhood(3,5,1,e) = 6_pInt
mesh_ipNeighborhood(3,6,1,e) = 5_pInt
enddo
enddo
enddo
e = 0_pInt
do z = 0_pInt,grid(1)-1_pInt
do y = 0_pInt,grid(2)-1_pInt
do x = 0_pInt,grid(3)-1_pInt
e = e + 1_pInt
mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) &
+ y * grid(1) &
+ modulo(x+1_pInt,grid(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) &
+ y * grid(1) &
+ modulo(x-1_pInt,grid(1)) &
+ 1_pInt
mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) &
+ modulo(y+1_pInt,grid(2)) * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) &
+ modulo(y-1_pInt,grid(2)) * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid(3)) * grid(1) * grid(2) &
+ y * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid(3)) * grid(1) * grid(2) &
+ y * grid(1) &
+ x &
+ 1_pInt
mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt
mesh_ipNeighborhood(3,1,1,e) = 2_pInt
mesh_ipNeighborhood(3,2,1,e) = 1_pInt
mesh_ipNeighborhood(3,3,1,e) = 4_pInt
mesh_ipNeighborhood(3,4,1,e) = 3_pInt
mesh_ipNeighborhood(3,5,1,e) = 6_pInt
mesh_ipNeighborhood(3,6,1,e) = 5_pInt
enddo
enddo
enddo
end subroutine mesh_spectral_build_ipNeighborhood end subroutine mesh_spectral_build_ipNeighborhood
@ -1454,6 +1413,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
getSolverJobName, & getSolverJobName, &
GeometryFile GeometryFile
use IO, only: & use IO, only: &
IO_open_file, &
IO_read_jobBinaryFile ,& IO_read_jobBinaryFile ,&
IO_read_jobBinaryIntFile ,& IO_read_jobBinaryIntFile ,&
IO_write_jobBinaryFile, & IO_write_jobBinaryFile, &
@ -1467,16 +1427,17 @@ function mesh_regrid(adaptive,resNewInput,minRes)
math_mul33x3 math_mul33x3
implicit none implicit none
character(len=1024):: formatString, N_Digits
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 integer(pInt), dimension(3) :: mesh_regrid, ratio, grid
integer(pInt), parameter :: myUnit = 777_pInt
integer(pInt), dimension(3,2) :: possibleResNew integer(pInt), dimension(3,2) :: possibleResNew
integer(pInt):: maxsize, i, j, k, ielem, NpointsNew, spatialDim integer(pInt):: maxsize, i, j, k, ielem, NpointsNew, spatialDim, Nelems
integer(pInt), dimension(3) :: resNew integer(pInt), dimension(3) :: resNew
integer(pInt), dimension(:), allocatable :: indices integer(pInt), dimension(:), allocatable :: indices
real(pReal), dimension(3) :: geomdimNew real(pReal) :: wgt
real(pReal), dimension(3) :: geomSizeNew, geomSize
real(pReal), dimension(3,3) :: Favg, Favg_LastInc, & real(pReal), dimension(3,3) :: Favg, Favg_LastInc, &
FavgNew, Favg_LastIncNew, & FavgNew, Favg_LastIncNew, &
deltaF, deltaF_lastInc deltaF, deltaF_lastInc
@ -1497,13 +1458,21 @@ function mesh_regrid(adaptive,resNewInput,minRes)
F_lastIncNew F_lastIncNew
real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: & real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: &
dPdF, dPdFNew dPdF, dPdFNew
character(len=1024):: formatString, N_Digits
integer(pInt), dimension(:,:), allocatable :: & integer(pInt), dimension(:,:), allocatable :: &
sizeStateHomog sizeStateHomog
integer(pInt), dimension(:,:,:), allocatable :: & integer(pInt), dimension(:,:,:), allocatable :: &
material_phase, material_phaseNew, & material_phase, material_phaseNew, &
sizeStateConst sizeStateConst
call IO_open_file(myUnit,trim(geometryFile))
grid = mesh_spectral_getGrid(myUnit)
geomSize = mesh_spectral_getsize(myUnit)
close(myUnit)
Nelems = product(grid)
wgt = 1.0_pReal/real(Nelems,pReal)
write(6,'(a)') 'Regridding geometry' write(6,'(a)') 'Regridding geometry'
if (adaptive) then if (adaptive) then
write(6,'(a)') 'adaptive resolution determination' write(6,'(a)') 'adaptive resolution determination'
@ -1519,53 +1488,54 @@ function mesh_regrid(adaptive,resNewInput,minRes)
endif endif
endif endif
allocate(coordinates(3,mesh_NcpElems)) allocate(coordinates(3,Nelems))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! read in deformation gradient to calculate coordinates, shape depend of selected solver ! read in deformation gradient to calculate coordinates, shape depend of selected solver
select case(myspectralsolver) select case(myspectralsolver)
case('basic') case('basic')
allocate(spectralF33(3,3,res(1),res(2),res(3))) allocate(spectralF33(3,3,grid(1),grid(2),grid(3)))
call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF33)) call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF33))
read (777,rec=1) spectralF33 read (777,rec=1) spectralF33
close (777) close (777)
Favg = sum(sum(sum(spectralF33,dim=5),dim=4),dim=3) * wgt Favg = sum(sum(sum(spectralF33,dim=5),dim=4),dim=3) * wgt
coordinates = reshape(mesh_deformedCoordsFFT(geomdim,spectralF33),[3,mesh_NcpElems]) coordinates = reshape(mesh_deformedCoordsFFT(geomSize,spectralF33),[3,mesh_NcpElems])
case('basicpetsc','al') case('basicpetsc','al')
allocate(spectralF9(9,res(1),res(2),res(3))) allocate(spectralF9(9,grid(1),grid(2),grid(3)))
call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF9)) call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF9))
read (777,rec=1) spectralF9 read (777,rec=1) spectralF9
close (777) close (777)
Favg = reshape(sum(sum(sum(spectralF9,dim=4),dim=3),dim=2) * wgt, [3,3]) Favg = reshape(sum(sum(sum(spectralF9,dim=4),dim=3),dim=2) * wgt, [3,3])
coordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(spectralF9, & coordinates = reshape(mesh_deformedCoordsFFT(geomSize,reshape(spectralF9, &
[3,3,res(1),res(2),res(3)])),[3,mesh_NcpElems]) [3,3,grid(1),grid(2),grid(3)])),[3,mesh_NcpElems])
end select end select
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! sanity check 2D/3D case ! sanity check 2D/3D case
if (res(3)== 1_pInt) then if (grid(3)== 1_pInt) then
spatialDim = 2_pInt spatialDim = 2_pInt
if (present (minRes)) then if (present (minRes)) then
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
if (present (minRes)) then if (present (minRes)) then
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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Automatic detection based on current geom ! Automatic detection based on current geom
geomdimNew = math_mul33x3(Favg,geomdim) geomSizeNew = math_mul33x3(Favg,geomSize)
if (adaptive) then if (adaptive) then
ratio = floor(real(resNewInput,pReal) * (geomdimNew/geomdim), pInt) ratio = floor(real(resNewInput,pReal) * (geomSizeNew/geomSize), pInt)
possibleResNew = 1_pInt possibleResNew = 1_pInt
do i = 1_pInt, spatialDim do i = 1_pInt, spatialDim
@ -1574,15 +1544,14 @@ 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
do k = 1_pInt,3_pInt; do 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))
enddo; enddo
endif endif
endif endif
enddo enddo
@ -1602,11 +1571,11 @@ function mesh_regrid(adaptive,resNewInput,minRes)
endif endif
enddo enddo
else else
resNew = res resNew = grid
endif endif
mesh_regrid = resNew mesh_regrid = resNew
NpointsNew = resNew(1)*resNew(2)*resNew(3) NpointsNew = product(resNew)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Calculate regular new coordinates ! Calculate regular new coordinates
@ -1614,14 +1583,14 @@ function mesh_regrid(adaptive,resNewInput,minRes)
ielem = 0_pInt ielem = 0_pInt
do k=1_pInt,resNew(3); do j=1_pInt, resNew(2); do i=1_pInt, resNew(1) do k=1_pInt,resNew(3); do j=1_pInt, resNew(2); do i=1_pInt, resNew(1)
ielem = ielem + 1_pInt ielem = ielem + 1_pInt
coordinatesNew(1:3,ielem) = math_mul33x3(Favg, geomdim/real(resNew,pReal)*real([i,j,k],pReal) & coordinatesNew(1:3,ielem) = math_mul33x3(Favg, geomSize/real(resNew,pReal)*real([i,j,k],pReal) &
- geomdim/real(2_pInt*resNew,pReal)) - geomSize/real(2_pInt*resNew,pReal))
enddo; enddo; enddo enddo; enddo; enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Nearest neighbour search ! Nearest neighbour search
allocate(indices(NpointsNew)) allocate(indices(NpointsNew))
indices = math_periodicNearestNeighbor(geomdim, Favg, coordinatesNew, coordinates) indices = math_periodicNearestNeighbor(geomSize, Favg, coordinatesNew, coordinates)
deallocate(coordinates) deallocate(coordinates)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1665,8 +1634,8 @@ function mesh_regrid(adaptive,resNewInput,minRes)
formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)' formatString = '(I'//trim(N_Digits)//'.'//trim(N_Digits)//',a)'
open(777,file=trim(getSolverWorkingDirectoryName())//trim(GeometryFile),status='REPLACE') open(777,file=trim(getSolverWorkingDirectoryName())//trim(GeometryFile),status='REPLACE')
write(777, '(A)') '3 header' write(777, '(A)') '3 header'
write(777, '(3(A, I8))') 'resolution a ', resNew(1), ' b ', resNew(2), ' c ', resNew(3) write(777, '(3(A, I8))') 'grid a ', resNew(1), ' b ', resNew(2), ' c ', resNew(3)
write(777, '(3(A, g17.10))') 'dimension x ', geomdim(1), ' y ', geomdim(2), ' z ', geomdim(3) write(777, '(3(A, g17.10))') 'size x ', geomSize(1), ' y ', geomSize(2), ' z ', geomSize(3)
write(777, '(A)') 'homogenization 1' write(777, '(A)') 'homogenization 1'
do i = 1_pInt, NpointsNew do i = 1_pInt, NpointsNew
write(777,trim(formatString),advance='no') mesh_element(4,indices(i)), ' ' write(777,trim(formatString),advance='no') mesh_element(4,indices(i)), ' '
@ -2763,11 +2732,12 @@ end subroutine mesh_marc_map_nodes
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_marc_build_nodes(myUnit) subroutine mesh_marc_build_nodes(myUnit)
use IO, only: IO_lc, & use IO, only: &
IO_stringValue, & IO_lc, &
IO_stringPos, & IO_stringValue, &
IO_fixedIntValue, & IO_stringPos, &
IO_fixedNoEFloatValue IO_fixedIntValue, &
IO_fixedNoEFloatValue
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -3464,7 +3434,7 @@ subroutine mesh_abaqus_build_nodes(myUnit)
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
m = mesh_FEasCP('node',IO_intValue(line,myPos,1_pInt)) m = mesh_FEasCP('node',IO_intValue(line,myPos,1_pInt))
do j=1_pInt, 3_pInt do j=1_pInt, 3_pInt
mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,myPos,j+1_pInt) mesh_node0(j,m) = numerics_unitlength * IO_floatValue(line,myPos,j+1_pInt)
enddo enddo
enddo enddo
endif endif
@ -3705,9 +3675,10 @@ use IO, only: &
endselect endselect
endif endif
enddo enddo
#endif
610 FORMAT(A300) 610 FORMAT(A300)
#endif
620 end subroutine mesh_get_damaskOptions 620 end subroutine mesh_get_damaskOptions
@ -3715,19 +3686,17 @@ use IO, only: &
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine mesh_build_ipAreas subroutine mesh_build_ipAreas
use math, only: & use math, only: &
math_norm3, & math_norm3, &
math_vectorproduct math_vectorproduct
implicit none implicit none
integer(pInt) :: e,t,g,c,i,f,n,m integer(pInt) :: e,t,g,c,i,f,n,m
real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals
real(pReal), dimension(3) :: normal real(pReal), dimension(3) :: normal
allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipArea = 0.0_pReal allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)); mesh_ipArea = 0.0_pReal
allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) ; mesh_ipAreaNormal = 0.0_pReal allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)); mesh_ipAreaNormal = 0.0_pReal
!$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals)
do e = 1_pInt,mesh_NcpElems ! loop over cpElems do e = 1_pInt,mesh_NcpElems ! loop over cpElems