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

removed unused variables and declared external functions as external

This commit is contained in:
Martin Diehl 2013-02-11 09:44:17 +00:00
parent a89efaa4a6
commit c7c81a5ab5
7 changed files with 326 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
code/DAMASK_spectral_interface.f90
View File

@ -45,10 +45,12 @@ module DAMASK_interface
loadCaseFile = '' !< parameter given for load case file loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
public :: getSolverWorkingDirectoryName, & public :: &
getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
DAMASK_interface_init DAMASK_interface_init
private :: storeWorkingDirectory, & private :: &
storeWorkingDirectory, &
getGeometryFile, & getGeometryFile, &
getLoadCaseFile, & getLoadCaseFile, &
rectifyPath, & rectifyPath, &
@ -58,6 +60,10 @@ module DAMASK_interface
IIO_intValue, & IIO_intValue, &
IIO_lc, & IIO_lc, &
IIO_stringPos IIO_stringPos
external :: &
quit, &
PetscInitialize, &
MPI_abort
contains contains
@ -243,6 +249,7 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
endif endif
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) & ! if path seperator is not given, append it
/= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep /= pathSep) storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep
!here check if exists and use chdir!
else ! using path to geometry file as working dir else ! using path to geometry file as working dir
if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.))

17
code/FEsolving.f90
View File

@ -66,17 +66,16 @@ module FEsolving
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief determine whether a symmetric solver is used and whether restart is requested !> @brief determine whether a symmetric solver is used and whether restart is requested
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine FE_init subroutine FE_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 debug, only: & use debug, only: &
debug_level, & debug_level, &
debug_FEsolving, & debug_FEsolving, &
debug_levelBasic debug_levelBasic
use IO, only: & use IO, only: &
IO_stringPos, & IO_stringPos, &
IO_stringValue, & IO_stringValue, &
@ -87,23 +86,21 @@ subroutine FE_init
IO_open_logFile, & IO_open_logFile, &
#endif #endif
IO_warning IO_warning
use DAMASK_interface use DAMASK_interface
implicit none implicit none
#ifndef Spectral
integer(pInt), parameter :: & integer(pInt), parameter :: &
fileunit = 222_pInt, & fileunit = 222_pInt, &
maxNchunks = 6_pInt maxNchunks = 6_pInt
#ifndef Spectral
integer(pInt) :: j integer(pInt) :: j
character(len=64) :: tag character(len=64) :: tag
character(len=1024) :: line character(len=1024) :: line
integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions
#endif #endif
write(6,*)
write(6,*) '<<<+- FEsolving init -+>>>' write(6,'(/,a)') ' <<<+- FEsolving init -+>>>'
write(6,*) '$Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
modelName = getSolverJobName() modelName = getSolverJobName()
@ -173,7 +170,9 @@ subroutine FE_init
#endif #endif
200 close(fileunit) 200 close(fileunit)
endif endif
! the following array are allocated by mesh.f90 and need to be deallocated in case of regridding
!--------------------------------------------------------------------------------------------------
! the following array are allocated by mesh.f90 and need to be deallocated in case of regridding
if (allocated(calcMode)) deallocate(calcMode) if (allocated(calcMode)) deallocate(calcMode)
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
#endif #endif

142
code/IO.f90
View File

@ -26,11 +26,14 @@
!> @brief input/output functions, partly depending on chosen solver !> @brief input/output functions, partly depending on chosen solver
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module IO module IO
use prec, only: pInt, pReal use prec, only: &
pInt, &
pReal
implicit none implicit none
private private
public :: IO_init, & public :: &
IO_init, &
IO_checkAndRewind, & IO_checkAndRewind, &
IO_open_file_stat, & IO_open_file_stat, &
IO_open_jobFile_stat, & IO_open_jobFile_stat, &
@ -65,22 +68,26 @@ module IO
IO_warning, & IO_warning, &
IO_intOut IO_intOut
#ifndef Spectral #ifndef Spectral
public :: IO_open_inputFile, & public :: &
IO_open_inputFile, &
IO_open_logFile IO_open_logFile
#endif #endif
#ifdef Abaqus #ifdef Abaqus
public :: IO_abaqus_hasNoPart public :: &
IO_abaqus_hasNoPart
#endif #endif
private :: &
private :: IO_fixedFloatValue, & IO_fixedFloatValue, &
IO_lcInplace ,& IO_lcInplace ,&
hybridIA_reps hybridIA_reps
#ifdef Abaqus #ifdef Abaqus
private :: abaqus_assembleInputFile private :: &
abaqus_assembleInputFile
#endif #endif
external :: &
quit
contains contains
@ -90,11 +97,9 @@ contains
subroutine IO_init 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)
write(6,*) write(6,'(/,a)') ' <<<+- IO init -+>>>'
write(6,*) '<<<+- IO init -+>>>' write(6,'(a)') ' $Id$'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
flush(6)
end subroutine IO_init end subroutine IO_init
@ -163,8 +168,8 @@ end function IO_open_JobFile_stat
!> @brief Open existing file to given unit path to file is relative to working directory !> @brief Open existing file to given unit path to file is relative to working directory
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_file(myUnit,relPath) subroutine IO_open_file(myUnit,relPath)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -184,8 +189,8 @@ end subroutine IO_open_file
!> @brief Open (write) file related to current job but with different extension to given unit !> @brief Open (write) file related to current job but with different extension to given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(myUnit,newExt) subroutine IO_open_jobFile(myUnit,newExt)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -208,7 +213,6 @@ end subroutine IO_open_jobFile
!> @brief open FEM input file to given unit !> @brief open FEM input file to given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(myUnit,model) subroutine IO_open_inputFile(myUnit,model)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName,& getSolverWorkingDirectoryName,&
getSolverJobName, & getSolverJobName, &
@ -220,10 +224,9 @@ subroutine IO_open_inputFile(myUnit,model)
integer(pInt) :: myStat integer(pInt) :: myStat
character(len=1024) :: path character(len=1024) :: path
character(len=4) :: InputFileExtension2 character(len=4), parameter :: InputFileExtension2 = '.pes'
#ifdef Abaqus #ifdef Abaqus
InputFileExtension2='.pes'
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used
open(myUnit+1,status='old',iostat=myStat,file=path) open(myUnit+1,status='old',iostat=myStat,file=path)
if(myStat /= 0_pInt) then !if .pes does not work / exist; use conventional extension, i.e.".inp" if(myStat /= 0_pInt) then !if .pes does not work / exist; use conventional extension, i.e.".inp"
@ -252,7 +255,6 @@ end subroutine IO_open_inputFile
!> @brief open FEM log file to given Unit !> @brief open FEM log file to given Unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(myUnit) subroutine IO_open_logFile(myUnit)
use DAMASK_interface, only: & use DAMASK_interface, only: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName, & getSolverJobName, &
@ -330,8 +332,8 @@ end subroutine IO_write_jobBinaryFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier) subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
getSolverJobName getSolverJobName
implicit none implicit none
@ -361,8 +363,8 @@ end subroutine IO_write_jobBinaryIntFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier) subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -390,8 +392,8 @@ end subroutine IO_read_jobBinaryFile
!> given unit !> given unit
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier) subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: &
use DAMASK_interface, only: getSolverWorkingDirectoryName getSolverWorkingDirectoryName
implicit none implicit none
integer(pInt), intent(in) :: myUnit integer(pInt), intent(in) :: myUnit
@ -454,6 +456,8 @@ function IO_hybridIA(Nast,ODFfileName)
character(len=*), intent(in) :: ODFfileName character(len=*), intent(in) :: ODFfileName
!--------------------------------------------------------------------------------------------------
! math module is not available
real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal
real(pReal), parameter :: INRAD = PI/180.0_pReal real(pReal), parameter :: INRAD = PI/180.0_pReal
character(len=*), parameter :: fileFormat = '(A80)' character(len=*), parameter :: fileFormat = '(A80)'
@ -469,11 +473,13 @@ function IO_hybridIA(Nast,ODFfileName)
real(pReal), dimension(:,:,:), allocatable :: dV_V real(pReal), dimension(:,:,:), allocatable :: dV_V
character(len=80) :: line character(len=80) :: line
!--- parse header of ODF file --- !--------------------------------------------------------------------------------------------------
! parse header of ODF file
call IO_open_file(999_pInt,ODFfileName) call IO_open_file(999_pInt,ODFfileName)
IO_hybridIA = -1.0_pReal ! initialize return value for case of error IO_hybridIA = -1.0_pReal ! initialize return value for case of error
!--- limits in phi1, Phi, phi2 --- !--------------------------------------------------------------------------------------------------
! limits in phi1, Phi, phi2
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks if (myPos(1) == 3) then ! found 3 chunks
@ -485,7 +491,8 @@ function IO_hybridIA(Nast,ODFfileName)
return return
endif endif
!--- deltas in phi1, Phi, phi2 --- !--------------------------------------------------------------------------------------------------
! deltas in phi1, Phi, phi2
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt) myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks if (myPos(1) == 3) then ! found 3 chunks
@ -500,7 +507,8 @@ function IO_hybridIA(Nast,ODFfileName)
steps = nint(limits/deltas,pInt) steps = nint(limits/deltas,pInt)
allocate(dV_V(steps(3),steps(2),steps(1))) allocate(dV_V(steps(3),steps(2),steps(1)))
!--- box boundary/center at origin? --- !--------------------------------------------------------------------------------------------------
! box boundary/center at origin?
read(999,fmt=fileFormat,end=100) line read(999,fmt=fileFormat,end=100) line
if (index(IO_lc(line),'bound')>0) then if (index(IO_lc(line),'bound')>0) then
center = 0.5_pReal center = 0.5_pReal
@ -508,8 +516,7 @@ function IO_hybridIA(Nast,ODFfileName)
center = 0.0_pReal center = 0.0_pReal
endif endif
!--- skip blank line --- read(999,fmt=fileFormat,end=100) line ! skip blank line
read(999,fmt=fileFormat,end=100) line
sum_dV_V = 0.0_pReal sum_dV_V = 0.0_pReal
dV_V = 0.0_pReal dV_V = 0.0_pReal
@ -533,7 +540,8 @@ function IO_hybridIA(Nast,ODFfileName)
dV_V = dV_V/sum_dV_V ! normalize to 1 dV_V = dV_V/sum_dV_V ! normalize to 1
!--- now fix bounds --- !--------------------------------------------------------------------------------------------------
! now fix bounds
Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much
lowerC = 0.0_pReal lowerC = 0.0_pReal
upperC = real(Nset, pReal) upperC = real(Nset, pReal)
@ -542,7 +550,9 @@ function IO_hybridIA(Nast,ODFfileName)
lowerC = upperC lowerC = upperC
upperC = upperC*2.0_pReal upperC = upperC*2.0_pReal
enddo enddo
!--- binary search for best C ---
!--------------------------------------------------------------------------------------------------
! binary search for best C
do do
C = (upperC+lowerC)/2.0_pReal C = (upperC+lowerC)/2.0_pReal
Nreps = hybridIA_reps(dV_V,steps,C) Nreps = hybridIA_reps(dV_V,steps,C)
@ -761,13 +771,13 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections)
100 end function IO_spotTagInPart 100 end function IO_spotTagInPart
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief return logical whether myTag is present within <part> before any [sections] !> @brief return logical whether myTag is present within <part> before any [sections]
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(myFile,part,myTag) logical function IO_globalTagInPart(myFile,part,myTag)
implicit none implicit none
integer(pInt), intent(in) :: myFile integer(pInt), intent(in) :: myFile
character(len=*), intent(in) :: part, & character(len=*), intent(in) :: part, &
myTag myTag
@ -1112,7 +1122,7 @@ pure subroutine IO_lcInplace(line)
endif endif
enddo enddo
end subroutine IO_lcInplace end subroutine IO_lcInplace
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1323,7 +1333,8 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
backspace(myUnit) backspace(myUnit)
enddo enddo
!check if the element values in the elset are auto generated !--------------------------------------------------------------------------------------------------
! check if the element values in the elset are auto generated
backspace(myUnit) backspace(myUnit)
read(myUnit,'(A65536)',end=100) line read(myUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,maxNchunks) myPos = IO_stringPos(line,maxNchunks)
@ -1392,13 +1403,13 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
select case (error_ID) select case (error_ID)
!* internal errors !--------------------------------------------------------------------------------------------------
! internal errors
case (0_pInt) case (0_pInt)
msg = 'internal check failed:' msg = 'internal check failed:'
!* file handling errors !--------------------------------------------------------------------------------------------------
! file handling errors
case (100_pInt) case (100_pInt)
msg = 'could not open file:' msg = 'could not open file:'
case (101_pInt) case (101_pInt)
@ -1408,9 +1419,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (103_pInt) case (103_pInt)
msg = 'could not assemble input files' msg = 'could not assemble input files'
!--------------------------------------------------------------------------------------------------
!* material error messages and related messages in mesh ! material error messages and related messages in mesh
case (150_pInt) case (150_pInt)
msg = 'crystallite index out of bounds' msg = 'crystallite index out of bounds'
case (151_pInt) case (151_pInt)
@ -1432,9 +1442,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (180_pInt) case (180_pInt)
msg = 'no microstructure specified via State Variable 3' msg = 'no microstructure specified via State Variable 3'
!--------------------------------------------------------------------------------------------------
!* plasticity error messages ! plasticity error messages
case (200_pInt) case (200_pInt)
msg = 'unknown elasticity specified:' msg = 'unknown elasticity specified:'
case (201_pInt) case (201_pInt)
@ -1454,17 +1463,15 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (253_pInt) case (253_pInt)
msg = 'element type not supported for nonlocal plasticity' msg = 'element type not supported for nonlocal plasticity'
!--------------------------------------------------------------------------------------------------
!* numerics error messages ! numerics error messages
case (300_pInt) case (300_pInt)
msg = 'unknown numerics parameter:' msg = 'unknown numerics parameter:'
case (301_pInt) case (301_pInt)
msg = 'numerics parameter out of bounds:' msg = 'numerics parameter out of bounds:'
!--------------------------------------------------------------------------------------------------
!* math errors ! math errors
case (400_pInt) case (400_pInt)
msg = 'matrix inversion error' msg = 'matrix inversion error'
case (401_pInt) case (401_pInt)
@ -1488,20 +1495,18 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (460_pInt) case (460_pInt)
msg = 'kdtree2 error' msg = 'kdtree2 error'
!* homogenization errors !-------------------------------------------------------------------------------------------------
! homogenization errors
case (500_pInt) case (500_pInt)
msg = 'unknown homogenization specified' msg = 'unknown homogenization specified'
!-------------------------------------------------------------------------------------------------
!* DAMASK_marc errors ! DAMASK_marc errors
case (700_pInt) case (700_pInt)
msg = 'invalid materialpoint result requested' msg = 'invalid materialpoint result requested'
!-------------------------------------------------------------------------------------------------
!* errors related to spectral solver ! errors related to spectral solver
case (809_pInt) case (809_pInt)
msg = 'initializing FFTW' msg = 'initializing FFTW'
case (831_pInt) case (831_pInt)
@ -1543,8 +1548,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (892_pInt) case (892_pInt)
msg = 'unknown filter type selected' msg = 'unknown filter type selected'
!* Error messages related to parsing of Abaqus input file !-------------------------------------------------------------------------------------------------
! error messages related to parsing of Abaqus input file
case (900_pInt) case (900_pInt)
msg = 'improper definition of nodes in input file (Nnodes < 2)' msg = 'improper definition of nodes in input file (Nnodes < 2)'
case (901_pInt) case (901_pInt)
@ -1569,8 +1574,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
msg = 'incorrect element type mapping in ' msg = 'incorrect element type mapping in '
!* general error messages !-------------------------------------------------------------------------------------------------
! general error messages
case (666_pInt) case (666_pInt)
msg = 'memory leak detected' msg = 'memory leak detected'
case default case default
@ -1689,7 +1694,9 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg)
end subroutine IO_warning end subroutine IO_warning
! INTERNAL (HELPER) FUNCTIONS: !--------------------------------------------------------------------------------------------------
! internal helper functions
#ifdef Abaqus #ifdef Abaqus
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1747,6 +1754,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
end function abaqus_assembleInputFile end function abaqus_assembleInputFile
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief hybrid IA repetition counter !> @brief hybrid IA repetition counter
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

154
code/debug.f90
View File

@ -33,7 +33,6 @@ module debug
implicit none implicit none
private private
integer(pInt), parameter, public :: & integer(pInt), parameter, public :: &
debug_levelSelective = 2_pInt**0_pInt, & debug_levelSelective = 2_pInt**0_pInt, &
debug_levelBasic = 2_pInt**1_pInt, & debug_levelBasic = 2_pInt**1_pInt, &
@ -116,11 +115,10 @@ module debug
contains contains
!******************************************************************** !--------------------------------------------------------------------------------------------------
! initialize the debugging capabilities !> @brief reads in parameters from debug.config and allocates arrays
!******************************************************************** !--------------------------------------------------------------------------------------------------
subroutine debug_init subroutine debug_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 numerics, only: nStress, & use numerics, only: nStress, &
nState, & nState, &
@ -144,6 +142,7 @@ subroutine debug_init
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
character(len=64) :: tag character(len=64) :: tag
character(len=1024) :: line character(len=1024) :: line
write(6,'(/,a)') ' <<<+- debug init -+>>>' write(6,'(/,a)') ' <<<+- debug init -+>>>'
write(6,'(a)') ' $Id$' write(6,'(a)') ' $Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
@ -169,11 +168,9 @@ subroutine debug_init
allocate(debug_MaterialpointLoopDistribution(nHomog+1)) allocate(debug_MaterialpointLoopDistribution(nHomog+1))
debug_MaterialpointLoopDistribution = 0_pInt debug_MaterialpointLoopDistribution = 0_pInt
!--------------------------------------------------------------------------------------------------
! try to open the config file ! try to open the config file
if(IO_open_file_stat(fileunit,debug_configFile)) then fileExists: if(IO_open_file_stat(fileunit,debug_configFile)) then
! read variables from config file and overwrite parameters
do do
read(fileunit,'(a1024)',END=100) line read(fileunit,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines if (IO_isBlank(line)) cycle ! skip empty lines
@ -253,15 +250,13 @@ subroutine debug_init
if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) &
write(6,'(a,/)') ' using values from config file' write(6,'(a,/)') ' using values from config file'
else fileExists
! no config file, so we use standard values
else
if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) & if (iand(debug_level(debug_debug),debug_levelBasic) /= 0) &
write(6,'(a,/)') ' using standard values' write(6,'(a,/)') ' using standard values'
endif endif fileExists
!output switched on (debug level for debug must be extensive) !--------------------------------------------------------------------------------------------------
! output switched on (debug level for debug must be extensive)
if (iand(debug_level(debug_debug),debug_levelExtensive) /= 0) then if (iand(debug_level(debug_debug),debug_levelExtensive) /= 0) then
do i = 1_pInt, debug_maxNtype do i = 1_pInt, debug_maxNtype
select case(i) select case(i)
@ -312,14 +307,15 @@ subroutine debug_init
end subroutine debug_init end subroutine debug_init
!********************************************************************
! reset debug distributions !--------------------------------------------------------------------------------------------------
!******************************************************************** !> @brief resets all debug values
!--------------------------------------------------------------------------------------------------
subroutine debug_reset subroutine debug_reset
implicit none implicit none
debug_StressLoopDistribution = 0_pInt ! initialize debugging data debug_StressLoopDistribution = 0_pInt
debug_StateLoopDistribution = 0_pInt debug_StateLoopDistribution = 0_pInt
debug_CrystalliteLoopDistribution = 0_pInt debug_CrystalliteLoopDistribution = 0_pInt
debug_MaterialpointStateLoopDistribution = 0_pInt debug_MaterialpointStateLoopDistribution = 0_pInt
@ -343,29 +339,28 @@ subroutine debug_reset
end subroutine debug_reset end subroutine debug_reset
!********************************************************************
! write debug statements to standard out
!********************************************************************
subroutine debug_info
use numerics, only: nStress, & !--------------------------------------------------------------------------------------------------
!> @brief writes debug statements to standard out
!--------------------------------------------------------------------------------------------------
subroutine debug_info
use numerics, only: &
nStress, &
nState, & nState, &
nCryst, & nCryst, &
nMPstate, & nMPstate, &
nHomog nHomog
implicit none implicit none
integer(pInt) :: i,integral integer(pInt) :: j,integral
integer(pLongInt) :: tickrate integer(pLongInt) :: tickrate
character(len=1) :: exceed character(len=1) :: exceed
call system_clock(count_rate=tickrate) call system_clock(count_rate=tickrate)
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then debugOutputCryst: if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0) then
write(6,*) write(6,'(/,a,/)') ' DEBUG Info (from previous cycle)'
write(6,*) 'DEBUG Info (from previous cycle)'
write(6,*)
write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls write(6,'(a33,1x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls
if (debug_cumLpCalls > 0_pInt) then if (debug_cumLpCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumLpTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumLpTicks,pReal)&
@ -373,8 +368,7 @@ subroutine debug_info
write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',& write(6,'(a33,1x,f12.6)') 'avg CPU time/microsecs per call :',&
real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal) real(debug_cumLpTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)/real(debug_cumLpCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
write(6,'(a33,1x,i12)') 'total calls to collectDotState :',debug_cumDotStateCalls
if (debug_cumdotStateCalls > 0_pInt) then if (debug_cumdotStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotStateTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -382,8 +376,7 @@ subroutine debug_info
real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& real(debug_cumDotStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDotStateCalls,pReal) /real(debug_cumDotStateCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to collectDeltaState:',debug_cumDeltaStateCalls
write(6,'(a33,1x,i12)') 'total calls to collectDeltaState:',debug_cumDeltaStateCalls
if (debug_cumDeltaStateCalls > 0_pInt) then if (debug_cumDeltaStateCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDeltaStateTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDeltaStateTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -391,8 +384,7 @@ subroutine debug_info
real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)& real(debug_cumDeltaStateTicks,pReal)*1.0e6_pReal/real(tickrate,pReal)&
/real(debug_cumDeltaStateCalls,pReal) /real(debug_cumDeltaStateCalls,pReal)
endif endif
write(6,*) write(6,'(/,a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls
write(6,'(a33,1x,i12)') 'total calls to dotTemperature :',debug_cumDotTemperatureCalls
if (debug_cumdotTemperatureCalls > 0_pInt) then if (debug_cumdotTemperatureCalls > 0_pInt) then
write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)& write(6,'(a33,1x,f12.3)') 'total CPU time/s :',real(debug_cumDotTemperatureTicks,pReal)&
/real(tickrate,pReal) /real(tickrate,pReal)
@ -402,88 +394,78 @@ subroutine debug_info
endif endif
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(3/,a)') 'distribution_StressLoop : stress stiffness'
write(6,*) do j=1_pInt,nStress+1_pInt
write(6,*) 'distribution_StressLoop : stress stiffness' if (any(debug_StressLoopDistribution(j,:) /= 0_pInt )) then
do i=1_pInt,nStress+1_pInt integral = integral + j*(debug_StressLoopDistribution(j,1) + debug_StressLoopDistribution(j,2))
if (any(debug_StressLoopDistribution(i,:) /= 0_pInt )) then
integral = integral + i*(debug_StressLoopDistribution(i,1) + debug_StressLoopDistribution(i,2))
exceed = ' ' exceed = ' '
if (i > nStress) exceed = '+' ! last entry gets "+" if (j > nStress) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nStress,i),exceed,debug_StressLoopDistribution(i,1),& write(6,'(i25,a1,i10,1x,i10)') min(nStress,j),exceed,debug_StressLoopDistribution(j,1),&
debug_StressLoopDistribution(i,2) debug_StressLoopDistribution(j,2)
endif endif
enddo enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopDistribution(:,1)), & write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StressLoopDistribution(:,1)), &
sum(debug_StressLoopDistribution(:,2)) sum(debug_StressLoopDistribution(:,2))
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_CrystalliteStateLoop :'
write(6,*) 'distribution_CrystalliteStateLoop :' do j=1_pInt,nState+1_pInt
do i=1_pInt,nState+1_pInt if (any(debug_StateLoopDistribution(j,:) /= 0)) then
if (any(debug_StateLoopDistribution(i,:) /= 0)) then integral = integral + j*(debug_StateLoopDistribution(j,1) + debug_StateLoopDistribution(j,2))
integral = integral + i*(debug_StateLoopDistribution(i,1) + debug_StateLoopDistribution(i,2))
exceed = ' ' exceed = ' '
if (i > nState) exceed = '+' ! last entry gets "+" if (j > nState) exceed = '+' ! last entry gets "+"
write(6,'(i25,a1,i10,1x,i10)') min(nState,i),exceed,debug_StateLoopDistribution(i,1),& write(6,'(i25,a1,i10,1x,i10)') min(nState,j),exceed,debug_StateLoopDistribution(j,1),&
debug_StateLoopDistribution(i,2) debug_StateLoopDistribution(j,2)
endif endif
enddo enddo
write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), & write(6,'(a15,i10,2(1x,i10))') ' total',integral,sum(debug_StateLoopDistribution(:,1)), &
sum(debug_StateLoopDistribution(:,2)) sum(debug_StateLoopDistribution(:,2))
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_CrystalliteCutbackLoop :'
write(6,*) 'distribution_CrystalliteCutbackLoop :' do j=1_pInt,nCryst+1_pInt
do i=1_pInt,nCryst+1_pInt if (debug_CrystalliteLoopDistribution(j) /= 0) then
if (debug_CrystalliteLoopDistribution(i) /= 0) then integral = integral + j*debug_CrystalliteLoopDistribution(j)
integral = integral + i*debug_CrystalliteLoopDistribution(i)
exceed = ' ' exceed = ' '
if (i > nCryst) exceed = '+' if (j > nCryst) exceed = '+'
write(6,'(i25,a1,i10)') min(nCryst,i),exceed,debug_CrystalliteLoopDistribution(i) write(6,'(i25,a1,i10)') min(nCryst,j),exceed,debug_CrystalliteLoopDistribution(j)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution)
endif endif debugOutputCryst
if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then debugOutputHomog: if (iand(debug_level(debug_homogenization),debug_levelBasic) /= 0) then
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_MaterialpointStateLoop :'
write(6,*) 'distribution_MaterialpointStateLoop :' do j=1_pInt,nMPstate
do i=1_pInt,nMPstate if (debug_MaterialpointStateLoopDistribution(j) /= 0) then
if (debug_MaterialpointStateLoopDistribution(i) /= 0) then integral = integral + j*debug_MaterialpointStateLoopDistribution(j)
integral = integral + i*debug_MaterialpointStateLoopDistribution(i) write(6,'(i25,1x,i10)') j,debug_MaterialpointStateLoopDistribution(j)
write(6,'(i25,1x,i10)') i,debug_MaterialpointStateLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution)
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,'(2/,a)') 'distribution_MaterialpointCutbackLoop :'
write(6,*) 'distribution_MaterialpointCutbackLoop :' do j=1_pInt,nHomog+1_pInt
do i=1_pInt,nHomog+1_pInt if (debug_MaterialpointLoopDistribution(j) /= 0) then
if (debug_MaterialpointLoopDistribution(i) /= 0) then integral = integral + j*debug_MaterialpointLoopDistribution(j)
integral = integral + i*debug_MaterialpointLoopDistribution(i)
exceed = ' ' exceed = ' '
if (i > nHomog) exceed = '+' if (j > nHomog) exceed = '+'
write(6,'(i25,a1,i10)') min(nHomog,i),exceed,debug_MaterialpointLoopDistribution(i) write(6,'(i25,a1,i10)') min(nHomog,j),exceed,debug_MaterialpointLoopDistribution(j)
endif endif
enddo enddo
write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution)
endif endif debugOutputHomog
if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_levelBasic) /= 0) then
write(6,*) write(6,'(2/,a,/)') ' Extreme values of returned stress and jacobian'
write(6,*)
write(6,*) 'Extreme values of returned stress and jacobian'
write(6,*)
write(6,'(a39)') ' value el ip' write(6,'(a39)') ' value el ip'
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'stress min :', debug_stressMin, debug_stressMinLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') 'jacobian min :', debug_jacobianMin, debug_jacobianMinLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' jacobian min :', debug_jacobianMin, debug_jacobianMinLocation
write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation write(6,'(a14,1x,e12.3,1x,i6,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation
write(6,*) endif debugOutputCPFEM
endif
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
end subroutine debug_info end subroutine debug_info

7
code/math.f90
View File

@ -234,7 +234,6 @@ real(pReal), dimension(4,36), parameter, private :: &
math_cauchy, & math_cauchy, &
math_periodicNearestNeighbor math_periodicNearestNeighbor
#endif #endif
private :: & private :: &
math_partition, & math_partition, &
halton, & halton, &
@ -243,6 +242,10 @@ real(pReal), dimension(4,36), parameter, private :: &
halton_seed_set, & halton_seed_set, &
i_to_halton, & i_to_halton, &
prime prime
external :: &
dsyev, &
dgetrf, &
dgetri
contains contains
@ -2689,8 +2692,10 @@ integer(pInt) function prime(n)
else if (n <= prime_max) then else if (n <= prime_max) then
prime = npvec(n) prime = npvec(n)
else else
prime = -1_pInt
call IO_error(error_ID=406_pInt) call IO_error(error_ID=406_pInt)
end if end if
end function prime end function prime

99
code/numerics.f90
View File

@ -16,11 +16,14 @@
! You should have received a copy of the GNU General Public License ! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>. ! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
! !
!############################################################## !--------------------------------------------------------------------------------------------------
!* $Id$ ! $Id$
!############################################################## !--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Managing of parameters related to numerics
!--------------------------------------------------------------------------------------------------
module numerics module numerics
!##############################################################
use prec, only: & use prec, only: &
pInt, & pInt, &
pReal pReal
@ -116,11 +119,12 @@ module numerics
contains contains
!*******************************************
! initialization subroutine
!*******************************************
subroutine numerics_init
!--------------------------------------------------------------------------------------------------
!> @brief reads in parameters from numerics.config and sets openMP related parameters. Also does
! a sanity check
!--------------------------------------------------------------------------------------------------
subroutine numerics_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, &
@ -138,7 +142,7 @@ subroutine numerics_init
#endif #endif
implicit none implicit none
#ifdef Marc #ifdef Marc
!$ include "omp_lib.h" ! use the non F90 standard include file to prevent crashes with some versions of MSC.Marc !$ include "omp_lib.h" ! use the not F90 standard conforming include file to prevent crashes with some versions of MSC.Marc
#endif #endif
integer(pInt), parameter :: fileunit = 300_pInt ,& integer(pInt), parameter :: fileunit = 300_pInt ,&
maxNchunks = 2_pInt maxNchunks = 2_pInt
@ -148,9 +152,8 @@ subroutine numerics_init
character(len=1024) :: line character(len=1024) :: line
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
write(6,*) write(6,'(/,a)') ' <<<+- numerics init -+>>>'
write(6,*) '<<<+- numerics init -+>>>' write(6,'(a)') ' $Id$'
write(6,*) '$Id$'
#include "compilation_info.f90" #include "compilation_info.f90"
!$ 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...
@ -159,14 +162,13 @@ subroutine numerics_init
!$ if (DAMASK_NumThreadsInt < 1_pInt) DAMASK_NumThreadsInt = 1_pInt ! ...ensure that its at least one... !$ if (DAMASK_NumThreadsInt < 1_pInt) DAMASK_NumThreadsInt = 1_pInt ! ...ensure that its at least one...
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution !$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! ...and use it as number of threads for parallel execution
! try to open the config file !--------------------------------------------------------------------------------------------------
if(IO_open_file_stat(fileunit,numerics_configFile)) then ! try to open the config file
fileExists: if(IO_open_file_stat(fileunit,numerics_configFile)) then
write(6,*) ' ... using values from config file' write(6,'(a,/)') ' using values from config file'
write(6,*)
!* read variables from config file and overwrite parameters
!--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present
line = '' line = ''
do do
read(fileunit,'(a1024)',END=100) line read(fileunit,'(a1024)',END=100) line
@ -227,8 +229,8 @@ subroutine numerics_init
case ('unitlength') case ('unitlength')
numerics_unitlength = IO_floatValue(line,positions,2_pInt) numerics_unitlength = IO_floatValue(line,positions,2_pInt)
!* RGC parameters: !--------------------------------------------------------------------------------------------------
! RGC parameters
case ('atol_rgc') case ('atol_rgc')
absTol_RGC = IO_floatValue(line,positions,2_pInt) absTol_RGC = IO_floatValue(line,positions,2_pInt)
case ('rtol_rgc') case ('rtol_rgc')
@ -255,10 +257,14 @@ subroutine numerics_init
volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt) volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt)
case ('discrepancypower_rgc') case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt) volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt)
!* Random seeding parameters
!--------------------------------------------------------------------------------------------------
! random seeding parameters
case ('fixed_seed') case ('fixed_seed')
fixedSeed = IO_intValue(line,positions,2_pInt) fixedSeed = IO_intValue(line,positions,2_pInt)
!* spectral parameters
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral #ifdef Spectral
case ('err_div_tol') case ('err_div_tol')
err_div_tol = IO_floatValue(line,positions,2_pInt) err_div_tol = IO_floatValue(line,positions,2_pInt)
@ -299,28 +305,27 @@ subroutine numerics_init
err_p_tol = IO_floatValue(line,positions,2_pInt) err_p_tol = IO_floatValue(line,positions,2_pInt)
#endif #endif
#ifndef PETSc #ifndef PETSc
case ('myspectralsolver', 'petsc_options','err_f_tol', 'err_p_tol') case ('myspectralsolver', 'petsc_options','err_f_tol', 'err_p_tol') ! found PETSc parameter, but compiled without PETSc
call IO_warning(41_pInt,ext_msg=tag) call IO_warning(41_pInt,ext_msg=tag)
#endif #endif
#endif #endif
#ifndef Spectral #ifndef Spectral
case ('err_div_tol','err_stress_tolrel','err_stress_tolabs',& case ('err_div_tol','err_stress_tolrel','err_stress_tolabs',& ! found spectral parameter for FEM build
'itmax', 'itmin','memory_efficient','fftw_timelimit','fftw_plan_mode','myspectralsolver', & 'itmax', 'itmin','memory_efficient','fftw_timelimit','fftw_plan_mode','myspectralsolver', &
'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', & 'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', &
'err_f_tol', 'err_p_tol', 'maxcutback') 'err_f_tol', 'err_p_tol', 'maxcutback')
call IO_warning(40_pInt,ext_msg=tag) call IO_warning(40_pInt,ext_msg=tag)
#endif #endif
case default case default ! found unknown keyword
call IO_error(300_pInt,ext_msg=tag) call IO_error(300_pInt,ext_msg=tag)
endselect endselect
enddo enddo
100 close(fileunit) 100 close(fileunit)
! no config file, so we use standard values else fileExists
else write(6,'(a,/)') ' using standard values'
write(6,*) ' ... using standard values' endif fileExists
write(6,*)
endif
#ifdef Spectral #ifdef Spectral
select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f select case(IO_lc(fftw_plan_mode)) ! setting parameters for the plan creation of FFTW. Basically a translation from fftw3.f
case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution case('estimate','fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
@ -339,8 +344,8 @@ subroutine numerics_init
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!* writing parameters to output file !--------------------------------------------------------------------------------------------------
! writing parameters to output file
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
@ -368,8 +373,8 @@ subroutine numerics_init
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
@ -382,13 +387,17 @@ subroutine numerics_init
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 parameters
!--------------------------------------------------------------------------------------------------
! Random seeding parameter
write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed
!* openMP parameter
!--------------------------------------------------------------------------------------------------
! openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt !$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!* spectral parameters !--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral #ifdef Spectral
write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol
write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel
@ -419,8 +428,8 @@ subroutine numerics_init
#endif #endif
#endif #endif
!* sanity check !--------------------------------------------------------------------------------------------------
! sanity checks
if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain') if (relevantStrain <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relevantStrain')
if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance') if (defgradTolerance <= 0.0_pReal) call IO_error(301_pInt,ext_msg='defgradTolerance')
if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness') if (iJacoStiffness < 1_pInt) call IO_error(301_pInt,ext_msg='iJacoStiffness')
@ -446,9 +455,6 @@ subroutine numerics_init
if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) & if (any(numerics_integrator <= 0_pInt) .or. any(numerics_integrator >= 6_pInt)) &
call IO_error(301_pInt,ext_msg='integrator') call IO_error(301_pInt,ext_msg='integrator')
if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength') if (numerics_unitlength <= 0.0_pReal) call IO_error(301_pInt,ext_msg='unitlength')
!* RGC parameters
if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC') if (absTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absTol_RGC')
if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC') if (relTol_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='relTol_RGC')
if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC') if (absMax_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='absMax_RGC')
@ -462,8 +468,6 @@ subroutine numerics_init
if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC') if (maxVolDiscr_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='maxVolDiscr_RGC')
if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC') if (volDiscrMod_RGC < 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrMod_RGC')
if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC') if (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC')
!* spectral parameters
#ifdef Spectral #ifdef Spectral
if (err_div_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tol') if (err_div_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_div_tol')
if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolrel') if (err_stress_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_stress_tolrel')
@ -480,9 +484,8 @@ subroutine numerics_init
if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol') if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol')
#endif #endif
#endif #endif
if (fixedSeed <= 0_pInt) then if (fixedSeed <= 0_pInt) &
write(6,'(a,/)') ' Random is random!' write(6,'(a,/)') ' No fixed Seed: Random is random!'
endif
end subroutine numerics_init end subroutine numerics_init

5
code/prec.f90
View File

@ -70,7 +70,10 @@ module prec
real(pReal), dimension(:), pointer :: p real(pReal), dimension(:), pointer :: p
end type p_vec end type p_vec
public :: prec_init public :: &
prec_init
external :: &
quit
contains contains