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

View File

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

View File

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

View File

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

View File

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