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

Merge branch 'CLI-material' into 'development' 

CLI-material

See merge request damask/DAMASK!763
This commit is contained in:
Sharan Roongta 2023-06-23 09:22:18 +00:00
parent 6ebff3ecda e34ee25597
commit 3bb5319f79
4 changed files with 221 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PRIVATE

@ -1 +1 @@
Subproject commit 486e66396f57abe970f01337b9b3967993dd601f Subproject commit 3ba790ed2d3d8d8cf66fa0ad7be7abe8f77c0d54

347
src/CLI.f90
View File

@ -16,6 +16,7 @@ module CLI
use prec use prec
use parallelization use parallelization
use system_routines use system_routines
use IO
implicit none(type,external) implicit none(type,external)
private private
@ -23,7 +24,8 @@ module CLI
CLI_restartInc = 0 !< Increment at which calculation starts CLI_restartInc = 0 !< Increment at which calculation starts
character(len=:), allocatable, public, protected :: & character(len=:), allocatable, public, protected :: &
CLI_geomFile, & !< parameter given for geometry file CLI_geomFile, & !< parameter given for geometry file
CLI_loadFile !< parameter given for load case file CLI_loadFile, & !< parameter given for load case file
CLI_materialFile
public :: & public :: &
getSolverJobName, & getSolverJobName, &
@ -35,158 +37,187 @@ contains
!> @brief initializes the solver by interpreting the command line arguments. Also writes !> @brief initializes the solver by interpreting the command line arguments. Also writes
!! information on computation to screen !! information on computation to screen
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine CLI_init subroutine CLI_init()
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR<PETSC_MINOR_MIN || PETSC_VERSION_MINOR>PETSC_MINOR_MAX #if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR<PETSC_MINOR_MIN || PETSC_VERSION_MINOR>PETSC_MINOR_MAX
-- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- -- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION ---
#endif #endif
character(len=pPathLen*3+pSTRLEN) :: & character(len=:), allocatable :: &
commandLine !< command line call as string commandLine, & !< command line call as string
character(len=pPathLen) :: &
arg, & !< individual argument arg, & !< individual argument
loadCaseArg = '', & !< -l argument given to the executable loadCaseArg, & !< -l argument given to the executable
geometryArg = '', & !< -g argument given to the executable geometryArg, & !< -g argument given to the executable
workingDirArg = '' !< -w argument given to the executable materialArg, & !< -m argument given to the executable
workingDirArg !< -w argument given to the executable
integer :: & integer :: &
stat, & stat, &
i i
integer, dimension(8) :: & integer, dimension(8) :: &
dateAndTime dateAndTime
integer :: err
external :: & external :: &
quit quit
workingDirArg = getCWD()
print'(/,1x,a)', '<<<+- CLI init -+>>>' print'(/,1x,a)', '<<<+- CLI init -+>>>'
! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203 ! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203
#ifdef DEBUG #ifdef DEBUG
print*, achar(27)//'[31m' print*, achar(27)//'[31m'
print'(a,/)', ' debug version - debug version - debug version - debug version - debug version' print'(1x,a,/)', 'debug version - debug version - debug version - debug version - debug version'
#else #else
print*, achar(27)//'[94m' print '(a)', achar(27)//'[94m'
#endif #endif
print*, ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/' print '(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/'
print*, ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/' print '(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/'
print*, ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/' print '(1x,a)', ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/'
print*, ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/' print '(1x,a)', ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/'
print*, ' _/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/' print '(1x,a)', '_/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/'
#if defined(GRID) #if defined(GRID)
print*, ' Grid solver' print '(1x,a)', 'Grid solver'
#elif defined(MESH) #elif defined(MESH)
print*, ' Mesh solver' print '(1x,a)', 'Mesh solver'
#endif #endif
#ifdef DEBUG #ifdef DEBUG
print'(/,a)', ' debug version - debug version - debug version - debug version - debug version' print'(/,1x,a)', 'debug version - debug version - debug version - debug version - debug version'
#endif #endif
print*, achar(27)//'[0m' print '(a)', achar(27)//'[0m'
print*, 'F. Roters et al., Computational Materials Science 158:420–478, 2019' print '(1x,a)', 'F. Roters et al., Computational Materials Science 158:420–478, 2019'
print*, 'https://doi.org/10.1016/j.commatsci.2018.04.030' print '(1x,a)', 'https://doi.org/10.1016/j.commatsci.2018.04.030'
print'(/,a)', ' Version: '//DAMASKVERSION print '(/,1x,a)', 'Version: '//DAMASKVERSION
print'(/,a)', ' Compiled with: '//compiler_version() print '(/,1x,a)', 'Compiled with: '//compiler_version()
print'(a)', ' Compiled on: '//CMAKE_SYSTEM print '(1x,a)', 'Compiled on: '//CMAKE_SYSTEM
print'(a)', ' Compiler options: '//compiler_options() print '(1x,a)', 'Compiler options: '//compiler_options()
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
print'(/,a)', ' Compiled on: '//__DATE__//' at '//__TIME__ print '(/,1x,a)', 'Compiled on: '//__DATE__//' at '//__TIME__
print'(/,a,i0,a,i0,a,i0)', & print '(/,1x,a,1x,i0,a,i0,a,i0)', &
' PETSc version: ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR 'PETSc version:',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
print'(/,a,2(i2.2,a),i4.4)', ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) print '(/,1x,a,1x,2(i2.2,a),i4.4)', 'Date:',dateAndTime(3),'/',dateAndTime(2),'/',dateAndTime(1)
print'(a,2(i2.2,a),i2.2)', ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) print '(1x,a,1x,2(i2.2,a),i2.2)', 'Time:',dateAndTime(5),':',dateAndTime(6),':',dateAndTime(7)
do i = 1, command_argument_count() do i = 1, command_argument_count()
call get_command_argument(i,arg,status=err) arg = getArg(i)
if (err /= 0) call quit(1)
select case(trim(arg)) ! extract key select case(trim(arg)) ! extract key
case ('-h','--help') case ('-h','--help')
print'(/,a)',' #######################################################################' print '(/,1x,a)','#######################################################################'
print'(a)', ' DAMASK Command Line Interface:' print '(1x,a)', 'DAMASK Command Line Interface:'
print'(a)', ' Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers' print '(1x,a)', 'Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers'
print'(a,/)',' #######################################################################' print '(1x,a,/)','#######################################################################'
print'(a,/)',' Valid command line switches:' print '(1x,a,/)','Valid command line switches:'
print'(a)', ' --geom (-g, --geometry)' print '(1x,a)', ' --geom (-g, --geometry)'
print'(a)', ' --load (-l, --loadcase)' print '(1x,a)', ' --load (-l, --loadcase)'
print'(a)', ' --workingdir (-w, --wd, --workingdirectory)' print '(1x,a)', ' --material (-m, --materialconfig)'
print'(a)', ' --restart (-r, --rs)' print '(1x,a)', ' --workingdir (-w, --wd, --workingdirectory)'
print'(a)', ' --help (-h)' print '(1x,a)', ' --restart (-r, --rs)'
print'(/,a)',' -----------------------------------------------------------------------' print '(1x,a)', ' --help (-h)'
print'(a)', ' Mandatory arguments:' print '(/,1x,a)','-----------------------------------------------------------------------'
print'(/,a)',' --geom PathToGeomFile/NameOfGeom' print '(1x,a)', 'Mandatory arguments:'
print'(a)', ' Specifies the location of the geometry definition file.' print '(/,1x,a)',' --geom PathToGeomFile/NameOfGeom'
print'(/,a)',' --load PathToLoadFile/NameOfLoadFile' print '(1x,a)', ' Specifies the location of the geometry definition file.'
print'(a)', ' Specifies the location of the load case definition file.' print '(/,1x,a)',' --load PathToLoadFile/NameOfLoadFile'
print'(/,a)',' -----------------------------------------------------------------------' print '(1x,a)', ' Specifies the location of the load case definition file.'
print'(a)', ' Optional arguments:' print '(/,1x,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile'
print'(/,a)',' --workingdirectory PathToWorkingDirectory' print '(1x,a)', ' Specifies the location of the material configuration file.'
print'(a)', ' Specifies the working directory and overwrites the default ./' print '(/,1x,a)','-----------------------------------------------------------------------'
print'(a)', ' Make sure the file "material.yaml" exists in the working' print '(1x,a)', 'Optional arguments:'
print'(a)', ' directory.' print '(/,1x,a)',' --workingdirectory PathToWorkingDirectory'
print'(a)', ' For further configuration place "numerics.yaml"' print '(1x,a)', ' Specifies the base directory of relative paths.'
print'(a)',' in that directory.' print '(/,1x,a)',' --restart N'
print'(/,a)',' --restart N' print '(1x,a)', ' Reads in increment N and continues with calculating'
print'(a)', ' Reads in increment N and continues with calculating' print '(1x,a)', ' increment N+1, N+2, ... based on this.'
print'(a)', ' increment N+1, N+2, ... based on this.' print '(1x,a)', ' Appends to existing results file'
print'(a)', ' Appends to existing results file' print '(1x,a)', ' "NameOfGeom_NameOfLoadFile_NameOfMaterialConfigurationFile.hdf5".'
print'(a)', ' "NameOfGeom_NameOfLoadFile.hdf5".' print '(1x,a)', ' Works only if the restart information for increment N'
print'(a)', ' Works only if the restart information for increment N' print '(1x,a)', ' is available in the base directory.'
print'(a)', ' is available in the working directory.' print '(/,1x,a)','-----------------------------------------------------------------------'
print'(/,a)',' -----------------------------------------------------------------------' print '(1x,a)', 'Help:'
print'(a)', ' Help:' print '(/,1x,a)',' --help'
print'(/,a)',' --help' print '(1x,a,/)',' Prints this message and exits'
print'(a,/)',' Prints this message and exits'
call quit(0) ! normal Termination call quit(0) ! normal Termination
case ('-l', '--load', '--loadcase') case ('-l', '--load', '--loadcase')
call get_command_argument(i+1,loadCaseArg,status=err) loadCaseArg = getArg(i+1)
case ('-g', '--geom', '--geometry') case ('-g', '--geom', '--geometry')
call get_command_argument(i+1,geometryArg,status=err) geometryArg = getArg(i+1)
case ('-m', '--material', '--materialconfig')
materialArg = getArg(i+1)
case ('-w', '--wd', '--workingdir', '--workingdirectory') case ('-w', '--wd', '--workingdir', '--workingdirectory')
call get_command_argument(i+1,workingDirArg,status=err) workingDirArg = getArg(i+1)
case ('-r', '--rs', '--restart') case ('-r', '--rs', '--restart')
call get_command_argument(i+1,arg,status=err) arg = getArg(i+1)
read(arg,*,iostat=stat) CLI_restartInc read(arg,*,iostat=stat) CLI_restartInc
if (CLI_restartInc < 0 .or. stat /=0) then if (CLI_restartInc < 0 .or. stat /= 0) then
print'(/,a)', ' ERROR: Could not parse restart increment: '//trim(arg) print'(/,1x,a)', 'ERROR: Could not parse restart increment: '//trim(arg)
call quit(1) call quit(1)
end if end if
end select end select
if (err /= 0) call quit(1)
end do end do
if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then
print'(/,a)', ' ERROR: Please specify geometry AND load case (-h for help)' print'(/,1x,a)', 'ERROR: Please specify geometry AND load case AND material configuration (-h for help)'
call quit(1) call quit(1)
end if end if
if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) call setWorkingDirectory(trim(workingDirArg))
CLI_geomFile = getGeometryFile(geometryArg) CLI_geomFile = getPathRelCWD(geometryArg,'geometry')
CLI_loadFile = getLoadCaseFile(loadCaseArg) CLI_loadFile = getPathRelCWD(loadCaseArg,'load case')
CLI_materialFile = getPathRelCWD(materialArg,'material configuration')
call get_command(commandLine) commandLine = getArg(-1)
print'(/,a)', ' Host name: '//getHostName()
print'(a)', ' User name: '//getUserName()
print'(/a)', ' Command line call: '//trim(commandLine) print'(/,1x,a)', 'Host name: '//getHostName()
if (len_trim(workingDirArg) > 0) & print'(1x,a)', 'User name: '//getUserName()
print'(a)', ' Working dir argument: '//trim(workingDirArg)
print'(a)', ' Geometry argument: '//trim(geometryArg) print'(/,1x,a,/)', 'Command line call: '//trim(commandLine)
print'(a)', ' Load case argument: '//trim(loadcaseArg) print'(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg)
print'(/,a)', ' Working directory: '//getCWD() print'(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg)
print'(a)', ' Geometry file: '//CLI_geomFile print'(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg)
print'(a)', ' Load case file: '//CLI_loadFile print'(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg)
print'(a)', ' Solver job name: '//getSolverJobName() print'(1x,a)', 'Solver job name: '//getSolverJobName()
if (CLI_restartInc > 0) & if (CLI_restartInc > 0) &
print'(a,i6.6)', ' Restart from increment: ', CLI_restartInc print'(1x,a,i6.6)', 'Restart from increment: ', CLI_restartInc
end subroutine CLI_init end subroutine CLI_init
!--------------------------------------------------------------------------------------------------
!> @brief Get argument from command line.
!--------------------------------------------------------------------------------------------------
function getArg(n)
integer, intent(in) :: n !< number of the argument
character(len=:), allocatable :: getArg
integer :: l,err
external :: quit
allocate(character(len=0)::getArg)
if (n<0) then
call get_command(getArg, length=l)
else
call get_command_argument(n,getArg,length=l)
endif
deallocate(getArg)
allocate(character(len=l)::getArg)
if (n<0) then
call get_command(getArg, status=err)
else
call get_command_argument(n,getArg,status=err)
endif
if (err /= 0) call quit(1)
end function getArg
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief extract working directory from given argument or from location of geometry file, !> @brief extract working directory from given argument or from location of geometry file,
@ -196,9 +227,11 @@ subroutine setWorkingDirectory(workingDirectoryArg)
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=:), allocatable :: workingDirectory character(len=:), allocatable :: workingDirectory
logical :: error logical :: error
external :: quit external :: quit
absolutePath: if (workingDirectoryArg(1:1) == '/') then absolutePath: if (workingDirectoryArg(1:1) == '/') then
workingDirectory = workingDirectoryArg workingDirectory = workingDirectoryArg
else absolutePath else absolutePath
@ -206,10 +239,10 @@ subroutine setWorkingDirectory(workingDirectoryArg)
workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg
end if absolutePath end if absolutePath
workingDirectory = trim(rectifyPath(workingDirectory)) workingDirectory = trim(normpath(workingDirectory))
error = setCWD(trim(workingDirectory)) error = setCWD(trim(workingDirectory))
if (error) then if (error) then
print*, 'ERROR: Invalid Working directory: '//trim(workingDirectory) print '(1x,a)', 'ERROR: Invalid Working directory: '//trim(workingDirectory)
call quit(1) call quit(1)
end if end if
@ -222,8 +255,10 @@ end subroutine setWorkingDirectory
function getSolverJobName() function getSolverJobName()
character(len=:), allocatable :: getSolverJobName character(len=:), allocatable :: getSolverJobName
integer :: posExt,posSep integer :: posExt,posSep
posExt = scan(CLI_geomFile,'.',back=.true.) posExt = scan(CLI_geomFile,'.',back=.true.)
posSep = scan(CLI_geomFile,'/',back=.true.) posSep = scan(CLI_geomFile,'/',back=.true.)
@ -238,123 +273,107 @@ end function getSolverJobName
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief basename of geometry file with extension from command line arguments !> @brief Translate path as relative to CWD and check for existence.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getGeometryFile(geometryParameter) function getPathRelCWD(path,fileType)
character(len=:), allocatable :: getPathRelCWD
character(len=*), intent(in) :: path
character(len=*), intent(in) :: fileType
character(len=:), allocatable :: getGeometryFile
character(len=*), intent(in) :: geometryParameter
logical :: file_exists logical :: file_exists
external :: quit external :: quit
getGeometryFile = trim(geometryParameter)
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = getCWD()//'/'//trim(getGeometryFile)
getGeometryFile = trim(makeRelativePath(getCWD(), getGeometryFile))
inquire(file=getGeometryFile, exist=file_exists) getPathRelCWD = trim(path)
if (scan(getPathRelCWD,'/') /= 1) getPathRelCWD = getCWD()//'/'//trim(getPathRelCWD)
getPathRelCWD = trim(relpath(getPathRelCWD,getCWD()))
inquire(file=getPathRelCWD, exist=file_exists)
if (.not. file_exists) then if (.not. file_exists) then
print*, 'ERROR: Geometry file does not exists: '//trim(getGeometryFile) print '(1x,a)', 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD)
call quit(1) call quit(1)
end if end if
end function getGeometryFile end function getPathRelCWD
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief relative path of load case from command line arguments !> @brief Remove ../, /./, and // from path.
!> @details Works only if absolute path is given.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getLoadCaseFile(loadCaseParameter) function normpath(path)
character(len=:), allocatable :: getLoadCaseFile
character(len=*), intent(in) :: loadCaseParameter
logical :: file_exists
external :: quit
getLoadCaseFile = trim(loadCaseParameter)
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = getCWD()//'/'//trim(getLoadCaseFile)
getLoadCaseFile = trim(makeRelativePath(getCWD(), getLoadCaseFile))
inquire(file=getLoadCaseFile, exist=file_exists)
if (.not. file_exists) then
print*, 'ERROR: Load case file does not exists: '//trim(getLoadCaseFile)
call quit(1)
end if
end function getLoadCaseFile
!--------------------------------------------------------------------------------------------------
!> @brief remove ../, /./, and // from path.
!> @details works only if absolute path is given
!--------------------------------------------------------------------------------------------------
function rectifyPath(path)
character(len=*), intent(in) :: path character(len=*), intent(in) :: path
character(len=:), allocatable :: rectifyPath character(len=:), allocatable :: normpath
integer :: i,j,k,l integer :: i,j,k,l
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove /./ from path ! remove /./ from path
rectifyPath = trim(path) normpath = trim(path)
l = len_trim(rectifyPath) l = len_trim(normpath)
do i = l,3,-1 do i = l,3,-1
if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' if (normpath(i-2:i) == '/./') normpath(i-1:l) = normpath(i+1:l)//' '
end do end do
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove // from path ! remove // from path
l = len_trim(rectifyPath) l = len_trim(normpath)
do i = l,2,-1 do i = l,2,-1
if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' if (normpath(i-1:i) == '//') normpath(i-1:l) = normpath(i:l)//' '
end do end do
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! remove ../ and corresponding directory from rectifyPath ! remove ../ and corresponding directory from path
l = len_trim(rectifyPath) l = len_trim(normpath)
i = index(rectifyPath(i:l),'../') i = index(normpath(i:l),'../')
j = 0 j = 0
do while (i > j) do while (i > j)
j = scan(rectifyPath(1:i-2),'/',back=.true.) j = scan(normpath(1:i-2),'/',back=.true.)
rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) normpath(j+1:l) = normpath(i+3:l)//repeat(' ',2+i-j)
if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX if (normpath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX
k = len_trim(rectifyPath) k = len_trim(normpath)
rectifyPath(j+1:k-1) = rectifyPath(j+2:k) normpath(j+1:k-1) = normpath(j+2:k)
rectifyPath(k:k) = ' ' normpath(k:k) = ' '
end if end if
i = j+index(rectifyPath(j+1:l),'../') i = j+index(normpath(j+1:l),'../')
end do end do
if (len_trim(rectifyPath) == 0) rectifyPath = '/' if (len_trim(normpath) == 0) normpath = '/'
rectifyPath = trim(rectifyPath) normpath = trim(normpath)
end function rectifyPath end function normpath
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Determine relative path from absolute a to absolute b !> @brief Determine relative path.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function makeRelativePath(a,b) function relpath(path,start)
character(len=*), intent(in) :: a,b character(len=*), intent(in) :: start,path
character(len=pPathLen) :: a_cleaned,b_cleaned character(len=:), allocatable :: relpath
character(len=:), allocatable :: makeRelativePath
character(len=:), allocatable :: start_cleaned,path_cleaned
integer :: i,posLastCommonSlash,remainingSlashes integer :: i,posLastCommonSlash,remainingSlashes
posLastCommonSlash = 0 posLastCommonSlash = 0
remainingSlashes = 0 remainingSlashes = 0
a_cleaned = rectifyPath(trim(a)//'/') start_cleaned = normpath(trim(start)//'/')
b_cleaned = rectifyPath(b) path_cleaned = normpath(path)
do i = 1, min(len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned))) do i = 1, min(len_trim(start_cleaned),len_trim(path_cleaned))
if (a_cleaned(i:i) /= b_cleaned(i:i)) exit if (start_cleaned(i:i) /= path_cleaned(i:i)) exit
if (a_cleaned(i:i) == '/') posLastCommonSlash = i if (start_cleaned(i:i) == '/') posLastCommonSlash = i
end do end do
do i = posLastCommonSlash+1,len_trim(a_cleaned) do i = posLastCommonSlash+1,len_trim(start_cleaned)
if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 if (start_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1
end do end do
makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) relpath = repeat('..'//'/',remainingSlashes)//path_cleaned(posLastCommonSlash+1:len_trim(path_cleaned))
end function makeRelativePath end function relpath
end module CLI end module CLI

24
src/IO.f90
View File

@ -38,6 +38,7 @@ module IO
IO_realValue, & IO_realValue, &
IO_lc, & IO_lc, &
IO_rmComment, & IO_rmComment, &
IO_glueDiffering, &
IO_intAsStr, & IO_intAsStr, &
IO_strAsInt, & IO_strAsInt, &
IO_strAsReal, & IO_strAsReal, &
@ -319,6 +320,7 @@ function IO_rmComment(line)
character(len=*), intent(in) :: line character(len=*), intent(in) :: line
character(len=:), allocatable :: IO_rmComment character(len=:), allocatable :: IO_rmComment
integer :: split integer :: split
@ -333,15 +335,35 @@ function IO_rmComment(line)
end function IO_rmComment end function IO_rmComment
!--------------------------------------------------------------------------------------------------
! @brief Return first (with glued on second if they differ).
!--------------------------------------------------------------------------------------------------
function IO_glueDiffering(first,second,glue)
character(len=*), intent(in) :: first
character(len=*), intent(in) :: second
character(len=*), optional, intent(in) :: glue
character(len=:), allocatable :: IO_glueDiffering
character(len=:), allocatable :: glue_
glue_ = misc_optional(glue,'<--')
IO_glueDiffering = trim(first)
if (trim(first) /= trim(second)) IO_glueDiffering = IO_glueDiffering//' '//trim(glue_)//' '//trim(second)
end function IO_glueDiffering
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Return given int value as string. !> @brief Return given int value as string.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function IO_intAsStr(i) function IO_intAsStr(i)
integer, intent(in) :: i integer, intent(in) :: i
character(len=:), allocatable :: IO_intAsStr character(len=:), allocatable :: IO_intAsStr
allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsStr) allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsStr)
write(IO_intAsStr,'(i0)') i write(IO_intAsStr,'(i0)') i

23
src/config.f90
View File

@ -9,7 +9,9 @@ module config
use YAML_types use YAML_types
use result use result
use parallelization use parallelization
#if defined(MESH) || defined(GRID)
use CLI
#endif
implicit none(type,external) implicit none(type,external)
private private
@ -96,17 +98,20 @@ end function config_listReferences
subroutine parse_material() subroutine parse_material()
logical :: fileExists logical :: fileExists
character(len=:), allocatable :: fileContent character(len=:), allocatable :: &
fileContent, fname
inquire(file='material.yaml',exist=fileExists)
if (.not. fileExists) call IO_error(100,ext_msg='material.yaml')
if (worldrank == 0) then if (worldrank == 0) then
print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT) print'(/,1x,a)', 'reading material configuration'; flush(IO_STDOUT)
fileContent = IO_read('material.yaml') #if defined(MESH) || defined(GRID)
fname = CLI_materialFile
#else
fname = 'material.yaml'
#endif
fileContent = IO_read(fname)
if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:)
call result_openJobFile(parallel=.false.) call result_openJobFile(parallel=.false.)
call result_writeDataset_str(fileContent,'setup','material.yaml','main configuration') call result_writeDataset_str(fileContent,'setup',fname,'material configuration')
call result_closeJobFile() call result_closeJobFile()
end if end if
call parallelization_bcast_str(fileContent) call parallelization_bcast_str(fileContent)