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

View File

@ -9,8 +9,7 @@ module spectral_utilities
use PETScSys
use prec, only: &
pReal, &
pStringLen, &
pInt
pStringLen
use math, only: &
math_I3
@ -25,11 +24,11 @@ module spectral_utilities
!--------------------------------------------------------------------------------------------------
! field labels information
enum, bind(c)
enumerator :: FIELD_UNDEFINED_ID, &
enumerator :: &
FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID, &
FIELD_VACANCYDIFFUSION_ID
FIELD_DAMAGE_ID
end enum
!--------------------------------------------------------------------------------------------------
@ -71,11 +70,12 @@ module spectral_utilities
!--------------------------------------------------------------------------------------------------
! derived types
type, public :: tSolutionState !< return type of solution from spectral solver variants
integer :: &
iterationsNeeded = 0
logical :: &
converged = .true., &
stagConverged = .true., &
termIll = .false.
integer :: iterationsNeeded = 0
end type tSolutionState
type, public :: tBoundaryCondition !< set of parameters defining a boundary condition
@ -121,10 +121,12 @@ module spectral_utilities
type(tNumerics) :: num ! numerics parameters. Better name?
enum, bind(c)
enumerator :: DERIVATIVE_CONTINUOUS_ID, &
enumerator :: &
DERIVATIVE_CONTINUOUS_ID, &
DERIVATIVE_CENTRAL_DIFF_ID, &
DERIVATIVE_FWBW_DIFF_ID
end enum
integer(kind(DERIVATIVE_CONTINUOUS_ID)) :: &
spectral_derivative_ID
@ -280,8 +282,8 @@ subroutine utilities_init
enddo
elseif (num%divergence_correction == 2) then
do j = 1, 3
if ( j /= int(minloc(geomSize/real(grid,pReal),1),pInt) &
.and. j /= int(maxloc(geomSize/real(grid,pReal),1),pInt)) &
if ( j /= int(minloc(geomSize/real(grid,pReal),1)) &
.and. j /= int(maxloc(geomSize/real(grid,pReal),1))) &
scaledGeomSize = geomSize/geomSize(j)*real(grid(j),pReal)
enddo
else
@ -305,7 +307,7 @@ subroutine utilities_init
!--------------------------------------------------------------------------------------------------
! 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
if (debugGeneral) write(6,'(/,a)') ' FFTW initialized'; flush(6)
@ -352,7 +354,7 @@ subroutine utilities_init
!--------------------------------------------------------------------------------------------------
! 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
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
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
if (.not. C_ASSOCIATED(planVectorForth)) call IO_error(810, ext_msg='planVectorForth')
@ -365,12 +367,12 @@ subroutine utilities_init
!--------------------------------------------------------------------------------------------------
! 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
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
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
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
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
PETSC_COMM_WORLD, FFTW_planner_flag) ! use all processors, planer precision
if (.not. C_ASSOCIATED(planScalarBack)) call IO_error(810, ext_msg='planScalarBack')
@ -475,8 +477,6 @@ end subroutine utilities_updateGamma
subroutine utilities_FFTtensorForward
implicit none
!--------------------------------------------------------------------------------------------------
! doing the tensor FFT
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
end subroutine utilities_FFTtensorForward
@ -501,8 +501,6 @@ end subroutine utilities_FFTtensorBackward
subroutine utilities_FFTscalarForward
implicit none
!--------------------------------------------------------------------------------------------------
! doing the scalar FFT
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
end subroutine utilities_FFTscalarForward
@ -528,8 +526,6 @@ end subroutine utilities_FFTscalarBackward
subroutine utilities_FFTvectorForward
implicit none
!--------------------------------------------------------------------------------------------------
! doing the vector FFT
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
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
GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,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
enddo; enddo; enddo
@ -790,7 +786,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
character(len=1024):: formatString
mask_stressVector = reshape(transpose(mask_stress), [9])
size_reduced = int(count(mask_stressVector), pInt)
size_reduced = count(mask_stressVector)
if(size_reduced > 0 )then
allocate (c_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)
forall(k = 1:grid3, j = 1:grid(2), i = 1:grid1Red) &
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)))
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)))
end subroutine utilities_fourierVectorDivergence
@ -932,9 +928,8 @@ subroutine utilities_fourierTensorDivergence()
vectorField_fourier = cmplx(0.0_pReal,0.0_pReal,pReal)
do k = 1, grid3; do j = 1, grid(2); do i = 1,grid1Red
do m = 1, 3; do n = 1, 3
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))
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))
enddo; enddo
enddo; enddo; enddo