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

added some warning and explicit size of arrays

This commit is contained in:
Martin Diehl 2013-01-10 13:33:43 +00:00
parent b098bc667c
commit 563b1f5e4b
4 changed files with 50 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
code/DAMASK_spectral_driver.f90
View File

@ -30,7 +30,8 @@ program DAMASK_spectral_Driver
IO_lc, &
IO_read_jobBinaryFile, &
IO_write_jobBinaryFile, &
IO_intOut
IO_intOut, &
IO_warning
use math ! need to include the whole module for FFTW
use mesh, only : &
res, &
@ -53,6 +54,7 @@ program DAMASK_spectral_Driver
tBoundaryCondition, &
tSolutionState, &
debugGeneral, &
debugDivergence, &
cutBack
use DAMASK_spectral_SolverBasic
#ifdef PETSc
@ -298,6 +300,7 @@ program DAMASK_spectral_Driver
case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init(loadCases(1)%temperature)
case (DAMASK_spectral_SolverAL_label)
if(debugDivergence) call IO_warning(42_pInt, ext_msg='debug Divergence')
call AL_init(loadCases(1)%temperature)
#endif
case default
@ -390,9 +393,9 @@ program DAMASK_spectral_Driver
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
' of load case ', currentLoadCase,'/',size(loadCases)
flush(6)
write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases(:)%incs))//&
write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
'Increment ',totalIncsCounter,'/',sum(loadCases(:)%incs),&
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
'-',stepFraction, '/', subStepFactor**cutBackLevel
select case(myspectralsolver)

29
code/DAMASK_spectral_solverAL.f90
View File

@ -366,7 +366,6 @@ end function AL_solution
!> @brief forms the AL residual vector
!--------------------------------------------------------------------------------------------------
subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: &
itmax, &
itmin
@ -392,19 +391,27 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr)
real(pReal), dimension(3,3) :: temp33_Real
logical :: report
DMDALocalInfo :: in(DMDA_LOCAL_INFO_SIZE)
PetscScalar, target :: x_scal(3,3,2,XG_RANGE,YG_RANGE,ZG_RANGE)
PetscScalar, target :: f_scal(3,3,2,X_RANGE,Y_RANGE,Z_RANGE)
PetscScalar, pointer :: F(:,:,:,:,:), F_lambda(:,:,:,:,:)
PetscScalar, pointer :: residual_F(:,:,:,:,:), residual_F_lambda(:,:,:,:,:)
PetscInt :: iter, nfuncs
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in
PetscScalar, target, dimension(3,3,2,XG_RANGE,YG_RANGE,ZG_RANGE) :: &
x_scal
PetscScalar, target, dimension(3,3,2,X_RANGE,Y_RANGE,Z_RANGE) :: &
f_scal
PetscScalar, pointer, dimension(:,:,:,:,:) :: &
F, &
F_lambda, &
residual_F &
residual_F_lambda
PetscInt :: &
iter, &
nfuncs
PetscObject :: dummy
PetscErrorCode :: ierr
F => x_scal(:,:,1,:,:,:)
F_lambda => x_scal(:,:,2,:,:,:)
residual_F => f_scal(:,:,1,:,:,:)
residual_F_lambda => f_scal(:,:,2,:,:,:)
F => x_scal(1:3,1:3,1,XG_RANGE,YG_RANGE,ZG_RANGE)
F_lambda => x_scal(1:3,1:3,2,XG_RANGE,YG_RANGE,ZG_RANGE)
residual_F => f_scal(1:3,1:3,1,X_RANGE,Y_RANGE,Z_RANGE)
residual_F_lambda => f_scal(1:3,1:3,2,X_RANGE,Y_RANGE,Z_RANGE)
call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,iter,ierr); CHKERRQ(ierr)

38
code/DAMASK_spectral_solverBasicPETSc.f90
View File

@ -127,9 +127,10 @@ subroutine basicPETSc_init(temperature)
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
call DMDACreate3d(PETSC_COMM_WORLD, &
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, &
DMDA_STENCIL_BOX,res(1),res(2),res(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, &
9,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr); CHKERRQ(ierr)
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, &
DMDA_STENCIL_BOX,res(1),res(2),res(3),PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE, &
9,1,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,da,ierr)
CHKERRQ(ierr)
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr)
call DMDASetLocalFunction(da,BasicPETSC_formResidual,ierr); CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr)
@ -178,8 +179,7 @@ subroutine basicPETSc_init(temperature)
reshape(F(0:8,0:res(1)-1_pInt,0:res(2)-1_pInt,0:res(3)-1_pInt),[3,3,res(1),res(2),res(3)]),&
reshape(F(0:8,0:res(1)-1_pInt,0:res(2)-1_pInt,0:res(3)-1_pInt),[3,3,res(1),res(2),res(3)]),&
temperature,0.0_pReal,P,C,temp33_Real,.false.,math_I3)
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr) ! write data back into PETSc
CHKERRQ(ierr)
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back into PETSc
if (restartInc == 1_pInt) then ! use initial stiffness as reference stiffness
temp3333_Real = C
endif
@ -300,16 +300,17 @@ type(tSolutionState) function &
if (update_gamma) call Utilities_updateGamma(C,restartWrite)
ForwardData = .True.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
mask_stress = P_BC%maskFloat
params%P_BC = P_BC%values
params%rotation_BC = rotation_BC
params%timeinc = timeinc
params%temperature = temperature_BC
call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr)
CHKERRQ(ierr)
call SNESGetConvergedReason(snes,reason,ierr)
CHKERRQ(ierr)
call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr): CHKERRQ(ierr)
call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr)
basicPETSc_solution%termIll = terminallyIll
terminallyIll = .false.
BasicPETSC_solution%converged =.false.
@ -324,7 +325,7 @@ end function BasicPETSc_solution
!--------------------------------------------------------------------------------------------------
!> @brief forms the AL residual vector
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_formResidual(myIn,x_scal,f_scal,dummy,ierr)
subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: &
itmax, &
itmin
@ -346,11 +347,14 @@ subroutine BasicPETSC_formResidual(myIn,x_scal,f_scal,dummy,ierr)
use IO, only : IO_intOut
implicit none
DMDALocalInfo, dimension(*) :: myIn
PetscScalar, dimension(3,3,res(1),res(2),res(3)) :: &
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
in
PetscScalar, dimension(3,3,res(1),res(2),res(3)) :: &
x_scal, &
f_scal
PetscInt :: iter, nfuncs
PetscInt :: &
iter, &
nfuncs
PetscObject :: dummy
PetscErrorCode :: ierr
integer(pInt), save :: callNo = 3_pInt
@ -433,15 +437,15 @@ subroutine BasicPETSc_converged(snes_local,it,xnorm,snorm,fnorm,reason,dummy,ier
PetscObject :: dummy
PetscErrorCode :: ierr
logical :: Converged
real(pReal) :: pAvgDivL2, &
real(pReal) :: &
pAvgDivL2, &
err_stress_tol
err_stress_tol =min(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs)
pAvgDivL2 = sqrt(maxval(math_eigenvalues33(math_mul33x33(P_av,math_transpose33(P_av)))))
Converged = (it >= itmin .and. &
all([ err_div/pAvgDivL2/err_div_tol, &
err_stress/err_stress_tol] < 1.0_pReal))
all([ err_div/pAvgDivL2/err_div_tol, &
err_stress/err_stress_tol ] < 1.0_pReal))
if (Converged) then
reason = 1

7
code/DAMASK_spectral_utilities.f90
View File

@ -98,7 +98,8 @@ contains
subroutine utilities_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use IO, only: &
IO_error
IO_error, &
IO_warning
use numerics, only: &
DAMASK_NumThreadsInt, &
fftw_planner_flag, &
@ -148,14 +149,16 @@ subroutine utilities_init()
debugRestart = iand(debug_level(debug_spectral),debug_spectralRestart) /= 0
debugFFTW = iand(debug_level(debug_spectral),debug_spectralFFTW) /= 0
debugRotation = iand(debug_level(debug_spectral),debug_spectralRotation) /= 0
#ifdef PETSc
debugPETSc = iand(debug_level(debug_spectral),debug_spectralPETSc) /= 0
#ifdef PETSc
if(debugPETSc) write(6,'(/,a)') ' Initializing PETSc with debug options: ', trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.config '
flush(6)
call PetscOptionsClear(ierr); CHKERRQ(ierr)
if(debugPETSc) call PetscOptionsInsertString(trim(PETScDebug),ierr); CHKERRQ(ierr)
call PetscOptionsInsertString(trim(petsc_options),ierr); CHKERRQ(ierr)
#else
call IO_warning(41_pInt, ext_msg='debug PETSc')
#endif
!--------------------------------------------------------------------------------------------------
! allocation