some more finetuning, still not running on gfortran 4.5.0

This commit is contained in:
Martin Diehl 2012-11-08 21:33:58 +00:00
parent c831716b26
commit b1c3c57412
2 changed files with 25 additions and 21 deletions

View File

@ -75,8 +75,8 @@ program DAMASK_spectral_Driver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file ! variables related to information from load case and geom file
real(pReal), dimension(9) :: temp_valueVector !< temporarily from loadcase file when reading in tensors real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
logical, dimension(9) :: temp_maskVector !< temporarily from loadcase file when reading in tensors logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors
integer(pInt), parameter :: maxNchunksLoadcase = (1_pInt + 9_pInt)*3_pInt +& ! deformation, rotation, and stress integer(pInt), parameter :: maxNchunksLoadcase = (1_pInt + 9_pInt)*3_pInt +& ! deformation, rotation, and stress
(1_pInt + 1_pInt)*5_pInt +& ! time, (log)incs, temp, restartfrequency, and outputfrequency (1_pInt + 1_pInt)*5_pInt +& ! time, (log)incs, temp, restartfrequency, and outputfrequency
1_pInt ! dropguessing 1_pInt ! dropguessing
@ -195,6 +195,7 @@ program DAMASK_spectral_Driver
case('guessreset','dropguessing') case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
case('euler') ! rotation of currentLoadCase given in euler angles case('euler') ! rotation of currentLoadCase given in euler angles
temp_valueVector = 0.0_pReal
l = 0_pInt ! assuming values given in degrees l = 0_pInt ! assuming values given in degrees
k = 0_pInt ! assuming keyword indicating degree/radians k = 0_pInt ! assuming keyword indicating degree/radians
select case (IO_lc(IO_stringValue(line,positions,i+1_pInt))) select case (IO_lc(IO_stringValue(line,positions,i+1_pInt)))

View File

@ -18,6 +18,7 @@ module DAMASK_spectral_SolverBasicPETSc
tSolutionState tSolutionState
implicit none implicit none
private
#include <finclude/petscsys.h> #include <finclude/petscsys.h>
#include <finclude/petscdmda.h> #include <finclude/petscdmda.h>
#include <finclude/petscsnes.h> #include <finclude/petscsnes.h>
@ -61,12 +62,15 @@ module DAMASK_spectral_SolverBasicPETSc
logical, private :: ForwardData logical, private :: ForwardData
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
contains
public :: basicPETSc_init, &
basicPETSc_solution ,&
basicPETSc_destroy
contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info !> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_init() subroutine basicPETSc_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)
@ -101,7 +105,7 @@ subroutine BasicPETSC_init()
#include <finclude/petscdmda.h90> #include <finclude/petscdmda.h90>
#include <finclude/petscsnes.h90> #include <finclude/petscsnes.h90>
integer(pInt) :: i,j,k integer(pInt) :: i,j,k
real(pReal), dimension(:,:,:,:,:), allocatable :: P real(pReal), dimension(3,3, res(1), res(2),res(3)) :: P
PetscScalar, dimension(:,:,:,:), pointer :: F PetscScalar, dimension(:,:,:,:), pointer :: F
PetscErrorCode :: ierr PetscErrorCode :: ierr
PetscObject :: dummy PetscObject :: dummy
@ -115,7 +119,6 @@ subroutine BasicPETSC_init()
allocate (F_lastInc (3,3, res(1), res(2),res(3)), source = 0.0_pReal) allocate (F_lastInc (3,3, res(1), res(2),res(3)), source = 0.0_pReal)
allocate (Fdot (3,3, res(1), res(2),res(3)), source = 0.0_pReal) allocate (Fdot (3,3, res(1), res(2),res(3)), source = 0.0_pReal)
allocate (P (3,3, res(1), res(2),res(3)), source = 0.0_pReal)
allocate (coordinates( res(1), res(2),res(3),3), source = 0.0_pReal) allocate (coordinates( res(1), res(2),res(3),3), source = 0.0_pReal)
allocate (temperature( res(1), res(2),res(3)), source = 0.0_pReal) allocate (temperature( res(1), res(2),res(3)), source = 0.0_pReal)
@ -192,7 +195,7 @@ subroutine BasicPETSC_init()
call Utilities_updateGamma(C,.True.) call Utilities_updateGamma(C,.True.)
end subroutine BasicPETSC_init end subroutine basicPETSc_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief solution for the Basic PETSC scheme with internal iterations !> @brief solution for the Basic PETSC scheme with internal iterations
@ -310,12 +313,12 @@ else
BasicPETSC_solution%converged = .true. BasicPETSC_solution%converged = .true.
endif endif
end function BasicPETSC_solution end function BasicPETSc_solution
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forms the AL residual vector !> @brief forms the AL residual vector
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) subroutine BasicPETSC_formResidual(myIn,x_scal,f_scal,dummy,ierr)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
@ -339,9 +342,9 @@ else
real(pReal), dimension(3,3) :: F_aim_lab_lastIter, F_aim_lab real(pReal), dimension(3,3) :: F_aim_lab_lastIter, F_aim_lab
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in DMDALocalInfo, dimension(*) :: myIn
PetscScalar, dimension(3,3,XG_RANGE,YG_RANGE,ZG_RANGE) :: x_scal PetscScalar, dimension(3,3,res(1),res(2),res(3)) :: x_scal
PetscScalar, dimension(3,3,X_RANGE,Y_RANGE,Z_RANGE):: f_scal PetscScalar, dimension(3,3,res(1),res(2),res(3)):: f_scal
PetscInt :: iter, nfuncs PetscInt :: iter, nfuncs
PetscObject :: dummy PetscObject :: dummy
PetscErrorCode :: ierr PetscErrorCode :: ierr
@ -383,12 +386,12 @@ else
! constructing residual ! constructing residual
f_scal = reshape(field_real(1:res(1),1:res(2),1:res(3),1:3,1:3),shape(x_scal),order=[3,4,5,1,2]) f_scal = reshape(field_real(1:res(1),1:res(2),1:res(3),1:3,1:3),shape(x_scal),order=[3,4,5,1,2])
write(6,'(/,a)') '==========================================================================' write(6,'(/,a)') '=========================================================================='
end subroutine BasicPETSC_formResidual end subroutine BasicPETSc_formResidual
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief convergence check !> @brief convergence check
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_converged(snes_local,it,xnorm,snorm,fnorm,reason,dummy,ierr) subroutine BasicPETSc_converged(snes_local,it,xnorm,snorm,fnorm,reason,dummy,ierr)
use numerics, only: & use numerics, only: &
itmax, & itmax, &
@ -431,12 +434,12 @@ else
write(6,'(a,f6.2,a,es11.4,a)') 'error stress = ', err_stress/min(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs), & write(6,'(a,f6.2,a,es11.4,a)') 'error stress = ', err_stress/min(maxval(abs(P_av))*err_stress_tolrel,err_stress_tolabs), &
' (',err_stress,' Pa)' ' (',err_stress,' Pa)'
end subroutine BasicPETSC_converged end subroutine BasicPETSc_converged
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief destroy routine !> @brief destroy routine
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_destroy() subroutine BasicPETSc_destroy()
use DAMASK_spectral_Utilities, only: & use DAMASK_spectral_Utilities, only: &
Utilities_destroy Utilities_destroy
@ -449,6 +452,6 @@ else
call PetscFinalize(ierr) call PetscFinalize(ierr)
call Utilities_destroy() call Utilities_destroy()
end subroutine BasicPETSC_destroy end subroutine BasicPETSc_destroy
end module DAMASK_spectral_SolverBasicPETSC end module DAMASK_spectral_SolverBasicPETSc