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

removed a bunch of unneded functions

This commit is contained in:
Martin Diehl 2016-06-27 18:15:56 +02:00
parent 14394e7e13
commit 21cfe09412
1 changed files with 3 additions and 329 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

332
code/mesh.f90
View File

@ -640,7 +640,7 @@ subroutine mesh_init(ip,el)
if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6)
call mesh_build_ipNeighborhood
#else
call mesh_spectral_build_ipNeighborhood(FILEUNIT)
call mesh_spectral_build_ipNeighborhood
#endif
if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6)
@ -1388,11 +1388,9 @@ end subroutine mesh_spectral_build_elements
!> @brief build neighborhood relations for spectral
!> @details assign globals: mesh_ipNeighborhood
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_build_ipNeighborhood(fileUnit)
subroutine mesh_spectral_build_ipNeighborhood
implicit none
integer(pInt), intent(in) :: &
fileUnit
integer(pInt) :: &
x,y,z, &
e
@ -1529,332 +1527,8 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes)
nodes = nodes/8.0_pReal
end function mesh_nodesAroundCentres
!--------------------------------------------------------------------------------------------------
!> @brief calculate coordinates in current configuration for given defgrad
! using integration in Fourier space
!--------------------------------------------------------------------------------------------------
function mesh_deformedCoordsFFT(gDim,F,FavgIn,scalingIn) result(coords)
use IO, only: &
IO_error
use numerics, only: &
fftw_timelimit, &
fftw_planner_flag
use debug, only: &
debug_mesh, &
debug_level, &
debug_levelBasic
use math, only: &
PI, &
math_mul33x3
implicit none
real(pReal), intent(in), dimension(:,:,:,:,:) :: F
real(pReal), dimension(3,size(F,3),size(F,4),size(F,5)) :: coords
real(pReal), intent(in), dimension(3) :: gDim
real(pReal), intent(in), dimension(3,3), optional :: FavgIn
real(pReal), intent(in), dimension(3), optional :: scalingIn
! allocatable arrays for fftw c routines
type(C_PTR) :: planForth, planBack
type(C_PTR) :: coords_fftw, defgrad_fftw
real(pReal), dimension(:,:,:,:,:), pointer :: F_real
complex(pReal), dimension(:,:,:,:,:), pointer :: F_fourier
real(pReal), dimension(:,:,:,:), pointer :: coords_real
complex(pReal), dimension(:,:,:,:), pointer :: coords_fourier
! other variables
integer(pInt) :: i, j, k, m, res1Red
integer(pInt), dimension(3) :: k_s, iRes
real(pReal), dimension(3) :: scaling, step, offset_coords, integrator
real(pReal), dimension(3,3) :: Favg
integer(pInt), dimension(2:3,2) :: Nyquist ! highest frequencies to be removed (1 if even, 2 if odd)
if (present(scalingIn)) then
where (scalingIn < 0.0_pReal) ! invalid values. in case of f2py -1 if not present
scaling = [1.0_pReal,1.0_pReal,1.0_pReal]
elsewhere
scaling = scalingIn
end where
else
scaling = 1.0_pReal
endif
iRes = [size(F,3),size(F,4),size(F,5)]
integrator = gDim / 2.0_pReal / PI ! see notes where it is used
res1Red = iRes(1)/2_pInt + 1_pInt ! size of complex array in first dimension (c2r, r2c)
step = gDim/real(iRes, pReal)
Nyquist(2,1:2) = [iRes(2)/2_pInt + 1_pInt, iRes(2)/2_pInt + 1_pInt + mod(iRes(2),2_pInt)]
Nyquist(3,1:2) = [iRes(3)/2_pInt + 1_pInt, iRes(3)/2_pInt + 1_pInt + mod(iRes(3),2_pInt)]
!--------------------------------------------------------------------------------------------------
! report
if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then
write(6,'(a)') ' Restore geometry using FFT-based integration'
write(6,'(a,3(i12 ))') ' grid a b c: ', iRes
write(6,'(a,3(es12.5))') ' size x y z: ', gDim
endif
!--------------------------------------------------------------------------------------------------
! sanity check
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
defgrad_fftw = fftw_alloc_complex(int(res1Red *iRes(2)*iRes(3)*9_pInt,C_SIZE_T)) ! C_SIZE_T is of type integer(8)
coords_fftw = fftw_alloc_complex(int(res1Red *iRes(2)*iRes(3)*3_pInt,C_SIZE_T)) ! C_SIZE_T is of type integer(8)
call c_f_pointer(defgrad_fftw, F_real, &
[iRes(1)+2_pInt-mod(iRes(1),2_pInt),iRes(2),iRes(3),3_pInt,3_pInt])
call c_f_pointer(defgrad_fftw, F_fourier, &
[res1Red, iRes(2),iRes(3),3_pInt,3_pInt])
call c_f_pointer(coords_fftw, coords_real, &
[iRes(1)+2_pInt-mod(iRes(1),2_pInt),iRes(2),iRes(3),3_pInt])
call c_f_pointer(coords_fftw, coords_fourier, &
[res1Red, iRes(2),iRes(3),3_pInt])
call fftw_set_timelimit(fftw_timelimit)
planForth = 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-mod(iRes(1),2_pInt)],& ! input data , physical length in each dimension in reversed order
1_pInt, iRes(3)*iRes(2)*(iRes(1)+2_pInt-mod(iRes(1),2_pInt)),& ! striding , product of physical lenght in the 3 dimensions
F_fourier,[iRes(3),iRes(2) ,res1Red],&
1_pInt, iRes(3)*iRes(2)* res1Red,fftw_planner_flag)
planBack = fftw_plan_many_dft_c2r(3_pInt,[iRes(3),iRes(2) ,iRes(1)],3_pInt,&
coords_fourier,[iRes(3),iRes(2) ,res1Red],&
1_pInt, iRes(3)*iRes(2)* res1Red,&
coords_real,[iRes(3),iRes(2) ,iRes(1)+2_pInt-mod(iRes(1),2_pInt)],&
1_pInt, iRes(3)*iRes(2)*(iRes(1)+2_pInt-mod(iRes(1),2_pInt)),&
fftw_planner_flag)
F_real(1:iRes(1),1:iRes(2),1:iRes(3),1:3,1:3) = &
reshape(F,[iRes(1),iRes(2),iRes(3),3,3], order = [4,5,1,2,3]) ! F_real is overwritten during plan creatio, is larger (padding) and has different order
!--------------------------------------------------------------------------------------------------
! FFT
call fftw_execute_dft_r2c(planForth, 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
else
Favg = FavgIn
endif
else
Favg = real(F_fourier(1,1,1,1:3,1:3),pReal)/real(product(iRes),pReal)
endif
!--------------------------------------------------------------------------------------------------
! remove highest frequency in each direction, in third direction only if not 2D
if(iRes(1)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
F_fourier (res1Red, 1:iRes(2), 1:iRes(3), 1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal)
if(iRes(2)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
F_fourier (1:res1Red,Nyquist(2,1):Nyquist(2,2),1:iRes(3), 1:3,1:3) &
= cmplx(0.0_pReal,0.0_pReal,pReal)
if(iRes(3)/=1_pInt) & ! do not delete the whole slice in case of 2D calculation
F_fourier (1:res1Red,1:iRes(2), Nyquist(3,1):Nyquist(3,2),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
if(k > iRes(3)/2_pInt+1_pInt) k_s(3) = k_s(3)-iRes(3)
do j = 1_pInt, iRes(2)
k_s(2) = j-1_pInt
if(j > iRes(2)/2_pInt+1_pInt) k_s(2) = k_s(2)-iRes(2)
do i = 1_pInt, res1Red
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 (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(planBack,coords_fourier,coords_real)
coords = reshape(coords_real(1:iRes(1),1:iRes(2),1:iRes(3),1:3), [3,iRes(1),iRes(2),iRes(3)], &
order = [2,3,4,1])/real(product(iRes),pReal) ! weight and change order
call fftw_destroy_plan(planForth)
call fftw_destroy_plan(planBack)
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
!--------------------------------------------------------------------------------------------------
function mesh_volumeMismatch(gDim,F,nodes) result(vMismatch)
use IO, only: &
IO_error
use debug, only: &
debug_mesh, &
debug_level, &
debug_levelBasic
use math, only: &
math_det33, &
math_volTetrahedron
implicit none
real(pReal), intent(in), dimension(:,:,:,:,:) :: &
F
real(pReal), dimension(size(F,3),size(F,4),size(F,5)) :: &
vMismatch
real(pReal), intent(in), dimension(:,:,:,:) :: &
nodes
real(pReal), dimension(3) :: &
gDim
integer(pInt), dimension(3) :: &
iRes
real(pReal), dimension(3,8) :: coords
integer(pInt) :: i,j,k
real(pReal) :: volInitial
iRes = [size(F,3),size(F,4),size(F,5)]
volInitial = product(gDim)/real(product(iRes), pReal)
!--------------------------------------------------------------------------------------------------
! report and check
if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then
write(6,'(a)') ' Calculating volume mismatch'
write(6,'(a,3(i12 ))') ' grid a b c: ', iRes
write(6,'(a,3(es12.5))') ' size x y z: ', gDim
endif
if (any([iRes/=size(nodes,2)-1_pInt,iRes/=size(nodes,3)-1_pInt,iRes/=size(nodes,4)-1_pInt]))&
call IO_error(0_pInt,ext_msg='Arrays F and nodes in mesh_volumeMismatch')
!--------------------------------------------------------------------------------------------------
! calculate actual volume and volume resulting from deformation gradient
do k = 1_pInt,iRes(3)
do j = 1_pInt,iRes(2)
do i = 1_pInt,iRes(1)
coords(1:3,1) = nodes(1:3,i, j, k )
coords(1:3,2) = nodes(1:3,i+1_pInt,j, k )
coords(1:3,3) = nodes(1:3,i+1_pInt,j+1_pInt,k )
coords(1:3,4) = nodes(1:3,i, j+1_pInt,k )
coords(1:3,5) = nodes(1:3,i, j, k+1_pInt)
coords(1:3,6) = nodes(1:3,i+1_pInt,j, k+1_pInt)
coords(1:3,7) = nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt)
coords(1:3,8) = nodes(1:3,i, j+1_pInt,k+1_pInt)
vMismatch(i,j,k) = &
abs(math_volTetrahedron(coords(1:3,7),coords(1:3,1),coords(1:3,8),coords(1:3,4))) &
+ abs(math_volTetrahedron(coords(1:3,7),coords(1:3,1),coords(1:3,8),coords(1:3,5))) &
+ abs(math_volTetrahedron(coords(1:3,7),coords(1:3,1),coords(1:3,3),coords(1:3,4))) &
+ abs(math_volTetrahedron(coords(1:3,7),coords(1:3,1),coords(1:3,3),coords(1:3,2))) &
+ abs(math_volTetrahedron(coords(1:3,7),coords(1:3,5),coords(1:3,2),coords(1:3,6))) &
+ abs(math_volTetrahedron(coords(1:3,7),coords(1:3,5),coords(1:3,2),coords(1:3,1)))
vMismatch(i,j,k) = vMismatch(i,j,k)/math_det33(F(1:3,1:3,i,j,k))
enddo; enddo; enddo
vMismatch = vMismatch/volInitial
end function mesh_volumeMismatch
!--------------------------------------------------------------------------------------------------
!> @brief Routine to calculate the mismatch between the vectors from the central point to
! the corners of reconstructed (combatible) volume element and the vectors calculated by deforming
! the initial volume element with the current deformation gradient
!--------------------------------------------------------------------------------------------------
function mesh_shapeMismatch(gDim,F,nodes,centres) result(sMismatch)
use IO, only: &
IO_error
use debug, only: &
debug_mesh, &
debug_level, &
debug_levelBasic
use math, only: &
math_mul33x3
implicit none
real(pReal), intent(in), dimension(:,:,:,:,:) :: &
F
real(pReal), dimension(size(F,3),size(F,4),size(F,5)) :: &
sMismatch
real(pReal), intent(in), dimension(:,:,:,:) :: &
nodes, &
centres
real(pReal), dimension(3) :: &
gDim, &
fRes
integer(pInt), dimension(3) :: &
iRes
real(pReal), dimension(3,8) :: coordsInitial
integer(pInt) i,j,k
iRes = [size(F,3),size(F,4),size(F,5)]
fRes = real(iRes,pReal)
!--------------------------------------------------------------------------------------------------
! report and check
if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then
write(6,'(a)') ' Calculating shape mismatch'
write(6,'(a,3(i12 ))') ' grid a b c: ', iRes
write(6,'(a,3(es12.5))') ' size x y z: ', gDim
endif
if(any([iRes/=size(nodes,2)-1_pInt,iRes/=size(nodes,3)-1_pInt,iRes/=size(nodes,4)-1_pInt]) .or.&
any([iRes/=size(centres,2), iRes/=size(centres,3), iRes/=size(centres,4)]))&
call IO_error(0_pInt,ext_msg='Arrays F and nodes/centres in mesh_shapeMismatch')
!--------------------------------------------------------------------------------------------------
! initial positions
coordsInitial(1:3,1) = [-gDim(1)/fRes(1),-gDim(2)/fRes(2),-gDim(3)/fRes(3)]
coordsInitial(1:3,2) = [+gDim(1)/fRes(1),-gDim(2)/fRes(2),-gDim(3)/fRes(3)]
coordsInitial(1:3,3) = [+gDim(1)/fRes(1),+gDim(2)/fRes(2),-gDim(3)/fRes(3)]
coordsInitial(1:3,4) = [-gDim(1)/fRes(1),+gDim(2)/fRes(2),-gDim(3)/fRes(3)]
coordsInitial(1:3,5) = [-gDim(1)/fRes(1),-gDim(2)/fRes(2),+gDim(3)/fRes(3)]
coordsInitial(1:3,6) = [+gDim(1)/fRes(1),-gDim(2)/fRes(2),+gDim(3)/fRes(3)]
coordsInitial(1:3,7) = [+gDim(1)/fRes(1),+gDim(2)/fRes(2),+gDim(3)/fRes(3)]
coordsInitial(1:3,8) = [-gDim(1)/fRes(1),+gDim(2)/fRes(2),+gDim(3)/fRes(3)]
coordsInitial = coordsInitial/2.0_pReal
!--------------------------------------------------------------------------------------------------
! compare deformed original and deformed positions to actual positions
do k = 1_pInt,iRes(3)
do j = 1_pInt,iRes(2)
do i = 1_pInt,iRes(1)
sMismatch(i,j,k) = &
sqrt(sum((nodes(1:3,i, j, k ) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,1)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i+1_pInt,j, k ) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,2)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i+1_pInt,j+1_pInt,k ) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,3)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i, j+1_pInt,k ) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,4)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i, j, k+1_pInt) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,5)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i+1_pInt,j, k+1_pInt) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,6)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,7)))**2.0_pReal))&
+ sqrt(sum((nodes(1:3,i, j+1_pInt,k+1_pInt) - centres(1:3,i,j,k)&
- math_mul33x3(F(1:3,1:3,i,j,k), coordsInitial(1:3,8)))**2.0_pReal))
enddo; enddo; enddo
end function mesh_shapeMismatch
#endif
#ifdef Marc4DAMASK
!--------------------------------------------------------------------------------------------------
!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and