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

View File

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

View File

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

View File

@ -26,61 +26,68 @@
!> @brief input/output functions, partly depending on chosen solver
!--------------------------------------------------------------------------------------------------
module IO
use prec, only: pInt, pReal
use prec, only: &
pInt, &
pReal
implicit none
private
public :: IO_init, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
IO_open_file, &
IO_open_jobFile, &
IO_write_jobFile, &
IO_write_jobBinaryFile, &
IO_write_jobBinaryIntFile, &
IO_read_jobBinaryFile, &
IO_read_jobBinaryIntFile, &
IO_hybridIA, &
IO_isBlank, &
IO_getTag, &
IO_countSections, &
IO_countTagInPart, &
IO_spotTagInPart, &
IO_globalTagInPart, &
IO_stringPos, &
IO_stringValue, &
IO_fixedStringValue ,&
IO_floatValue, &
IO_fixedNoEFloatValue, &
IO_intValue, &
IO_fixedIntValue, &
IO_lc, &
IO_skipChunks, &
IO_extractValue, &
IO_countDataLines, &
IO_countContinuousIntValues, &
IO_continuousIntValues, &
IO_error, &
IO_warning, &
IO_intOut
public :: &
IO_init, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
IO_open_file, &
IO_open_jobFile, &
IO_write_jobFile, &
IO_write_jobBinaryFile, &
IO_write_jobBinaryIntFile, &
IO_read_jobBinaryFile, &
IO_read_jobBinaryIntFile, &
IO_hybridIA, &
IO_isBlank, &
IO_getTag, &
IO_countSections, &
IO_countTagInPart, &
IO_spotTagInPart, &
IO_globalTagInPart, &
IO_stringPos, &
IO_stringValue, &
IO_fixedStringValue ,&
IO_floatValue, &
IO_fixedNoEFloatValue, &
IO_intValue, &
IO_fixedIntValue, &
IO_lc, &
IO_skipChunks, &
IO_extractValue, &
IO_countDataLines, &
IO_countContinuousIntValues, &
IO_continuousIntValues, &
IO_error, &
IO_warning, &
IO_intOut
#ifndef Spectral
public :: IO_open_inputFile, &
IO_open_logFile
public :: &
IO_open_inputFile, &
IO_open_logFile
#endif
#ifdef Abaqus
public :: IO_abaqus_hasNoPart
public :: &
IO_abaqus_hasNoPart
#endif
private :: IO_fixedFloatValue, &
IO_lcInplace ,&
hybridIA_reps
private :: &
IO_fixedFloatValue, &
IO_lcInplace ,&
hybridIA_reps
#ifdef Abaqus
private :: abaqus_assembleInputFile
private :: &
abaqus_assembleInputFile
#endif
external :: &
quit
contains
@ -90,11 +97,9 @@ contains
subroutine IO_init
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,*) '<<<+- IO init -+>>>'
write(6,*) '$Id$'
write(6,'(/,a)') ' <<<+- IO init -+>>>'
write(6,'(a)') ' $Id$'
#include "compilation_info.f90"
flush(6)
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
!--------------------------------------------------------------------------------------------------
subroutine IO_open_file(myUnit,relPath)
use DAMASK_interface, only: getSolverWorkingDirectoryName
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: myUnit
@ -184,9 +189,9 @@ end subroutine IO_open_file
!> @brief Open (write) file related to current job but with different extension to given unit
!--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(myUnit,newExt)
use DAMASK_interface, only: getSolverWorkingDirectoryName, &
getSolverJobName
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
integer(pInt), intent(in) :: myUnit
@ -208,7 +213,6 @@ end subroutine IO_open_jobFile
!> @brief open FEM input file to given unit
!--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(myUnit,model)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName,&
getSolverJobName, &
@ -220,10 +224,9 @@ subroutine IO_open_inputFile(myUnit,model)
integer(pInt) :: myStat
character(len=1024) :: path
character(len=4) :: InputFileExtension2
character(len=4), parameter :: InputFileExtension2 = '.pes'
#ifdef Abaqus
InputFileExtension2='.pes'
path = trim(getSolverWorkingDirectoryName())//trim(model)//InputFileExtension2 ! attempt .pes, if it exists: it should be used
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"
@ -252,7 +255,6 @@ end subroutine IO_open_inputFile
!> @brief open FEM log file to given Unit
!--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(myUnit)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName, &
@ -330,9 +332,9 @@ end subroutine IO_write_jobBinaryFile
!> given unit
!--------------------------------------------------------------------------------------------------
subroutine IO_write_jobBinaryIntFile(myUnit,newExt,recMultiplier)
use DAMASK_interface, only: getSolverWorkingDirectoryName, &
getSolverJobName
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
integer(pInt), intent(in) :: myUnit
@ -361,8 +363,8 @@ end subroutine IO_write_jobBinaryIntFile
!> given unit
!--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: getSolverWorkingDirectoryName
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: myUnit
@ -390,8 +392,8 @@ end subroutine IO_read_jobBinaryFile
!> given unit
!--------------------------------------------------------------------------------------------------
subroutine IO_read_jobBinaryIntFile(myUnit,newExt,jobName,recMultiplier)
use DAMASK_interface, only: getSolverWorkingDirectoryName
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: myUnit
@ -454,6 +456,8 @@ function IO_hybridIA(Nast,ODFfileName)
character(len=*), intent(in) :: ODFfileName
!--------------------------------------------------------------------------------------------------
! math module is not available
real(pReal), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_pReal
real(pReal), parameter :: INRAD = PI/180.0_pReal
character(len=*), parameter :: fileFormat = '(A80)'
@ -469,11 +473,13 @@ function IO_hybridIA(Nast,ODFfileName)
real(pReal), dimension(:,:,:), allocatable :: dV_V
character(len=80) :: line
!--- parse header of ODF file ---
!--------------------------------------------------------------------------------------------------
! parse header of ODF file
call IO_open_file(999_pInt,ODFfileName)
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
myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks
@ -485,7 +491,8 @@ function IO_hybridIA(Nast,ODFfileName)
return
endif
!--- deltas in phi1, Phi, phi2 ---
!--------------------------------------------------------------------------------------------------
! deltas in phi1, Phi, phi2
read(999,fmt=fileFormat,end=100) line
myPos = IO_stringPos(line,3_pInt)
if (myPos(1) == 3) then ! found 3 chunks
@ -500,7 +507,8 @@ function IO_hybridIA(Nast,ODFfileName)
steps = nint(limits/deltas,pInt)
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
if (index(IO_lc(line),'bound')>0) then
center = 0.5_pReal
@ -508,8 +516,7 @@ function IO_hybridIA(Nast,ODFfileName)
center = 0.0_pReal
endif
!--- skip blank line ---
read(999,fmt=fileFormat,end=100) line
read(999,fmt=fileFormat,end=100) line ! skip blank line
sum_dV_V = 0.0_pReal
dV_V = 0.0_pReal
@ -531,10 +538,11 @@ function IO_hybridIA(Nast,ODFfileName)
enddo
enddo
dV_V = dV_V/sum_dV_V ! normalize to 1
dV_V = dV_V/sum_dV_V ! normalize to 1
!--- now fix bounds ---
Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much
!--------------------------------------------------------------------------------------------------
! now fix bounds
Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much
lowerC = 0.0_pReal
upperC = real(Nset, pReal)
@ -542,7 +550,9 @@ function IO_hybridIA(Nast,ODFfileName)
lowerC = upperC
upperC = upperC*2.0_pReal
enddo
!--- binary search for best C ---
!--------------------------------------------------------------------------------------------------
! binary search for best C
do
C = (upperC+lowerC)/2.0_pReal
Nreps = hybridIA_reps(dV_V,steps,C)
@ -560,15 +570,15 @@ function IO_hybridIA(Nast,ODFfileName)
enddo
allocate(binSet(Nreps))
bin = 0_pInt ! bin counter
i = 1_pInt ! set counter
bin = 0_pInt ! bin counter
i = 1_pInt ! set counter
do phi1=1_pInt,steps(1)
do Phi=1_pInt,steps(2)
do phi2=1_pInt,steps(3)
reps = nint(C*dV_V(phi2,Phi,phi1), pInt)
binSet(i:i+reps-1) = bin
bin = bin+1_pInt ! advance bin
i = i+reps ! advance set
bin = bin+1_pInt ! advance bin
i = i+reps ! advance set
enddo
enddo
enddo
@ -600,10 +610,10 @@ logical pure function IO_isBlank(line)
implicit none
character(len=*), intent(in) :: line
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#'
character(len=*), parameter :: blankChar = achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: comment = achar(35) ! comment id '#'
integer :: posNonBlank, posComment ! no pInt
integer :: posNonBlank, posComment ! no pInt
posNonBlank = verify(line,blankChar)
posComment = scan(line,comment)
@ -624,15 +634,15 @@ pure function IO_getTag(line,openChar,closeChar)
character(len=*), intent(in) :: openChar, &
closeChar
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt
integer :: left,right ! no pInt
IO_getTag = ''
left = scan(line,openChar)
right = scan(line,closeChar)
if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs
if (left == verify(line,sep) .and. right > left) & ! openChar is first and closeChar occurs
IO_getTag = line(left+1:right-1)
end function IO_getTag
@ -653,15 +663,15 @@ integer(pInt) function IO_countSections(myFile,part)
IO_countSections = 0_pInt
rewind(myFile)
do while (IO_getTag(line,'<','>') /= part) ! search for part
do while (IO_getTag(line,'<','>') /= part) ! search for part
read(myFile,'(a1024)',END=100) line
enddo
do
read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
IO_countSections = IO_countSections + 1_pInt
enddo
@ -693,20 +703,20 @@ function IO_countTagInPart(myFile,part,myTag,Nsections)
section = 0_pInt
rewind(myFile)
do while (IO_getTag(line,'<','>') /= part) ! search for part
do while (IO_getTag(line,'<','>') /= part) ! search for part
read(myFile,'(a1024)',END=100) line
enddo
do
read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt
if (section > 0) then
positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match
counter(section) = counter(section) + 1_pInt
endif
enddo
@ -736,38 +746,38 @@ function IO_spotTagInPart(myFile,part,myTag,Nsections)
character(len=1024) :: line, &
tag
IO_spotTagInPart = .false. ! assume to nowhere spot tag
IO_spotTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt
line =''
rewind(myFile)
do while (IO_getTag(line,'<','>') /= part) ! search for part
do while (IO_getTag(line,'<','>') /= part) ! search for part
read(myFile,'(a1024)',END=100) line
enddo
do
read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt
if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
if (tag == myTag) & ! match
IO_spotTagInPart(section) = .true.
endif
enddo
100 end function IO_spotTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief return logical whether myTag is present within <part> before any [sections]
!--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(myFile,part,myTag)
implicit none
integer(pInt), intent(in) :: myFile
character(len=*), intent(in) :: part, &
myTag
@ -779,20 +789,20 @@ logical function IO_globalTagInPart(myFile,part,myTag)
character(len=1024) :: line, &
tag
IO_globalTagInPart = .false. ! assume to nowhere spot tag
IO_globalTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt
line =''
rewind(myFile)
do while (IO_getTag(line,'<','>') /= part) ! search for part
do while (IO_getTag(line,'<','>') /= part) ! search for part
read(myFile,'(a1024)',END=100) line
enddo
do
read(myFile,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') exit ! stop at next part
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
section = section + 1_pInt
if (section == 0_pInt) then
positions = IO_stringPos(line,maxNchunks)
@ -1101,7 +1111,7 @@ pure subroutine IO_lcInplace(line)
character(len=*), intent(inout) :: line
character(len=len(line)) :: IO_lc
integer :: i,n ! no pInt (len returns default integer)
integer :: i,n ! no pInt (len returns default integer)
do i=1,len(line)
n = index(upper,line(i:i))
@ -1112,7 +1122,7 @@ pure subroutine IO_lcInplace(line)
endif
enddo
end subroutine IO_lcInplace
end subroutine IO_lcInplace
!--------------------------------------------------------------------------------------------------
@ -1181,7 +1191,7 @@ integer(pInt) function IO_countDataLines(myUnit)
read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks)
tmp = IO_lc(IO_stringValue(line,myPos,1_pInt))
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword
exit
else
if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt
@ -1216,7 +1226,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
do
read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks)
if (myPos(1) < 1_pInt) then ! empty line
if (myPos(1) < 1_pInt) then ! empty line
exit
elseif (IO_lc(IO_stringValue(line,myPos,2_pInt)) == 'to' ) then ! found range indicator
IO_countContinuousIntValues = 1_pInt + IO_intValue(line,myPos,3_pInt) &
@ -1242,7 +1252,7 @@ integer(pInt) function IO_countContinuousIntValues(myUnit)
do l = 1_pInt,c
read(myUnit,'(A300)',end=100) line
myPos = IO_stringPos(line,maxNchunks)
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation
IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation
(IO_intValue(line,myPos,2_pInt)-IO_intValue(line,myPos,1_pInt))/&
max(1_pInt,IO_intValue(line,myPos,3_pInt))
enddo
@ -1323,7 +1333,8 @@ function IO_continuousIntValues(myUnit,maxN,lookupName,lookupMap,lookupMaxN)
backspace(myUnit)
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)
read(myUnit,'(A65536)',end=100) line
myPos = IO_stringPos(line,maxNchunks)
@ -1392,13 +1403,13 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
select case (error_ID)
!* internal errors
!--------------------------------------------------------------------------------------------------
! internal errors
case (0_pInt)
msg = 'internal check failed:'
!* file handling errors
!--------------------------------------------------------------------------------------------------
! file handling errors
case (100_pInt)
msg = 'could not open file:'
case (101_pInt)
@ -1408,9 +1419,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (103_pInt)
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)
msg = 'crystallite index out of bounds'
case (151_pInt)
@ -1432,9 +1442,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (180_pInt)
msg = 'no microstructure specified via State Variable 3'
!* plasticity error messages
!--------------------------------------------------------------------------------------------------
! plasticity error messages
case (200_pInt)
msg = 'unknown elasticity specified:'
case (201_pInt)
@ -1454,17 +1463,15 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (253_pInt)
msg = 'element type not supported for nonlocal plasticity'
!* numerics error messages
!--------------------------------------------------------------------------------------------------
! numerics error messages
case (300_pInt)
msg = 'unknown numerics parameter:'
case (301_pInt)
msg = 'numerics parameter out of bounds:'
!* math errors
!--------------------------------------------------------------------------------------------------
! math errors
case (400_pInt)
msg = 'matrix inversion error'
case (401_pInt)
@ -1488,20 +1495,18 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (460_pInt)
msg = 'kdtree2 error'
!* homogenization errors
!-------------------------------------------------------------------------------------------------
! homogenization errors
case (500_pInt)
msg = 'unknown homogenization specified'
!* DAMASK_marc errors
!-------------------------------------------------------------------------------------------------
! DAMASK_marc errors
case (700_pInt)
msg = 'invalid materialpoint result requested'
!* errors related to spectral solver
!-------------------------------------------------------------------------------------------------
! errors related to spectral solver
case (809_pInt)
msg = 'initializing FFTW'
case (831_pInt)
@ -1543,8 +1548,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
case (892_pInt)
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)
msg = 'improper definition of nodes in input file (Nnodes < 2)'
case (901_pInt)
@ -1569,8 +1574,8 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
msg = 'incorrect element type mapping in '
!* general error messages
!-------------------------------------------------------------------------------------------------
! general error messages
case (666_pInt)
msg = 'memory leak detected'
case default
@ -1689,7 +1694,9 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg)
end subroutine IO_warning
! INTERNAL (HELPER) FUNCTIONS:
!--------------------------------------------------------------------------------------------------
! internal helper functions
#ifdef Abaqus
!--------------------------------------------------------------------------------------------------
@ -1747,6 +1754,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
end function abaqus_assembleInputFile
#endif
!--------------------------------------------------------------------------------------------------
!> @brief hybrid IA repetition counter
!--------------------------------------------------------------------------------------------------

View File

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

View File

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

View File

@ -16,11 +16,14 @@
! You should have received a copy of the GNU General Public License
! 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
!##############################################################
use prec, only: &
pInt, &
pReal
@ -116,11 +119,12 @@ module numerics
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 IO, only: &
IO_error, &
@ -138,7 +142,7 @@ subroutine numerics_init
#endif
implicit none
#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
integer(pInt), parameter :: fileunit = 300_pInt ,&
maxNchunks = 2_pInt
@ -148,9 +152,8 @@ subroutine numerics_init
character(len=1024) :: line
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
write(6,*)
write(6,*) '<<<+- numerics init -+>>>'
write(6,*) '$Id$'
write(6,'(/,a)') ' <<<+- numerics init -+>>>'
write(6,'(a)') ' $Id$'
#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...
@ -159,20 +162,19 @@ subroutine numerics_init
!$ 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
! try to open the config file
if(IO_open_file_stat(fileunit,numerics_configFile)) then
write(6,*) ' ... using values from config file'
write(6,*)
!* read variables from config file and overwrite parameters
!--------------------------------------------------------------------------------------------------
! try to open the config file
fileExists: if(IO_open_file_stat(fileunit,numerics_configFile)) then
write(6,'(a,/)') ' using values from config file'
!--------------------------------------------------------------------------------------------------
! read variables from config file and overwrite default parameters if keyword is present
line = ''
do
read(fileunit,'(a1024)',END=100) line
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_isBlank(line)) cycle ! skip empty lines
positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag)
case ('relevantstrain')
relevantStrain = IO_floatValue(line,positions,2_pInt)
@ -227,8 +229,8 @@ subroutine numerics_init
case ('unitlength')
numerics_unitlength = IO_floatValue(line,positions,2_pInt)
!* RGC parameters:
!--------------------------------------------------------------------------------------------------
! RGC parameters
case ('atol_rgc')
absTol_RGC = IO_floatValue(line,positions,2_pInt)
case ('rtol_rgc')
@ -255,10 +257,14 @@ subroutine numerics_init
volDiscrMod_RGC = IO_floatValue(line,positions,2_pInt)
case ('discrepancypower_rgc')
volDiscrPow_RGC = IO_floatValue(line,positions,2_pInt)
!* Random seeding parameters
!--------------------------------------------------------------------------------------------------
! random seeding parameters
case ('fixed_seed')
fixedSeed = IO_intValue(line,positions,2_pInt)
!* spectral parameters
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral
case ('err_div_tol')
err_div_tol = IO_floatValue(line,positions,2_pInt)
@ -299,31 +305,30 @@ subroutine numerics_init
err_p_tol = IO_floatValue(line,positions,2_pInt)
#endif
#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)
#endif
#endif
#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', &
'rotation_tol','divergence_correction','update_gamma','petsc_options','myfilter', &
'err_f_tol', 'err_p_tol', 'maxcutback')
call IO_warning(40_pInt,ext_msg=tag)
#endif
case default
case default ! found unknown keyword
call IO_error(300_pInt,ext_msg=tag)
endselect
enddo
100 close(fileunit)
! no config file, so we use standard values
else
write(6,*) ' ... using standard values'
write(6,*)
endif
else fileExists
write(6,'(a,/)') ' using standard values'
endif fileExists
#ifdef Spectral
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
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
fftw_planner_flag = 64_pInt
case('measure','fftw_measure')
fftw_planner_flag = 0_pInt
@ -337,10 +342,10 @@ subroutine numerics_init
end select
#endif
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!* writing parameters to output file
numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt) ! timeSyncing only allowed for explicit Euler integrator
!--------------------------------------------------------------------------------------------------
! writing parameters to output file
write(6,'(a24,1x,es8.1)') ' relevantStrain: ',relevantStrain
write(6,'(a24,1x,es8.1)') ' defgradTolerance: ',defgradTolerance
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,i8,/)') ' nMPstate: ',nMPstate
!* RGC parameters
!--------------------------------------------------------------------------------------------------
! RGC parameters
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)') ' 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)') ' volDiscrepancyMod_RGC: ',volDiscrMod_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
!* openMP parameter
!--------------------------------------------------------------------------------------------------
! openMP parameter
!$ write(6,'(a24,1x,i8,/)') ' number of threads: ',DAMASK_NumThreadsInt
!* spectral parameters
!--------------------------------------------------------------------------------------------------
! spectral parameters
#ifdef Spectral
write(6,'(a24,1x,es8.1)') ' err_div_tol: ',err_div_tol
write(6,'(a24,1x,es8.1)') ' err_stress_tolrel: ',err_stress_tolrel
@ -419,8 +428,8 @@ subroutine numerics_init
#endif
#endif
!* sanity check
!--------------------------------------------------------------------------------------------------
! sanity checks
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 (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)) &
call IO_error(301_pInt,ext_msg='integrator')
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 (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')
@ -462,8 +468,6 @@ subroutine numerics_init
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 (volDiscrPow_RGC <= 0.0_pReal) call IO_error(301_pInt,ext_msg='volDiscrPw_RGC')
!* spectral parameters
#ifdef Spectral
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')
@ -480,9 +484,8 @@ subroutine numerics_init
if (err_p_tol <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_p_tol')
#endif
#endif
if (fixedSeed <= 0_pInt) then
write(6,'(a,/)') ' Random is random!'
endif
if (fixedSeed <= 0_pInt) &
write(6,'(a,/)') ' No fixed Seed: Random is random!'
end subroutine numerics_init

View File

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