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

Merge branch 'warning-error-cleanup' into 'development' 

more flexible error/warning handling

See merge request damask/DAMASK!594
This commit is contained in:
Philip Eisenlohr 2022-05-28 16:56:53 +00:00
parent e163d247ec b56ded62d9
commit 3d10d29254
19 changed files with 181 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

199
src/IO.f90
View File

@ -24,11 +24,6 @@ module IO
character, parameter :: & character, parameter :: &
CR = achar(13), & CR = achar(13), &
LF = IO_EOL LF = IO_EOL
character(len=*), parameter :: &
IO_DIVIDER = '───────────────────'//&
'───────────────────'//&
'───────────────────'//&
'────────────'
public :: & public :: &
IO_init, & IO_init, &
@ -54,11 +49,11 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Do self test. !> @brief Do self test.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_init subroutine IO_init()
print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT)
call selfTest call selfTest()
end subroutine IO_init end subroutine IO_init
@ -95,7 +90,7 @@ function IO_readlines(fileName) result(fileContent)
if (endPos - startPos > pStringLen-1) then if (endPos - startPos > pStringLen-1) then
line = rawData(startPos:startPos+pStringLen-1) line = rawData(startPos:startPos+pStringLen-1)
if (.not. warned) then if (.not. warned) then
call IO_warning(207,ext_msg=trim(fileName),el=l) call IO_warning(207,trim(fileName),label1='line',ID1=l)
warned = .true. warned = .true.
endif endif
else else
@ -129,7 +124,7 @@ function IO_read(fileName) result(fileContent)
inquire(file = fileName, size=fileLength) inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',& open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat) status='old', position='rewind', action='read',iostat=myStat)
if (myStat /= 0) call IO_error(100,ext_msg=trim(fileName)) if (myStat /= 0) call IO_error(100,trim(fileName))
allocate(character(len=fileLength)::fileContent) allocate(character(len=fileLength)::fileContent)
if (fileLength==0) then if (fileLength==0) then
close(fileUnit) close(fileUnit)
@ -137,7 +132,7 @@ function IO_read(fileName) result(fileContent)
endif endif
read(fileUnit,iostat=myStat) fileContent read(fileUnit,iostat=myStat) fileContent
if (myStat /= 0) call IO_error(102,ext_msg=trim(fileName)) if (myStat /= 0) call IO_error(102,trim(fileName))
close(fileUnit) close(fileUnit)
if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent) if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent)
@ -206,7 +201,7 @@ function IO_stringValue(string,chunkPos,myChunk)
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
IO_stringValue = '' IO_stringValue = ''
call IO_error(110,el=myChunk,ext_msg='IO_stringValue: "'//trim(string)//'"') call IO_error(110,'IO_stringValue: "'//trim(string)//'"',label1='chunk',ID1=myChunk)
else validChunk else validChunk
IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif validChunk endif validChunk
@ -303,10 +298,10 @@ integer function IO_stringAsInt(string)
valid: if (verify(string,VALIDCHARS) == 0) then valid: if (verify(string,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsInt read(string,*,iostat=readStatus) IO_stringAsInt
if (readStatus /= 0) call IO_error(111,ext_msg=string) if (readStatus /= 0) call IO_error(111,string)
else valid else valid
IO_stringAsInt = 0 IO_stringAsInt = 0
call IO_error(111,ext_msg=string) call IO_error(111,string)
endif valid endif valid
end function IO_stringAsInt end function IO_stringAsInt
@ -325,10 +320,10 @@ real(pReal) function IO_stringAsFloat(string)
valid: if (verify(string,VALIDCHARS) == 0) then valid: if (verify(string,VALIDCHARS) == 0) then
read(string,*,iostat=readStatus) IO_stringAsFloat read(string,*,iostat=readStatus) IO_stringAsFloat
if (readStatus /= 0) call IO_error(112,ext_msg=string) if (readStatus /= 0) call IO_error(112,string)
else valid else valid
IO_stringAsFloat = 0.0_pReal IO_stringAsFloat = 0.0_pReal
call IO_error(112,ext_msg=string) call IO_error(112,string)
endif valid endif valid
end function IO_stringAsFloat end function IO_stringAsFloat
@ -348,33 +343,27 @@ logical function IO_stringAsBool(string)
IO_stringAsBool = .false. IO_stringAsBool = .false.
else else
IO_stringAsBool = .false. IO_stringAsBool = .false.
call IO_error(113,ext_msg=string) call IO_error(113,string)
endif endif
end function IO_stringAsBool end function IO_stringAsBool
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Write error statements to standard out and terminate the run with exit #9xxx !> @brief Write error statements and terminate the run with exit #9xxx.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
integer, intent(in) :: error_ID integer, intent(in) :: error_ID
integer, optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg,label1,label2
character(len=*), optional, intent(in) :: ext_msg integer, optional, intent(in) :: ID1,ID2
external :: quit external :: quit
character(len=:), allocatable :: msg character(len=:), allocatable :: msg
character(len=pStringLen) :: formatString
select case (error_ID) select case (error_ID)
!--------------------------------------------------------------------------------------------------
! internal errors
case (0)
msg = 'internal check failed:'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! file handling errors ! file handling errors
case (100) case (100)
@ -446,7 +435,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (190) case (190)
msg = 'unknown element type:' msg = 'unknown element type:'
case (191) case (191)
msg = 'mesh consists of more than one element type' msg = 'mesh contains more than one element type'
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! plasticity error messages ! plasticity error messages
@ -483,27 +472,27 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
! errors related to YAML data ! errors related to YAML data
case (701) case (701)
msg = 'Incorrect indent/Null value not allowed' msg = 'incorrect indent/Null value not allowed'
case (702) case (702)
msg = 'Invalid use of flow YAML' msg = 'invalid use of flow YAML'
case (703) case (703)
msg = 'Invalid YAML' msg = 'invalid YAML'
case (704) case (704)
msg = 'Space expected after a colon for <key>: <value> pair' msg = 'space expected after a colon for <key>: <value> pair'
case (705) case (705)
msg = 'Unsupported feature' msg = 'unsupported feature'
case (706) case (706)
msg = 'Type mismatch in YAML data node' msg = 'type mismatch in YAML data node'
case (707) case (707)
msg = 'Abrupt end of file' msg = 'abrupt end of file'
case (708) case (708)
msg = '--- expected after YAML file header' msg = '"---" expected after YAML file header'
case (709) case (709)
msg = 'Length mismatch' msg = 'length mismatch'
case (710) case (710)
msg = 'Closing quotation mark missing in string' msg = 'closing quotation mark missing in string'
case (711) case (711)
msg = 'Incorrect type' msg = 'incorrect type'
!------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------------
! errors related to the mesh solver ! errors related to the mesh solver
@ -540,58 +529,35 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (950) case (950)
msg = 'max number of cut back exceeded, terminating' msg = 'max number of cut back exceeded, terminating'
!-------------------------------------------------------------------------------------------------
! general error messages
case default case default
msg = 'unknown error number...' error stop 'invalid error number'
end select end select
!$OMP CRITICAL (write2out) call panel('error',error_ID,msg, &
write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐' ext_msg=ext_msg, &
write(IO_STDERR,'(a,24x,a,40x,a)') ' │','error', '│' label1=label1,ID1=ID1, &
write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',error_ID, '│' label2=label2,ID2=ID2)
write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
if (present(instance)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at instance ',instance, '│'
write(IO_STDERR,'(a,69x,a)') ' │', '│'
write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘'
flush(IO_STDERR)
call quit(9000+error_ID) call quit(9000+error_ID)
!$OMP END CRITICAL (write2out)
end subroutine IO_error end subroutine IO_error
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Write warning statement to standard out. !> @brief Write warning statements.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_warning(warning_ID,el,ip,g,ext_msg) subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2)
integer, intent(in) :: warning_ID integer, intent(in) :: warning_ID
integer, optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg,label1,label2
character(len=*), optional, intent(in) :: ext_msg integer, optional, intent(in) :: ID1,ID2
character(len=:), allocatable :: msg character(len=:), allocatable :: msg
character(len=pStringLen) :: formatString
select case (warning_ID) select case (warning_ID)
case (47) case (47)
msg = 'no valid parameter for FFTW, using FFTW_PATIENT' msg = 'invalid parameter for FFTW'
case (207) case (207)
msg = 'line truncated' msg = 'line truncated'
case (600) case (600)
@ -600,33 +566,15 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
msg = 'stiffness close to zero' msg = 'stiffness close to zero'
case (709) case (709)
msg = 'read only the first document' msg = 'read only the first document'
case default case default
msg = 'unknown warning number' error stop 'invalid warning number'
end select end select
!$OMP CRITICAL (write2out) call panel('warning',warning_ID,msg, &
write(IO_STDERR,'(/,a)') ' ┌'//IO_DIVIDER//'┐' ext_msg=ext_msg, &
write(IO_STDERR,'(a,24x,a,38x,a)') ' │','warning', '│' label1=label1,ID1=ID1, &
write(IO_STDERR,'(a,24x,i3,42x,a)') ' │',warning_ID, '│' label2=label2,ID2=ID2)
write(IO_STDERR,'(a)') ' ├'//IO_DIVIDER//'┤'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,72-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,72-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(el)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at element ',el, '│'
if (present(ip)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at IP ',ip, '│'
if (present(g)) &
write(IO_STDERR,'(a19,1x,i9,44x,a3)') ' │ at constituent',g, '│'
write(IO_STDERR,'(a,69x,a)') ' │', '│'
write(IO_STDERR,'(a)') ' └'//IO_DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine IO_warning end subroutine IO_warning
@ -654,7 +602,61 @@ pure function CRLF2LF(string)
CRLF2LF = CRLF2LF(:c-n) CRLF2LF = CRLF2LF(:c-n)
end function end function CRLF2LF
!--------------------------------------------------------------------------------------------------
!> @brief Write statements to standard error.
!--------------------------------------------------------------------------------------------------
subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
character(len=*), intent(in) :: paneltype,msg
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2
character(len=pStringLen) :: formatString
integer, parameter :: panelwidth = 69
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1'
if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2'
if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1'
if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2'
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐'
write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,panelwidth-24-len_trim(paneltype)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype), '│'
write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,panelwidth-24-3),'x,a)'
write(IO_STDERR,formatString) ' │',ID, '│'
write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,panelwidth+3-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(label1)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',&
max(1,panelwidth+3-len_trim(label1)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│'
endif
if (present(label2)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',&
max(1,panelwidth+3-len_trim(label2)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│'
endif
write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)'
write(IO_STDERR,formatString) ' │', '│'
write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine panel
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -665,6 +667,7 @@ subroutine selfTest()
integer, dimension(:), allocatable :: chunkPos integer, dimension(:), allocatable :: chunkPos
character(len=:), allocatable :: str character(len=:), allocatable :: str
if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat' if(dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat'
if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat' if(dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat'
if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat' if(dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat'

16
src/Marc/discretization_Marc.f90
View File

@ -80,13 +80,13 @@ subroutine discretization_Marc_init
num_commercialFEM => config_numerics%get('commercialFEM',defaultVal = emptyDict) num_commercialFEM => config_numerics%get('commercialFEM',defaultVal = emptyDict)
mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh
if (mesh_unitlength <= 0.0_pReal) call IO_error(301,ext_msg='unitlength') if (mesh_unitlength <= 0.0_pReal) call IO_error(301,'unitlength')
call inputRead(elem,node0_elem,connectivity_elem,materialAt) call inputRead(elem,node0_elem,connectivity_elem,materialAt)
nElems = size(connectivity_elem,2) nElems = size(connectivity_elem,2)
if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,'element')
if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,'IP')
allocate(cellNodeDefinition(elem%nNodes-1)) allocate(cellNodeDefinition(elem%nNodes-1))
allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems))
@ -579,7 +579,7 @@ subroutine inputRead_elemType(elem, &
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
integer, allocatable, dimension(:) :: chunkPos integer, allocatable, dimension(:) :: chunkPos
integer :: i,j,t,l,remainingChunks integer :: i,j,t,t_,l,remainingChunks
t = -1 t = -1
@ -594,7 +594,8 @@ subroutine inputRead_elemType(elem, &
t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2)) t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))
call elem%init(t) call elem%init(t)
else else
if (t /= mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))) call IO_error(191,el=t,ip=i) t_ = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))
if (t /= t_) call IO_error(191,IO_stringValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t)
endif endif
remainingChunks = elem%nNodes - (chunkPos(1) - 2) remainingChunks = elem%nNodes - (chunkPos(1) - 2)
do while(remainingChunks > 0) do while(remainingChunks > 0)
@ -616,7 +617,8 @@ subroutine inputRead_elemType(elem, &
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
select case (IO_lc(what))
select case (what)
case ( '6') case ( '6')
mapElemtype = 1 ! Two-dimensional Plane Strain Triangle mapElemtype = 1 ! Two-dimensional Plane Strain Triangle
case ( '125') ! 155, 128 (need test) case ( '125') ! 155, 128 (need test)
@ -644,7 +646,7 @@ subroutine inputRead_elemType(elem, &
case ( '21') case ( '21')
mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral mapElemtype = 13 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral
case default case default
call IO_error(error_ID=190,ext_msg=IO_lc(what)) call IO_error(190,what)
end select end select
end function mapElemtype end function mapElemtype

2
src/Marc/element.f90
View File

@ -714,7 +714,7 @@ subroutine tElement_init(self,elemType)
case(13) case(13)
self%cellNodeParentNodeWeights = CELLNODEPARENTNODEWEIGHTS13 self%cellNodeParentNodeWeights = CELLNODEPARENTNODEWEIGHTS13
case default case default
call IO_error(0,ext_msg='invalid element type') error stop 'invalid element type'
end select end select

3
src/Marc/materialpoint_Marc.f90
View File

@ -240,7 +240,8 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
endif endif
if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) call IO_warning(601,elCP,ip) if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) &
call IO_warning(601,label1='element (CP)',ID1=elCP,label2='IP',ID2=ip)
cauchyStress = materialpoint_cs (1:6, ip,elCP) cauchyStress = materialpoint_cs (1:6, ip,elCP)
jacobian = materialpoint_dcsdE(1:6,1:6,ip,elCP) jacobian = materialpoint_dcsdE(1:6,1:6,ip,elCP)

2
src/grid/DAMASK_grid.f90
View File

@ -290,7 +290,7 @@ program DAMASK_grid
if (loadCases(l)%f_restart < huge(0)) & if (loadCases(l)%f_restart < huge(0)) &
print'(2x,a,1x,i0)', 'f_restart:', loadCases(l)%f_restart print'(2x,a,1x,i0)', 'f_restart:', loadCases(l)%f_restart
if (errorID > 0) call IO_error(error_ID = errorID, el = l) if (errorID > 0) call IO_error(errorID,label1='line',ID1=l)
endif reportAndCheck endif reportAndCheck
enddo enddo

16
src/grid/grid_mech_FEM.f90
View File

@ -115,6 +115,8 @@ subroutine grid_mechanical_FEM_init
class(tNode), pointer :: & class(tNode), pointer :: &
num_grid, & num_grid, &
debug_grid debug_grid
character(len=pStringLen) :: &
extmsg = ''
print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- grid_mechanical_FEM init -+>>>'; flush(IO_STDOUT)
@ -134,12 +136,14 @@ subroutine grid_mechanical_FEM_init
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc

16
src/grid/grid_mech_spectral_basic.f90
View File

@ -117,6 +117,8 @@ subroutine grid_mechanical_spectral_basic_init
class (tNode), pointer :: & class (tNode), pointer :: &
num_grid, & num_grid, &
debug_grid debug_grid
character(len=pStringLen) :: &
extmsg = ''
print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- grid_mechanical_spectral_basic init -+>>>'; flush(IO_STDOUT)
@ -143,12 +145,14 @@ subroutine grid_mechanical_spectral_basic_init
num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc

24
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -130,6 +130,8 @@ subroutine grid_mechanical_spectral_polarisation_init
class (tNode), pointer :: & class (tNode), pointer :: &
num_grid, & num_grid, &
debug_grid debug_grid
character(len=pStringLen) :: &
extmsg = ''
print'(/,1x,a)', '<<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- grid_mechanical_spectral_polarization init -+>>>'; flush(IO_STDOUT)
@ -157,16 +159,18 @@ subroutine grid_mechanical_spectral_polarisation_init
num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal) num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal)
num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal) num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal)
if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol') if (num%eps_curl_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_atol'
if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol') if (num%eps_curl_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_rtol'
if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha') if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) extmsg = trim(extmsg)//' alpha'
if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta') if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) extmsg = trim(extmsg)//' beta'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc ! set default and user defined options for PETSc

2
src/grid/spectral_utilities.f90
View File

@ -249,7 +249,7 @@ subroutine spectral_utilities_init()
case('fftw_exhaustive') case('fftw_exhaustive')
FFTW_planner_flag = FFTW_EXHAUSTIVE FFTW_planner_flag = FFTW_EXHAUSTIVE
case default case default
call IO_warning(warning_ID=47,ext_msg=trim(IO_lc(num_grid%get_asString('fftw_plan_mode')))) call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asString('fftw_plan_mode'))//'"')
FFTW_planner_flag = FFTW_MEASURE FFTW_planner_flag = FFTW_MEASURE
end select end select

6
src/lattice.f90
View File

@ -576,7 +576,7 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
do i = 1,6 do i = 1,6
if (abs(C_target_unrotated66(i,i))<tol_math_check) & if (abs(C_target_unrotated66(i,i))<tol_math_check) &
call IO_error(135,el=i,ext_msg='matrix diagonal "el"ement in transformation') call IO_error(135,'matrix diagonal in transformation',label1='entry',ID1=i)
enddo enddo
call buildTransformationSystem(Q,S,Ntrans,cOverA_trans,a_cF,a_cI) call buildTransformationSystem(Q,S,Ntrans,cOverA_trans,a_cF,a_cI)
@ -1431,7 +1431,7 @@ function lattice_SchmidMatrix_slip(Nslip,lattice,cOverA) result(SchmidMatrix)
do i = 1, sum(Nslip) do i = 1, sum(Nslip)
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for slip') error stop 'dilatational Schmid matrix for slip'
enddo enddo
end function lattice_SchmidMatrix_slip end function lattice_SchmidMatrix_slip
@ -1478,7 +1478,7 @@ function lattice_SchmidMatrix_twin(Ntwin,lattice,cOverA) result(SchmidMatrix)
do i = 1, sum(Ntwin) do i = 1, sum(Ntwin)
SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) SchmidMatrix(1:3,1:3,i) = math_outer(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i))
if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) & if (abs(math_trace33(SchmidMatrix(1:3,1:3,i))) > tol_math_check) &
call IO_error(0,i,ext_msg = 'dilatational Schmid matrix for twin') error stop 'dilatational Schmid matrix for twin'
enddo enddo
end function lattice_SchmidMatrix_twin end function lattice_SchmidMatrix_twin

30
src/phase.f90
View File

@ -539,7 +539,8 @@ subroutine crystallite_init()
class(tNode), pointer :: & class(tNode), pointer :: &
num_crystallite, & num_crystallite, &
phases phases
character(len=pStringLen) :: &
extmsg = ''
num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict)
@ -555,22 +556,19 @@ subroutine crystallite_init()
num%nState = num_crystallite%get_asInt ('nState', defaultVal=20) num%nState = num_crystallite%get_asInt ('nState', defaultVal=20)
num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40) num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40)
if (num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') if (num%subStepMinCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepMinCryst'
if (num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') if (num%subStepSizeCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeCryst'
if (num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') if (num%stepIncreaseCryst <= 0.0_pReal) extmsg = trim(extmsg)//' stepIncreaseCryst'
if (num%subStepSizeLp <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLp'
if (num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') if (num%subStepSizeLi <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLi'
if (num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') if (num%rtol_crystalliteState <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteState'
if (num%rtol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteStress'
if (num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') if (num%atol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_crystalliteStress'
if (num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') if (num%iJacoLpresiduum < 1) extmsg = trim(extmsg)//' iJacoLpresiduum'
if (num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') if (num%nState < 1) extmsg = trim(extmsg)//' nState'
if (num%nStress < 1) extmsg = trim(extmsg)//' nStress'
if (num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum')
if (num%nState < 1) call IO_error(301,ext_msg='nState')
if (num%nStress< 1) call IO_error(301,ext_msg='nStress')
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
phases => config_material%get('phase') phases => config_material%get('phase')

8
src/phase_mechanical.f90
View File

@ -1167,8 +1167,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
enddo; enddo enddo; enddo
call math_invert(temp_99,error,math_3333to99(lhs_3333)) call math_invert(temp_99,error,math_3333to99(lhs_3333))
if (error) then if (error) then
call IO_warning(warning_ID=600, & call IO_warning(600,'inversion error in analytic tangent calculation', &
ext_msg='inversion error in analytic tangent calculation') label1='phase',ID1=ph,label2='entry',ID2=en)
dFidS = 0.0_pReal dFidS = 0.0_pReal
else else
dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333)
@ -1201,8 +1201,8 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333))
if (error) then if (error) then
call IO_warning(warning_ID=600, & call IO_warning(600,'inversion error in analytic tangent calculation', &
ext_msg='inversion error in analytic tangent calculation') label1='phase',ID1=ph,label2='entry',ID2=en)
dSdF = rhs_3333 dSdF = rhs_3333
else else
dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333)

2
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -252,7 +252,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotungsten)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

2
src/phase_mechanical_plastic_dislotwin.f90
View File

@ -430,7 +430,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotwin)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

2
src/phase_mechanical_plastic_isotropic.f90
View File

@ -135,7 +135,7 @@ module function plastic_isotropic_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(isotropic)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

2
src/phase_mechanical_plastic_kinehardening.f90
View File

@ -224,7 +224,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(kinehardening)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

2
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -504,7 +504,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(nonlocal)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

2
src/phase_mechanical_plastic_phenopowerlaw.f90
View File

@ -269,7 +269,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! exit if any parameter is out of range ! exit if any parameter is out of range
if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(phenopowerlaw)') if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg))
end do end do

10
src/quit.f90
View File

@ -18,22 +18,22 @@ subroutine quit(stop_id)
integer :: err_HDF5 integer :: err_HDF5
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
call h5open_f(err_HDF5) call h5open_f(err_HDF5)
if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5open_f ',err_HDF5 ! prevents error if not opened yet if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5open_f ',err_HDF5 ! prevents error if not opened yet
call h5close_f(err_HDF5) call h5close_f(err_HDF5)
if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5close_f ',err_HDF5 if (err_HDF5 /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in h5close_f ',err_HDF5
call PetscFinalize(err_PETSc) call PetscFinalize(err_PETSc)
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
#ifdef _OPENMP #ifdef _OPENMP
call MPI_finalize(err_MPI) call MPI_finalize(err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in MPI_finalize',err_MPI if (err_MPI /= 0_MPI_INTEGER_KIND) write(6,'(a,i5)') ' Error in MPI_finalize',err_MPI
#else #else
err_MPI = 0_MPI_INTEGER_KIND err_MPI = 0_MPI_INTEGER_KIND
#endif #endif
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' DAMASK terminated on:' write(6,'(/,a)') ' DAMASK terminated on:'
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
@ -42,7 +42,7 @@ subroutine quit(stop_id)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',& dateAndTime(6),':',&
dateAndTime(7) dateAndTime(7)
if (stop_id == 0 .and. & if (stop_id == 0 .and. &
err_HDF5 == 0 .and. & err_HDF5 == 0 .and. &
err_MPI == 0_MPI_INTEGER_KIND .and. & err_MPI == 0_MPI_INTEGER_KIND .and. &