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

merge does not work for strings of different length 

fixed possible out of bounds access
This commit is contained in:
Martin Diehl 2018-07-10 21:40:01 +02:00
parent f493a5419b
commit a4e4a9c4ab
2 changed files with 21 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/IO.f90
View File

@ -988,11 +988,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent)
logical :: warn logical :: warn
if (.not. present(silent)) then warn = merge(silent,.false.,present(silent))
warn = .false.
else
warn = silent
endif
IO_stringValue = '' IO_stringValue = ''
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then

41
src/spectral_interface.f90
View File

@ -55,9 +55,9 @@ subroutine DAMASK_interface_init()
implicit none implicit none
character(len=1024) :: & character(len=1024) :: &
commandLine, & !< command line call as string commandLine, & !< command line call as string
loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe loadcaseArg = '', & !< -l argument given to DAMASK_spectral.exe
geometryArg ='', & !< -g argument given to DAMASK_spectral.exe geometryArg = '', & !< -g argument given to DAMASK_spectral.exe
workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe workingDirArg = '', & !< -w argument given to DAMASK_spectral.exe
hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME)
userName, & !< name of user calling DAMASK_spectral.exe userName, & !< name of user calling DAMASK_spectral.exe
tag tag
@ -112,7 +112,7 @@ subroutine DAMASK_interface_init()
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& dateAndTime(2),'/',&
@ -126,9 +126,8 @@ subroutine DAMASK_interface_init()
call get_command(commandLine) call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine) chunkPos = IIO_stringPos(commandLine)
do i = 1, chunkPos(1) do i = 2_pInt, chunkPos(1)
tag = IIO_stringValue(commandLine,chunkPos,i) ! extract key select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
select case(tag)
case ('-h','--help') case ('-h','--help')
write(6,'(a)') ' #######################################################################' write(6,'(a)') ' #######################################################################'
write(6,'(a)') ' DAMASK_spectral:' write(6,'(a)') ' DAMASK_spectral:'
@ -177,18 +176,20 @@ subroutine DAMASK_interface_init()
write(6,'(a,/)')' Prints this message and exits' write(6,'(a,/)')' Prints this message and exits'
call quit(0_pInt) ! normal Termination call quit(0_pInt) ! normal Termination
case ('-l', '--load', '--loadcase') case ('-l', '--load', '--loadcase')
loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-g', '--geom', '--geometry') case ('-g', '--geom', '--geometry')
geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory')
workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-r', '--rs', '--restart') case ('-r', '--rs', '--restart')
spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) if (i < chunkPos(1)) then
appendToOutFile = .true. spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
appendToOutFile = .true.
endif
end select end select
enddo enddo
if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then
write(6,'(a)') ' Please specify geometry AND load case (-h for help)' write(6,'(a)') ' Please specify geometry AND load case (-h for help)'
call quit(1_pInt) call quit(1_pInt)
endif endif
@ -410,14 +411,12 @@ end function makeRelativePath
pure function IIO_stringValue(string,chunkPos,myChunk) pure function IIO_stringValue(string,chunkPos,myChunk)
implicit none implicit none
integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer(pInt), intent(in) :: myChunk !< position number of desired chunk integer(pInt), intent(in) :: myChunk !< position number of desired chunk
character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
IIO_stringValue = merge('',string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)),&
(myChunk > chunkPos(1) .or. myChunk < 1_pInt))
end function IIO_stringValue end function IIO_stringValue