IO_error and IO_warning crashed for string of zero length (or only containing whitespaces), fixed now.

Also added BEGIN and END statement to numerics in case of non-presen DAMASK_NUM_THREADS, would prevent this error and is better for debugging
This commit is contained in:
Martin Diehl 2013-02-20 21:56:59 +00:00
parent 831ad6d9c8
commit a98be4e0cf
2 changed files with 10 additions and 9 deletions

View File

@ -1584,12 +1584,12 @@ subroutine IO_error(error_ID,e,i,g,ext_msg)
write(6,'(a)') ' + error +'
write(6,'(a,i3,a)') ' + ',error_ID,' +'
write(6,'(a)') ' + +'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',len(trim(msg)),',',&
max(1,60-len(trim(msg))-5),'x,a)'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',max(1,len(trim(msg))),',',&
max(1,60-len(trim(msg))-5),'x,a)'
write(6,formatString) '+ ', trim(msg),'+'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',len(trim(ext_msg)),',',&
max(1,60-len(trim(ext_msg))-5),'x,a)'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',max(1,len(trim(ext_msg))),',',&
max(1,60-len(trim(ext_msg))-5),'x,a)'
write(6,formatString) '+ ', trim(ext_msg),'+'
endif
if (present(e)) then
@ -1664,12 +1664,12 @@ subroutine IO_warning(warning_ID,e,i,g,ext_msg)
write(6,'(a)') ' + warning +'
write(6,'(a,i3,a)') ' + ',warning_ID,' +'
write(6,'(a)') ' + +'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',len(trim(msg)),',',&
max(1,60-len(trim(msg))-5),'x,a)'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',max(1,len(trim(msg))),',',&
max(1,60-len(trim(msg))-5),'x,a)'
write(6,formatString) '+ ', trim(msg),'+'
if (present(ext_msg)) then
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',len(trim(ext_msg)),',',&
max(1,60-len(trim(ext_msg))-5),'x,a)'
write(formatString,'(a,i6.6,a,i6.6,a)') '(1x,a2,a',max(1,len(trim(ext_msg))),',',&
max(1,60-len(trim(ext_msg))-5),'x,a)'
write(6,formatString) '+ ', trim(ext_msg),'+'
endif
if (present(e)) then

View File

@ -157,7 +157,8 @@ subroutine numerics_init
#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...
!$ if(gotDAMASK_NUM_THREADS /= 0) call IO_warning(35_pInt,ext_msg=DAMASK_NumThreadsString)
!$ if(gotDAMASK_NUM_THREADS /= 0) &
!$ call IO_warning(35_pInt,ext_msg='BEGIN:'//DAMASK_NumThreadsString//':END')
!$ read(DAMASK_NumThreadsString,'(i6)') DAMASK_NumThreadsInt ! ...convert it to integer...
!$ 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