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

Merge branch 'development' of magit0.mpie.de:damask/DAMASK into development

This commit is contained in:
Martin Diehl 2016-10-26 07:54:31 +02:00
parent 4a305e72b1 2b50494951
commit 476c8ba815
20 changed files with 246 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
VERSION
View File

@ -1 +1 @@
v2.0.1-249-g54c0ba5 v2.0.1-257-g68006f0

62
code/DAMASK_spectral.f90
View File

@ -192,7 +192,7 @@ program DAMASK_spectral
if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check
call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
allocate (loadCases(N_n)) ! array of load cases allocate (loadCases(N_n)) ! array of load cases
loadCases%P%myType='p' loadCases%stress%myType='stress'
do i = 1, size(loadCases) do i = 1, size(loadCases)
allocate(loadCases(i)%ID(nActiveFields)) allocate(loadCases(i)%ID(nActiveFields))
@ -244,10 +244,10 @@ program DAMASK_spectral
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo enddo
loadCases(currentLoadCase)%P%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(currentLoadCase)%P%maskFloat = merge(ones,zeros,& loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,&
loadCases(currentLoadCase)%P%maskLogical) loadCases(currentLoadCase)%stress%maskLogical)
loadCases(currentLoadCase)%P%values = math_plain9to33(temp_valueVector) loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector)
case('t','time','delta') ! increment time case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt)
case('n','incs','increments','steps') ! number of increments case('n','incs','increments','steps') ! number of increments
@ -318,16 +318,16 @@ program DAMASK_spectral
endif endif
enddo; write(6,'(/)',advance='no') enddo; write(6,'(/)',advance='no')
enddo enddo
if (any(loadCases(currentLoadCase)%P%maskLogical .eqv. & if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. &
loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(loadCases(currentLoadCase)%P%maskLogical .and. & if (any(loadCases(currentLoadCase)%stress%maskLogical .and. &
transpose(loadCases(currentLoadCase)%P%maskLogical) .and. & transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC errorID = 838_pInt ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:' write(6,'(2x,a)') 'stress / GPa:'
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
if(loadCases(currentLoadCase)%P%maskLogical(i,j)) then if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%P%values(i,j)*1e-9_pReal write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal
else else
write(6,'(2x,12a)',advance='no') ' * ' write(6,'(2x,12a)',advance='no') ' * '
endif endif
@ -524,30 +524,25 @@ program DAMASK_spectral
case (DAMASK_spectral_SolverBasicPETSc_label) case (DAMASK_spectral_SolverBasicPETSc_label)
call BasicPETSc_forward (& call BasicPETSc_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, & guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, & deformation_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverAL_label) case (DAMASK_spectral_SolverAL_label)
call AL_forward (& call AL_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, & guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, & deformation_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label) case (DAMASK_spectral_SolverPolarisation_label)
call Polarisation_forward (& call Polarisation_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, & guess,timeinc,timeIncOld,remainingLoadCaseTime, &
F_BC = loadCases(currentLoadCase)%deformation, & deformation_BC = loadCases(currentLoadCase)%deformation, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
end select end select
case(FIELD_THERMAL_ID) case(FIELD_THERMAL_ID); call spectral_thermal_forward()
call spectral_thermal_forward (& case(FIELD_DAMAGE_ID); call spectral_damage_forward()
guess,timeinc,timeIncOld,remainingLoadCaseTime)
case(FIELD_DAMAGE_ID)
call spectral_damage_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime)
end select end select
enddo enddo
@ -562,34 +557,29 @@ program DAMASK_spectral
select case (spectral_solver) select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label) case (DAMASK_spectral_SolverBasicPETSc_label)
solres(field) = BasicPETSC_solution (& solres(field) = BasicPETSC_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, & incInfo,timeinc,timeIncOld, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverAL_label) case (DAMASK_spectral_SolverAL_label)
solres(field) = AL_solution (& solres(field) = AL_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, & incInfo,timeinc,timeIncOld, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label) case (DAMASK_spectral_SolverPolarisation_label)
solres(field) = Polarisation_solution (& solres(field) = Polarisation_solution (&
incInfo,guess,timeinc,timeIncOld,remainingLoadCaseTime, & incInfo,timeinc,timeIncOld, &
P_BC = loadCases(currentLoadCase)%P, & stress_BC = loadCases(currentLoadCase)%stress, &
F_BC = loadCases(currentLoadCase)%deformation, &
rotation_BC = loadCases(currentLoadCase)%rotation) rotation_BC = loadCases(currentLoadCase)%rotation)
end select end select
case(FIELD_THERMAL_ID) case(FIELD_THERMAL_ID)
solres(field) = spectral_thermal_solution (& solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime)
guess,timeinc,timeIncOld,remainingLoadCaseTime)
case(FIELD_DAMAGE_ID) case(FIELD_DAMAGE_ID)
solres(field) = spectral_damage_solution (& solres(field) = spectral_damage_solution(timeinc,timeIncOld,remainingLoadCaseTime)
guess,timeinc,timeIncOld,remainingLoadCaseTime)
end select end select
if (.not. solres(field)%converged) exit ! no solution found if (.not. solres(field)%converged) exit ! no solution found

2
code/Makefile
View File

@ -22,7 +22,7 @@ DAMASKVERSION :=$(shell cat ../VERSION)
include ${PETSC_DIR}/lib/petsc/conf/variables include ${PETSC_DIR}/lib/petsc/conf/variables
include ${PETSC_DIR}/lib/petsc/conf/rules include ${PETSC_DIR}/lib/petsc/conf/rules
INCLUDE_DIRS := $(PETSC_FC_INCLUDES) -DPETSc -I../lib INCLUDE_DIRS := $(PETSC_FC_INCLUDES) -DPETSc
LIBRARIES := $(PETSC_WITH_EXTERNAL_LIB) LIBRARIES := $(PETSC_WITH_EXTERNAL_LIB)
FCOMPILERNAME ?= $(FC) FCOMPILERNAME ?= $(FC)
CCOMPILERNAME ?= $(CC) CCOMPILERNAME ?= $(CC)

8
code/kinematics_hydrogen_strain.f90
View File

@ -67,8 +67,6 @@ subroutine kinematics_hydrogen_strain_init(fileUnit)
KINEMATICS_hydrogen_strain_ID, & KINEMATICS_hydrogen_strain_ID, &
material_Nphase, & material_Nphase, &
MATERIAL_partPhase MATERIAL_partPhase
use numerics,only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
@ -79,11 +77,9 @@ subroutine kinematics_hydrogen_strain_init(fileUnit)
tag = '', & tag = '', &
line = '' line = ''
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>'
write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt) maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_ID),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return

4
code/mesh.f90
View File

@ -549,13 +549,13 @@ subroutine mesh_init(ip,el)
call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file...
if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6)
grid = mesh_spectral_getGrid(fileUnit) grid = mesh_spectral_getGrid(fileUnit)
call MPI_comm_size(MPI_COMM_WORLD, worldsize, ierr) call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size')
if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)')
geomSize = mesh_spectral_getSize(fileUnit) geomSize = mesh_spectral_getSize(fileUnit)
devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T),int(grid(2),C_INTPTR_T),& devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T),int(grid(2),C_INTPTR_T),&
int(grid(1),C_INTPTR_T)/2+1,MPI_COMM_WORLD,local_K,local_K_offset) int(grid(1),C_INTPTR_T)/2+1,PETSC_COMM_WORLD,local_K,local_K_offset)
grid3 = int(local_K,pInt) grid3 = int(local_K,pInt)
grid3Offset = int(local_K_offset,pInt) grid3Offset = int(local_K_offset,pInt)
size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal)

10
code/porosity_none.f90
View File

@ -23,21 +23,17 @@ subroutine porosity_none_init()
use IO, only: & use IO, only: &
IO_timeStamp IO_timeStamp
use material use material
use numerics, only: &
worldrank
implicit none implicit none
integer(pInt) :: & integer(pInt) :: &
homog, & homog, &
NofMyHomog NofMyHomog
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_none_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_none_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (porosity_type(homog) == POROSITY_none_ID) then myhomog: if (porosity_type(homog) == POROSITY_none_ID) then
NofMyHomog = count(material_homog == homog) NofMyHomog = count(material_homog == homog)

5
code/prec.f90
View File

@ -20,12 +20,7 @@ module prec
private private
#if (FLOAT==8) #if (FLOAT==8)
integer, parameter, public :: pReal = 8 !< floating point double precision (was selected_real_kind(15,300), number with 15 significant digits, up to 1e+-300) integer, parameter, public :: pReal = 8 !< floating point double precision (was selected_real_kind(15,300), number with 15 significant digits, up to 1e+-300)
#ifdef __INTEL_COMPILER
real(pReal), parameter, public :: DAMASK_NaN = Z'7FF8000000000000' !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html)
#endif
#ifdef __GFORTRAN__
real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF8000000000000',pReal) !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html) real(pReal), parameter, public :: DAMASK_NaN = real(Z'7FF8000000000000',pReal) !< quiet NaN for double precision (from http://www.hpc.unimelb.edu.au/doc/f90lrm/dfum_035.html)
#endif
#else #else
NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION NO SUITABLE PRECISION FOR REAL SELECTED, STOPPING COMPILATION
#endif #endif

24
code/spectral_damage.f90
View File

@ -81,7 +81,6 @@ subroutine spectral_damage_init()
DM :: damage_grid DM :: damage_grid
Vec :: uBound, lBound Vec :: uBound, lBound
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy
character(len=100) :: snes_type character(len=100) :: snes_type
external :: & external :: &
@ -99,11 +98,9 @@ subroutine spectral_damage_init()
DMRestoreGlobalVector, & DMRestoreGlobalVector, &
SNESVISetVariableBounds SNESVISetVariableBounds
mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>'
write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc ! initialize solver specific parts of PETSc
@ -124,7 +121,8 @@ subroutine spectral_damage_init()
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da
call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,dummy,ierr) !< residual vector of same shape as solution vector call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,&
PETSC_NULL_OBJECT,ierr) !< residual vector of same shape as solution vector
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments
call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr)
@ -171,7 +169,7 @@ end subroutine spectral_damage_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief solution for the spectral damage scheme with internal iterations !> @brief solution for the spectral damage scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function spectral_damage_solution(guess,timeinc,timeinc_old,loadCaseTime) type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadCaseTime)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
err_damage_tolAbs, & err_damage_tolAbs, &
@ -190,7 +188,6 @@ type(tSolutionState) function spectral_damage_solution(guess,timeinc,timeinc_old
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
logical, intent(in) :: guess
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
PetscInt ::position PetscInt ::position
PetscReal :: minDamage, maxDamage, stagNorm, solnNorm PetscReal :: minDamage, maxDamage, stagNorm, solnNorm
@ -283,10 +280,10 @@ subroutine spectral_damage_formResidual(in,x_scal,f_scal,dummy,ierr)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, dimension( & PetscScalar, dimension( &
XG_RANGE,YG_RANGE,ZG_RANGE) :: & XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: &
x_scal x_scal
PetscScalar, dimension( & PetscScalar, dimension( &
X_RANGE,Y_RANGE,Z_RANGE) :: & X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: &
f_scal f_scal
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode :: ierr PetscErrorCode :: ierr
@ -341,7 +338,7 @@ end subroutine spectral_damage_formResidual
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief spectral damage forwarding routine !> @brief spectral damage forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine spectral_damage_forward(guess,timeinc,timeinc_old,loadCaseTime) subroutine spectral_damage_forward()
use mesh, only: & use mesh, only: &
grid, & grid, &
grid3 grid3
@ -354,11 +351,6 @@ subroutine spectral_damage_forward(guess,timeinc,timeinc_old,loadCaseTime)
damage_nonlocal_getMobility damage_nonlocal_getMobility
implicit none implicit none
real(pReal), intent(in) :: &
timeinc_old, &
timeinc, &
loadCaseTime !< remaining time of current load case
logical, intent(in) :: guess
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
DM :: dm_local DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal PetscScalar, dimension(:,:,:), pointer :: x_scal

2
code/spectral_interface.f90
View File

@ -89,7 +89,7 @@ subroutine DAMASK_interface_init()
call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code
CHKERRQ(ierr) ! this is a macro definition, it is case sensitive CHKERRQ(ierr) ! this is a macro definition, it is case sensitive
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
call MPI_Comm_size(MPI_COMM_WORLD, worldsize, ierr);CHKERRQ(ierr) call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr)
mainProcess: if (worldrank == 0) then mainProcess: if (worldrank == 0) then
if (output_unit /= 6) then if (output_unit /= 6) then
write(output_unit,'(a)') ' STDOUT != 6' write(output_unit,'(a)') ' STDOUT != 6'

119
code/spectral_mech_AL.f90
View File

@ -49,7 +49,7 @@ module spectral_mech_AL
F_av = 0.0_pReal, & !< average incompatible def grad field F_av = 0.0_pReal, & !< average incompatible def grad field
P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress
P_avLastEval = 0.0_pReal !< average 1st Piola--Kirchhoff stress last call of CPFEM_general P_avLastEval = 0.0_pReal !< average 1st Piola--Kirchhoff stress last call of CPFEM_general
character(len=1024), private :: incInfo !< time and increment information character(len=1024), private :: incInfo !< time and increment information
real(pReal), private, dimension(3,3,3,3) :: & real(pReal), private, dimension(3,3,3,3) :: &
C_volAvg = 0.0_pReal, & !< current volume average stiffness C_volAvg = 0.0_pReal, & !< current volume average stiffness
C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
@ -116,7 +116,6 @@ subroutine AL_init
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda
integer(pInt), dimension(:), allocatable :: localK integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc integer(pInt) :: proc
@ -133,11 +132,9 @@ subroutine AL_init
SNESSetConvergenceTest, & SNESSetConvergenceTest, &
SNESSetFromOptions SNESSetFromOptions
mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
@ -165,9 +162,9 @@ subroutine AL_init
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,dummy,ierr) call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_OBJECT,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetConvergenceTest(snes,AL_converged,dummy,PETSC_NULL_FUNCTION,ierr) call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr)
@ -245,7 +242,7 @@ end subroutine AL_init
!> @brief solution for the AL scheme with internal iterations !> @brief solution for the AL scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function & type(tSolutionState) function &
AL_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) AL_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
use IO, only: & use IO, only: &
IO_error IO_error
use numerics, only: & use numerics, only: &
@ -266,13 +263,9 @@ type(tSolutionState) function &
! input data for solution ! input data for solution
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment timeinc_old !< increment in time of last increment
loadCaseTime !< remaining time of current load case
logical, intent(in) :: &
guess
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC
F_BC
character(len=*), intent(in) :: & character(len=*), intent(in) :: &
incInfoIn incInfoIn
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
@ -290,7 +283,7 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) S = Utilities_maskedCompliance(rotation_BC,stress_BC%maskLogical,C_volAvg)
if (update_gamma) then if (update_gamma) then
call Utilities_updateGamma(C_minMaxAvg,restartWrite) call Utilities_updateGamma(C_minMaxAvg,restartWrite)
C_scale = C_minMaxAvg C_scale = C_minMaxAvg
@ -299,11 +292,11 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set module wide availabe data ! set module wide availabe data
mask_stress = P_BC%maskFloat mask_stress = stress_BC%maskFloat
params%P_BC = P_BC%values params%stress_BC = stress_BC%values
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
params%timeinc = timeinc params%timeinc = timeinc
params%timeincOld = timeinc_old params%timeincOld = timeinc_old
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! solve BVP ! solve BVP
@ -331,8 +324,7 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
itmax, & itmax, &
itmin, & itmin, &
polarAlpha, & polarAlpha, &
polarBeta, & polarBeta
worldrank
use mesh, only: & use mesh, only: &
grid3, & grid3, &
grid grid
@ -369,10 +361,10 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
DMDA_LOCAL_INFO_SIZE) :: & DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, target, dimension(3,3,2, & PetscScalar, target, dimension(3,3,2, &
XG_RANGE,YG_RANGE,ZG_RANGE) :: & XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: &
x_scal x_scal
PetscScalar, target, dimension(3,3,2, & PetscScalar, target, dimension(3,3,2, &
X_RANGE,Y_RANGE,Z_RANGE) :: & X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: &
f_scal f_scal
PetscScalar, pointer, dimension(:,:,:,:,:) :: & PetscScalar, pointer, dimension(:,:,:,:,:) :: &
F, & F, &
@ -411,16 +403,14 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
if (worldrank == 0_pInt) then write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & math_transpose33(F_aim)
math_transpose33(F_aim) flush(6)
flush(6)
endif
endif newIteration endif newIteration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -495,8 +485,7 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
err_curl_tolRel, & err_curl_tolRel, &
err_curl_tolAbs, & err_curl_tolAbs, &
err_stress_tolAbs, & err_stress_tolAbs, &
err_stress_tolRel, & err_stress_tolRel
worldrank
use math, only: & use math, only: &
math_mul3333xx33 math_mul3333xx33
use FEsolving, only: & use FEsolving, only: &
@ -519,9 +508,9 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress BC handling ! stress BC handling
F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc
err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + &
mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc mask_stress *(P_av - params%stress_BC))) ! mask = 0.0 for no bc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! error calculation ! error calculation
@ -543,24 +532,22 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
if (worldrank == 0_pInt) then write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a)') ' ... reporting .............................................................' write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')'
err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')'
err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')'
err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' write(6,'(/,a)') ' ==========================================================================='
write(6,'(/,a)') ' ===========================================================================' flush(6)
flush(6)
endif
end subroutine AL_converged end subroutine AL_converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwarding routine !> @brief forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: & use math, only: &
math_mul33x33, & math_mul33x33, &
math_mul3333xx33, & math_mul3333xx33, &
@ -588,8 +575,8 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
timeinc, & timeinc, &
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC, &
F_BC deformation_BC
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
logical, intent(in) :: & logical, intent(in) :: &
guess guess
@ -605,21 +592,19 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_lambda => xx_psc(9:17,:,:,:) F_lambda => xx_psc(9:17,:,:,:)
if (restartWrite) then if (restartWrite) then
if (worldrank == 0_pInt) then write(6,'(/,a)') ' writing converged results for restart'
write(6,'(/,a)') ' writing converged results for restart' flush(6)
flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_lambda'//trim(rankStr),size(F_lambda)) ! writing deformation gradient field to file call IO_write_jobRealFile(777,'F_lambda'//trim(rankStr),size(F_lambda)) ! writing deformation gradient field to file
write (777,rec=1) F_lambda write (777,rec=1) F_lambda
close (777) close (777)
call IO_write_jobRealFile(777,'F_lambda_lastInc'//trim(rankStr),size(F_lambda_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lambda_lastInc'//trim(rankStr),size(F_lambda_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lambda_lastInc write (777,rec=1) F_lambda_lastInc
close (777) close (777)
if (worldrank == 0_pInt) then if (worldrank == 0_pInt) then
@ -653,14 +638,14 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_
C_volAvgLastInc = C_volAvg C_volAvgLastInc = C_volAvg
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate rate for aim ! calculate rate for aim
if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F
f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim)
elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed
f_aimDot = F_BC%maskFloat * F_BC%values f_aimDot = deformation_BC%maskFloat * deformation_BC%values
elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed elseif(deformation_BC%myType=='f') then ! aim at end of load case is prescribed
f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime f_aimDot = deformation_BC%maskFloat * (deformation_BC%values -F_aim)/loadCaseTime
endif endif
if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old
F_aim_lastInc = F_aim F_aim_lastInc = F_aim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

110
code/spectral_mech_Basic.f90
View File

@ -105,7 +105,6 @@ subroutine basicPETSc_init
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: F PetscScalar, pointer, dimension(:,:,:,:) :: F
integer(pInt), dimension(:), allocatable :: localK integer(pInt), dimension(:), allocatable :: localK
@ -123,11 +122,9 @@ subroutine basicPETSc_init
SNESSetConvergenceTest, & SNESSetConvergenceTest, &
SNESSetFromOptions SNESSetFromOptions
mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
@ -153,10 +150,10 @@ subroutine basicPETSc_init
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,dummy,ierr) ! residual vector of same shape as solution vector call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da
call SNESSetConvergenceTest(snes,BasicPETSC_converged,dummy,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" call SNESSetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments
@ -165,7 +162,7 @@ subroutine basicPETSc_init
call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with
restart: if (restartInc > 1_pInt) then restart: if (restartInc > 1_pInt) then
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading values of increment ', restartInc - 1_pInt, ' from file' 'reading values of increment ', restartInc - 1_pInt, ' from file'
flush(6) flush(6)
@ -220,7 +217,7 @@ end subroutine basicPETSc_init
!> @brief solution for the Basic PETSC scheme with internal iterations !> @brief solution for the Basic PETSC scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function & type(tSolutionState) function &
basicPETSc_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
use IO, only: & use IO, only: &
IO_error IO_error
use numerics, only: & use numerics, only: &
@ -239,13 +236,9 @@ type(tSolutionState) function &
! input data for solution ! input data for solution
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment timeinc_old !< increment in time of last increment
loadCaseTime !< remaining time of current load case
logical, intent(in) :: &
guess
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC
F_BC
character(len=*), intent(in) :: & character(len=*), intent(in) :: &
incInfoIn incInfoIn
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
@ -263,17 +256,17 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) S = Utilities_maskedCompliance(rotation_BC,stress_BC%maskLogical,C_volAvg)
if (update_gamma) call Utilities_updateGamma(C_minmaxAvg,restartWrite) if (update_gamma) call Utilities_updateGamma(C_minmaxAvg,restartWrite)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set module wide availabe data ! set module wide availabe data
mask_stress = P_BC%maskFloat mask_stress = stress_BC%maskFloat
params%P_BC = P_BC%values params%stress_BC = stress_BC%values
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
params%timeinc = timeinc params%timeinc = timeinc
params%timeincOld = timeinc_old params%timeincOld = timeinc_old
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! solve BVP ! solve BVP
@ -301,8 +294,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
itmin itmin
use numerics, only: &
worldrank
use mesh, only: & use mesh, only: &
grid, & grid, &
grid3 grid3
@ -331,10 +322,10 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, dimension(3,3, & PetscScalar, dimension(3,3, &
XG_RANGE,YG_RANGE,ZG_RANGE) :: & XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: &
x_scal x_scal
PetscScalar, dimension(3,3, & PetscScalar, dimension(3,3, &
X_RANGE,Y_RANGE,Z_RANGE) :: & X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: &
f_scal f_scal
PetscInt :: & PetscInt :: &
PETScIter, & PETScIter, &
@ -354,16 +345,14 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
if (worldrank == 0_pInt) then write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & math_transpose33(F_aim)
math_transpose33(F_aim) flush(6)
flush(6)
endif
endif newIteration endif newIteration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -376,8 +365,8 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress BC handling ! stress BC handling
F_aim_lastIter = F_aim F_aim_lastIter = F_aim
F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc
err_stress = maxval(abs(mask_stress * (P_av - params%P_BC))) ! mask = 0.0 for no bc err_stress = maxval(abs(mask_stress * (P_av - params%stress_BC))) ! mask = 0.0 for no bc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! updated deformation gradient using fix point algorithm of basic scheme ! updated deformation gradient using fix point algorithm of basic scheme
@ -405,8 +394,7 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
err_div_tolRel, & err_div_tolRel, &
err_div_tolAbs, & err_div_tolAbs, &
err_stress_tolRel, & err_stress_tolRel, &
err_stress_tolAbs, & err_stress_tolAbs
worldrank
use FEsolving, only: & use FEsolving, only: &
terminallyIll terminallyIll
@ -440,22 +428,20 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
if (worldrank == 0_pInt) then write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a)') ' ... reporting .............................................................' write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
write(6,'(1/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & err_div/divTol, ' (',err_div,' / m, tol =',divTol,')'
err_div/divTol, ' (',err_div,' / m, tol =',divTol,')' write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', &
write(6,'(a,f12.2,a,es8.2,a,es9.2,a)') ' error stress BC = ', & err_stress/stressTol, ' (',err_stress, ' Pa, tol =',stressTol,')'
err_stress/stressTol, ' (',err_stress, ' Pa, tol =',stressTol,')' write(6,'(/,a)') ' ==========================================================================='
write(6,'(/,a)') ' ===========================================================================' flush(6)
flush(6)
endif
end subroutine BasicPETSc_converged end subroutine BasicPETSc_converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwarding routine !> @brief forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: & use math, only: &
math_mul33x33 ,& math_mul33x33 ,&
math_rotate_backward33 math_rotate_backward33
@ -481,8 +467,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
timeinc, & timeinc, &
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC, &
F_BC deformation_BC
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
logical, intent(in) :: & logical, intent(in) :: &
guess guess
@ -495,10 +481,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! restart information for spectral solver ! restart information for spectral solver
if (restartWrite) then if (restartWrite) then
if (worldrank == 0_pInt) then write(6,'(/,a)') ' writing converged results for restart'
write(6,'(/,a)') ' writing converged results for restart' flush(6)
flush(6)
endif
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
@ -530,14 +514,14 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
C_volAvgLastInc = C_volAvg C_volAvgLastInc = C_volAvg
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate rate for aim ! calculate rate for aim
if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F
f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim)
elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed
f_aimDot = F_BC%maskFloat * F_BC%values f_aimDot = deformation_BC%maskFloat * deformation_BC%values
elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed elseif(deformation_BC%myType=='f') then ! aim at end of load case is prescribed
f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime f_aimDot = deformation_BC%maskFloat * (deformation_BC%values -F_aim)/loadCaseTime
endif endif
if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old
F_aim_lastInc = F_aim F_aim_lastInc = F_aim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -552,8 +536,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update local deformation gradient ! update local deformation gradient
F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim
math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_forward end subroutine BasicPETSc_forward

115
code/spectral_mech_Polarisation.f90
View File

@ -116,7 +116,6 @@ subroutine Polarisation_init
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau
integer(pInt), dimension(:), allocatable :: localK integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc integer(pInt) :: proc
@ -133,11 +132,9 @@ subroutine Polarisation_init
SNESSetConvergenceTest, & SNESSetConvergenceTest, &
SNESSetFromOptions SNESSetFromOptions
mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
@ -165,9 +162,9 @@ subroutine Polarisation_init
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,dummy,ierr) call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetConvergenceTest(snes,Polarisation_converged,dummy,PETSC_NULL_FUNCTION,ierr) call SNESSetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr)
@ -177,7 +174,7 @@ subroutine Polarisation_init
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_tau => xx_psc(9:17,:,:,:) F_tau => xx_psc(9:17,:,:,:)
restart: if (restartInc > 1_pInt) then restart: if (restartInc > 1_pInt) then
if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading values of increment ', restartInc - 1_pInt, ' from file' 'reading values of increment ', restartInc - 1_pInt, ' from file'
flush(6) flush(6)
@ -245,7 +242,7 @@ end subroutine Polarisation_init
!> @brief solution for the Polarisation scheme with internal iterations !> @brief solution for the Polarisation scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function & type(tSolutionState) function &
Polarisation_solution(incInfoIn,guess,timeinc,timeinc_old,loadCaseTime,P_BC,F_BC,rotation_BC) Polarisation_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
use IO, only: & use IO, only: &
IO_error IO_error
use numerics, only: & use numerics, only: &
@ -266,13 +263,9 @@ type(tSolutionState) function &
! input data for solution ! input data for solution
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment timeinc_old !< increment in time of last increment
loadCaseTime !< remaining time of current load case
logical, intent(in) :: &
guess
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC
F_BC
character(len=*), intent(in) :: & character(len=*), intent(in) :: &
incInfoIn incInfoIn
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
@ -290,7 +283,7 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! update stiffness (and gamma operator) ! update stiffness (and gamma operator)
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) S = Utilities_maskedCompliance(rotation_BC,stress_BC%maskLogical,C_volAvg)
if (update_gamma) then if (update_gamma) then
call Utilities_updateGamma(C_minMaxAvg,restartWrite) call Utilities_updateGamma(C_minMaxAvg,restartWrite)
C_scale = C_minMaxAvg C_scale = C_minMaxAvg
@ -299,11 +292,11 @@ type(tSolutionState) function &
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set module wide availabe data ! set module wide availabe data
mask_stress = P_BC%maskFloat mask_stress = stress_BC%maskFloat
params%P_BC = P_BC%values params%stress_BC = stress_BC%values
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
params%timeinc = timeinc params%timeinc = timeinc
params%timeincOld = timeinc_old params%timeincOld = timeinc_old
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! solve BVP ! solve BVP
@ -331,8 +324,7 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
itmax, & itmax, &
itmin, & itmin, &
polarAlpha, & polarAlpha, &
polarBeta, & polarBeta
worldrank
use mesh, only: & use mesh, only: &
grid3, & grid3, &
grid grid
@ -369,10 +361,10 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
DMDA_LOCAL_INFO_SIZE) :: & DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, target, dimension(3,3,2, & PetscScalar, target, dimension(3,3,2, &
XG_RANGE,YG_RANGE,ZG_RANGE) :: & XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: &
x_scal x_scal
PetscScalar, target, dimension(3,3,2, & PetscScalar, target, dimension(3,3,2, &
X_RANGE,Y_RANGE,Z_RANGE) :: & X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: &
f_scal f_scal
PetscScalar, pointer, dimension(:,:,:,:,:) :: & PetscScalar, pointer, dimension(:,:,:,:,:) :: &
F, & F, &
@ -411,16 +403,14 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
if (worldrank == 0_pInt) then write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), &
write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax
' @ Iteration ', itmin, '≤',totalIter, '≤', itmax if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) &
if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC))
math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', &
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & math_transpose33(F_aim)
math_transpose33(F_aim) flush(6)
flush(6)
endif
endif newIteration endif newIteration
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -494,8 +484,7 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
err_curl_tolRel, & err_curl_tolRel, &
err_curl_tolAbs, & err_curl_tolAbs, &
err_stress_tolAbs, & err_stress_tolAbs, &
err_stress_tolRel, & err_stress_tolRel
worldrank
use math, only: & use math, only: &
math_mul3333xx33 math_mul3333xx33
use FEsolving, only: & use FEsolving, only: &
@ -518,9 +507,9 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! stress BC handling ! stress BC handling
F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%P_BC))) ! S = 0.0 for no bc F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc
err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + & err_BC = maxval(abs((-mask_stress+1.0_pReal)*math_mul3333xx33(C_scale,F_aim-F_av) + &
mask_stress *(P_av - params%P_BC))) ! mask = 0.0 for no bc mask_stress *(P_av - params%stress_BC))) ! mask = 0.0 for no bc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! error calculation ! error calculation
@ -542,24 +531,22 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report ! report
if (worldrank == 0_pInt) then write(6,'(1/,a)') ' ... reporting .............................................................'
write(6,'(1/,a)') ' ... reporting .............................................................' write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', &
write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')'
err_curl/curlTol,' (',err_curl,' -, tol =',curlTol,')' write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', &
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')'
err_div/divTol, ' (',err_div, ' / m, tol =',divTol,')' write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', &
write(6,' (a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')'
err_BC/BC_tol, ' (',err_BC, ' Pa, tol =',BC_tol,')' write(6,'(/,a)') ' ==========================================================================='
write(6,'(/,a)') ' ===========================================================================' flush(6)
flush(6)
endif
end subroutine Polarisation_converged end subroutine Polarisation_converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwarding routine !> @brief forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,rotation_BC) subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: & use math, only: &
math_mul33x33, & math_mul33x33, &
math_mul3333xx33, & math_mul3333xx33, &
@ -587,8 +574,8 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
timeinc, & timeinc, &
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & stress_BC, &
F_BC deformation_BC
real(pReal), dimension(3,3), intent(in) :: rotation_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC
logical, intent(in) :: & logical, intent(in) :: &
guess guess
@ -604,19 +591,19 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
F => xx_psc(0:8,:,:,:) F => xx_psc(0:8,:,:,:)
F_tau => xx_psc(9:17,:,:,:) F_tau => xx_psc(9:17,:,:,:)
if (restartWrite) then if (restartWrite) then
if (worldrank == 0_pInt) write(6,'(/,a)') ' writing converged results for restart' write(6,'(/,a)') ' writing converged results for restart'
flush(6) flush(6)
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file
write (777,rec=1) F write (777,rec=1) F
close (777) close (777)
call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_lastInc write (777,rec=1) F_lastInc
close (777) close (777)
call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file call IO_write_jobRealFile(777,'F_tau'//trim(rankStr),size(F_tau)) ! writing deformation gradient field to file
write (777,rec=1) F_tau write (777,rec=1) F_tau
close (777) close (777)
call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_lastInc field to file call IO_write_jobRealFile(777,'F_tau_lastInc'//trim(rankStr),size(F_tau_lastInc)) ! writing F_lastInc field to file
write (777,rec=1) F_tau_lastInc write (777,rec=1) F_tau_lastInc
close (777) close (777)
if (worldrank == 0_pInt) then if (worldrank == 0_pInt) then
@ -650,14 +637,14 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
C_volAvgLastInc = C_volAvg C_volAvgLastInc = C_volAvg
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! calculate rate for aim ! calculate rate for aim
if (F_BC%myType=='l') then ! calculate f_aimDot from given L and current F if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F
f_aimDot = F_BC%maskFloat * math_mul33x33(F_BC%values, F_aim) f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim)
elseif(F_BC%myType=='fdot') then ! f_aimDot is prescribed elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed
f_aimDot = F_BC%maskFloat * F_BC%values f_aimDot = deformation_BC%maskFloat * deformation_BC%values
elseif(F_BC%myType=='f') then ! aim at end of load case is prescribed elseif(deformation_BC%myType=='f') then ! aim at end of load case is prescribed
f_aimDot = F_BC%maskFloat * (F_BC%values -F_aim)/loadCaseTime f_aimDot = deformation_BC%maskFloat * (deformation_BC%values -F_aim)/loadCaseTime
endif endif
if (guess) f_aimDot = f_aimDot + P_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old
F_aim_lastInc = F_aim F_aim_lastInc = F_aim
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

18
code/spectral_thermal.f90
View File

@ -86,7 +86,6 @@ subroutine spectral_thermal_init
DM :: thermal_grid DM :: thermal_grid
PetscScalar, dimension(:,:,:), pointer :: x_scal PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy
external :: & external :: &
SNESCreate, & SNESCreate, &
@ -123,7 +122,8 @@ subroutine spectral_thermal_init
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da
call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,dummy,ierr) ! residual vector of same shape as solution vector call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,&
PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments
@ -170,7 +170,7 @@ end subroutine spectral_thermal_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief solution for the spectral thermal scheme with internal iterations !> @brief solution for the spectral thermal scheme with internal iterations
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
type(tSolutionState) function spectral_thermal_solution(guess,timeinc,timeinc_old,loadCaseTime) type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,loadCaseTime)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
err_thermal_tolAbs, & err_thermal_tolAbs, &
@ -189,7 +189,6 @@ type(tSolutionState) function spectral_thermal_solution(guess,timeinc,timeinc_ol
timeinc, & !< increment in time for current solution timeinc, & !< increment in time for current solution
timeinc_old, & !< increment in time of last increment timeinc_old, & !< increment in time of last increment
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
logical, intent(in) :: guess
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
PetscInt :: position PetscInt :: position
PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm PetscReal :: minTemperature, maxTemperature, stagNorm, solnNorm
@ -283,10 +282,10 @@ subroutine spectral_thermal_formResidual(in,x_scal,f_scal,dummy,ierr)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in in
PetscScalar, dimension( & PetscScalar, dimension( &
XG_RANGE,YG_RANGE,ZG_RANGE) :: & XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: &
x_scal x_scal
PetscScalar, dimension( & PetscScalar, dimension( &
X_RANGE,Y_RANGE,Z_RANGE) :: & X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: &
f_scal f_scal
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode :: ierr PetscErrorCode :: ierr
@ -337,7 +336,7 @@ end subroutine spectral_thermal_formResidual
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forwarding routine !> @brief forwarding routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine spectral_thermal_forward(guess,timeinc,timeinc_old,loadCaseTime) subroutine spectral_thermal_forward()
use mesh, only: & use mesh, only: &
grid, & grid, &
grid3 grid3
@ -351,11 +350,6 @@ subroutine spectral_thermal_forward(guess,timeinc,timeinc_old,loadCaseTime)
thermal_conduction_getSpecificHeat thermal_conduction_getSpecificHeat
implicit none implicit none
real(pReal), intent(in) :: &
timeinc_old, &
timeinc, &
loadCaseTime !< remaining time of current load case
logical, intent(in) :: guess
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
DM :: dm_local DM :: dm_local
PetscScalar, dimension(:,:,:), pointer :: x_scal PetscScalar, dimension(:,:,:), pointer :: x_scal

56
code/spectral_utilities.f90
View File

@ -1,3 +1,4 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Utilities used by the different spectral solver variants !> @brief Utilities used by the different spectral solver variants
@ -84,7 +85,7 @@ module spectral_utilities
type, public :: tLoadCase type, public :: tLoadCase
real(pReal), dimension (3,3) :: rotation = math_I3 !< rotation of BC real(pReal), dimension (3,3) :: rotation = math_I3 !< rotation of BC
type(tBoundaryCondition) :: P, & !< stress BC type(tBoundaryCondition) :: stress, & !< stress BC
deformation !< deformation BC (Fdot or L) deformation !< deformation BC (Fdot or L)
real(pReal) :: time = 0.0_pReal !< length of increment real(pReal) :: time = 0.0_pReal !< length of increment
integer(pInt) :: incs = 0_pInt, & !< number of increments integer(pInt) :: incs = 0_pInt, & !< number of increments
@ -96,7 +97,7 @@ module spectral_utilities
end type tLoadCase end type tLoadCase
type, public :: tSolutionParams !< @todo use here the type definition for a full loadcase including mask type, public :: tSolutionParams !< @todo use here the type definition for a full loadcase including mask
real(pReal), dimension(3,3) :: P_BC, rotation_BC real(pReal), dimension(3,3) :: stress_BC, rotation_BC
real(pReal) :: timeinc real(pReal) :: timeinc
real(pReal) :: timeincOld real(pReal) :: timeincOld
real(pReal) :: density real(pReal) :: density
@ -227,9 +228,12 @@ subroutine utilities_init()
' add more using the PETSc_Options keyword in numerics.config '; flush(6) ' add more using the PETSc_Options keyword in numerics.config '; flush(6)
call PetscOptionsClear(ierr); CHKERRQ(ierr) call PetscOptionsClear(ierr); CHKERRQ(ierr)
if(debugPETSc) call PetscOptionsInsertString(trim(PETSCDEBUG),ierr); CHKERRQ(ierr) if(debugPETSc) call PetscOptionsInsertString(trim(PETSCDEBUG),ierr)
call PetscOptionsInsertString(trim(petsc_defaultOptions),ierr); CHKERRQ(ierr) CHKERRQ(ierr)
call PetscOptionsInsertString(trim(petsc_options),ierr); CHKERRQ(ierr) call PetscOptionsInsertString(trim(petsc_defaultOptions),ierr)
CHKERRQ(ierr)
call PetscOptionsInsertString(trim(petsc_options),ierr)
CHKERRQ(ierr)
grid1Red = grid(1)/2_pInt + 1_pInt grid1Red = grid(1)/2_pInt + 1_pInt
wgt = 1.0/real(product(grid),pReal) wgt = 1.0/real(product(grid),pReal)
@ -238,11 +242,11 @@ subroutine utilities_init()
write(6,'(a,3(es12.5))') ' size x y z: ', geomSize write(6,'(a,3(es12.5))') ' size x y z: ', geomSize
select case (spectral_derivative) select case (spectral_derivative)
case ('continuous') ! default, no weighting case ('continuous')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference') ! cosine curve with 1 for avg and zero for highest freq case ('central_difference')
spectral_derivative_ID = DERIVATIVE_CENTRAL_DIFF_ID spectral_derivative_ID = DERIVATIVE_CENTRAL_DIFF_ID
case ('fwbw_difference') ! gradient, might need grid scaling as for cosine filter case ('fwbw_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
case default case default
call IO_error(892_pInt,ext_msg=trim(spectral_derivative)) call IO_error(892_pInt,ext_msg=trim(spectral_derivative))
@ -271,9 +275,9 @@ subroutine utilities_init()
! MPI allocation ! MPI allocation
gridFFTW = int(grid,C_INTPTR_T) gridFFTW = int(grid,C_INTPTR_T)
alloc_local = fftw_mpi_local_size_3d(gridFFTW(3), gridFFTW(2), gridFFTW(1)/2 +1, & alloc_local = fftw_mpi_local_size_3d(gridFFTW(3), gridFFTW(2), gridFFTW(1)/2 +1, &
MPI_COMM_WORLD, local_K, local_K_offset) PETSC_COMM_WORLD, local_K, local_K_offset)
allocate (xi1st (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies, only half the size for first dimension allocate (xi1st (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension
allocate (xi2nd (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies, only half the size for first dimension allocate (xi2nd (3,grid1Red,grid(2),grid3),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension
tensorField = fftw_alloc_complex(tensorSize*alloc_local) tensorField = fftw_alloc_complex(tensorSize*alloc_local)
call c_f_pointer(tensorField, tensorField_real, [3_C_INTPTR_T,3_C_INTPTR_T, & call c_f_pointer(tensorField, tensorField_real, [3_C_INTPTR_T,3_C_INTPTR_T, &
@ -298,12 +302,12 @@ subroutine utilities_init()
planTensorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order planTensorForth = fftw_mpi_plan_many_dft_r2c(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order
tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock
tensorField_real, tensorField_fourier, & ! input data, output data tensorField_real, tensorField_fourier, & ! input data, output data
MPI_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(planTensorForth)) call IO_error(810, ext_msg='planTensorForth') if (.not. C_ASSOCIATED(planTensorForth)) call IO_error(810, ext_msg='planTensorForth')
planTensorBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order planTensorBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order
tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock tensorSize, FFTW_MPI_DEFAULT_BLOCK, FFTW_MPI_DEFAULT_BLOCK, &! no. of transforms, default iblock and oblock
tensorField_fourier,tensorField_real, & ! input data, output data tensorField_fourier,tensorField_real, & ! input data, output data
MPI_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision PETSC_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision
if (.not. C_ASSOCIATED(planTensorBack)) call IO_error(810, ext_msg='planTensorBack') if (.not. C_ASSOCIATED(planTensorBack)) call IO_error(810, ext_msg='planTensorBack')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -311,12 +315,12 @@ subroutine utilities_init()
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
MPI_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')
planVectorBack = fftw_mpi_plan_many_dft_c2r(3, [gridFFTW(3),gridFFTW(2),gridFFTW(1)], & ! dimension, logical length in each dimension in reversed order planVectorBack = fftw_mpi_plan_many_dft_c2r(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_fourier,vectorField_real, & ! input data, output data vectorField_fourier,vectorField_real, & ! input data, output data
MPI_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision PETSC_COMM_WORLD, fftw_planner_flag) ! all processors, planer precision
if (.not. C_ASSOCIATED(planVectorBack)) call IO_error(810, ext_msg='planVectorBack') if (.not. C_ASSOCIATED(planVectorBack)) call IO_error(810, ext_msg='planVectorBack')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -324,12 +328,12 @@ subroutine utilities_init()
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
MPI_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
MPI_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')
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -699,8 +703,8 @@ real(pReal) function utilities_curlRMS()
curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1) & curl_fourier(l,3) = (+tensorField_fourier(l,2,i,j,k)*xi1st(1,i,j,k)*rescaledGeom(1) &
-tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2)) -tensorField_fourier(l,1,i,j,k)*xi1st(2,i,j,k)*rescaledGeom(2))
enddo enddo
utilities_curlRMS = utilities_curlRMS + & utilities_curlRMS = utilities_curlRMS &
2.0_pReal*sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! Has somewhere a conj. complex counterpart. Therefore count it twice. +2.0_pReal*sum(real(curl_fourier)**2.0_pReal+aimag(curl_fourier)**2.0_pReal) ! Has somewhere a conj. complex counterpart. Therefore count it twice.
enddo enddo
do l = 1_pInt, 3_pInt do l = 1_pInt, 3_pInt
curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2) & curl_fourier = (+tensorField_fourier(l,3,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2) &
@ -710,8 +714,8 @@ real(pReal) function utilities_curlRMS()
curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1) & curl_fourier = (+tensorField_fourier(l,2,1,j,k)*xi1st(1,1,j,k)*rescaledGeom(1) &
-tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2)) -tensorField_fourier(l,1,1,j,k)*xi1st(2,1,j,k)*rescaledGeom(2))
enddo enddo
utilities_curlRMS = utilities_curlRMS + & utilities_curlRMS = utilities_curlRMS &
sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (DC) does not have a conjugate complex counterpart (if grid(1) /= 1) + sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal) ! this layer (DC) does not have a conjugate complex counterpart (if grid(1) /= 1)
do l = 1_pInt, 3_pInt do l = 1_pInt, 3_pInt
curl_fourier = (+tensorField_fourier(l,3,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2) & curl_fourier = (+tensorField_fourier(l,3,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2) &
-tensorField_fourier(l,2,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*rescaledGeom(3)) -tensorField_fourier(l,2,grid1Red,j,k)*xi1st(3,grid1Red,j,k)*rescaledGeom(3))
@ -720,14 +724,14 @@ real(pReal) function utilities_curlRMS()
curl_fourier = (+tensorField_fourier(l,2,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*rescaledGeom(1) & curl_fourier = (+tensorField_fourier(l,2,grid1Red,j,k)*xi1st(1,grid1Red,j,k)*rescaledGeom(1) &
-tensorField_fourier(l,1,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2)) -tensorField_fourier(l,1,grid1Red,j,k)*xi1st(2,grid1Red,j,k)*rescaledGeom(2))
enddo enddo
utilities_curlRMS = utilities_curlRMS + & utilities_curlRMS = utilities_curlRMS &
sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal)! this layer (Nyquist) does not have a conjugate complex counterpart (if grid(1) /= 1) + sum(real(curl_fourier)**2.0_pReal + aimag(curl_fourier)**2.0_pReal) ! this layer (Nyquist) does not have a conjugate complex counterpart (if grid(1) /= 1)
enddo; enddo enddo; enddo
call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='utilities_curlRMS') if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='utilities_curlRMS')
utilities_curlRMS = sqrt(utilities_curlRMS) * wgt utilities_curlRMS = sqrt(utilities_curlRMS) * wgt
if(grid(1) == 1_pInt) utilities_curlRMS = utilities_curlRMS * 0.5_pReal ! counted twice in case of grid(1) == 1 if(grid(1) == 1_pInt) utilities_curlRMS = utilities_curlRMS * 0.5_pReal ! counted twice in case of grid(1) == 1
end function utilities_curlRMS end function utilities_curlRMS

8
code/thermal_adiabatic.f90
View File

@ -74,8 +74,6 @@ subroutine thermal_adiabatic_init(fileUnit)
temperature, & temperature, &
temperatureRate, & temperatureRate, &
material_partHomogenization material_partHomogenization
use numerics,only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
@ -88,11 +86,9 @@ subroutine thermal_adiabatic_init(fileUnit)
tag = '', & tag = '', &
line = '' line = ''
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_ADIABATIC_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(thermal_type == THERMAL_adiabatic_ID),pInt) maxNinstance = int(count(thermal_type == THERMAL_adiabatic_ID),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return

8
code/thermal_conduction.f90
View File

@ -75,8 +75,6 @@ subroutine thermal_conduction_init(fileUnit)
temperature, & temperature, &
temperatureRate, & temperatureRate, &
material_partHomogenization material_partHomogenization
use numerics,only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
@ -89,11 +87,9 @@ subroutine thermal_conduction_init(fileUnit)
tag = '', & tag = '', &
line = '' line = ''
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_CONDUCTION_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt) maxNinstance = int(count(thermal_type == THERMAL_conduction_ID),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return

10
code/thermal_isothermal.f90
View File

@ -23,8 +23,6 @@ subroutine thermal_isothermal_init()
use IO, only: & use IO, only: &
IO_timeStamp IO_timeStamp
use material use material
use numerics, only: &
worldrank
implicit none implicit none
integer(pInt) :: & integer(pInt) :: &
@ -32,13 +30,11 @@ subroutine thermal_isothermal_init()
NofMyHomog, & NofMyHomog, &
sizeState sizeState
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- thermal_'//THERMAL_isothermal_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (thermal_type(homog) == THERMAL_isothermal_ID) then myhomog: if (thermal_type(homog) == THERMAL_isothermal_ID) then
NofMyHomog = count(material_homog == homog) NofMyHomog = count(material_homog == homog)

8
code/vacancyflux_cahnhilliard.f90
View File

@ -90,8 +90,6 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit)
vacancyflux_initialCv, & vacancyflux_initialCv, &
material_partHomogenization, & material_partHomogenization, &
material_partPhase material_partPhase
use numerics,only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
@ -104,11 +102,9 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit)
tag = '', & tag = '', &
line = '' line = ''
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt) maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return

8
code/vacancyflux_isochempot.f90
View File

@ -72,8 +72,6 @@ subroutine vacancyflux_isochempot_init(fileUnit)
vacancyConcRate, & vacancyConcRate, &
vacancyflux_initialCv, & vacancyflux_initialCv, &
material_partHomogenization material_partHomogenization
use numerics,only: &
worldrank
implicit none implicit none
integer(pInt), intent(in) :: fileUnit integer(pInt), intent(in) :: fileUnit
@ -86,11 +84,9 @@ subroutine vacancyflux_isochempot_init(fileUnit)
tag = '', & tag = '', &
line = '' line = ''
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isochempot_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isochempot_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt) maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt)
if (maxNinstance == 0_pInt) return if (maxNinstance == 0_pInt) return

10
code/vacancyflux_isoconc.f90
View File

@ -23,21 +23,17 @@ subroutine vacancyflux_isoconc_init()
use IO, only: & use IO, only: &
IO_timeStamp IO_timeStamp
use material use material
use numerics, only: &
worldrank
implicit none implicit none
integer(pInt) :: & integer(pInt) :: &
homog, & homog, &
NofMyHomog NofMyHomog
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isoconc_label//' init -+>>>'
write(6,'(/,a)') ' <<<+- vacancyflux_'//VACANCYFLUX_isoconc_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
initializeInstances: do homog = 1_pInt, material_Nhomogenization initializeInstances: do homog = 1_pInt, material_Nhomogenization
myhomog: if (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then myhomog: if (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then
NofMyHomog = count(material_homog == homog) NofMyHomog = count(material_homog == homog)