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 magit1.mpie.de:damask/DAMASK into miscImprovements

This commit is contained in:
Martin Diehl 2016-06-30 10:25:32 +02:00
parent ddb292e360 e99784d20e
commit 3e130ee7b6
10 changed files with 326 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
VERSION
View File

@ -1 +1 @@
v2.0.0-297-ga27aba1 v2.0.0-302-g2c8427e

19
code/IO.f90
View File

@ -80,25 +80,10 @@ subroutine IO_init
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
implicit none implicit none
integer(pInt) :: worldrank = 0_pInt
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
PetscErrorCode :: ierr
#endif
external :: &
MPI_Comm_rank, &
MPI_Abort
#ifdef PETSc write(6,'(/,a)') ' <<<+- IO init -+>>>'
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- IO init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90" #include "compilation_info.f90"
endif mainProcess
end subroutine IO_init end subroutine IO_init

202
code/numerics.f90
View File

@ -236,11 +236,9 @@ subroutine numerics_init
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(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr)
#endif #endif
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- numerics init -+>>>'
write(6,'(/,a)') ' <<<+- numerics 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
!$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS... !$ call GET_ENVIRONMENT_VARIABLE(NAME='DAMASK_NUM_THREADS',VALUE=DAMASK_NumThreadsString,STATUS=gotDAMASK_NUM_THREADS) ! get environment variable DAMASK_NUM_THREADS...
!$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1 !$ if(gotDAMASK_NUM_THREADS /= 0) then ! could not get number of threads, set it to 1
@ -489,14 +487,8 @@ subroutine numerics_init
close(FILEUNIT) close(FILEUNIT)
else fileExists else fileExists
#ifdef FEM
if (worldrank == 0) then
#endif
write(6,'(a,/)') ' using standard values' write(6,'(a,/)') ' using standard values'
flush(6) flush(6)
#ifdef FEM
endif
#endif
endif fileExists endif fileExists
#ifdef Spectral #ifdef Spectral
@ -519,128 +511,126 @@ subroutine numerics_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! writing parameters to output ! writing parameters to output
mainProcess3: if (worldrank == 0) then write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance
write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness
write(6,'(a24,1x,i8)') ' iJacoStiffness: ',iJacoStiffness write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum
write(6,'(a24,1x,i8)') ' iJacoLpresiduum: ',iJacoLpresiduum write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg
write(6,'(a24,1x,es8.1)') ' pert_Fg: ',pert_Fg write(6,'(a24,1x,i8)') ' pert_method: ',pert_method
write(6,'(a24,1x,i8)') ' pert_method: ',pert_method write(6,'(a24,1x,i8)') ' nCryst: ',nCryst
write(6,'(a24,1x,i8)') ' nCryst: ',nCryst write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst
write(6,'(a24,1x,es8.1)') ' subStepMinCryst: ',subStepMinCryst write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst
write(6,'(a24,1x,es8.1)') ' subStepSizeCryst: ',subStepSizeCryst write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst
write(6,'(a24,1x,es8.1)') ' stepIncreaseCryst: ',stepIncreaseCryst write(6,'(a24,1x,i8)') ' nState: ',nState
write(6,'(a24,1x,i8)') ' nState: ',nState write(6,'(a24,1x,i8)') ' nStress: ',nStress
write(6,'(a24,1x,i8)') ' nStress: ',nStress write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteState: ',rTol_crystalliteState write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress
write(6,'(a24,1x,es8.1)') ' rTol_crystalliteStress: ',rTol_crystalliteStress write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress
write(6,'(a24,1x,es8.1)') ' aTol_crystalliteStress: ',aTol_crystalliteStress write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator
write(6,'(a24,2(1x,i8))') ' integrator: ',numerics_integrator write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing
write(6,'(a24,1x,L8)') ' timeSyncing: ',numerics_timeSyncing write(6,'(a24,1x,L8)') ' analytic Jacobian: ',analyticJaco
write(6,'(a24,1x,L8)') ' analytic Jacobian: ',analyticJaco write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong
write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength
write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength
write(6,'(a24,1x,i8)') ' nHomog: ',nHomog write(6,'(a24,1x,i8)') ' nHomog: ',nHomog
write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog
write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog
write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog
write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate write(6,'(a24,1x,i8,/)') ' nMPstate: ',nMPstate
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! RGC parameters ! RGC parameters
write(6,'(a24,1x,es8.1)') ' aTol_RGC: ',absTol_RGC write(6,'(a24,1x,es8.1)') ' aTol_RGC: ',absTol_RGC
write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC write(6,'(a24,1x,es8.1)') ' rTol_RGC: ',relTol_RGC
write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC write(6,'(a24,1x,es8.1)') ' aMax_RGC: ',absMax_RGC
write(6,'(a24,1x,es8.1)') ' rMax_RGC: ',relMax_RGC write(6,'(a24,1x,es8.1)') ' rMax_RGC: ',relMax_RGC
write(6,'(a24,1x,es8.1)') ' perturbPenalty_RGC: ',pPert_RGC write(6,'(a24,1x,es8.1)') ' perturbPenalty_RGC: ',pPert_RGC
write(6,'(a24,1x,es8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC write(6,'(a24,1x,es8.1)') ' relevantMismatch_RGC: ',xSmoo_RGC
write(6,'(a24,1x,es8.1)') ' viscosityrate_RGC: ',viscPower_RGC write(6,'(a24,1x,es8.1)') ' viscosityrate_RGC: ',viscPower_RGC
write(6,'(a24,1x,es8.1)') ' viscositymodulus_RGC: ',viscModus_RGC write(6,'(a24,1x,es8.1)') ' viscositymodulus_RGC: ',viscModus_RGC
write(6,'(a24,1x,es8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC write(6,'(a24,1x,es8.1)') ' maxrelaxation_RGC: ',maxdRelax_RGC
write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC write(6,'(a24,1x,es8.1)') ' maxVolDiscrepancy_RGC: ',maxVolDiscr_RGC
write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC write(6,'(a24,1x,es8.1)') ' volDiscrepancyMod_RGC: ',volDiscrMod_RGC
write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC write(6,'(a24,1x,es8.1,/)') ' discrepancyPower_RGC: ',volDiscrPow_RGC
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! Random seeding parameter ! Random seeding parameter
write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed
if (fixedSeed <= 0_pInt) & if (fixedSeed <= 0_pInt) &
write(6,'(a,/)') ' No fixed Seed: Random is random!' write(6,'(a,/)') ' No fixed Seed: Random is random!'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! gradient parameter ! gradient parameter
write(6,'(a24,1x,es8.1)') ' charLength: ',charLength write(6,'(a24,1x,es8.1)') ' charLength: ',charLength
write(6,'(a24,1x,es8.1)') ' residualStiffness: ',residualStiffness write(6,'(a24,1x,es8.1)') ' residualStiffness: ',residualStiffness
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! openMP parameter ! openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! field parameters ! field parameters
write(6,'(a24,1x,i8)') ' itmax: ',itmax write(6,'(a24,1x,i8)') ' itmax: ',itmax
write(6,'(a24,1x,i8)') ' itmin: ',itmin write(6,'(a24,1x,i8)') ' itmin: ',itmin
write(6,'(a24,1x,i8)') ' maxCutBack: ',maxCutBack write(6,'(a24,1x,i8)') ' maxCutBack: ',maxCutBack
write(6,'(a24,1x,i8)') ' maxStaggeredIter: ',stagItMax write(6,'(a24,1x,i8)') ' maxStaggeredIter: ',stagItMax
write(6,'(a24,1x,i8)') ' vacancyPolyOrder: ',vacancyPolyOrder write(6,'(a24,1x,i8)') ' vacancyPolyOrder: ',vacancyPolyOrder
write(6,'(a24,1x,i8)') ' hydrogenPolyOrder: ',hydrogenPolyOrder write(6,'(a24,1x,i8)') ' hydrogenPolyOrder: ',hydrogenPolyOrder
write(6,'(a24,1x,es8.1)') ' err_struct_tolAbs: ',err_struct_tolAbs write(6,'(a24,1x,es8.1)') ' err_struct_tolAbs: ',err_struct_tolAbs
write(6,'(a24,1x,es8.1)') ' err_struct_tolRel: ',err_struct_tolRel write(6,'(a24,1x,es8.1)') ' err_struct_tolRel: ',err_struct_tolRel
write(6,'(a24,1x,es8.1)') ' err_thermal_tolabs: ',err_thermal_tolabs write(6,'(a24,1x,es8.1)') ' err_thermal_tolabs: ',err_thermal_tolabs
write(6,'(a24,1x,es8.1)') ' err_thermal_tolrel: ',err_thermal_tolrel write(6,'(a24,1x,es8.1)') ' err_thermal_tolrel: ',err_thermal_tolrel
write(6,'(a24,1x,es8.1)') ' err_damage_tolabs: ',err_damage_tolabs write(6,'(a24,1x,es8.1)') ' err_damage_tolabs: ',err_damage_tolabs
write(6,'(a24,1x,es8.1)') ' err_damage_tolrel: ',err_damage_tolrel write(6,'(a24,1x,es8.1)') ' err_damage_tolrel: ',err_damage_tolrel
write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolabs: ',err_vacancyflux_tolabs write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolabs: ',err_vacancyflux_tolabs
write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolrel: ',err_vacancyflux_tolrel write(6,'(a24,1x,es8.1)') ' err_vacancyflux_tolrel: ',err_vacancyflux_tolrel
write(6,'(a24,1x,es8.1)') ' err_porosity_tolabs: ',err_porosity_tolabs write(6,'(a24,1x,es8.1)') ' err_porosity_tolabs: ',err_porosity_tolabs
write(6,'(a24,1x,es8.1)') ' err_porosity_tolrel: ',err_porosity_tolrel write(6,'(a24,1x,es8.1)') ' err_porosity_tolrel: ',err_porosity_tolrel
write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolabs:',err_hydrogenflux_tolabs write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolabs:',err_hydrogenflux_tolabs
write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolrel:',err_hydrogenflux_tolrel write(6,'(a24,1x,es8.1)') ' err_hydrogenflux_tolrel:',err_hydrogenflux_tolrel
write(6,'(a24,1x,es8.1)') ' vacancyBoundPenalty: ',vacancyBoundPenalty write(6,'(a24,1x,es8.1)') ' vacancyBoundPenalty: ',vacancyBoundPenalty
write(6,'(a24,1x,es8.1)') ' hydrogenBoundPenalty: ',hydrogenBoundPenalty write(6,'(a24,1x,es8.1)') ' hydrogenBoundPenalty: ',hydrogenBoundPenalty
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! spectral parameters ! spectral parameters
#ifdef Spectral #ifdef Spectral
write(6,'(a24,1x,i8)') ' continueCalculation: ',continueCalculation write(6,'(a24,1x,i8)') ' continueCalculation: ',continueCalculation
write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient
write(6,'(a24,1x,i8)') ' divergence_correction: ',divergence_correction write(6,'(a24,1x,i8)') ' divergence_correction: ',divergence_correction
write(6,'(a24,1x,a)') ' spectral_derivative: ',trim(spectral_derivative) write(6,'(a24,1x,a)') ' spectral_derivative: ',trim(spectral_derivative)
if(fftw_timelimit<0.0_pReal) then if(fftw_timelimit<0.0_pReal) then
write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false. write(6,'(a24,1x,L8)') ' fftw_timelimit: ',.false.
else else
write(6,'(a24,1x,es8.1)') ' fftw_timelimit: ',fftw_timelimit write(6,'(a24,1x,es8.1)') ' fftw_timelimit: ',fftw_timelimit
endif endif
write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode) write(6,'(a24,1x,a)') ' fftw_plan_mode: ',trim(fftw_plan_mode)
write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag write(6,'(a24,1x,i8)') ' fftw_planner_flag: ',fftw_planner_flag
write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma write(6,'(a24,1x,L8,/)') ' update_gamma: ',update_gamma
write(6,'(a24,1x,es8.1)') ' err_stress_tolAbs: ',err_stress_tolAbs write(6,'(a24,1x,es8.1)') ' err_stress_tolAbs: ',err_stress_tolAbs
write(6,'(a24,1x,es8.1)') ' err_stress_tolRel: ',err_stress_tolRel write(6,'(a24,1x,es8.1)') ' err_stress_tolRel: ',err_stress_tolRel
write(6,'(a24,1x,es8.1)') ' err_div_tolAbs: ',err_div_tolAbs write(6,'(a24,1x,es8.1)') ' err_div_tolAbs: ',err_div_tolAbs
write(6,'(a24,1x,es8.1)') ' err_div_tolRel: ',err_div_tolRel write(6,'(a24,1x,es8.1)') ' err_div_tolRel: ',err_div_tolRel
write(6,'(a24,1x,es8.1)') ' err_curl_tolAbs: ',err_curl_tolAbs write(6,'(a24,1x,es8.1)') ' err_curl_tolAbs: ',err_curl_tolAbs
write(6,'(a24,1x,es8.1)') ' err_curl_tolRel: ',err_curl_tolRel write(6,'(a24,1x,es8.1)') ' err_curl_tolRel: ',err_curl_tolRel
write(6,'(a24,1x,es8.1)') ' polarAlpha: ',polarAlpha write(6,'(a24,1x,es8.1)') ' polarAlpha: ',polarAlpha
write(6,'(a24,1x,es8.1)') ' polarBeta: ',polarBeta write(6,'(a24,1x,es8.1)') ' polarBeta: ',polarBeta
write(6,'(a24,1x,a)') ' spectral solver: ',trim(spectral_solver) write(6,'(a24,1x,a)') ' spectral solver: ',trim(spectral_solver)
write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options) write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options)
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! spectral parameters ! spectral parameters
#ifdef FEM #ifdef FEM
write(6,'(a24,1x,i8)') ' integrationOrder: ',integrationOrder write(6,'(a24,1x,i8)') ' integrationOrder: ',integrationOrder
write(6,'(a24,1x,i8)') ' structOrder: ',structOrder write(6,'(a24,1x,i8)') ' structOrder: ',structOrder
write(6,'(a24,1x,i8)') ' thermalOrder: ',thermalOrder write(6,'(a24,1x,i8)') ' thermalOrder: ',thermalOrder
write(6,'(a24,1x,i8)') ' damageOrder: ',damageOrder write(6,'(a24,1x,i8)') ' damageOrder: ',damageOrder
write(6,'(a24,1x,i8)') ' vacancyfluxOrder: ',vacancyfluxOrder write(6,'(a24,1x,i8)') ' vacancyfluxOrder: ',vacancyfluxOrder
write(6,'(a24,1x,i8)') ' porosityOrder: ',porosityOrder write(6,'(a24,1x,i8)') ' porosityOrder: ',porosityOrder
write(6,'(a24,1x,i8)') ' hydrogenfluxOrder: ',hydrogenfluxOrder write(6,'(a24,1x,i8)') ' hydrogenfluxOrder: ',hydrogenfluxOrder
write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options) write(6,'(a24,1x,a)') ' PETSc_options: ',trim(petsc_defaultOptions)//' '//trim(petsc_options)
write(6,'(a24,1x,L8)') ' B-Bar stabilisation: ',BBarStabilisation write(6,'(a24,1x,L8)') ' B-Bar stabilisation: ',BBarStabilisation
#endif #endif
endif mainProcess3
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

29
code/prec.f90
View File

@ -130,30 +130,17 @@ subroutine prec_init
iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
implicit none implicit none
integer(pInt) :: worldrank = 0_pInt
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
PetscErrorCode :: ierr
#endif
external :: & external :: &
quit, & quit
MPI_Comm_rank, &
MPI_Abort
#ifdef PETSc
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
#endif
mainProcess: if (worldrank == 0) then write(6,'(/,a)') ' <<<+- prec init -+>>>'
write(6,'(/,a)') ' <<<+- prec init -+>>>'
#include "compilation_info.f90" #include "compilation_info.f90"
write(6,'(a,i3)') ' Bytes for pReal: ',pReal write(6,'(a,i3)') ' Bytes for pReal: ',pReal
write(6,'(a,i3)') ' Bytes for pInt: ',pInt write(6,'(a,i3)') ' Bytes for pInt: ',pInt
write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt write(6,'(a,i3)') ' Bytes for pLongInt: ',pLongInt
write(6,'(a,e10.3)') ' NaN: ', DAMASK_NaN write(6,'(a,e10.3)') ' NaN: ', DAMASK_NaN
write(6,'(a,l3)') ' NaN != NaN: ',DAMASK_NaN /= DAMASK_NaN write(6,'(a,l3)') ' NaN != NaN: ',DAMASK_NaN /= DAMASK_NaN
write(6,'(a,l3,/)') ' NaN check passed ',prec_isNAN(DAMASK_NaN) write(6,'(a,l3,/)') ' NaN check passed ',prec_isNAN(DAMASK_NaN)
endif mainProcess
if ((.not. prec_isNaN(DAMASK_NaN)) .or. (DAMASK_NaN == DAMASK_NaN)) call quit(9000) if ((.not. prec_isNaN(DAMASK_NaN)) .or. (DAMASK_NaN == DAMASK_NaN)) call quit(9000)
realloc_lhs_test = [1_pInt,2_pInt] realloc_lhs_test = [1_pInt,2_pInt]

55
code/spectral_damage.f90
View File

@ -42,7 +42,6 @@ module spectral_damage
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
real(pReal), dimension(3,3), private :: D_ref real(pReal), dimension(3,3), private :: D_ref
real(pReal), private :: mobility_ref real(pReal), private :: mobility_ref
character(len=1024), private :: incInfo
public :: & public :: &
spectral_damage_init, & spectral_damage_init, &
@ -50,21 +49,7 @@ module spectral_damage
spectral_damage_forward, & spectral_damage_forward, &
spectral_damage_destroy spectral_damage_destroy
external :: & external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort, & MPI_Abort, &
MPI_Bcast, & MPI_Bcast, &
MPI_Allreduce MPI_Allreduce
@ -90,15 +75,30 @@ subroutine spectral_damage_init()
damage_nonlocal_getMobility damage_nonlocal_getMobility
implicit none implicit none
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
integer(pInt) :: i, j, k, cell
DM :: damage_grid DM :: damage_grid
Vec :: uBound, lBound Vec :: uBound, lBound
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc
integer(pInt) :: i, j, k, cell
character(len=100) :: snes_type character(len=100) :: snes_type
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMDAGetCorners, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESSetFromOptions, &
SNESGetType, &
VecSet, &
DMGetGlobalVector, &
DMRestoreGlobalVector, &
SNESVISetVariableBounds
mainProcess: if (worldrank == 0_pInt) then 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()
@ -194,12 +194,18 @@ type(tSolutionState) function spectral_damage_solution(guess,timeinc,timeinc_old
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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Data ! PETSc Data
PetscErrorCode :: ierr PetscErrorCode :: ierr
SNESConvergedReason :: reason SNESConvergedReason :: reason
external :: &
VecMin, &
VecMax, &
SNESSolve, &
SNESGetConvergedReason
spectral_damage_solution%converged =.false. spectral_damage_solution%converged =.false.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -353,10 +359,13 @@ subroutine spectral_damage_forward(guess,timeinc,timeinc_old,loadCaseTime)
timeinc, & timeinc, &
loadCaseTime !< remaining time of current load case loadCaseTime !< remaining time of current load case
logical, intent(in) :: guess logical, intent(in) :: guess
PetscErrorCode :: ierr
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
PetscErrorCode :: ierr
external :: &
SNESGetDM
if (cutBack) then if (cutBack) then
damage_current = damage_lastInc damage_current = damage_lastInc
@ -400,6 +409,10 @@ subroutine spectral_damage_destroy()
implicit none implicit none
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy
call VecDestroy(solution,ierr); CHKERRQ(ierr) call VecDestroy(solution,ierr); CHKERRQ(ierr)
call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr) call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr)

35
code/spectral_interface.f90
View File

@ -77,6 +77,8 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn)
MPI_Init_Thread, & MPI_Init_Thread, &
MPI_abort MPI_abort
open(6, encoding='UTF-8') ! for special characters in output
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! PETSc Init
#ifdef PETSc #ifdef PETSc
@ -89,22 +91,31 @@ subroutine DAMASK_interface_init(loadCaseParameterIn,geometryParameterIn)
#endif #endif
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
open(6, encoding='UTF-8')
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
#endif #endif
mainProcess: if (worldrank == 0) then mainProcess: if (worldrank == 0) then
call date_and_time(values = dateAndTime) if (output_unit /= 6) then
write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' write(output_unit,'(a)') 'STDOUT != 6'
write(6,'(/,a)') ' Version: '//DAMASKVERSION call quit(1_pInt)
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& endif
dateAndTime(2),'/',& else mainProcess
dateAndTime(1) close(6) ! disable output for non-master processes (open 6 to rank specific file for debug)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90"
endif mainProcess endif mainProcess
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',&
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90"
if ( present(loadcaseParameterIn) .and. present(geometryParameterIn)) then ! both mandatory parameters given in function call if ( present(loadcaseParameterIn) .and. present(geometryParameterIn)) then ! both mandatory parameters given in function call
geometryArg = geometryParameterIn geometryArg = geometryParameterIn
loadcaseArg = loadcaseParameterIn loadcaseArg = loadcaseParameterIn

67
code/spectral_mech_AL.f90
View File

@ -22,7 +22,7 @@ module spectral_mech_AL
DAMASK_spectral_solverAL_label = 'al' DAMASK_spectral_solverAL_label = 'al'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type(tSolutionParams), private :: params type(tSolutionParams), private :: params
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
@ -31,7 +31,7 @@ module spectral_mech_AL
DM, private :: da DM, private :: da
SNES, private :: snes SNES, private :: snes
Vec, private :: solution_vec Vec, private :: solution_vec
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
real(pReal), private, dimension(:,:,:,:,:), allocatable :: & real(pReal), private, dimension(:,:,:,:,:), allocatable :: &
@ -72,21 +72,7 @@ module spectral_mech_AL
AL_forward, & AL_forward, &
AL_destroy AL_destroy
external :: & external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort, & MPI_Abort, &
MPI_Bcast, & MPI_Bcast, &
MPI_Allreduce MPI_Allreduce
@ -136,11 +122,22 @@ subroutine AL_init
integer(pInt) :: proc integer(pInt) :: proc
character(len=1024) :: rankStr character(len=1024) :: rankStr
if (worldrank == 0_pInt) then external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
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 endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
@ -150,7 +147,7 @@ subroutine AL_init
allocate (F_lambdaDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) allocate (F_lambdaDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
@ -185,10 +182,10 @@ subroutine AL_init
'reading values of increment ', restartInc - 1_pInt, ' from file' 'reading values of increment ', restartInc - 1_pInt, ' from file'
flush(6) flush(6)
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr), trim(getSolverJobName()),size(F)) call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
read (777,rec=1) F read (777,rec=1) F
close (777) close (777)
call IO_read_realFile(777,'F_lastInc'//trim(rankStr), trim(getSolverJobName()),size(F_lastInc)) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc))
read (777,rec=1) F_lastInc read (777,rec=1) F_lastInc
close (777) close (777)
call IO_read_realFile(777,'F_lambda'//trim(rankStr),trim(getSolverJobName()),size(F_lambda)) call IO_read_realFile(777,'F_lambda'//trim(rankStr),trim(getSolverJobName()),size(F_lambda))
@ -214,15 +211,14 @@ subroutine AL_init
F_lambda_lastInc = F_lastInc F_lambda_lastInc = F_lastInc
endif restart endif restart
call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) call Utilities_updateIPcoords(reshape(F,shape(F_lastInc)))
call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), &
0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3)
nullify(F) nullify(F)
nullify(F_lambda) nullify(F_lambda)
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc
readRestart: if (restartInc > 1_pInt) then restartRead: 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 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -236,7 +232,7 @@ subroutine AL_init
call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg))
read (777,rec=1) C_minMaxAvg read (777,rec=1) C_minMaxAvg
close (777) close (777)
endif readRestart endif restartRead
call Utilities_updateGamma(C_minMaxAvg,.True.) call Utilities_updateGamma(C_minMaxAvg,.True.)
C_scale = C_minMaxAvg C_scale = C_minMaxAvg
@ -263,7 +259,7 @@ type(tSolutionState) function &
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
terminallyIll terminallyIll
implicit none implicit none
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -286,6 +282,10 @@ type(tSolutionState) function &
PetscErrorCode :: ierr PetscErrorCode :: ierr
SNESConvergedReason :: reason SNESConvergedReason :: reason
external :: &
SNESSolve, &
SNESGetConvergedReason
incInfo = incInfoIn incInfo = incInfoIn
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -298,7 +298,7 @@ type(tSolutionState) function &
endif endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set module wide availabe data ! set module wide availabe data
mask_stress = P_BC%maskFloat mask_stress = P_BC%maskFloat
params%P_BC = P_BC%values params%P_BC = P_BC%values
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
@ -387,6 +387,10 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
integer(pInt) :: & integer(pInt) :: &
i, j, k, e i, j, k, e
external :: &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber
F => x_scal(1:3,1:3,1,& F => x_scal(1:3,1:3,1,&
XG_RANGE,YG_RANGE,ZG_RANGE) XG_RANGE,YG_RANGE,ZG_RANGE)
F_lambda => x_scal(1:3,1:3,2,& F_lambda => x_scal(1:3,1:3,2,&
@ -414,7 +418,7 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
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
endif newIteration endif newIteration
@ -507,7 +511,7 @@ subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr
fnorm fnorm
SNESConvergedReason :: reason SNESConvergedReason :: reason
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode ::ierr PetscErrorCode :: ierr
real(pReal) :: & real(pReal) :: &
curlTol, & curlTol, &
divTol, & divTol, &
@ -704,6 +708,11 @@ subroutine AL_destroy()
implicit none implicit none
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy, &
DMDestroy
call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) call VecDestroy(solution_vec,ierr); CHKERRQ(ierr)
call SNESDestroy(snes,ierr); CHKERRQ(ierr) call SNESDestroy(snes,ierr); CHKERRQ(ierr)
call DMDestroy(da,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr)

95
code/spectral_mech_Basic.f90
View File

@ -48,7 +48,7 @@ module spectral_mech_basic
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
C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness
S = 0.0_pReal !< current compliance (filled up with zeros) S = 0.0_pReal !< current compliance (filled up with zeros)
real(pReal), private :: err_stress, err_div real(pReal), private :: err_stress, err_div
logical, private :: ForwardData logical, private :: ForwardData
integer(pInt), private :: & integer(pInt), private :: &
@ -61,21 +61,7 @@ module spectral_mech_basic
BasicPETSc_forward, & BasicPETSc_forward, &
basicPETSc_destroy basicPETSc_destroy
external :: & external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort, & MPI_Abort, &
MPI_Bcast, & MPI_Bcast, &
MPI_Allreduce MPI_Allreduce
@ -105,7 +91,7 @@ subroutine basicPETSc_init
use spectral_utilities, only: & use spectral_utilities, only: &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_updateGamma, & Utilities_updateGamma, &
utilities_updateIPcoords, & Utilities_updateIPcoords, &
wgt wgt
use mesh, only: & use mesh, only: &
grid, & grid, &
@ -115,15 +101,28 @@ subroutine basicPETSc_init
implicit none implicit none
real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
PetscScalar, dimension(:,:,:,:), pointer :: F
PetscErrorCode :: ierr
PetscObject :: dummy
real(pReal), dimension(3,3) :: & real(pReal), dimension(3,3) :: &
temp33_Real = 0.0_pReal temp33_Real = 0.0_pReal
PetscErrorCode :: ierr
PetscObject :: dummy
PetscScalar, pointer, dimension(:,:,:,:) :: F
integer(pInt), dimension(:), allocatable :: localK integer(pInt), dimension(:), allocatable :: localK
integer(pInt) :: proc integer(pInt) :: proc
character(len=1024) :: rankStr character(len=1024) :: rankStr
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions
mainProcess: if (worldrank == 0_pInt) then 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()
@ -147,9 +146,9 @@ subroutine basicPETSc_init
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! global grid grid(1),grid(2),grid(3), & ! global grid
1, 1, worldsize, & 1 , 1, worldsize, &
9, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) 9, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
grid (1),grid (2),localK, & ! local grid grid(1),grid(2),localK, & ! local grid
da,ierr) ! handle, error da,ierr) ! handle, error
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
@ -195,10 +194,9 @@ subroutine basicPETSc_init
temp33_Real, & temp33_Real, &
.false., & .false., &
math_I3) math_I3)
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc
restartRead: if (restartInc > 1_pInt) then restartRead: 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 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -243,19 +241,24 @@ type(tSolutionState) function &
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
type(tBoundaryCondition), intent(in) :: & type(tBoundaryCondition), intent(in) :: &
P_BC, & P_BC, &
F_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
logical, intent(in) :: &
guess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Data ! PETSc Data
PetscErrorCode :: ierr PetscErrorCode :: ierr
SNESConvergedReason :: reason SNESConvergedReason :: reason
external :: &
SNESSolve, &
SNESGetConvergedReason
incInfo = incInfoIn incInfo = incInfoIn
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -263,9 +266,9 @@ type(tSolutionState) function &
S = Utilities_maskedCompliance(rotation_BC,P_BC%maskLogical,C_volAvg) S = Utilities_maskedCompliance(rotation_BC,P_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 = P_BC%maskFloat
params%P_BC = P_BC%values params%P_BC = P_BC%values
params%rotation_BC = rotation_BC params%rotation_BC = rotation_BC
@ -292,7 +295,7 @@ end function BasicPETSc_solution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forms the AL residual vector !> @brief forms the basic residual vector
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: & use numerics, only: &
@ -312,10 +315,11 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
debug_spectral, & debug_spectral, &
debug_spectralRotation debug_spectralRotation
use spectral_utilities, only: & use spectral_utilities, only: &
wgt, &
tensorField_real, & tensorField_real, &
utilities_FFTtensorForward, & utilities_FFTtensorForward, &
utilities_FFTtensorBackward, &
utilities_fourierGammaConvolution, & utilities_fourierGammaConvolution, &
utilities_FFTtensorBackward, &
Utilities_constitutiveResponse, & Utilities_constitutiveResponse, &
Utilities_divergenceRMS Utilities_divergenceRMS
use IO, only: & use IO, only: &
@ -338,11 +342,15 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber
call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment
newIteration: if (totalIter <= PETScIter) then newIteration: if(totalIter <= PETScIter) then
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! report begin of new iteration ! report begin of new iteration
totalIter = totalIter + 1_pInt totalIter = totalIter + 1_pInt
@ -351,7 +359,7 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
' @ 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)
@ -401,7 +409,7 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
worldrank worldrank
use FEsolving, only: & use FEsolving, only: &
terminallyIll terminallyIll
implicit none implicit none
SNES :: snes_local SNES :: snes_local
PetscInt :: PETScIter PetscInt :: PETScIter
@ -415,10 +423,10 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
real(pReal) :: & real(pReal) :: &
divTol, & divTol, &
stressTol stressTol
divTol = max(maxval(abs(P_av))*err_div_tolRel,err_div_tolAbs) divTol = max(maxval(abs(P_av))*err_div_tolRel,err_div_tolAbs)
stressTol = max(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs) stressTol = max(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs)
converged: if ((totalIter >= itmin .and. & converged: if ((totalIter >= itmin .and. &
all([ err_div/divTol, & all([ err_div/divTol, &
err_stress/stressTol ] < 1.0_pReal)) & err_stress/stressTol ] < 1.0_pReal)) &
@ -451,21 +459,21 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
use math, only: & use math, only: &
math_mul33x33 ,& math_mul33x33 ,&
math_rotate_backward33 math_rotate_backward33
use numerics, only: &
worldrank
use mesh, only: & use mesh, only: &
grid, & grid, &
grid3 grid3
use spectral_utilities, only: & use spectral_utilities, only: &
Utilities_calculateRate, & Utilities_calculateRate, &
Utilities_forwardField, & Utilities_forwardField, &
utilities_updateIPcoords, & Utilities_updateIPcoords, &
tBoundaryCondition, & tBoundaryCondition, &
cutBack cutBack
use IO, only: & use IO, only: &
IO_write_JobRealFile IO_write_JobRealFile
use FEsolving, only: & use FEsolving, only: &
restartWrite restartWrite
use numerics, only: &
worldrank
implicit none implicit none
real(pReal), intent(in) :: & real(pReal), intent(in) :: &
@ -478,8 +486,9 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
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
PetscErrorCode :: ierr
PetscScalar, pointer :: F(:,:,:,:) PetscScalar, pointer :: F(:,:,:,:)
PetscErrorCode :: ierr
character(len=1024) :: rankStr character(len=1024) :: rankStr
call DMDAVecGetArrayF90(da,solution_vec,F,ierr) call DMDAVecGetArrayF90(da,solution_vec,F,ierr)
@ -508,7 +517,7 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
write (777,rec=1) C_volAvgLastInc write (777,rec=1) C_volAvgLastInc
close(777) close(777)
endif endif
endif endif
call utilities_updateIPcoords(F) call utilities_updateIPcoords(F)
@ -538,6 +547,7 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC,r
timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]))
F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3])
endif endif
F_aim = F_aim + f_aimDot * timeinc F_aim = F_aim + f_aimDot * timeinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -558,6 +568,11 @@ subroutine BasicPETSc_destroy()
implicit none implicit none
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy, &
DMDestroy
call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) call VecDestroy(solution_vec,ierr); CHKERRQ(ierr)
call SNESDestroy(snes,ierr); CHKERRQ(ierr) call SNESDestroy(snes,ierr); CHKERRQ(ierr)
call DMDestroy(da,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr)

67
code/spectral_mech_Polarisation.f90
View File

@ -22,7 +22,7 @@ module spectral_mech_Polarisation
DAMASK_spectral_solverPolarisation_label = 'polarisation' DAMASK_spectral_solverPolarisation_label = 'polarisation'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! derived types ! derived types
type(tSolutionParams), private :: params type(tSolutionParams), private :: params
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
@ -31,7 +31,7 @@ module spectral_mech_Polarisation
DM, private :: da DM, private :: da
SNES, private :: snes SNES, private :: snes
Vec, private :: solution_vec Vec, private :: solution_vec
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! common pointwise data ! common pointwise data
real(pReal), private, dimension(:,:,:,:,:), allocatable :: & real(pReal), private, dimension(:,:,:,:,:), allocatable :: &
@ -57,7 +57,7 @@ module spectral_mech_Polarisation
S = 0.0_pReal, & !< current compliance (filled up with zeros) S = 0.0_pReal, & !< current compliance (filled up with zeros)
C_scale = 0.0_pReal, & C_scale = 0.0_pReal, &
S_scale = 0.0_pReal S_scale = 0.0_pReal
real(pReal), private :: & real(pReal), private :: &
err_BC, & !< deviation from stress BC err_BC, & !< deviation from stress BC
err_curl, & !< RMS of curl of F err_curl, & !< RMS of curl of F
@ -72,21 +72,7 @@ module spectral_mech_Polarisation
Polarisation_forward, & Polarisation_forward, &
Polarisation_destroy Polarisation_destroy
external :: & external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort, & MPI_Abort, &
MPI_Bcast, & MPI_Bcast, &
MPI_Allreduce MPI_Allreduce
@ -136,11 +122,22 @@ subroutine Polarisation_init
integer(pInt) :: proc integer(pInt) :: proc
character(len=1024) :: rankStr character(len=1024) :: rankStr
if (worldrank == 0_pInt) then external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
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 endif mainProcess
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! allocate global fields ! allocate global fields
@ -150,7 +147,7 @@ subroutine Polarisation_init
allocate (F_tauDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) allocate (F_tauDot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Init ! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3
@ -163,7 +160,7 @@ subroutine Polarisation_init
grid(1),grid(2),grid(3), & ! global grid grid(1),grid(2),grid(3), & ! global grid
1 , 1, worldsize, & 1 , 1, worldsize, &
18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) 18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
grid (1),grid (2),localK, & ! local grid grid(1),grid(2),localK, & ! local grid
da,ierr) ! handle, error da,ierr) ! handle, error
CHKERRQ(ierr) CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
@ -182,7 +179,7 @@ subroutine Polarisation_init
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 .and. worldrank == 0_pInt) &
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)
write(rankStr,'(a1,i0)')'_',worldrank write(rankStr,'(a1,i0)')'_',worldrank
call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F))
@ -221,7 +218,7 @@ subroutine Polarisation_init
nullify(F_tau) nullify(F_tau)
call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc
readRestart: if (restartInc > 1_pInt) then restartRead: 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 .and. worldrank == 0_pInt) &
write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') &
'reading more values of increment', restartInc - 1_pInt, 'from file' 'reading more values of increment', restartInc - 1_pInt, 'from file'
@ -235,7 +232,7 @@ subroutine Polarisation_init
call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg))
read (777,rec=1) C_minMaxAvg read (777,rec=1) C_minMaxAvg
close (777) close (777)
endif readRestart endif restartRead
call Utilities_updateGamma(C_minMaxAvg,.True.) call Utilities_updateGamma(C_minMaxAvg,.True.)
C_scale = C_minMaxAvg C_scale = C_minMaxAvg
@ -262,7 +259,7 @@ type(tSolutionState) function &
use FEsolving, only: & use FEsolving, only: &
restartWrite, & restartWrite, &
terminallyIll terminallyIll
implicit none implicit none
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -285,6 +282,10 @@ type(tSolutionState) function &
PetscErrorCode :: ierr PetscErrorCode :: ierr
SNESConvergedReason :: reason SNESConvergedReason :: reason
external :: &
SNESSolve, &
SNESGetConvergedReason
incInfo = incInfoIn incInfo = incInfoIn
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -385,7 +386,11 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
PetscErrorCode :: ierr PetscErrorCode :: ierr
integer(pInt) :: & integer(pInt) :: &
i, j, k, e i, j, k, e
external :: &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber
F => x_scal(1:3,1:3,1,& F => x_scal(1:3,1:3,1,&
XG_RANGE,YG_RANGE,ZG_RANGE) XG_RANGE,YG_RANGE,ZG_RANGE)
F_tau => x_scal(1:3,1:3,2,& F_tau => x_scal(1:3,1:3,2,&
@ -505,7 +510,7 @@ subroutine Polarisation_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,
fnorm fnorm
SNESConvergedReason :: reason SNESConvergedReason :: reason
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode ::ierr PetscErrorCode :: ierr
real(pReal) :: & real(pReal) :: &
curlTol, & curlTol, &
divTol, & divTol, &
@ -631,7 +636,8 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,F_BC,P_BC
write (777,rec=1) C_volAvgLastInc write (777,rec=1) C_volAvgLastInc
close(777) close(777)
endif endif
endif endif
call utilities_updateIPcoords(F) call utilities_updateIPcoords(F)
if (cutBack) then if (cutBack) then
@ -701,6 +707,11 @@ subroutine Polarisation_destroy()
implicit none implicit none
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy, &
DMDestroy
call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) call VecDestroy(solution_vec,ierr); CHKERRQ(ierr)
call SNESDestroy(snes,ierr); CHKERRQ(ierr) call SNESDestroy(snes,ierr); CHKERRQ(ierr)
call DMDestroy(da,ierr); CHKERRQ(ierr) call DMDestroy(da,ierr); CHKERRQ(ierr)

50
code/spectral_thermal.f90
View File

@ -42,7 +42,6 @@ module spectral_thermal
integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment integer(pInt), private :: totalIter = 0_pInt !< total iteration in current increment
real(pReal), dimension(3,3), private :: D_ref real(pReal), dimension(3,3), private :: D_ref
real(pReal), private :: mobility_ref real(pReal), private :: mobility_ref
character(len=1024), private :: incInfo
public :: & public :: &
spectral_thermal_init, & spectral_thermal_init, &
@ -50,21 +49,7 @@ module spectral_thermal
spectral_thermal_forward, & spectral_thermal_forward, &
spectral_thermal_destroy spectral_thermal_destroy
external :: & external :: &
VecDestroy, &
DMDestroy, &
DMDACreate3D, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
PETScFinalize, & PETScFinalize, &
SNESDestroy, &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber, &
SNESSolve, &
SNESSetDM, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions, &
SNESCreate, &
MPI_Abort, & MPI_Abort, &
MPI_Bcast, & MPI_Bcast, &
MPI_Allreduce MPI_Allreduce
@ -99,10 +84,20 @@ subroutine spectral_thermal_init
integer(pInt) :: proc integer(pInt) :: proc
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
DM :: thermal_grid DM :: thermal_grid
PetscScalar, pointer :: x_scal(:,:,:) PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMDAGetCorners, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESSetFromOptions
mainProcess: if (worldrank == 0_pInt) then mainProcess: if (worldrank == 0_pInt) then
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp() write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -154,6 +149,8 @@ subroutine spectral_thermal_init
x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current
call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! thermal reference diffusion update
cell = 0_pInt cell = 0_pInt
D_ref = 0.0_pReal D_ref = 0.0_pReal
mobility_ref = 0.0_pReal mobility_ref = 0.0_pReal
@ -171,7 +168,7 @@ subroutine spectral_thermal_init
end subroutine spectral_thermal_init end subroutine spectral_thermal_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief solution for the Basic PETSC 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(guess,timeinc,timeinc_old,loadCaseTime)
use numerics, only: & use numerics, only: &
@ -196,12 +193,18 @@ type(tSolutionState) function spectral_thermal_solution(guess,timeinc,timeinc_ol
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
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! PETSc Data ! PETSc Data
PetscErrorCode :: ierr PetscErrorCode :: ierr
SNESConvergedReason :: reason SNESConvergedReason :: reason
external :: &
VecMin, &
VecMax, &
SNESSolve, &
SNESGetConvergedReason
spectral_thermal_solution%converged =.false. spectral_thermal_solution%converged =.false.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -355,8 +358,11 @@ subroutine spectral_thermal_forward(guess,timeinc,timeinc_old,loadCaseTime)
logical, intent(in) :: guess logical, intent(in) :: guess
integer(pInt) :: i, j, k, cell integer(pInt) :: i, j, k, cell
DM :: dm_local DM :: dm_local
PetscScalar, pointer :: x_scal(:,:,:) PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
SNESGetDM
if (cutBack) then if (cutBack) then
temperature_current = temperature_lastInc temperature_current = temperature_lastInc
@ -405,6 +411,10 @@ subroutine spectral_thermal_destroy()
implicit none implicit none
PetscErrorCode :: ierr PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy
call VecDestroy(solution,ierr); CHKERRQ(ierr) call VecDestroy(solution,ierr); CHKERRQ(ierr)
call SNESDestroy(thermal_snes,ierr); CHKERRQ(ierr) call SNESDestroy(thermal_snes,ierr); CHKERRQ(ierr)