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

fixed bug in coordinate calculation when no average F was given (scaled wrong by ncp_elems**2) 

other changes: just polishing + some more comments
This commit is contained in:
Martin Diehl 2013-03-27 12:28:55 +00:00
parent b6aecdac17
commit 39a70e8a19
7 changed files with 137 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
code/CPFEM.f90
View File

@ -175,6 +175,11 @@ subroutine CPFEM_init
implicit none
integer(pInt) i,j,k,l,m
write(6,'(/,a)') ' <<<+- CPFEM init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
if (any(.not. crystallite_localPlasticity) .and. (mesh_Nelems /= mesh_NcpElems)) call IO_error(600)
if ((DAMASK_NumThreadsInt > 1_pInt) .and. (mesh_Nelems /= mesh_NcpElems)) call IO_error(601)
usePingPong = (any(.not. crystallite_localPlasticity) .or. (DAMASK_NumThreadsInt > 1_pInt))
@ -241,12 +246,7 @@ subroutine CPFEM_init
close (777)
restartRead = .false.
endif
! *** end of restoring
write(6,'(/,a)') '<<<+- CPFEM init -+>>>'
write(6,'(a)') '$Id$'
write(6,'(a16,a)') ' Current time : ',IO_timeStamp()
#include "compilation_info.f90"
if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) then
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_cs: ', shape(CPFEM_cs)
write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE)
@ -361,7 +361,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
H, &
jacobian3333 ! jacobian in Matrix notation
integer(pInt) cp_en, & ! crystal plasticity element number
i, j, k, l, m, n, e
i, j, k, l, m, n
logical updateJaco ! flag indicating if JAcobian has to be updated

21
code/DAMASK_spectral_solverAL.f90
View File

@ -87,8 +87,27 @@ module DAMASK_spectral_solverAL
err_p !< difference of stress resulting from compatible and incompatible F
logical, private :: ForwardData
integer(pInt), private :: reportIter = 0_pInt
external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASetLocalFunction, &
PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------

14
code/DAMASK_spectral_solverBasic.f90
View File

@ -55,7 +55,7 @@ module DAMASK_spectral_SolverBasic
real(pReal), private,dimension(3,3,3,3) :: &
C = 0.0_pReal, C_minmaxAvg = 0.0_pReal, & !< average stiffness
C_lastInc = 0.0_pReal !< average stiffness last increment
contains
!--------------------------------------------------------------------------------------------------
@ -91,17 +91,15 @@ subroutine basic_init(temperature)
real(pReal), intent(inout) :: &
temperature
real(pReal), dimension(3,3,res(1),res(2),res(3)) :: P
integer(pInt) :: &
i, j, k
real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal
real(pReal), dimension(3,3,3,3) :: &
temp3333_Real
call Utilities_Init()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(a,3(f12.5)/)') ' scaledDim x y z:', scaledDim
@ -228,10 +226,6 @@ type(tSolutionState) function &
real(pReal) :: err_div, err_stress
integer(pInt) :: iter, row, column
logical :: ForwardData
real(pReal) :: &
defgradDet, &
defgradDetMax, &
defgradDetMin
!--------------------------------------------------------------------------------------------------
! write restart information for spectral solver

19
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -79,11 +79,27 @@ module DAMASK_spectral_SolverBasicPETSc
integer(pInt), private :: reportIter = 0_pInt
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
public :: &
basicPETSc_init, &
basicPETSc_solution ,&
basicPETSc_destroy
external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASetLocalFunction, &
PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort
contains
@ -379,7 +395,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
PetscObject :: dummy
PetscErrorCode :: ierr
integer(pInt), save :: callNo = 3_pInt
logical :: report
call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,iter,ierr); CHKERRQ(ierr)

12
code/DAMASK_spectral_utilities.f90
View File

@ -159,12 +159,10 @@ subroutine utilities_init()
scalarField_realC, & !< field cotaining data for FFTW in real space when debugging FFTW (no in place)
scalarField_fourierC, & !< field cotaining data for FFTW in fourier space when debugging FFTW (no in place)
divergence !< field cotaining data for FFTW in real and fourier space when debugging divergence (in place)
write(6,'(/,a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a16,a)') ' Current time : ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- DAMASK_spectral_utilities init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
write(6,'(a)') ''
flush(6)
!--------------------------------------------------------------------------------------------------
! set debugging parameters
@ -572,7 +570,6 @@ real(pReal) function utilities_curlRMS()
implicit none
integer(pInt) :: i, j, k, l
complex(pReal), dimension(3,3) :: curl_fourier
real(pReal) :: curl_abs
write(6,'(/,a)') ' ... calculating curl ................................................'
flush(6)
@ -922,9 +919,10 @@ real(pReal) function utilities_getFilter(k)
implicit none
real(pReal),intent(in), dimension(3) :: k !< indices of frequency
utilities_getFilter = 1.0_pReal
select case (myfilter)
case ('none')
utilities_getFilter = 1.0_pReal
case ('cosine') !< cosine curve with 1 for avg and zero for highest freq
utilities_getFilter = (1.0_pReal + cos(PI*k(3)/res(3))) &
*(1.0_pReal + cos(PI*k(2)/res(2))) &

42
code/math.f90
View File

@ -271,9 +271,9 @@ subroutine math_init
! comment the first random_seed call out, set randSize to 1, and use ifort
character(len=64) :: error_msg
write(6,'(/,a)') ' <<<+- math init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a16,a)') ' Current time : ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- math init -+>>>'
write(6,'(a)') ' $Id$'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
call random_seed(size=randSize)
@ -1757,12 +1757,12 @@ function math_qDisorientation(Q1, Q2, symmetryType)
implicit none
!*** input variables
real(pReal), dimension(4), intent(in) :: Q1, & ! 1st orientation
Q2 ! 2nd orientation
integer(pInt), intent(in) :: symmetryType ! Type of crystal symmetry; 1:cubic, 2:hexagonal
real(pReal), dimension(4), intent(in) :: Q1, & ! 1st orientation
Q2 ! 2nd orientation
integer(pInt), intent(in) :: symmetryType ! Type of crystal symmetry; 1:cubic, 2:hexagonal
!*** output variables
real(pReal), dimension(4) :: math_qDisorientation ! disorientation
real(pReal), dimension(4) :: math_qDisorientation ! disorientation
!*** local variables
real(pReal), dimension(4) :: dQ,dQsymA,mis
@ -1774,25 +1774,25 @@ function math_qDisorientation(Q1, Q2, symmetryType)
select case (symmetryType)
case (0_pInt)
if (math_qDisorientation(1) < 0.0_pReal) &
math_qDisorientation = -math_qDisorientation ! keep omega within 0 to 180 deg
math_qDisorientation = -math_qDisorientation ! keep omega within 0 to 180 deg
case (1_pInt,2_pInt)
s = sum(math_NsymOperations(1:symmetryType-1_pInt))
do i = 1_pInt,2_pInt
dQ = math_qConj(dQ) ! switch order of "from -- to"
do j = 1_pInt,math_NsymOperations(symmetryType) ! run through first crystal's symmetries
dQsymA = math_qMul(math_symOperations(1:4,s+j),dQ) ! apply sym
do k = 1_pInt,math_NsymOperations(symmetryType) ! run through 2nd crystal's symmetries
mis = math_qMul(dQsymA,math_symOperations(1:4,s+k)) ! apply sym
if (mis(1) < 0.0_pReal) & ! want positive angle
dQ = math_qConj(dQ) ! switch order of "from -- to"
do j = 1_pInt,math_NsymOperations(symmetryType) ! run through first crystal's symmetries
dQsymA = math_qMul(math_symOperations(1:4,s+j),dQ) ! apply sym
do k = 1_pInt,math_NsymOperations(symmetryType) ! run through 2nd crystal's symmetries
mis = math_qMul(dQsymA,math_symOperations(1:4,s+k)) ! apply sym
if (mis(1) < 0.0_pReal) & ! want positive angle
mis = -mis
if (mis(1)-math_qDisorientation(1) > -1e-8_pReal .and. &
math_qInSST(mis,symmetryType)) &
math_qDisorientation = mis ! found better one
math_qDisorientation = mis ! found better one
enddo; enddo; enddo
case default
call IO_error(450_pInt,symmetryType) ! complain about unknown symmetry
call IO_error(450_pInt,symmetryType) ! complain about unknown symmetry
end select
end function math_qDisorientation
@ -2778,7 +2778,7 @@ function math_curlFFT(geomdim,field)
call fftw_execute_dft_r2c(fftw_forth, field_real, field_fourier)
!--------------------------------------------------------------------------------------------------
! remove highest frequency in each direction
! remove highest frequency in each direction, in third direction only if not 2D
field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,&
1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,&
@ -2814,7 +2814,7 @@ function math_curlFFT(geomdim,field)
math_curlFFT = curl_real(1:res(1),1:res(2),1:res(3),1:vec_tens,1:3)*wgt ! copy to output and weight
if (vec_tens == 3_pInt) &
forall(k = 1_pInt:res(3), j = 1_pInt:res(2), i = 1_pInt: res(1)) &
forall(k = 1_pInt:res(3), j = 1_pInt:res(2), i = 1_pInt:res(1)) &
math_curlFFT(i,j,k,1:3,1:3) = math_transpose33(math_curlFFT(i,j,k,1:3,1:3)) ! results are stored transposed
call fftw_destroy_plan(fftw_forth)
@ -2910,7 +2910,7 @@ function math_gradFFT(geomdim,field)
call fftw_execute_dft_r2c(fftw_forth, field_real, field_fourier)
!--------------------------------------------------------------------------------------------------
! remove highest frequency in each direction
! remove highest frequency in each direction, in third direction only if not 2D
field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,&
1:vec_tens) = cmplx(0.0_pReal,0.0_pReal,pReal)
field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,&
@ -3039,7 +3039,7 @@ function math_divergenceFFT(geomdim,field)
call fftw_execute_dft_r2c(fftw_forth, field_real, field_fourier)
!--------------------------------------------------------------------------------------------------
! remove highest frequency in each direction
! remove highest frequency in each direction, in third direction only if not 2D
field_fourier( res(1)/2_pInt+1_pInt,1:res(2) ,1:res(3) ,&
1:vec_tens,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
field_fourier(1:res1_red ,res(2)/2_pInt+1_pInt,1:res(3) ,&
@ -3240,7 +3240,7 @@ function math_nearestNeighbor(querySet, domainSet)
real(pReal), dimension(:,:), intent(in) :: domainSet
integer(pInt), dimension(size(querySet,2)) :: math_nearestNeighbor
integer(pInt) :: i,j, l,m,n, spatialDim
integer(pInt) :: j, spatialDim
type(kdtree2), pointer :: tree
type(kdtree2_result), dimension(1) :: Results

120
code/mesh.f90
View File

@ -1232,22 +1232,22 @@ function mesh_regrid(adaptive,resNewInput,minRes)
real(pReal), dimension(3,3) :: Favg, Favg_LastInc, &
FavgNew, Favg_LastIncNew, &
deltaF, deltaF_lastInc
real(pReal), dimension(:,:), allocatable :: &
real(pReal), dimension(:,:), allocatable :: &
coordinates, coordinatesNew
real(pReal), dimension(:,:,:), allocatable :: &
real(pReal), dimension(:,:,:), allocatable :: &
stateHomog
real(pReal), dimension (:,:,:,:), allocatable :: &
real(pReal), dimension (:,:,:,:), allocatable :: &
spectralF9, spectralF9New, &
Tstar, TstarNew, &
stateConst
real(pReal), dimension(:,:,:,:,:), allocatable :: &
real(pReal), dimension(:,:,:,:,:), allocatable :: &
spectralF33, spectralF33New, &
F, FNew, &
Fp, FpNew, &
Lp, LpNew, &
dcsdE, dcsdENew, &
F_lastIncNew
real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: &
real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: &
dPdF, dPdFNew
integer(pInt), dimension(:,:), allocatable :: &
@ -1282,7 +1282,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
read (777,rec=1) spectralF33
close (777)
Favg = sum(sum(sum(spectralF33,dim=5),dim=4),dim=3) * wgt
coordinates = reshape(mesh_deformedCoordsFFT(geomdim,spectralF33,Favg),[3,mesh_NcpElems])
coordinates = reshape(mesh_deformedCoordsFFT(geomdim,spectralF33),[3,mesh_NcpElems])
case('basicpetsc','al')
allocate(spectralF9(9,res(1),res(2),res(3)))
call IO_read_jobBinaryFile(777,'F',trim(getSolverJobName()),size(spectralF9))
@ -1290,7 +1290,7 @@ function mesh_regrid(adaptive,resNewInput,minRes)
close (777)
Favg = reshape(sum(sum(sum(spectralF9,dim=4),dim=3),dim=2) * wgt, [3,3])
coordinates = reshape(mesh_deformedCoordsFFT(geomdim,reshape(spectralF9, &
[3,3,res(1),res(2),res(3)]),Favg),[3,mesh_NcpElems])
[3,3,res(1),res(2),res(3)])),[3,mesh_NcpElems])
end select
!--------------------------------------------------------------------------------------------------
@ -1696,7 +1696,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin
j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin
i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin
me = [i,j,k] ! me on skin
me = [i,j,k] ! me on skin
shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me)
lookup = me-diag+shift*iRes
wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = &
@ -1929,7 +1929,7 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
real(pReal), dimension(3,3) :: Favg
if (present(scalingIn)) then
where (scalingIn < 0.0_pReal) !the f2py way to tell it is not present
where (scalingIn < 0.0_pReal) ! the f2py way to tell it is not present
scaling = [1.0_pReal,1.0_pReal,1.0_pReal]
elsewhere
scaling = scalingIn
@ -1939,7 +1939,9 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
endif
iRes = [size(F,3),size(F,4),size(F,5)]
integrator = gDim / 2.0_pReal / PI ! see notes where it is used
integrator = gDim / 2.0_pReal / PI ! see notes where it is used
res1_red = iRes(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
step = gDim/real(iRes, pReal)
!--------------------------------------------------------------------------------------------------
! report
@ -1948,25 +1950,29 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
write(6,'(a,3(e12.5))') ' Dimension: ', gDim
write(6,'(a,3(i5))') ' Resolution:', iRes
endif
res1_red = iRes(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
step = gDim/real(iRes, pReal)
!--------------------------------------------------------------------------------------------------
! sanity checks
if ((mod(iRes(3),2_pInt)/=0_pInt .and. iRes(3) /= 1_pInt) .or. &
mod(iRes(2),2_pInt)/=0_pInt .or. &
mod(iRes(1),2_pInt)/=0_pInt) &
call IO_error(0_pInt,ext_msg='Resolution in mesh_deformedCoordsFFT')
if (pReal /= C_DOUBLE .or. pInt /= C_INT) &
call IO_error(0_pInt,ext_msg='Fortran to C in mesh_deformedCoordsFFT')
!--------------------------------------------------------------------------------------------------
! allocation and FFTW initialization
call fftw_set_timelimit(fftw_timelimit)
defgrad_fftw = fftw_alloc_complex(int(res1_red *iRes(2)*iRes(3)*9_pInt,C_SIZE_T)) !C_SIZE_T is of type integer(8)
defgrad_fftw = fftw_alloc_complex(int(res1_red *iRes(2)*iRes(3)*9_pInt,C_SIZE_T)) ! C_SIZE_T is of type integer(8)
call c_f_pointer(defgrad_fftw, F_real, [iRes(1)+2_pInt,iRes(2),iRes(3),3_pInt,3_pInt])
call c_f_pointer(defgrad_fftw, F_fourier,[res1_red ,iRes(2),iRes(3),3_pInt,3_pInt])
coords_fftw = fftw_alloc_complex(int(res1_red *iRes(2)*iRes(3)*3_pInt,C_SIZE_T)) !C_SIZE_T is of type integer(8)
coords_fftw = fftw_alloc_complex(int(res1_red *iRes(2)*iRes(3)*3_pInt,C_SIZE_T)) ! C_SIZE_T is of type integer(8)
call c_f_pointer(coords_fftw, coords_real, [iRes(1)+2_pInt,iRes(2),iRes(3),3_pInt])
call c_f_pointer(coords_fftw, coords_fourier, [res1_red ,iRes(2),iRes(3),3_pInt])
fftw_forth = fftw_plan_many_dft_r2c(3_pInt,[iRes(3),iRes(2) ,iRes(1)],9_pInt,& ! dimensions , length in each dimension in reversed order
F_real,[iRes(3),iRes(2) ,iRes(1)+2_pInt],& ! input data , physical length in each dimension in reversed order
1_pInt, iRes(3)*iRes(2)*(iRes(1)+2_pInt),& ! striding , product of physical lenght in the 3 dimensions
fftw_forth = fftw_plan_many_dft_r2c(3_pInt,[iRes(3),iRes(2) ,iRes(1)],9_pInt,& ! dimensions , length in each dimension in reversed order
F_real,[iRes(3),iRes(2) ,iRes(1)+2_pInt],& ! input data , physical length in each dimension in reversed order
1_pInt, iRes(3)*iRes(2)*(iRes(1)+2_pInt),& ! striding , product of physical lenght in the 3 dimensions
F_fourier,[iRes(3),iRes(2) ,res1_red],&
1_pInt, iRes(3)*iRes(2)* res1_red,fftw_planner_flag)
@ -1975,34 +1981,37 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
1_pInt, iRes(3)*iRes(2)* res1_red,&
coords_real,[iRes(3),iRes(2) ,iRes(1)+2_pInt],&
1_pInt, iRes(3)*iRes(2)*(iRes(1)+2_pInt),fftw_planner_flag)
do k = 1_pInt, iRes(3); do j = 1_pInt, iRes(2); do i = 1_pInt, iRes(1)
F_real(i,j,k,1:3,1:3) = F(1:3,1:3,i,j,k) ! ensure that data is aligned properly (fftw_alloc)
enddo; enddo; enddo
forall(k = 1_pInt:iRes(3), j = 1_pInt:iRes(2), i = 1_pInt:iRes(1)) &
F_real(i,j,k,1:3,1:3) = F(1:3,1:3,i,j,k) ! F_real is overwritten during plan creation and is larger (padding)
!--------------------------------------------------------------------------------------------------
! FFT
call fftw_execute_dft_r2c(fftw_forth, F_real, F_fourier)
!--------------------------------------------------------------------------------------------------
! if no average F is given, compute it in Fourier space
if (present(FavgIn)) then
if (all(FavgIn < 0.0_pReal)) then
Favg = real(F_fourier(1,1,1,1:3,1:3),pReal)*real(product(iRes),pReal) !the f2py way to tell it is not present
Favg = real(F_fourier(1,1,1,1:3,1:3),pReal)/real(product(iRes),pReal) !the f2py way to tell it is not present
else
Favg = FavgIn
endif
else
Favg = real(F_fourier(1,1,1,1:3,1:3),pReal)*real(product(iRes),pReal)
Favg = real(F_fourier(1,1,1,1:3,1:3),pReal)/real(product(iRes),pReal)
endif
!remove highest frequency in each direction
if(iRes(1)>1_pInt) &
F_fourier( iRes(1)/2_pInt+1_pInt,1:iRes(2) ,1:iRes(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
if(iRes(2)>1_pInt) &
F_fourier(1:res1_red ,iRes(2)/2_pInt+1_pInt,1:iRes(3) ,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
!--------------------------------------------------------------------------------------------------
! remove highest frequency in each direction, in third direction only if not 2D
F_fourier( iRes(1)/2_pInt+1_pInt,1:iRes(2) ,1:iRes(3) ,1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal)
F_fourier( 1:res1_red ,iRes(2)/2_pInt+1_pInt,1:iRes(3) ,1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal)
if(iRes(3)>1_pInt) &
F_fourier(1:res1_red ,1:iRes(2) ,iRes(3)/2_pInt+1_pInt,&
1:3,1:3) = cmplx(0.0_pReal,0.0_pReal,pReal)
F_fourier(1:res1_red ,1:iRes(2) ,iRes(3)/2_pInt+1_pInt,1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal)
!--------------------------------------------------------------------------------------------------
! integration in Fourier space
coords_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
do k = 1_pInt, iRes(3)
k_s(3) = k-1_pInt
@ -2013,39 +2022,38 @@ function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
do i = 1_pInt, res1_red
k_s(1) = i-1_pInt
do m = 1_pInt,3_pInt
coords_fourier(i,j,k,m) = sum(F_fourier(i,j,k,m,1:3)*cmplx(0.0_pReal,real(k_s,pReal)*integrator,pReal))
enddo
if (k_s(3) /= 0_pInt .or. k_s(2) /= 0_pInt .or. k_s(1) /= 0_pInt) &
coords_fourier(i,j,k,1:3) = coords_fourier(i,j,k,1:3) / cmplx(-sum(k_s*k_s),0.0_pReal,pReal)
coords_fourier(i,j,k,m) = sum(F_fourier(i,j,k,m,1:3)*&
cmplx(0.0_pReal,real(k_s,pReal)*integrator,pReal))
enddo
if (any(k_s /= 0_pInt)) coords_fourier(i,j,k,1:3) = &
coords_fourier(i,j,k,1:3) / cmplx(-sum(k_s*k_s),0.0_pReal,pReal)
enddo; enddo; enddo
!--------------------------------------------------------------------------------------------------
! iFFT and freeing memory
call fftw_execute_dft_c2r(fftw_back,coords_fourier,coords_real)
coords_real = coords_real/real(iRes(1)*iRes(2)*iRes(3),pReal)
do k = 1_pInt, iRes(3); do j = 1_pInt, iRes(2); do i = 1_pInt, iRes(1)
coords(1:3,i,j,k) = coords_real(i,j,k,1:3) ! ensure that data is aligned properly (fftw_alloc)
enddo; enddo; enddo
offset_coords = math_mul33x3(F(1:3,1:3,1,1,1),step/2.0_pReal) - scaling(1:3)*coords(1:3,1,1,1)
do k = 1_pInt, iRes(3); do j = 1_pInt, iRes(2); do i = 1_pInt, iRes(1)
coords(1:3,i,j,k) = scaling(1:3)*coords(1:3,i,j,k) &
+ offset_coords + math_mul33x3(Favg,[step(1)*real(i-1_pInt,pReal),&
step(2)*real(j-1_pInt,pReal),&
step(3)*real(k-1_pInt,pReal)])
enddo; enddo; enddo
coords_real = coords_real/real(product(iRes),pReal)
forall(k = 1_pInt:iRes(3), j = 1_pInt:iRes(2), i = 1_pInt:iRes(1)) &
coords(1:3,i,j,k) = coords_real(i,j,k,1:3)
call fftw_destroy_plan(fftw_forth)
call fftw_destroy_plan(fftw_back)
call fftw_free(defgrad_fftw)
call fftw_free(coords_fftw)
!--------------------------------------------------------------------------------------------------
! add average to scaled fluctuation and put (0,0,0) on (0,0,0)
offset_coords = math_mul33x3(F(1:3,1:3,1,1,1),step/2.0_pReal) - scaling*coords(1:3,1,1,1)
forall(k = 1_pInt:iRes(3), j = 1_pInt:iRes(2), i = 1_pInt:iRes(1)) &
coords(1:3,i,j,k) = scaling(1:3)*coords(1:3,i,j,k) &
+ offset_coords &
+ math_mul33x3(Favg,step*real([i,j,k]-1_pInt,pReal))
end function mesh_deformedCoordsFFT
!--------------------------------------------------------------------------------------------------
!> @brief calculates the mismatch between volume of reconstructed (compatible
! cube and determinant of defgrad at the FP
!> @brief calculates the mismatch between volume of reconstructed (compatible) cube and
! determinant of defgrad at the FP
!--------------------------------------------------------------------------------------------------
function mesh_volumeMismatch(gDim,F,nodes) result(vMismatch)
use IO, only: &
@ -2230,7 +2238,7 @@ subroutine mesh_marc_get_tableStyles(myUnit)
read (myUnit,610,END=620) line
myPos = IO_stringPos(line,maxNchunks)
if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'table' .and. myPos(1_pInt) .GT. 5) then
if ( IO_lc(IO_stringValue(line,myPos,1_pInt)) == 'table' .and. myPos(1_pInt) > 5) then
initialcondTableStyle = IO_intValue(line,myPos,4_pInt)
hypoelasticTableStyle = IO_intValue(line,myPos,5_pInt)
exit