2018-08-17 03:44:25 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
!> @brief Utilities used by the FEM solver
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
module FEM_utilities
|
2018-08-30 16:08:44 +05:30
|
|
|
#include <petsc/finclude/petscdmplex.h>
|
2018-09-21 11:49:36 +05:30
|
|
|
#include <petsc/finclude/petscdmda.h>
|
|
|
|
#include <petsc/finclude/petscis.h>
|
2018-08-17 14:53:24 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
use PETScdmplex
|
|
|
|
use PETScdmda
|
|
|
|
use PETScis
|
|
|
|
|
|
|
|
use prec
|
|
|
|
use FEsolving
|
|
|
|
use homogenization
|
|
|
|
use numerics
|
|
|
|
use debug
|
|
|
|
use math
|
|
|
|
use mesh
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
private
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2020-01-21 10:40:19 +05:30
|
|
|
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
|
2019-06-11 13:18:07 +05:30
|
|
|
integer, public, parameter :: maxFields = 6
|
|
|
|
integer, public :: nActiveFields = 0
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! grid related information information
|
2019-06-11 13:18:07 +05:30
|
|
|
real(pReal), public :: wgt !< weighting factor 1/Nelems
|
2018-09-19 22:03:37 +05:30
|
|
|
|
2019-05-12 13:35:40 +05:30
|
|
|
|
2018-08-17 03:44:25 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! field labels information
|
2019-06-11 13:18:07 +05:30
|
|
|
character(len=*), parameter, public :: &
|
|
|
|
FIELD_MECH_label = 'mechanical'
|
|
|
|
|
|
|
|
enum, bind(c)
|
|
|
|
enumerator :: FIELD_UNDEFINED_ID, &
|
|
|
|
FIELD_MECH_ID
|
|
|
|
end enum
|
|
|
|
enum, bind(c)
|
|
|
|
enumerator :: COMPONENT_UNDEFINED_ID, &
|
|
|
|
COMPONENT_MECH_X_ID, &
|
|
|
|
COMPONENT_MECH_Y_ID, &
|
|
|
|
COMPONENT_MECH_Z_ID
|
|
|
|
end enum
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! variables controlling debugging
|
2019-06-11 13:18:07 +05:30
|
|
|
logical :: &
|
2018-08-17 03:44:25 +05:30
|
|
|
debugPETSc !< use some in debug defined options for more verbose PETSc solution
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! derived types
|
2019-06-11 13:18:07 +05:30
|
|
|
type, public :: tSolutionState !< return type of solution from FEM solver variants
|
2020-01-21 10:40:19 +05:30
|
|
|
logical :: converged = .true.
|
|
|
|
logical :: stagConverged = .true.
|
|
|
|
integer :: iterationsNeeded = 0
|
2019-06-11 13:18:07 +05:30
|
|
|
end type tSolutionState
|
|
|
|
|
|
|
|
type, public :: tComponentBC
|
|
|
|
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
|
2020-01-21 10:40:19 +05:30
|
|
|
real(pReal), allocatable, dimension(:) :: Value
|
|
|
|
logical, allocatable, dimension(:) :: Mask
|
2019-06-11 13:18:07 +05:30
|
|
|
end type tComponentBC
|
2018-08-17 03:44:25 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
type, public :: tFieldBC
|
|
|
|
integer(kind(FIELD_UNDEFINED_ID)) :: ID
|
|
|
|
integer :: nComponents = 0
|
|
|
|
type(tComponentBC), allocatable :: componentBC(:)
|
|
|
|
end type tFieldBC
|
|
|
|
|
|
|
|
type, public :: tLoadCase
|
|
|
|
real(pReal) :: time = 0.0_pReal !< length of increment
|
|
|
|
integer :: incs = 0, & !< number of increments
|
|
|
|
outputfrequency = 1, & !< frequency of result writes
|
|
|
|
logscale = 0 !< linear/logarithmic time inc flag
|
|
|
|
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
|
2020-01-21 10:40:19 +05:30
|
|
|
integer, allocatable, dimension(:) :: faceID
|
|
|
|
type(tFieldBC), allocatable, dimension(:) :: fieldBC
|
2019-06-11 13:18:07 +05:30
|
|
|
end type tLoadCase
|
|
|
|
|
|
|
|
public :: &
|
|
|
|
utilities_init, &
|
|
|
|
utilities_constitutiveResponse, &
|
|
|
|
utilities_projectBCValues, &
|
|
|
|
FIELD_MECH_ID, &
|
2020-01-21 12:16:32 +05:30
|
|
|
COMPONENT_UNDEFINED_ID, &
|
2019-06-11 13:18:07 +05:30
|
|
|
COMPONENT_MECH_X_ID, &
|
|
|
|
COMPONENT_MECH_Y_ID, &
|
|
|
|
COMPONENT_MECH_Z_ID
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief allocates all neccessary fields, sets debug flags
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2019-05-12 12:59:51 +05:30
|
|
|
subroutine utilities_init
|
2019-05-12 16:41:30 +05:30
|
|
|
|
2020-01-26 16:54:35 +05:30
|
|
|
character(len=pStringLen) :: petsc_optionsOrder
|
|
|
|
PetscErrorCode :: ierr
|
2018-08-17 03:44:25 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
! set debugging parameters
|
2019-06-11 13:18:07 +05:30
|
|
|
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
|
|
|
|
if(debugPETSc) write(6,'(3(/,a),/)') &
|
|
|
|
' Initializing PETSc with debug options: ', &
|
|
|
|
trim(PETScDebug), &
|
|
|
|
' add more using the PETSc_Options keyword in numerics.config '
|
|
|
|
flush(6)
|
|
|
|
call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
|
|
|
|
CHKERRQ(ierr)
|
|
|
|
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
|
|
|
|
CHKERRQ(ierr)
|
2020-03-17 04:40:23 +05:30
|
|
|
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type newtonls &
|
|
|
|
&-mech_snes_linesearch_type cp -mech_snes_ksp_ew &
|
|
|
|
&-mech_snes_ksp_ew_rtol0 0.01 -mech_snes_ksp_ew_rtolmax 0.01 &
|
|
|
|
&-mech_ksp_type fgmres -mech_ksp_max_it 25 &
|
|
|
|
&-mech_pc_type ml -mech_mg_levels_ksp_type chebyshev &
|
|
|
|
&-mech_mg_levels_pc_type sor -mech_pc_ml_nullspace user',ierr)
|
|
|
|
CHKERRQ(ierr)
|
2019-06-11 13:18:07 +05:30
|
|
|
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
|
|
|
|
CHKERRQ(ierr)
|
2020-01-26 16:54:35 +05:30
|
|
|
write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', structOrder
|
|
|
|
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),ierr)
|
2019-06-11 13:18:07 +05:30
|
|
|
CHKERRQ(ierr)
|
|
|
|
|
|
|
|
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
|
|
|
|
end subroutine utilities_init
|
|
|
|
|
2020-03-17 04:40:23 +05:30
|
|
|
|
2018-08-17 03:44:25 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief calculates constitutive response
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
|
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
real(pReal), intent(in) :: timeinc !< loading time
|
|
|
|
logical, intent(in) :: forwardData !< age results
|
|
|
|
|
|
|
|
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
|
|
|
|
|
|
|
|
PetscErrorCode :: ierr
|
2018-08-17 03:44:25 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
|
2018-08-17 03:44:25 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field
|
2018-08-17 14:53:24 +05:30
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
cutBack = .false. ! reset cutBack status
|
|
|
|
|
|
|
|
P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P
|
|
|
|
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
end subroutine utilities_constitutiveResponse
|
|
|
|
|
2019-03-09 03:53:07 +05:30
|
|
|
|
2018-08-17 03:44:25 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
!> @brief Project BC values to local vector
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc)
|
|
|
|
|
2019-06-11 13:18:07 +05:30
|
|
|
Vec :: localVec
|
|
|
|
PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset
|
|
|
|
PetscSection :: section
|
|
|
|
IS :: bcPointsIS
|
|
|
|
PetscInt, pointer :: bcPoints(:)
|
|
|
|
PetscScalar, pointer :: localArray(:)
|
|
|
|
PetscScalar :: BCValue,BCDotValue,timeinc
|
|
|
|
PetscErrorCode :: ierr
|
|
|
|
|
|
|
|
call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr)
|
|
|
|
call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr)
|
|
|
|
if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr)
|
|
|
|
call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
|
|
|
do point = 1, nBcPoints
|
|
|
|
call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr)
|
|
|
|
CHKERRQ(ierr)
|
|
|
|
call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr)
|
|
|
|
CHKERRQ(ierr)
|
|
|
|
do dof = offset+comp+1, offset+numDof, numComp
|
|
|
|
localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc
|
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
|
|
|
|
call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr)
|
|
|
|
call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr)
|
|
|
|
if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr)
|
2018-08-17 03:44:25 +05:30
|
|
|
|
|
|
|
end subroutine utilities_projectBCValues
|
|
|
|
|
|
|
|
end module FEM_utilities
|