added subroutine to throw warnings (instead of terminal errors)

This commit is contained in:
Philip Eisenlohr 2009-03-31 09:21:57 +00:00
parent 318fa8008c
commit d96c0a6495
1 changed files with 78 additions and 38 deletions

View File

@ -21,6 +21,7 @@
! function IO_lc(line) ! function IO_lc(line)
! subroutine IO_lcInplace(line) ! subroutine IO_lcInplace(line)
! subroutine IO_error(ID) ! subroutine IO_error(ID)
! subroutine IO_warning(ID)
!--------------------------- !---------------------------
@ -698,45 +699,45 @@ END FUNCTION
select case (ID) select case (ID)
case (0) case (0)
msg='Unable to open input file.' msg = 'Unable to open input file'
case (100) case (100)
msg='Error reading from configuration file.' msg = 'Error reading from configuration file'
case (105) case (105)
msg='Error reading from ODF file.' msg = 'Error reading from ODF file'
case (110) case (110)
msg='No homogenization specified via State Variable 2.' msg = 'No homogenization specified via State Variable 2'
case (120) case (120)
msg='No microstructure specified via State Variable 3.' msg = 'No microstructure specified via State Variable 3'
case (130) case (130)
msg='Homogenization index out of bounds.' msg = 'Homogenization index out of bounds'
case (140) case (140)
msg='Microstructure index out of bounds.' msg = 'Microstructure index out of bounds'
case (150) case (150)
msg='Phase index out of bounds.' msg = 'Phase index out of bounds'
case (160) case (160)
msg='Texture index out of bounds.' msg = 'Texture index out of bounds'
case (170) case (170)
msg='Sum of phase fractions differs from 1.' msg = 'Sum of phase fractions differs from 1'
case (200) case (200)
msg='Unknown constitution specified.' msg = 'Unknown constitution specified'
case (201) case (201)
msg='Unknown lattice type specified.' msg = 'Unknown lattice type specified'
case (202) case (202)
msg='Number of slip systems too small.' msg = 'Number of slip systems too small'
case (203) case (203)
msg='Negative initial slip resistance.' msg = 'Negative initial slip resistance'
case (204) case (204)
msg='Non-positive reference shear rate.' msg = 'Non-positive reference shear rate'
case (205) case (205)
msg='Non-positive stress exponent.' msg = 'Non-positive stress exponent'
case (206) case (206)
msg='Non-positive initial hardening slope.' msg = 'Non-positive initial hardening slope'
case (207) case (207)
msg='Non-positive saturation stress.' msg = 'Non-positive saturation stress'
case (208) case (208)
msg='Non-positive w0.' msg = 'Non-positive w0'
case (209) case (209)
msg='Negative latent hardening ratio.' msg = 'Negative latent hardening ratio'
case (220) case (220)
msg = 'Negative initial dislocation density' msg = 'Negative initial dislocation density'
case (221) case (221)
@ -748,19 +749,17 @@ END FUNCTION
case (224) case (224)
msg = 'Negative diffusion constant' msg = 'Negative diffusion constant'
case (240) case (240)
msg='Non-positive Taylor factor.' msg = 'Non-positive Taylor factor'
case (300) case (300)
msg='This material can only be used with elements with three direct stress components.' msg = 'This material can only be used with elements with three direct stress components'
case (500) case (500)
msg='Unknown lattice type specified.' msg = 'Unknown lattice type specified'
case (600) case (600)
msg='Convergence not reached.' msg = 'Convergence not reached'
case (610) case (610)
msg='Stress loop not converged.' msg = 'Stress loop not converged'
case (650)
msg='Polar decomposition failed.'
case (700) case (700)
msg='Singular matrix in stress iteration.' msg = 'Singular matrix in stress iteration'
case (800) case (800)
msg = 'GIA requires 8 grains per IP (bonehead, you!)' msg = 'GIA requires 8 grains per IP (bonehead, you!)'
case default case default
@ -768,18 +767,20 @@ END FUNCTION
end select end select
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*)
write(6,*) '+------------------------------+' write(6,*) '+------------------------------+'
write(6,*) '+ ERROR +'
write(6,*) '+ +'
write(6,*) msg write(6,*) msg
if (present(ext_msg)) write(6,*) ext_msg if (present(ext_msg)) write(6,*) ext_msg
write(6,*) '+------------------------------+'
if (present(e)) then if (present(e)) then
if (present(i) .and. present(g)) then if (present(i) .and. present(g)) then
write(6,'(a10,x,i6,x,a2,x,i2,x,a5,x,i4)') 'at element',e,'IP',i,'grain',g write(6,'(a10,x,i6,x,a2,x,i2,x,a5,x,i4)') 'at element',e,'IP',i,'grain',g
else else
write(6,'(a2,x,i6)') 'at',e write(6,'(a2,x,i6)') 'at',e
endif endif
write(6,*)
endif endif
write(6,*) '+------------------------------+'
call debug_info() call debug_info()
call flush(6) call flush(6)
@ -792,4 +793,43 @@ END FUNCTION
END SUBROUTINE END SUBROUTINE
!********************************************************************
! write warning statements to standard out
!********************************************************************
SUBROUTINE IO_warning(ID,e,i,g,ext_msg)
use prec, only: pInt
use debug
implicit none
integer(pInt), intent(in) :: ID
integer(pInt), optional, intent(in) :: e,i,g
character(len=*), optional, intent(in) :: ext_msg
character(len=80) msg
select case (ID)
case (650)
msg = 'Polar decomposition failed'
case default
msg = 'Unknown warning number...'
end select
!$OMP CRITICAL (write2out)
write(6,*)
write(6,*) '+------------------------------+'
write(6,*) '+ warning +'
write(6,*) '+ +'
write(6,*) msg
if (present(ext_msg)) write(6,*) ext_msg
if (present(e)) then
if (present(i) .and. present(g)) then
write(6,'(a10,x,i6,x,a2,x,i2,x,a5,x,i4)') 'at element',e,'IP',i,'grain',g
else
write(6,'(a2,x,i6)') 'at',e
endif
endif
write(6,*) '+------------------------------+'
END SUBROUTINE
END MODULE IO END MODULE IO