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

syntax polishing

This commit is contained in:
Martin Diehl 2019-03-25 19:17:10 +01:00
parent 27da4b2b7a
commit 17455d1dc6
1 changed files with 434 additions and 439 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/spectral_utilities.f90
View File

@ -9,8 +9,7 @@ module spectral_utilities
use PETScSys use PETScSys
use prec, only: & use prec, only: &
pReal, & pReal, &
pStringLen, & pStringLen
pInt
use math, only: & use math, only: &
math_I3 math_I3
@ -25,11 +24,11 @@ module spectral_utilities
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! field labels information ! field labels information
enum, bind(c) enum, bind(c)
enumerator :: FIELD_UNDEFINED_ID, & enumerator :: &
FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, & FIELD_MECH_ID, &
FIELD_THERMAL_ID, & FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID, & FIELD_DAMAGE_ID
FIELD_VACANCYDIFFUSION_ID
end enum end enum
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -71,11 +70,12 @@ module spectral_utilities
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type, public :: tSolutionState !< return type of solution from spectral solver variants type, public :: tSolutionState !< return type of solution from spectral solver variants
integer :: &
iterationsNeeded = 0
logical :: & logical :: &
converged = .true., & converged = .true., &
stagConverged = .true., & stagConverged = .true., &
termIll = .false. termIll = .false.
integer :: iterationsNeeded = 0
end type tSolutionState end type tSolutionState
type, public :: tBoundaryCondition !< set of parameters defining a boundary condition type, public :: tBoundaryCondition !< set of parameters defining a boundary condition
@ -121,10 +121,12 @@ module spectral_utilities
type(tNumerics) :: num ! numerics parameters. Better name? type(tNumerics) :: num ! numerics parameters. Better name?
enum, bind(c) enum, bind(c)
enumerator :: DERIVATIVE_CONTINUOUS_ID, & enumerator :: &
DERIVATIVE_CONTINUOUS_ID, &
DERIVATIVE_CENTRAL_DIFF_ID, & DERIVATIVE_CENTRAL_DIFF_ID, &
DERIVATIVE_FWBW_DIFF_ID DERIVATIVE_FWBW_DIFF_ID
end enum end enum
integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: & integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: &
spectral_derivative_ID spectral_derivative_ID
@ -280,8 +282,8 @@ subroutine utilities_init
enddo enddo
elseif (num%divergence_correction == 2) then elseif (num%divergence_correction == 2) then
do j = 1, 3 do j = 1, 3
if ( j /= int(minloc(geomSize/real(grid,pReal),1),pInt) & if ( j /= int(minloc(geomSize/real(grid,pReal),1)) &
.and. j /= int(maxloc(geomSize/real(grid,pReal),1),pInt)) & .and. j /= int(maxloc(geomSize/real(grid,pReal),1))) &
scaledGeomSize = geomSize/geomSize(j)*real(grid(j),pReal) scaledGeomSize = geomSize/geomSize(j)*real(grid(j),pReal)
enddo enddo
else else
@ -305,7 +307,7 @@ subroutine utilities_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! general initialization of FFTW (see manual on fftw.org for more details) ! general initialization of FFTW (see manual on fftw.org for more details)
if (pReal /= C_DOUBLE .or. pInt /= C_INT) call IO_error(0,ext_msg='Fortran to C') ! check for correct precision in C if (pReal /= C_DOUBLE .or. kind(1) /= C_INT) call IO_error(0,ext_msg='Fortran to C') ! check for correct precision in C
call fftw_set_timelimit(num%FFTW_timelimit) ! set timelimit for plan creation call fftw_set_timelimit(num%FFTW_timelimit) ! set timelimit for plan creation
if (debugGeneral) write(6,'(/,a)') ' FFTW initialized'; flush(6) if (debugGeneral) write(6,'(/,a)') ' FFTW initialized'; flush(6)
@ -352,7 +354,7 @@ subroutine utilities_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! vector MPI fftw plans ! vector MPI fftw plans
planVectorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order planVectorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order
vecSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock vecSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK,&! no. of transforms, default iblock and oblock
vectorField_real, vectorField_fourier, & ! input data, output data vectorField_real, vectorField_fourier, & ! input data, output data
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
if (.not. C_ASSOCIATED(planVectorForth)) call IO_error(810, ext_msg='planVectorForth') if (.not. C_ASSOCIATED(planVectorForth)) call IO_error(810, ext_msg='planVectorForth')
@ -365,12 +367,12 @@ subroutine utilities_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! scalar MPI fftw plans ! scalar MPI fftw plans
planScalarForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order planScalarForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order
scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & ! no. of transforms, default iblock and oblock scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock
scalarField_real, scalarField_fourier, & ! input data, output data scalarField_real, scalarField_fourier, & ! input data, output data
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
if (.not. C_ASSOCIATED(planScalarForth)) call IO_error(810, ext_msg='planScalarForth') if (.not. C_ASSOCIATED(planScalarForth)) call IO_error(810, ext_msg='planScalarForth')
planScalarBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order, no. of transforms planScalarBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order, no. of transforms
scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, & ! no. of transforms, default iblock and oblock scalarSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock
scalarField_fourier,scalarField_real, & ! input data, output data scalarField_fourier,scalarField_real, & ! input data, output data
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
if (.not. C_ASSOCIATED(planScalarBack)) call IO_error(810, ext_msg='planScalarBack') if (.not. C_ASSOCIATED(planScalarBack)) call IO_error(810, ext_msg='planScalarBack')
@ -475,8 +477,6 @@ end subroutine utilities_updateGamma
subroutine utilities_FFTtensorForward subroutine utilities_FFTtensorForward
implicit none implicit none
!--------------------------------------------------------------------------------------------------
! doing the tensor FFT
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier) call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
end subroutine utilities_FFTtensorForward end subroutine utilities_FFTtensorForward
@ -501,8 +501,6 @@ end subroutine utilities_FFTtensorBackward
subroutine utilities_FFTscalarForward subroutine utilities_FFTscalarForward
implicit none implicit none
!--------------------------------------------------------------------------------------------------
! doing the scalar FFT
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier) call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
end subroutine utilities_FFTscalarForward end subroutine utilities_FFTscalarForward
@ -528,8 +526,6 @@ end subroutine utilities_FFTscalarBackward
subroutine utilities_FFTvectorForward subroutine utilities_FFTvectorForward
implicit none implicit none
!--------------------------------------------------------------------------------------------------
! doing the vector FFT
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier) call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
end subroutine utilities_FFTvectorForward end subroutine utilities_FFTvectorForward
@ -633,7 +629,7 @@ subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT)
do k = 1, grid3; do j = 1, grid(2) ;do i = 1, grid1Red do k = 1, grid3; do j = 1, grid(2) ;do i = 1, grid1Red
GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal)/ & GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal)/ &
(cmplx(mobility_ref,0.0_pReal,pReal) + cmplx(deltaT,0.0_pReal)*& (cmplx(mobility_ref,0.0_pReal,pReal) + cmplx(deltaT,0.0_pReal)*&
sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal),xi1st(1:3,i,j,k)))) ! why not use dot_product sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal),xi1st(1:3,i,j,k))))
scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat
enddo; enddo; enddo enddo; enddo; enddo
@ -790,7 +786,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
character(len=1024):: formatString character(len=1024):: formatString
mask_stressVector = reshape(transpose(mask_stress), [9]) mask_stressVector = reshape(transpose(mask_stress), [9])
size_reduced = int(count(mask_stressVector), pInt) size_reduced = count(mask_stressVector)
if(size_reduced > 0 )then if(size_reduced > 0 )then
allocate (c_reduced(size_reduced,size_reduced), source =0.0_pReal) allocate (c_reduced(size_reduced,size_reduced), source =0.0_pReal)
allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal) allocate (s_reduced(size_reduced,size_reduced), source =0.0_pReal)
@ -891,8 +887,8 @@ subroutine utilities_fourierVectorDivergence()
scalarField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) scalarField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
forall(k = 1:grid3, j = 1:grid(2), i = 1:grid1Red) & forall(k = 1:grid3, j = 1:grid(2), i = 1:grid1Red) &
scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k) + & scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k) &
sum(vectorField_fourier(1:3,i,j,k)*conjg(-xi1st(1:3,i,j,k))) + sum(vectorField_fourier(1:3,i,j,k)*conjg(-xi1st(1:3,i,j,k)))
end subroutine utilities_fourierVectorDivergence end subroutine utilities_fourierVectorDivergence
@ -932,9 +928,8 @@ subroutine utilities_fourierTensorDivergence()
vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal) vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid1Red do k = 1, grid3; do j = 1, grid(2); do i = 1,grid1Red
do m = 1, 3; do n = 1, 3 do m = 1, 3; do n = 1, 3
vectorField_fourier(m,i,j,k) = & vectorField_fourier(m,i,j,k) = vectorField_fourier(m,i,j,k) &
vectorField_fourier(m,i,j,k) + & + tensorField_fourier(m,n,i,j,k)*conjg(-xi1st(n,i,j,k))
tensorField_fourier(m,n,i,j,k)*conjg(-xi1st(n,i,j,k))
enddo; enddo enddo; enddo
enddo; enddo; enddo enddo; enddo; enddo