removed unused variables and declared external functions as external
This commit is contained in:
Martin Diehl
parent
a89efaa4a6
commit
c7c81a5ab5
|
|
@ -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.))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
296
code/IO.f90
296
code/IO.f90
|
|
@ -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
|
||||
|
|
@ -453,7 +455,9 @@ function IO_hybridIA(Nast,ODFfileName)
|
|||
real(pReal), dimension(3,Nast) :: IO_hybridIA
|
||||
|
||||
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
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
172
code/debug.f90
172
code/debug.f90
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -233,8 +233,7 @@ real(pReal), dimension(4,36), parameter, private :: &
|
|||
math_logstrainMat, &
|
||||
math_cauchy, &
|
||||
math_periodicNearestNeighbor
|
||||
#endif
|
||||
|
||||
#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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
!*******************************************
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
!> @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,*)
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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 parameters
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! 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
|
||||
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)') ' 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
|
||||
|
||||
|
|
|
|||
|
|
@ -70,7 +70,10 @@ module prec
|
|||
real(pReal), dimension(:), pointer :: p
|
||||
end type p_vec
|
||||
|
||||
public :: prec_init
|
||||
public :: &
|
||||
prec_init
|
||||
external :: &
|
||||
quit
|
||||
|
||||
contains
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue