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

path sep does not change

This commit is contained in:
Martin Diehl 2017-04-10 18:04:26 +02:00
parent f152e81fcd
commit 23ecffa2e5
1 changed files with 25 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
code/spectral_interface.f90
View File

@ -20,7 +20,6 @@ module DAMASK_interface
geometryFile = '', & !< parameter given for geometry file geometryFile = '', & !< parameter given for geometry file
loadCaseFile = '' !< parameter given for load case file loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
character, private,parameter :: pathSep = '/'
public :: & public :: &
getSolverWorkingDirectoryName, & getSolverWorkingDirectoryName, &
@ -168,7 +167,7 @@ subroutine DAMASK_interface_init()
write(6,'(a)') ' Help:' write(6,'(a)') ' Help:'
write(6,'(/,a)')' --help' write(6,'(/,a)')' --help'
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) loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
case ('-g', '--geom', '--geometry') case ('-g', '--geom', '--geometry')
@ -194,7 +193,6 @@ subroutine DAMASK_interface_init()
error = getHostName(hostName) error = getHostName(hostName)
write(6,'(a,a)') ' Host name: ', trim(hostName) write(6,'(a,a)') ' Host name: ', trim(hostName)
write(6,'(a,a)') ' User name: ', trim(userName) write(6,'(a,a)') ' User name: ', trim(userName)
write(6,'(a,a)') ' Path separator: ', pathSep
write(6,'(a,a)') ' Command line call: ', trim(commandLine) write(6,'(a,a)') ' Command line call: ', trim(commandLine)
if (len(trim(workingDirArg))>0) & if (len(trim(workingDirArg))>0) &
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
@ -229,22 +227,22 @@ character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryA
external :: quit external :: quit
wdGiven: if (len(workingDirectoryArg)>0) then wdGiven: if (len(workingDirectoryArg)>0) then
absolutePath: if (workingDirectoryArg(1:1) == pathSep) then absolutePath: if (workingDirectoryArg(1:1) == '/') then
storeWorkingDirectory = workingDirectoryArg storeWorkingDirectory = workingDirectoryArg
else absolutePath else absolutePath
error = getCWD(cwd) error = getCWD(cwd)
if (error) call quit(1_pInt) if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//pathSep//workingDirectoryArg storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg
endif absolutePath endif absolutePath
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= pathSep) & if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') &
storeWorkingDirectory = trim(storeWorkingDirectory)//pathSep ! if path seperator is not given, append it storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it
else wdGiven else wdGiven
if (geometryArg(1:1) == pathSep) then ! absolute path given as command line argument if (geometryArg(1:1) == '/') then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.))
else else
error = getCWD(cwd) ! relative path given as command line argument error = getCWD(cwd) ! relative path given as command line argument
if (error) call quit(1_pInt) if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//pathSep//geometryArg(1:scan(geometryArg,pathSep,back=.true.)) storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.))
endif endif
endif wdGiven endif wdGiven
@ -281,13 +279,13 @@ character(len=1024) function getSolverJobName()
tempString = geometryFile tempString = geometryFile
posExt = scan(tempString,'.',back=.true.) posExt = scan(tempString,'.',back=.true.)
posSep = scan(tempString,pathSep,back=.true.) posSep = scan(tempString,'/',back=.true.)
getSolverJobName = tempString(posSep+1:posExt-1) getSolverJobName = tempString(posSep+1:posExt-1)
tempString = loadCaseFile tempString = loadCaseFile
posExt = scan(tempString,'.',back=.true.) posExt = scan(tempString,'.',back=.true.)
posSep = scan(tempString,pathSep,back=.true.) posSep = scan(tempString,'/',back=.true.)
getSolverJobName = trim(getSolverJobName)//'_'//tempString(posSep+1:posExt-1) getSolverJobName = trim(getSolverJobName)//'_'//tempString(posSep+1:posExt-1)
@ -312,13 +310,13 @@ character(len=1024) function getGeometryFile(geometryParameter)
getGeometryFile = geometryParameter getGeometryFile = geometryParameter
posExt = scan(getGeometryFile,'.',back=.true.) posExt = scan(getGeometryFile,'.',back=.true.)
posSep = scan(getGeometryFile,pathSep,back=.true.) posSep = scan(getGeometryFile,'/',back=.true.)
if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present
if (scan(getGeometryFile,pathSep) /= 1) then ! relative path given as command line argument if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument
error = getcwd(cwd) error = getcwd(cwd)
if (error) call quit(1_pInt) if (error) call quit(1_pInt)
getGeometryFile = rectifyPath(trim(cwd)//pathSep//getGeometryFile) getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile)
else else
getGeometryFile = rectifyPath(getGeometryFile) getGeometryFile = rectifyPath(getGeometryFile)
endif endif
@ -346,13 +344,13 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter)
getLoadCaseFile = loadcaseParameter getLoadCaseFile = loadcaseParameter
posExt = scan(getLoadCaseFile,'.',back=.true.) posExt = scan(getLoadCaseFile,'.',back=.true.)
posSep = scan(getLoadCaseFile,pathSep,back=.true.) posSep = scan(getLoadCaseFile,'/',back=.true.)
if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present
if (scan(getLoadCaseFile,pathSep) /= 1) then ! relative path given as command line argument if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument
error = getcwd(cwd) error = getcwd(cwd)
if (error) call quit(1_pInt) if (error) call quit(1_pInt)
getLoadCaseFile = rectifyPath(trim(cwd)//pathSep//getLoadCaseFile) getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile)
else else
getLoadCaseFile = rectifyPath(getLoadCaseFile) getLoadCaseFile = rectifyPath(getLoadCaseFile)
endif endif
@ -377,26 +375,26 @@ function rectifyPath(path)
l = len_trim(path) l = len_trim(path)
rectifyPath = path rectifyPath = path
do i = l,3,-1 do i = l,3,-1
if (rectifyPath(i-2:i) == pathSep//'.'//pathSep) & if (rectifyPath(i-2:i) == '/'//'.'//'/') &
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove ../ and corresponding directory from rectifyPath ! remove ../ and corresponding directory from rectifyPath
l = len_trim(rectifyPath) l = len_trim(rectifyPath)
i = index(rectifyPath(i:l),'..'//pathSep) i = index(rectifyPath(i:l),'..'//'/')
j = 0 j = 0
do while (i > j) do while (i > j)
j = scan(rectifyPath(1:i-2),pathSep,back=.true.) j = scan(rectifyPath(1:i-2),'/',back=.true.)
rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j)
if (rectifyPath(j+1:j+1) == pathSep) then !search for '//' that appear in case of XXX/../../XXX if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX
k = len_trim(rectifyPath) k = len_trim(rectifyPath)
rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(j+1:k-1) = rectifyPath(j+2:k)
rectifyPath(k:k) = ' ' rectifyPath(k:k) = ' '
endif endif
i = j+index(rectifyPath(j+1:l),'..'//pathSep) i = j+index(rectifyPath(j+1:l),'..'//'/')
enddo enddo
if(len_trim(rectifyPath) == 0) rectifyPath = pathSep if(len_trim(rectifyPath) == 0) rectifyPath = '/'
end function rectifyPath end function rectifyPath
@ -415,12 +413,12 @@ character(len=1024) function makeRelativePath(a,b)
do i = 1, min(1024,len_trim(a),len_trim(b)) do i = 1, min(1024,len_trim(a),len_trim(b))
if (a(i:i) /= b(i:i)) exit if (a(i:i) /= b(i:i)) exit
if (a(i:i) == pathSep) posLastCommonSlash = i if (a(i:i) == '/') posLastCommonSlash = i
enddo enddo
do i = posLastCommonSlash+1,len_trim(a) do i = posLastCommonSlash+1,len_trim(a)
if (a(i:i) == pathSep) remainingSlashes = remainingSlashes + 1 if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1
enddo enddo
makeRelativePath = repeat('..'//pathSep,remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
end function makeRelativePath end function makeRelativePath