From 2d0c7b2335823ceaac7e5960573d25f81b388b91 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 5 Jun 2023 16:07:47 +0200 Subject: [PATCH 01/21] reading material.yaml from command line --- src/CLI.f90 | 44 ++++++++++++++++++++++++++++++++++++++------ src/config.f90 | 14 +++++++------- 2 files changed, 45 insertions(+), 13 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index aba6e542f..bc735af40 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -23,7 +23,8 @@ module CLI CLI_restartInc = 0 !< Increment at which calculation starts character(len=:), allocatable, public, protected :: & 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 :: & getSolverJobName, & @@ -46,9 +47,10 @@ subroutine CLI_init commandLine !< command line call as string character(len=pPathLen) :: & arg, & !< individual argument - loadCaseArg = '', & !< -l argument given to the executable - geometryArg = '', & !< -g argument given to the executable - workingDirArg = '' !< -w argument given to the executable + loadCaseArg = '', & !< -l argument given to the executable + geometryArg = '', & !< -g argument given to the executable + materialFileArg = '', & !< -m argument given to the executable + workingDirArg = '' !< -w argument given to the executable integer :: & stat, & i @@ -114,6 +116,7 @@ subroutine CLI_init print'(a,/)',' Valid command line switches:' print'(a)', ' --geom (-g, --geometry)' print'(a)', ' --load (-l, --loadcase)' + print'(a)', ' --material (-m, --materialConfig)' print'(a)', ' --workingdir (-w, --wd, --workingdirectory)' print'(a)', ' --restart (-r, --rs)' print'(a)', ' --help (-h)' @@ -123,6 +126,8 @@ subroutine CLI_init print'(a)', ' Specifies the location of the geometry definition file.' print'(/,a)',' --load PathToLoadFile/NameOfLoadFile' print'(a)', ' Specifies the location of the load case definition file.' + print'(/,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile' + print'(a)', ' Specifies the location of the material configuration file.' print'(/,a)',' -----------------------------------------------------------------------' print'(a)', ' Optional arguments:' print'(/,a)',' --workingdirectory PathToWorkingDirectory' @@ -147,6 +152,8 @@ subroutine CLI_init call get_command_argument(i+1,loadCaseArg,status=err) case ('-g', '--geom', '--geometry') call get_command_argument(i+1,geometryArg,status=err) + case ('-m', '--material', '--materialConfig') + call get_command_argument(i+1,materialFileArg,status=err) case ('-w', '--wd', '--workingdir', '--workingdirectory') call get_command_argument(i+1,workingDirArg,status=err) case ('-r', '--rs', '--restart') @@ -160,14 +167,15 @@ subroutine CLI_init if (err /= 0) call quit(1) end do - if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then - print'(/,a)', ' ERROR: Please specify geometry AND load case (-h for help)' + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0 .or. len_trim(materialFileArg) == 0) then + print'(/,a)', ' ERROR: Please specify geometry AND load case AND material configuration (-h for help)' call quit(1) end if if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) CLI_geomFile = getGeometryFile(geometryArg) CLI_loadFile = getLoadCaseFile(loadCaseArg) + CLI_materialFile = getMaterialFile(materialFileArg) call get_command(commandLine) print'(/,a)', ' Host name: '//getHostName() @@ -178,6 +186,7 @@ subroutine CLI_init print'(a)', ' Working dir argument: '//trim(workingDirArg) print'(a)', ' Geometry argument: '//trim(geometryArg) print'(a)', ' Load case argument: '//trim(loadcaseArg) + print'(a)', ' Material file argument: '//trim(materialFileArg) print'(/,a)', ' Working directory: '//getCWD() print'(a)', ' Geometry file: '//CLI_geomFile print'(a)', ' Load case file: '//CLI_loadFile @@ -283,6 +292,29 @@ function getLoadCaseFile(loadCaseParameter) end function getLoadCaseFile +!-------------------------------------------------------------------------------------------------- +!> @brief relative path of material configuration file from command line arguments +!-------------------------------------------------------------------------------------------------- +function getMaterialFile(materialFileParameter) + + character(len=:), allocatable :: getMaterialFile + character(len=*), intent(in) :: materialFileParameter + logical :: file_exists + external :: quit + + getMaterialFile = trim(materialFileParameter) + if (scan(getMaterialFile,'/') /= 1) getMaterialFile = getCWD()//'/'//trim(getMaterialFile) + getMaterialFile = trim(makeRelativePath(getCWD(), getMaterialFile)) + + inquire(file=getMaterialFile, exist=file_exists) + if (.not. file_exists) then + print*, 'ERROR: Material Configuration file does not exists: '//trim(getMaterialFile) + call quit(1) + end if + +end function getMaterialFile + + !-------------------------------------------------------------------------------------------------- !> @brief remove ../, /./, and // from path. !> @details works only if absolute path is given diff --git a/src/config.f90 b/src/config.f90 index e5f9011fb..955cc291b 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -4,6 +4,7 @@ !-------------------------------------------------------------------------------------------------- module config use IO + use CLI use misc use YAML_parse use YAML_types @@ -96,17 +97,16 @@ end function config_listReferences subroutine parse_material() logical :: fileExists - character(len=:), allocatable :: fileContent - - - inquire(file='material.yaml',exist=fileExists) - if (.not. fileExists) call IO_error(100,ext_msg='material.yaml') + character(len=:), allocatable :: & + fileContent, fname if (worldrank == 0) then print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT) - fileContent = IO_read('material.yaml') + fileContent = IO_read(CLI_materialFile) + fname = CLI_materialFile + if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) call result_openJobFile(parallel=.false.) - call result_writeDataset_str(fileContent,'setup','material.yaml','main configuration') + call result_writeDataset_str(fileContent,'setup',fname,'main configuration') call result_closeJobFile() end if call parallelization_bcast_str(fileContent) From a767008444f1c9a98b1281344156260448cac5fe Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 7 Jun 2023 15:43:01 +0200 Subject: [PATCH 02/21] gtid and mesh tests updated with new command line argument --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 4cd6c7350..926aef772 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 4cd6c7350b0a9d4ad3efcb5fe6c6cfffa99c426f +Subproject commit 926aef7724e6688e277ec8acb277d7b87278610e From d00bf2d3d5c0bef3fbd8529e7ea29192870816fd Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 7 Jun 2023 15:55:01 +0200 Subject: [PATCH 03/21] causes problem for MARC to be removed later --- src/Marc/DAMASK_Marc.f90 | 27 +++++++++++++++++++++++++++ src/config.f90 | 10 ++++++++-- 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 032c77394..84ad33de2 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -33,6 +33,7 @@ module DAMASK_interface public :: & DAMASK_interface_init, & +! getMaterialFileName, & getSolverJobName contains @@ -93,6 +94,32 @@ function getSolverJobName() end function getSolverJobName +!-------------------------------------------------------------------------------------------------- +!> @brief material configuration file name +!-------------------------------------------------------------------------------------------------- +!function getMaterialFileName() + +! character(len=:), allocatable :: getMaterialFileName +! character(len=pSTRLEN) :: line +! integer :: myStat,fileUnit,s,e + +! open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, & +! status='old', position='rewind', action='read',iostat=myStat) +! do +! read (fileUnit,'(A)',END=100) line +! if (index(trim(line),'materialConfig') == 1) then +! read (fileUnit,'(A)',END=100) line ! next line +! s = verify(line, ' ') ! start of first chunk +! s = s + verify(line(s+1:),' ') ! start of second chunk +! e = s + scan (line(s+1:),' ') ! end of second chunk +! getMaterialFileName = line(s:e) +! end if +! end do +!100 close(fileUnit) + +!end function getMaterialFileName + + !-------------------------------------------------------------------------------------------------- !> @brief determines whether a symmetric solver is used !-------------------------------------------------------------------------------------------------- diff --git a/src/config.f90 b/src/config.f90 index a78e2eb73..5d0d6e222 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -4,13 +4,14 @@ !-------------------------------------------------------------------------------------------------- module config use IO - use CLI use misc use YAML_parse use YAML_types use result use parallelization - +#if defined(MESH) || defined(GRID) + use CLI +#endif implicit none(type,external) private @@ -102,8 +103,13 @@ subroutine parse_material() if (worldrank == 0) then print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT) +#if defined(MESH) || defined(GRID) fileContent = IO_read(CLI_materialFile) fname = CLI_materialFile +#else + fileContent = IO_read('material.yaml') + fname = 'material.yaml' +#endif if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) call result_openJobFile(parallel=.false.) call result_writeDataset_str(fileContent,'setup',fname,'main configuration') From 1d8939efade03e26e72b2a1a7badee8d6a9dc39b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 12 Jun 2023 14:14:20 +0200 Subject: [PATCH 04/21] adjusted tests --- PRIVATE | 2 +- src/Marc/DAMASK_Marc.f90 | 27 --------------------------- 2 files changed, 1 insertion(+), 28 deletions(-) diff --git a/PRIVATE b/PRIVATE index 926aef772..69a9625ec 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 926aef7724e6688e277ec8acb277d7b87278610e +Subproject commit 69a9625ec7534b302706387941a98738041e4c77 diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 84ad33de2..032c77394 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -33,7 +33,6 @@ module DAMASK_interface public :: & DAMASK_interface_init, & -! getMaterialFileName, & getSolverJobName contains @@ -94,32 +93,6 @@ function getSolverJobName() end function getSolverJobName -!-------------------------------------------------------------------------------------------------- -!> @brief material configuration file name -!-------------------------------------------------------------------------------------------------- -!function getMaterialFileName() - -! character(len=:), allocatable :: getMaterialFileName -! character(len=pSTRLEN) :: line -! integer :: myStat,fileUnit,s,e - -! open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, & -! status='old', position='rewind', action='read',iostat=myStat) -! do -! read (fileUnit,'(A)',END=100) line -! if (index(trim(line),'materialConfig') == 1) then -! read (fileUnit,'(A)',END=100) line ! next line -! s = verify(line, ' ') ! start of first chunk -! s = s + verify(line(s+1:),' ') ! start of second chunk -! e = s + scan (line(s+1:),' ') ! end of second chunk -! getMaterialFileName = line(s:e) -! end if -! end do -!100 close(fileUnit) - -!end function getMaterialFileName - - !-------------------------------------------------------------------------------------------------- !> @brief determines whether a symmetric solver is used !-------------------------------------------------------------------------------------------------- From 21c958c427655f85bb57ab988e70f3b122a23cac Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 13 Jun 2023 12:59:23 +0200 Subject: [PATCH 05/21] adjusted test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 69a9625ec..ec1159815 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 69a9625ec7534b302706387941a98738041e4c77 +Subproject commit ec1159815c1bc8ff80b5f226c36cde57139bac12 From cb6b1b30f53c930be033d8b4ef455b0061114e6c Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Fri, 16 Jun 2023 12:09:53 -0400 Subject: [PATCH 06/21] shortened CLI reporting; condensed repeated CLI functions --- src/CLI.f90 | 98 ++++++++++++++--------------------------------------- src/IO.f90 | 24 +++++++++++++ 2 files changed, 50 insertions(+), 72 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index 6058ce2b2..b0d66ea2d 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -16,6 +16,7 @@ module CLI use prec use parallelization use system_routines + use IO implicit none(type,external) private @@ -49,7 +50,7 @@ subroutine CLI_init arg, & !< individual argument loadCaseArg = '', & !< -l argument given to the executable geometryArg = '', & !< -g argument given to the executable - materialFileArg = '', & !< -m argument given to the executable + materialArg = '', & !< -m argument given to the executable workingDirArg = '' !< -w argument given to the executable integer :: & stat, & @@ -61,6 +62,8 @@ subroutine CLI_init quit + workingDirArg = getCWD() + print'(/,1x,a)', '<<<+- CLI init -+>>>' ! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203 @@ -153,7 +156,7 @@ subroutine CLI_init case ('-g', '--geom', '--geometry') call get_command_argument(i+1,geometryArg,status=err) case ('-m', '--material', '--materialConfig') - call get_command_argument(i+1,materialFileArg,status=err) + call get_command_argument(i+1,materialArg,status=err) case ('-w', '--wd', '--workingdir', '--workingdirectory') call get_command_argument(i+1,workingDirArg,status=err) case ('-r', '--rs', '--restart') @@ -167,29 +170,25 @@ subroutine CLI_init if (err /= 0) call quit(1) end do - if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0 .or. len_trim(materialFileArg) == 0) then + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0 .or. len_trim(materialArg) == 0) then print'(/,a)', ' ERROR: Please specify geometry AND load case AND material configuration (-h for help)' call quit(1) end if - if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) - CLI_geomFile = getGeometryFile(geometryArg) - CLI_loadFile = getLoadCaseFile(loadCaseArg) - CLI_materialFile = getMaterialFile(materialFileArg) + call setWorkingDirectory(trim(workingDirArg)) + CLI_geomFile = getPathRelCWD(geometryArg,'geometry') + CLI_loadFile = getPathRelCWD(loadCaseArg,'load case') + CLI_materialFile = getPathRelCWD(materialArg,'material configuration') call get_command(commandLine) print'(/,a)', ' Host name: '//getHostName() print'(a)', ' User name: '//getUserName() - print'(/a)', ' Command line call: '//trim(commandLine) - if (len_trim(workingDirArg) > 0) & - print'(a)', ' Working dir argument: '//trim(workingDirArg) - print'(a)', ' Geometry argument: '//trim(geometryArg) - print'(a)', ' Load case argument: '//trim(loadcaseArg) - print'(a)', ' Material file argument: '//trim(materialFileArg) - print'(/,a)', ' Working directory: '//getCWD() - print'(a)', ' Geometry file: '//CLI_geomFile - print'(a)', ' Load case file: '//CLI_loadFile + print'(/a/)', ' Command line call: '//trim(commandLine) + print'(a)', ' Working directory: '//IO_glueDiffering(getCWD(),workingDirArg) + print'(a)', ' Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg) + print'(a)', ' Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg) + print'(a)', ' Material config: '//IO_glueDiffering(CLI_materialFile,materialArg) print'(a)', ' Solver job name: '//getSolverJobName() if (CLI_restartInc > 0) & print'(a,i6.6)', ' Restart from increment: ', CLI_restartInc @@ -247,72 +246,27 @@ 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 :: getGeometryFile - character(len=*), intent(in) :: geometryParameter + character(len=:), allocatable :: getPathRelCWD + character(len=*), intent(in) :: path + character(len=*), intent(in) :: fileType logical :: file_exists external :: quit - getGeometryFile = trim(geometryParameter) - if (scan(getGeometryFile,'/') /= 1) getGeometryFile = getCWD()//'/'//trim(getGeometryFile) - getGeometryFile = trim(makeRelativePath(getCWD(), getGeometryFile)) + getPathRelCWD = trim(path) + if (scan(getPathRelCWD,'/') /= 1) getPathRelCWD = getCWD()//'/'//trim(getPathRelCWD) + getPathRelCWD = trim(makeRelativePath(getCWD(), getPathRelCWD)) - inquire(file=getGeometryFile, exist=file_exists) + inquire(file=getPathRelCWD, exist=file_exists) if (.not. file_exists) then - print*, 'ERROR: Geometry file does not exists: '//trim(getGeometryFile) + print*, 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD) call quit(1) end if -end function getGeometryFile - - -!-------------------------------------------------------------------------------------------------- -!> @brief relative path of load case from command line arguments -!-------------------------------------------------------------------------------------------------- -function getLoadCaseFile(loadCaseParameter) - - 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 relative path of material configuration file from command line arguments -!-------------------------------------------------------------------------------------------------- -function getMaterialFile(materialFileParameter) - - character(len=:), allocatable :: getMaterialFile - character(len=*), intent(in) :: materialFileParameter - logical :: file_exists - external :: quit - - getMaterialFile = trim(materialFileParameter) - if (scan(getMaterialFile,'/') /= 1) getMaterialFile = getCWD()//'/'//trim(getMaterialFile) - getMaterialFile = trim(makeRelativePath(getCWD(), getMaterialFile)) - - inquire(file=getMaterialFile, exist=file_exists) - if (.not. file_exists) then - print*, 'ERROR: Material Configuration file does not exists: '//trim(getMaterialFile) - call quit(1) - end if - -end function getMaterialFile +end function getPathRelCWD !-------------------------------------------------------------------------------------------------- diff --git a/src/IO.f90 b/src/IO.f90 index 27e650825..6ba1f3165 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -38,6 +38,7 @@ module IO IO_realValue, & IO_lc, & IO_rmComment, & + IO_glueDiffering, & IO_intAsStr, & IO_strAsInt, & IO_strAsReal, & @@ -333,6 +334,29 @@ function IO_rmComment(line) 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=pSTRLEN) :: glue_ + + if (present(glue)) then + glue_ = glue + else + glue_ = '<--' + end if + + 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. !-------------------------------------------------------------------------------------------------- From e4a0b0722500528abbb7fe67c4f0c43246ba9662 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Wed, 21 Jun 2023 11:21:44 -0400 Subject: [PATCH 07/21] removed confusing Schmid-Boas in favor of cleaner Thompson tetrahedron notation --- src/lattice.f90 | 74 ++++++++++++++++++++++++------------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 350860ecb..96a55aea4 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -40,19 +40,19 @@ module lattice real(pREAL), dimension(3+3,CF_NSLIP), parameter :: & CF_SYSTEMSLIP = reshape(real([& - ! <110>{111} systems - 0, 1,-1, 1, 1, 1, & ! B2 - -1, 0, 1, 1, 1, 1, & ! B4 - 1,-1, 0, 1, 1, 1, & ! B5 - 0,-1,-1, -1,-1, 1, & ! C1 - 1, 0, 1, -1,-1, 1, & ! C3 - -1, 1, 0, -1,-1, 1, & ! C5 - 0,-1, 1, 1,-1,-1, & ! A2 - -1, 0,-1, 1,-1,-1, & ! A3 - 1, 1, 0, 1,-1,-1, & ! A6 - 0, 1, 1, -1, 1,-1, & ! D1 - 1, 0,-1, -1, 1,-1, & ! D4 - -1,-1, 0, -1, 1,-1, & ! D6 + ! <110>{111} systems (Thompson tetrahedron labeling according to Fig. 3 of 10.1016/S1572-4859(05)80003-8) + 0, 1,-1, 1, 1, 1, & ! δAC + -1, 0, 1, 1, 1, 1, & ! δCB + 1,-1, 0, 1, 1, 1, & ! δBA + 0,-1,-1, -1,-1, 1, & ! γBD + 1, 0, 1, -1,-1, 1, & ! γDA + -1, 1, 0, -1,-1, 1, & ! γAB + 0,-1, 1, 1,-1,-1, & ! βCA + -1, 0,-1, 1,-1,-1, & ! βAD + 1, 1, 0, 1,-1,-1, & ! βDC + 0, 1, 1, -1, 1,-1, & ! αDB + 1, 0,-1, -1, 1,-1, & ! αBC + -1,-1, 0, -1, 1,-1, & ! αCD ! <110>{110}/non-octahedral systems 1, 1, 0, 1,-1, 0, & 1,-1, 0, 1, 1, 0, & @@ -123,31 +123,31 @@ module lattice real(pREAL), dimension(3+3,CI_NSLIP), parameter :: & CI_SYSTEMSLIP = reshape(real([& ! <111>{110} systems - 1,-1, 1, 0, 1, 1, & ! D1 - -1,-1, 1, 0, 1, 1, & ! C1 - 1, 1, 1, 0,-1, 1, & ! B2 - -1, 1, 1, 0,-1, 1, & ! A2 - -1, 1, 1, 1, 0, 1, & ! A3 - -1,-1, 1, 1, 0, 1, & ! C3 - 1, 1, 1, -1, 0, 1, & ! B4 - 1,-1, 1, -1, 0, 1, & ! D4 - -1, 1, 1, 1, 1, 0, & ! A6 - -1, 1,-1, 1, 1, 0, & ! D6 - 1, 1, 1, -1, 1, 0, & ! B5 - 1, 1,-1, -1, 1, 0, & ! C5 + 1,-1, 1, 0, 1, 1, & + -1,-1, 1, 0, 1, 1, & + 1, 1, 1, 0,-1, 1, & + -1, 1, 1, 0,-1, 1, & + -1, 1, 1, 1, 0, 1, & + -1,-1, 1, 1, 0, 1, & + 1, 1, 1, -1, 0, 1, & + 1,-1, 1, -1, 0, 1, & + -1, 1, 1, 1, 1, 0, & + -1, 1,-1, 1, 1, 0, & + 1, 1, 1, -1, 1, 0, & + 1, 1,-1, -1, 1, 0, & ! <111>{112} systems - -1, 1, 1, 2, 1, 1, & ! A-4 - 1, 1, 1, -2, 1, 1, & ! B-3 - 1, 1,-1, 2,-1, 1, & ! C-10 - 1,-1, 1, 2, 1,-1, & ! D-9 - 1,-1, 1, 1, 2, 1, & ! D-6 - 1, 1,-1, -1, 2, 1, & ! C-5 - 1, 1, 1, 1,-2, 1, & ! B-12 - -1, 1, 1, 1, 2,-1, & ! A-11 - 1, 1,-1, 1, 1, 2, & ! C-2 - 1,-1, 1, -1, 1, 2, & ! D-1 - -1, 1, 1, 1,-1, 2, & ! A-8 - 1, 1, 1, 1, 1,-2, & ! B-7 + -1, 1, 1, 2, 1, 1, & + 1, 1, 1, -2, 1, 1, & + 1, 1,-1, 2,-1, 1, & + 1,-1, 1, 2, 1,-1, & + 1,-1, 1, 1, 2, 1, & + 1, 1,-1, -1, 2, 1, & + 1, 1, 1, 1,-2, 1, & + -1, 1, 1, 1, 2,-1, & + 1, 1,-1, 1, 1, 2, & + 1,-1, 1, -1, 1, 2, & + -1, 1, 1, 1,-1, 2, & + 1, 1, 1, 1, 1,-2, & ! Slip system <111>{123} 1, 1,-1, 1, 2, 3, & 1,-1, 1, -1, 2, 3, & From 0842bd503a543e86f129f98b57e02a038184bfc8 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Wed, 21 Jun 2023 16:21:52 -0400 Subject: [PATCH 08/21] immediate parameter expansion over slip systems --- ...phase_mechanical_plastic_phenopowerlaw.f90 | 73 +++++++++---------- 1 file changed, 35 insertions(+), 38 deletions(-) diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index b83c7a2d4..1fcc5eb69 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -139,7 +139,18 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray) prm%sum_N_sl = sum(abs(N_sl)) slipActive: if (prm%sum_N_sl > 0) then - prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) + prm%dot_gamma_0_sl = pl%get_asReal('dot_gamma_0_sl') + prm%n_sl = pl%get_asReal('n_sl') + prm%a_sl = pl%get_asReal('a_sl') + prm%h_0_sl_sl = pl%get_asReal('h_0_sl-sl') + + xi_0_sl = math_expand(pl%get_as1dReal('xi_0_sl', requiredSize=size(N_sl)),N_sl) + prm%xi_inf_sl = math_expand(pl%get_as1dReal('xi_inf_sl', requiredSize=size(N_sl)),N_sl) + prm%h_int = math_expand(pl%get_as1dReal('h_int', requiredSize=size(N_sl), & + defaultVal=[(0.0_pREAL,i=1,size(N_sl))]),N_sl) + + prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'),phase_lattice(ph)) + prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph)) if (phase_lattice(ph) == 'cI') then @@ -151,33 +162,21 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) prm%P_nS_pos = prm%P_sl prm%P_nS_neg = prm%P_sl end if - prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'),phase_lattice(ph)) - xi_0_sl = pl%get_as1dReal('xi_0_sl', requiredSize=size(N_sl)) - prm%xi_inf_sl = pl%get_as1dReal('xi_inf_sl', requiredSize=size(N_sl)) - prm%h_int = pl%get_as1dReal('h_int', requiredSize=size(N_sl), & - defaultVal=[(0.0_pREAL,i=1,size(N_sl))]) - - prm%dot_gamma_0_sl = pl%get_asReal('dot_gamma_0_sl') - prm%n_sl = pl%get_asReal('n_sl') - prm%a_sl = pl%get_asReal('a_sl') - prm%h_0_sl_sl = pl%get_asReal('h_0_sl-sl') - - ! expand: family => system - xi_0_sl = math_expand(xi_0_sl, N_sl) - prm%xi_inf_sl = math_expand(prm%xi_inf_sl,N_sl) - prm%h_int = math_expand(prm%h_int, N_sl) + prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph)) ! sanity checks - if ( prm%dot_gamma_0_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0_sl' - if ( prm%a_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' a_sl' - if ( prm%n_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' n_sl' - if (any(xi_0_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_0_sl' - if (any(prm%xi_inf_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_inf_sl' + if ( prm%dot_gamma_0_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0_sl' + if ( prm%a_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' a_sl' + if ( prm%n_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' n_sl' + if (any(xi_0_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_0_sl' + if (any(prm%xi_inf_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_inf_sl' else slipActive xi_0_sl = emptyRealArray - allocate(prm%xi_inf_sl,prm%h_int,source=emptyRealArray) + allocate(prm%xi_inf_sl, & + prm%h_int, & + source=emptyRealArray) allocate(prm%h_sl_sl(0,0)) end if slipActive @@ -186,24 +185,22 @@ module function plastic_phenopowerlaw_init() result(myPlasticity) N_tw = pl%get_as1dInt('N_tw', defaultVal=emptyIntArray) prm%sum_N_tw = sum(abs(N_tw)) twinActive: if (prm%sum_N_tw > 0) then - prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph)) - prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) - prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dReal('h_tw-tw'),phase_lattice(ph)) + prm%c_1 = pl%get_asReal('c_1',defaultVal=0.0_pREAL) + prm%c_2 = pl%get_asReal('c_2',defaultVal=1.0_pREAL) + prm%c_3 = pl%get_asReal('c_3',defaultVal=0.0_pREAL) + prm%c_4 = pl%get_asReal('c_4',defaultVal=0.0_pREAL) + prm%dot_gamma_0_tw = pl%get_asReal('dot_gamma_0_tw') + prm%n_tw = pl%get_asReal('n_tw') + prm%f_sat_sl_tw = pl%get_asReal('f_sat_sl-tw') + prm%h_0_tw_tw = pl%get_asReal('h_0_tw-tw') + + xi_0_tw = math_expand(pl%get_as1dReal('xi_0_tw',requiredSize=size(N_tw)),N_tw) + prm%gamma_char = lattice_characteristicShear_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) + prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dReal('h_tw-tw'),phase_lattice(ph)) - xi_0_tw = pl%get_as1dReal('xi_0_tw',requiredSize=size(N_tw)) - - prm%c_1 = pl%get_asReal('c_1',defaultVal=0.0_pREAL) - prm%c_2 = pl%get_asReal('c_2',defaultVal=1.0_pREAL) - prm%c_3 = pl%get_asReal('c_3',defaultVal=0.0_pREAL) - prm%c_4 = pl%get_asReal('c_4',defaultVal=0.0_pREAL) - prm%dot_gamma_0_tw = pl%get_asReal('dot_gamma_0_tw') - prm%n_tw = pl%get_asReal('n_tw') - prm%f_sat_sl_tw = pl%get_asReal('f_sat_sl-tw') - prm%h_0_tw_tw = pl%get_asReal('h_0_tw-tw') - - ! expand: family => system - xi_0_tw = math_expand(xi_0_tw,N_tw) + prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph)) + prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph)) ! sanity checks if (prm%dot_gamma_0_tw <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0_tw' From d4d3178717c16eb08344687bc048be608cf90e56 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 22 Jun 2023 15:27:46 +0000 Subject: [PATCH 09/21] Corrected labeling of {111} planes --- src/lattice.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 96a55aea4..c44e775db 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -41,18 +41,18 @@ module lattice real(pREAL), dimension(3+3,CF_NSLIP), parameter :: & CF_SYSTEMSLIP = reshape(real([& ! <110>{111} systems (Thompson tetrahedron labeling according to Fig. 3 of 10.1016/S1572-4859(05)80003-8) - 0, 1,-1, 1, 1, 1, & ! δAC - -1, 0, 1, 1, 1, 1, & ! δCB - 1,-1, 0, 1, 1, 1, & ! δBA - 0,-1,-1, -1,-1, 1, & ! γBD - 1, 0, 1, -1,-1, 1, & ! γDA - -1, 1, 0, -1,-1, 1, & ! γAB - 0,-1, 1, 1,-1,-1, & ! βCA - -1, 0,-1, 1,-1,-1, & ! βAD - 1, 1, 0, 1,-1,-1, & ! βDC - 0, 1, 1, -1, 1,-1, & ! αDB - 1, 0,-1, -1, 1,-1, & ! αBC - -1,-1, 0, -1, 1,-1, & ! αCD + 0, 1,-1, 1, 1, 1, & ! AC(d) + -1, 0, 1, 1, 1, 1, & ! CB(d) + 1,-1, 0, 1, 1, 1, & ! BA(d) + 0,-1,-1, -1,-1, 1, & ! BD(c) + 1, 0, 1, -1,-1, 1, & ! DA(c) + -1, 1, 0, -1,-1, 1, & ! AB(c) + 0,-1, 1, 1,-1,-1, & ! CA(b) + -1, 0,-1, 1,-1,-1, & ! AD(b) + 1, 1, 0, 1,-1,-1, & ! DC(b) + 0, 1, 1, -1, 1,-1, & ! DB(a) + 1, 0,-1, -1, 1,-1, & ! BC(a) + -1,-1, 0, -1, 1,-1, & ! CD(a) ! <110>{110}/non-octahedral systems 1, 1, 0, 1,-1, 0, & 1,-1, 0, 1, 1, 0, & From 28ebc8ef1a2a258497a4f3ac2438e760b1ea6b22 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 22 Jun 2023 14:43:55 -0400 Subject: [PATCH 10/21] inline math_expand for other constitutive laws --- src/phase_mechanical_plastic_isotropic.f90 | 5 +- ...phase_mechanical_plastic_kinehardening.f90 | 42 +++++------ src/phase_mechanical_plastic_none.f90 | 5 +- src/phase_mechanical_plastic_nonlocal.f90 | 69 ++++++++----------- 4 files changed, 55 insertions(+), 66 deletions(-) diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index eff65f9f3..be859dddb 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -82,13 +82,14 @@ module function plastic_isotropic_init() result(myPlasticity) do ph = 1, phases%length if (.not. myPlasticity(ph)) cycle - associate(prm => param(ph), stt => state(ph)) + associate(prm => param(ph), & + stt => state(ph)) phase => phases%get_dict(ph) mech => phase%get_dict('mechanical') pl => mech%get_dict('plastic') - print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph) + print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph) refs = config_listReferences(pl,indent=3) if (len(refs) > 0) print'(/,1x,a)', refs diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index ad2543b83..0bebe3368 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -116,14 +116,15 @@ module function plastic_kinehardening_init() result(myPlasticity) do ph = 1, phases%length if (.not. myPlasticity(ph)) cycle - associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph), & + associate(prm => param(ph), & + stt => state(ph), dlt => deltaState(ph), & idx_dot => indexDotState(ph)) phase => phases%get_dict(ph) mech => phase%get_dict('mechanical') pl => mech%get_dict('plastic') - print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph) + print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph) refs = config_listReferences(pl,indent=3) if (len(refs) > 0) print'(/,1x,a)', refs @@ -150,28 +151,21 @@ module function plastic_kinehardening_init() result(myPlasticity) prm%P_nS_pos = prm%P prm%P_nS_neg = prm%P end if - prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), & - phase_lattice(ph)) - - xi_0 = pl%get_as1dReal('xi_0', requiredSize=size(N_sl)) - prm%xi_inf = pl%get_as1dReal('xi_inf', requiredSize=size(N_sl)) - prm%chi_inf = pl%get_as1dReal('chi_inf', requiredSize=size(N_sl)) - prm%h_0_xi = pl%get_as1dReal('h_0_xi', requiredSize=size(N_sl)) - prm%h_0_chi = pl%get_as1dReal('h_0_chi', requiredSize=size(N_sl)) - prm%h_inf_xi = pl%get_as1dReal('h_inf_xi', requiredSize=size(N_sl)) - prm%h_inf_chi = pl%get_as1dReal('h_inf_chi', requiredSize=size(N_sl)) prm%dot_gamma_0 = pl%get_asReal('dot_gamma_0') prm%n = pl%get_asReal('n') - ! expand: family => system - xi_0 = math_expand(xi_0, N_sl) - prm%xi_inf = math_expand(prm%xi_inf, N_sl) - prm%chi_inf = math_expand(prm%chi_inf, N_sl) - prm%h_0_xi = math_expand(prm%h_0_xi, N_sl) - prm%h_0_chi = math_expand(prm%h_0_chi, N_sl) - prm%h_inf_xi = math_expand(prm%h_inf_xi, N_sl) - prm%h_inf_chi = math_expand(prm%h_inf_chi, N_sl) + prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), & + phase_lattice(ph)) + + xi_0 = math_expand(pl%get_as1dReal('xi_0', requiredSize=size(N_sl)),N_sl) + prm%xi_inf = math_expand(pl%get_as1dReal('xi_inf', requiredSize=size(N_sl)),N_sl) + prm%chi_inf = math_expand(pl%get_as1dReal('chi_inf', requiredSize=size(N_sl)),N_sl) + prm%h_0_xi = math_expand(pl%get_as1dReal('h_0_xi', requiredSize=size(N_sl)),N_sl) + prm%h_0_chi = math_expand(pl%get_as1dReal('h_0_chi', requiredSize=size(N_sl)),N_sl) + prm%h_inf_xi = math_expand(pl%get_as1dReal('h_inf_xi', requiredSize=size(N_sl)),N_sl) + prm%h_inf_chi = math_expand(pl%get_as1dReal('h_inf_chi', requiredSize=size(N_sl)),N_sl) + !-------------------------------------------------------------------------------------------------- ! sanity checks @@ -183,7 +177,13 @@ module function plastic_kinehardening_init() result(myPlasticity) else slipActive xi_0 = emptyRealArray - allocate(prm%xi_inf,prm%chi_inf,prm%h_0_xi,prm%h_inf_xi,prm%h_0_chi,prm%h_inf_chi,source=emptyRealArray) + allocate(prm%xi_inf, & + prm%chi_inf, & + prm%h_0_xi, & + prm%h_0_chi, & + prm%h_inf_xi, & + prm%h_inf_chi, & + source=emptyRealArray) allocate(prm%h_sl_sl(0,0)) end if slipActive diff --git a/src/phase_mechanical_plastic_none.f90 b/src/phase_mechanical_plastic_none.f90 index b79a61183..748e0579b 100644 --- a/src/phase_mechanical_plastic_none.f90 +++ b/src/phase_mechanical_plastic_none.f90 @@ -29,9 +29,12 @@ module function plastic_none_init() result(myPlasticity) phases => config_material%get_dict('phase') + do ph = 1, phases%length if (.not. myPlasticity(ph)) cycle - print'(a,i0,a)', ' phase ',ph + + print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph) + call phase_allocateState(plasticState(ph),count(material_ID_phase == ph),0,0,0) end do diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index d50f562ca..4e45066b5 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -92,17 +92,13 @@ submodule(phase:plastic) nonlocal mu, & nu real(pREAL), dimension(:), allocatable :: & - d_ed, & !< minimum stable edge dipole height - d_sc, & !< minimum stable screw dipole height - tau_Peierls_ed, & - tau_Peierls_sc, & i_sl, & !< mean free path prefactor for each b_sl !< absolute length of Burgers vector [m] real(pREAL), dimension(:,:), allocatable :: & slip_normal, & slip_direction, & slip_transverse, & - minDipoleHeight, & ! edge and screw + minDipoleHeight, & ! minimum stable dipole height edge and screw peierlsstress, & ! edge and screw h_sl_sl ,& !< coefficients for slip-slip interaction forestProjection_Edge, & !< matrix of forest projections of edge dislocations @@ -236,7 +232,7 @@ module function plastic_nonlocal_init() result(myPlasticity) mech => phase%get_dict('mechanical') pl => mech%get_dict('plastic') - print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph) + print'(/,1x,a,1x,i0,a)', 'phase',ph,': '//phases%key(ph) refs = config_listReferences(pl,indent=3) if (len(refs) > 0) print'(/,1x,a)', refs @@ -295,52 +291,41 @@ module function plastic_nonlocal_init() result(myPlasticity) ini%rho_d_ed_0 = pl%get_as1dReal('rho_d_ed_0', requiredSize=size(ini%N_sl)) ini%rho_d_sc_0 = pl%get_as1dReal('rho_d_sc_0', requiredSize=size(ini%N_sl)) - prm%i_sl = pl%get_as1dReal('i_sl', requiredSize=size(ini%N_sl)) - prm%b_sl = pl%get_as1dReal('b_sl', requiredSize=size(ini%N_sl)) + prm%i_sl = math_expand(pl%get_as1dReal('i_sl', requiredSize=size(ini%N_sl)),ini%N_sl) + prm%b_sl = math_expand(pl%get_as1dReal('b_sl', requiredSize=size(ini%N_sl)),ini%N_sl) - prm%i_sl = math_expand(prm%i_sl,ini%N_sl) - prm%b_sl = math_expand(prm%b_sl,ini%N_sl) - - prm%d_ed = pl%get_as1dReal('d_ed', requiredSize=size(ini%N_sl)) - prm%d_sc = pl%get_as1dReal('d_sc', requiredSize=size(ini%N_sl)) - prm%d_ed = math_expand(prm%d_ed,ini%N_sl) - prm%d_sc = math_expand(prm%d_sc,ini%N_sl) allocate(prm%minDipoleHeight(prm%sum_N_sl,2)) - prm%minDipoleHeight(:,1) = prm%d_ed - prm%minDipoleHeight(:,2) = prm%d_sc + prm%minDipoleHeight(:,1) = math_expand(pl%get_as1dReal('d_ed', requiredSize=size(ini%N_sl)),ini%N_sl) + prm%minDipoleHeight(:,2) = math_expand(pl%get_as1dReal('d_sc', requiredSize=size(ini%N_sl)),ini%N_sl) - prm%tau_Peierls_ed = pl%get_as1dReal('tau_Peierls_ed', requiredSize=size(ini%N_sl)) - prm%tau_Peierls_sc = pl%get_as1dReal('tau_Peierls_sc', requiredSize=size(ini%N_sl)) - prm%tau_Peierls_ed = math_expand(prm%tau_Peierls_ed,ini%N_sl) - prm%tau_Peierls_sc = math_expand(prm%tau_Peierls_sc,ini%N_sl) allocate(prm%peierlsstress(prm%sum_N_sl,2)) - prm%peierlsstress(:,1) = prm%tau_Peierls_ed - prm%peierlsstress(:,2) = prm%tau_Peierls_sc + prm%peierlsstress(:,1) = math_expand(pl%get_as1dReal('tau_Peierls_ed', requiredSize=size(ini%N_sl)),ini%N_sl) + prm%peierlsstress(:,2) = math_expand(pl%get_as1dReal('tau_Peierls_sc', requiredSize=size(ini%N_sl)),ini%N_sl) - prm%rho_significant = pl%get_asReal('rho_significant') - prm%rho_min = pl%get_asReal('rho_min', 0.0_pREAL) - prm%C_CFL = pl%get_asReal('C_CFL',defaultVal=2.0_pREAL) + prm%rho_significant = pl%get_asReal('rho_significant') + prm%rho_min = pl%get_asReal('rho_min', 0.0_pREAL) + prm%C_CFL = pl%get_asReal('C_CFL',defaultVal=2.0_pREAL) - prm%V_at = pl%get_asReal('V_at') - prm%D_0 = pl%get_asReal('D_0') - prm%Q_cl = pl%get_asReal('Q_cl') - prm%f_F = pl%get_asReal('f_F') - prm%f_ed = pl%get_asReal('f_ed') - prm%w = pl%get_asReal('w') - prm%Q_sol = pl%get_asReal('Q_sol') - prm%f_sol = pl%get_asReal('f_sol') - prm%c_sol = pl%get_asReal('c_sol') + prm%V_at = pl%get_asReal('V_at') + prm%D_0 = pl%get_asReal('D_0') + prm%Q_cl = pl%get_asReal('Q_cl') + prm%f_F = pl%get_asReal('f_F') + prm%f_ed = pl%get_asReal('f_ed') + prm%w = pl%get_asReal('w') + prm%Q_sol = pl%get_asReal('Q_sol') + prm%f_sol = pl%get_asReal('f_sol') + prm%c_sol = pl%get_asReal('c_sol') - prm%p = pl%get_asReal('p_sl') - prm%q = pl%get_asReal('q_sl') - prm%B = pl%get_asReal('B') - prm%nu_a = pl%get_asReal('nu_a') + prm%p = pl%get_asReal('p_sl') + prm%q = pl%get_asReal('q_sl') + prm%B = pl%get_asReal('B') + prm%nu_a = pl%get_asReal('nu_a') ! ToDo: discuss logic - ini%sigma_rho_u = pl%get_asReal('sigma_rho_u') - ini%random_rho_u = pl%get_asReal('random_rho_u',defaultVal= 0.0_pREAL) + ini%sigma_rho_u = pl%get_asReal('sigma_rho_u') + ini%random_rho_u = pl%get_asReal('random_rho_u',defaultVal= 0.0_pREAL) if (pl%contains('random_rho_u')) & - ini%random_rho_u_binning = pl%get_asReal('random_rho_u_binning',defaultVal=0.0_pREAL) !ToDo: useful default? + ini%random_rho_u_binning = pl%get_asReal('random_rho_u_binning',defaultVal=0.0_pREAL) !ToDo: useful default? ! if (rhoSglRandom(instance) < 0.0_pREAL) & ! if (rhoSglRandomBinning(instance) <= 0.0_pREAL) & From 5053c53ee43665330b4dcdba5a3d4805ad85d3f3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 22 Jun 2023 22:44:19 +0200 Subject: [PATCH 11/21] don't rely on upper bound estimates for string length --- src/CLI.f90 | 68 +++++++++++++++++++++++++++++++++++------------------ 1 file changed, 45 insertions(+), 23 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index b0d66ea2d..1ac425a25 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -44,14 +44,13 @@ subroutine CLI_init -- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- #endif - character(len=pPathLen*3+pSTRLEN) :: & - commandLine !< command line call as string - character(len=pPathLen) :: & - arg, & !< individual argument - loadCaseArg = '', & !< -l argument given to the executable - geometryArg = '', & !< -g argument given to the executable - materialArg = '', & !< -m argument given to the executable - workingDirArg = '' !< -w argument given to the executable + character(len=:), allocatable :: & + commandLine, & !< command line call as string + arg, & !< individual argument + loadCaseArg, & !< -l argument given to the executable + geometryArg, & !< -g argument given to the executable + materialArg, & !< -m argument given to the executable + workingDirArg !< -w argument given to the executable integer :: & stat, & i @@ -108,8 +107,7 @@ subroutine CLI_init print'(a,2(i2.2,a),i2.2)', ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) do i = 1, command_argument_count() - call get_command_argument(i,arg,status=err) - if (err /= 0) call quit(1) + arg = getArg(i) select case(trim(arg)) ! extract key case ('-h','--help') print'(/,a)',' #######################################################################' @@ -152,15 +150,15 @@ subroutine CLI_init print'(a,/)',' Prints this message and exits' call quit(0) ! normal Termination case ('-l', '--load', '--loadcase') - call get_command_argument(i+1,loadCaseArg,status=err) + loadCaseArg = getArg(i+1) case ('-g', '--geom', '--geometry') - call get_command_argument(i+1,geometryArg,status=err) + geometryArg = getArg(i+1) case ('-m', '--material', '--materialConfig') - call get_command_argument(i+1,materialArg,status=err) + materialArg = getArg(i+1) case ('-w', '--wd', '--workingdir', '--workingdirectory') - call get_command_argument(i+1,workingDirArg,status=err) + workingDirArg = getArg(i+1) case ('-r', '--rs', '--restart') - call get_command_argument(i+1,arg,status=err) + arg = getArg(i+1) read(arg,*,iostat=stat) CLI_restartInc if (CLI_restartInc < 0 .or. stat /=0) then print'(/,a)', ' ERROR: Could not parse restart increment: '//trim(arg) @@ -170,7 +168,7 @@ subroutine CLI_init if (err /= 0) call quit(1) end do - if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0 .or. len_trim(materialArg) == 0) then + if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then print'(/,a)', ' ERROR: Please specify geometry AND load case AND material configuration (-h for help)' call quit(1) end if @@ -180,7 +178,7 @@ subroutine CLI_init CLI_loadFile = getPathRelCWD(loadCaseArg,'load case') CLI_materialFile = getPathRelCWD(materialArg,'material configuration') - call get_command(commandLine) + commandLine = getArg(0) print'(/,a)', ' Host name: '//getHostName() print'(a)', ' User name: '//getUserName() @@ -193,6 +191,28 @@ subroutine CLI_init if (CLI_restartInc > 0) & print'(a,i6.6)', ' Restart from increment: ', CLI_restartInc + contains + + !------------------------------------------------------------------------------------------------ + !> @brief Get argument from command line. + !------------------------------------------------------------------------------------------------ + function getArg(n) + + integer, intent(in) :: n !< number of the argument + character(len=:), allocatable :: getArg + + integer :: l,err + + + allocate(character(len=0)::getArg) + call get_command_argument(n,getArg,length=l) + deallocate(getArg) + allocate(character(len=l)::getArg) + call get_command_argument(n,getArg,status=err) + if (err /= 0) call quit(1) + + end function getArg + end subroutine CLI_init @@ -246,7 +266,7 @@ end function getSolverJobName !-------------------------------------------------------------------------------------------------- -!> @brief translate path as relative to CWD and check for existence +!> @brief Translate path as relative to CWD and check for existence. !-------------------------------------------------------------------------------------------------- function getPathRelCWD(path,fileType) @@ -270,8 +290,8 @@ end function getPathRelCWD !-------------------------------------------------------------------------------------------------- -!> @brief remove ../, /./, and // from path. -!> @details works only if absolute path is given +!> @brief Remove ../, /./, and // from path. +!> @details Works only if absolute path is given. !-------------------------------------------------------------------------------------------------- function rectifyPath(path) @@ -317,21 +337,23 @@ end function rectifyPath !-------------------------------------------------------------------------------------------------- -!> @brief Determine relative path from absolute a to absolute b +!> @brief Determine relative path from absolute a to absolute b. !-------------------------------------------------------------------------------------------------- function makeRelativePath(a,b) character(len=*), intent(in) :: a,b - character(len=pPathLen) :: a_cleaned,b_cleaned character(len=:), allocatable :: makeRelativePath + + character(len=:), allocatable :: a_cleaned,b_cleaned integer :: i,posLastCommonSlash,remainingSlashes + posLastCommonSlash = 0 remainingSlashes = 0 a_cleaned = rectifyPath(trim(a)//'/') b_cleaned = rectifyPath(b) - do i = 1, min(len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned))) + do i = 1, min(len_trim(a_cleaned),len_trim(b_cleaned)) if (a_cleaned(i:i) /= b_cleaned(i:i)) exit if (a_cleaned(i:i) == '/') posLastCommonSlash = i end do From fff811edd907704030a9ad8bf23cc1082b99ea3e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 22 Jun 2023 22:54:20 +0200 Subject: [PATCH 12/21] following Python (os.path.normpath, os.path.relpath) --- src/CLI.f90 | 92 ++++++++++++++++++++++++++++------------------------- 1 file changed, 49 insertions(+), 43 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index 1ac425a25..cabec731f 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -37,7 +37,7 @@ contains !> @brief initializes the solver by interpreting the command line arguments. Also writes !! information on computation to screen !-------------------------------------------------------------------------------------------------- -subroutine CLI_init +subroutine CLI_init() #include #if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINORPETSC_MINOR_MAX @@ -45,12 +45,12 @@ subroutine CLI_init #endif character(len=:), allocatable :: & - commandLine, & !< command line call as string - arg, & !< individual argument - loadCaseArg, & !< -l argument given to the executable - geometryArg, & !< -g argument given to the executable - materialArg, & !< -m argument given to the executable - workingDirArg !< -w argument given to the executable + commandLine, & !< command line call as string + arg, & !< individual argument + loadCaseArg, & !< -l argument given to the executable + geometryArg, & !< -g argument given to the executable + materialArg, & !< -m argument given to the executable + workingDirArg !< -w argument given to the executable integer :: & stat, & i @@ -234,7 +234,7 @@ subroutine setWorkingDirectory(workingDirectoryArg) workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg end if absolutePath - workingDirectory = trim(rectifyPath(workingDirectory)) + workingDirectory = trim(normpath(workingDirectory)) error = setCWD(trim(workingDirectory)) if (error) then print*, 'ERROR: Invalid Working directory: '//trim(workingDirectory) @@ -250,8 +250,10 @@ end subroutine setWorkingDirectory function getSolverJobName() character(len=:), allocatable :: getSolverJobName + integer :: posExt,posSep + posExt = scan(CLI_geomFile,'.',back=.true.) posSep = scan(CLI_geomFile,'/',back=.true.) @@ -273,12 +275,14 @@ function getPathRelCWD(path,fileType) character(len=:), allocatable :: getPathRelCWD character(len=*), intent(in) :: path character(len=*), intent(in) :: fileType + logical :: file_exists external :: quit + getPathRelCWD = trim(path) if (scan(getPathRelCWD,'/') /= 1) getPathRelCWD = getCWD()//'/'//trim(getPathRelCWD) - getPathRelCWD = trim(makeRelativePath(getCWD(), getPathRelCWD)) + getPathRelCWD = trim(relpath(getPathRelCWD,getCWD())) inquire(file=getPathRelCWD, exist=file_exists) if (.not. file_exists) then @@ -293,76 +297,78 @@ end function getPathRelCWD !> @brief Remove ../, /./, and // from path. !> @details Works only if absolute path is given. !-------------------------------------------------------------------------------------------------- -function rectifyPath(path) +function normpath(path) character(len=*), intent(in) :: path - character(len=:), allocatable :: rectifyPath + character(len=:), allocatable :: normpath + integer :: i,j,k,l + !-------------------------------------------------------------------------------------------------- ! remove /./ from path - rectifyPath = trim(path) - l = len_trim(rectifyPath) + normpath = trim(path) + l = len_trim(normpath) 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 !-------------------------------------------------------------------------------------------------- ! remove // from path - l = len_trim(rectifyPath) + l = len_trim(normpath) 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 !-------------------------------------------------------------------------------------------------- -! remove ../ and corresponding directory from rectifyPath - l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'../') +! remove ../ and corresponding directory from path + l = len_trim(normpath) + i = index(normpath(i:l),'../') j = 0 do while (i > j) - j = scan(rectifyPath(1:i-2),'/',back=.true.) - rectifyPath(j+1:l) = rectifyPath(i+3:l)//repeat(' ',2+i-j) - if (rectifyPath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX - k = len_trim(rectifyPath) - rectifyPath(j+1:k-1) = rectifyPath(j+2:k) - rectifyPath(k:k) = ' ' + j = scan(normpath(1:i-2),'/',back=.true.) + normpath(j+1:l) = normpath(i+3:l)//repeat(' ',2+i-j) + if (normpath(j+1:j+1) == '/') then !search for '//' that appear in case of XXX/../../XXX + k = len_trim(normpath) + normpath(j+1:k-1) = normpath(j+2:k) + normpath(k:k) = ' ' end if - i = j+index(rectifyPath(j+1:l),'../') + i = j+index(normpath(j+1:l),'../') 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=:), allocatable :: makeRelativePath + character(len=*), intent(in) :: start,path + character(len=:), allocatable :: relpath - character(len=:), allocatable :: a_cleaned,b_cleaned + character(len=:), allocatable :: start_cleaned,path_cleaned integer :: i,posLastCommonSlash,remainingSlashes posLastCommonSlash = 0 remainingSlashes = 0 - a_cleaned = rectifyPath(trim(a)//'/') - b_cleaned = rectifyPath(b) + start_cleaned = normpath(trim(start)//'/') + path_cleaned = normpath(path) - do i = 1, min(len_trim(a_cleaned),len_trim(b_cleaned)) - if (a_cleaned(i:i) /= b_cleaned(i:i)) exit - if (a_cleaned(i:i) == '/') posLastCommonSlash = i + do i = 1, min(len_trim(start_cleaned),len_trim(path_cleaned)) + if (start_cleaned(i:i) /= path_cleaned(i:i)) exit + if (start_cleaned(i:i) == '/') posLastCommonSlash = i end do - do i = posLastCommonSlash+1,len_trim(a_cleaned) - if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 + do i = posLastCommonSlash+1,len_trim(start_cleaned) + if (start_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 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 From a4c52fb119c478ac7f2704e35bac117315fe6312 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 22 Jun 2023 23:19:36 +0200 Subject: [PATCH 13/21] no CamelCasing --- src/CLI.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index cabec731f..0d60daf45 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -153,7 +153,7 @@ subroutine CLI_init() loadCaseArg = getArg(i+1) case ('-g', '--geom', '--geometry') geometryArg = getArg(i+1) - case ('-m', '--material', '--materialConfig') + case ('-m', '--material', '--materialconfig') materialArg = getArg(i+1) case ('-w', '--wd', '--workingdir', '--workingdirectory') workingDirArg = getArg(i+1) From e197e455664ca60f1133943d23cbc0cb046fe513 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 22 Jun 2023 23:25:25 +0200 Subject: [PATCH 14/21] use existing functionality --- src/IO.f90 | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 6ba1f3165..5b3cae71c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -320,6 +320,7 @@ function IO_rmComment(line) character(len=*), intent(in) :: line character(len=:), allocatable :: IO_rmComment + integer :: split @@ -335,7 +336,7 @@ end function IO_rmComment !-------------------------------------------------------------------------------------------------- -! @brief Return first (with glued on second if they differ) +! @brief Return first (with glued on second if they differ). !-------------------------------------------------------------------------------------------------- function IO_glueDiffering(first,second,glue) @@ -343,14 +344,11 @@ function IO_glueDiffering(first,second,glue) character(len=*), intent(in) :: second character(len=*), optional, intent(in) :: glue character(len=:), allocatable :: IO_glueDiffering + character(len=pSTRLEN) :: glue_ - if (present(glue)) then - glue_ = glue - else - glue_ = '<--' - end if + glue_ = misc_optional(glue,'<--') IO_glueDiffering = trim(first) if (trim(first) /= trim(second)) IO_glueDiffering = IO_glueDiffering//' '//trim(glue_)//' '//trim(second) @@ -363,9 +361,9 @@ end function IO_glueDiffering function IO_intAsStr(i) integer, intent(in) :: i - character(len=:), allocatable :: 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 From a38a860783fe9576965c955bbd994c7225aff9e3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 22 Jun 2023 23:56:44 +0200 Subject: [PATCH 15/21] fixed tests (for people having a user name that starts with m) --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index ec1159815..3ba790ed2 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit ec1159815c1bc8ff80b5f226c36cde57139bac12 +Subproject commit 3ba790ed2d3d8d8cf66fa0ad7be7abe8f77c0d54 From efc9391ca7f3f21e82b3c38759e0b2b8ba2d50f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 23 Jun 2023 00:06:44 +0200 Subject: [PATCH 16/21] simplified --- src/CLI.f90 | 2 +- src/IO.f90 | 2 +- src/config.f90 | 7 +++---- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index 0d60daf45..d73e74c12 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -117,7 +117,7 @@ subroutine CLI_init() print'(a,/)',' Valid command line switches:' print'(a)', ' --geom (-g, --geometry)' print'(a)', ' --load (-l, --loadcase)' - print'(a)', ' --material (-m, --materialConfig)' + print'(a)', ' --material (-m, --materialconfig)' print'(a)', ' --workingdir (-w, --wd, --workingdirectory)' print'(a)', ' --restart (-r, --rs)' print'(a)', ' --help (-h)' diff --git a/src/IO.f90 b/src/IO.f90 index 5b3cae71c..39a48e1e5 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -345,7 +345,7 @@ function IO_glueDiffering(first,second,glue) character(len=*), optional, intent(in) :: glue character(len=:), allocatable :: IO_glueDiffering - character(len=pSTRLEN) :: glue_ + character(len=:), allocatable :: glue_ glue_ = misc_optional(glue,'<--') diff --git a/src/config.f90 b/src/config.f90 index 5d0d6e222..9006839bf 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -102,17 +102,16 @@ subroutine parse_material() fileContent, fname if (worldrank == 0) then - print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT) + print'(/,1x,a)', 'reading material configuration'; flush(IO_STDOUT) #if defined(MESH) || defined(GRID) - fileContent = IO_read(CLI_materialFile) fname = CLI_materialFile #else - fileContent = IO_read('material.yaml') 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_writeDataset_str(fileContent,'setup',fname,'main configuration') + call result_writeDataset_str(fileContent,'setup',fname,'material configuration') call result_closeJobFile() end if call parallelization_bcast_str(fileContent) From 6ebff3ecdac703047f315d6792eeab1f55fd33eb Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 23 Jun 2023 01:26:04 +0200 Subject: [PATCH 17/21] [skip ci] updated version information after successful test of v3.0.0-alpha7-562-g04f9b3d16 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index db8be18b4..cff01db52 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha7-558-gf6c7fd280 +3.0.0-alpha7-562-g04f9b3d16 From 4e7d953fe92105b0968751dfdfc808690ec7e8f0 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 22 Jun 2023 22:59:44 -0400 Subject: [PATCH 18/21] indent by format string; provide full commandline call --- src/CLI.f90 | 159 +++++++++++++++++++++++++++------------------------- 1 file changed, 82 insertions(+), 77 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index d73e74c12..daf909d47 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -68,86 +68,82 @@ subroutine CLI_init() ! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203 #ifdef DEBUG 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 - print*, achar(27)//'[94m' + print '(a)', achar(27)//'[94m' #endif - print*, ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/' - print*, ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/' - print*, ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/' - print*, ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/' - print*, ' _/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/' + print '(1x,a)', ' _/_/_/ _/_/ _/ _/ _/_/ _/_/_/ _/ _/ _/_/_/' + print '(1x,a)', ' _/ _/ _/ _/ _/_/ _/_/ _/ _/ _/ _/ _/ _/' + print '(1x,a)', ' _/ _/ _/_/_/_/ _/ _/ _/ _/_/_/_/ _/_/ _/_/ _/_/' + print '(1x,a)', ' _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/' + print '(1x,a)', '_/_/_/ _/ _/ _/ _/ _/ _/ _/_/_/ _/ _/ _/_/_/' #if defined(GRID) - print*, ' Grid solver' + print '(1x,a)', 'Grid solver' #elif defined(MESH) - print*, ' Mesh solver' + print '(1x,a)', 'Mesh solver' #endif #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 - print*, achar(27)//'[0m' + print '(a)', achar(27)//'[0m' - print*, '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)', 'F. Roters et al., Computational Materials Science 158:420–478, 2019' + 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'(a)', ' Compiled on: '//CMAKE_SYSTEM - print'(a)', ' Compiler options: '//compiler_options() + print '(/,1x,a)', 'Compiled with: '//compiler_version() + print '(1x,a)', 'Compiled on: '//CMAKE_SYSTEM + print '(1x,a)', 'Compiler options: '//compiler_options() ! 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)', & - ' PETSc version: ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR + print '(/,1x,a,1x,i0,a,i0,a,i0)', & + 'PETSc version:',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR call date_and_time(values = dateAndTime) - print'(/,a,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),i4.4)', 'Date:',dateAndTime(3),'/',dateAndTime(2),'/',dateAndTime(1) + print '(1x,a,1x,2(i2.2,a),i2.2)', 'Time:',dateAndTime(5),':',dateAndTime(6),':',dateAndTime(7) do i = 1, command_argument_count() arg = getArg(i) select case(trim(arg)) ! extract key case ('-h','--help') - print'(/,a)',' #######################################################################' - print'(a)', ' DAMASK Command Line Interface:' - print'(a)', ' Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers' - print'(a,/)',' #######################################################################' - print'(a,/)',' Valid command line switches:' - print'(a)', ' --geom (-g, --geometry)' - print'(a)', ' --load (-l, --loadcase)' - print'(a)', ' --material (-m, --materialconfig)' - print'(a)', ' --workingdir (-w, --wd, --workingdirectory)' - print'(a)', ' --restart (-r, --rs)' - print'(a)', ' --help (-h)' - print'(/,a)',' -----------------------------------------------------------------------' - print'(a)', ' Mandatory arguments:' - print'(/,a)',' --geom PathToGeomFile/NameOfGeom' - print'(a)', ' Specifies the location of the geometry definition file.' - print'(/,a)',' --load PathToLoadFile/NameOfLoadFile' - print'(a)', ' Specifies the location of the load case definition file.' - print'(/,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile' - print'(a)', ' Specifies the location of the material configuration file.' - print'(/,a)',' -----------------------------------------------------------------------' - print'(a)', ' Optional arguments:' - print'(/,a)',' --workingdirectory PathToWorkingDirectory' - print'(a)', ' Specifies the working directory and overwrites the default ./' - print'(a)', ' Make sure the file "material.yaml" exists in the working' - print'(a)', ' directory.' - print'(a)', ' For further configuration place "numerics.yaml"' - print'(a)',' in that directory.' - print'(/,a)',' --restart N' - print'(a)', ' Reads in increment N and continues with calculating' - print'(a)', ' increment N+1, N+2, ... based on this.' - print'(a)', ' Appends to existing results file' - print'(a)', ' "NameOfGeom_NameOfLoadFile.hdf5".' - print'(a)', ' Works only if the restart information for increment N' - print'(a)', ' is available in the working directory.' - print'(/,a)',' -----------------------------------------------------------------------' - print'(a)', ' Help:' - print'(/,a)',' --help' - print'(a,/)',' Prints this message and exits' + print '(/,1x,a)','#######################################################################' + print '(1x,a)', 'DAMASK Command Line Interface:' + print '(1x,a)', 'Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers' + print '(1x,a,/)','#######################################################################' + print '(1x,a,/)','Valid command line switches:' + print '(1x,a)', ' --geom (-g, --geometry)' + print '(1x,a)', ' --load (-l, --loadcase)' + print '(1x,a)', ' --material (-m, --materialconfig)' + print '(1x,a)', ' --workingdir (-w, --wd, --workingdirectory)' + print '(1x,a)', ' --restart (-r, --rs)' + print '(1x,a)', ' --help (-h)' + print '(/,1x,a)','-----------------------------------------------------------------------' + print '(1x,a)', 'Mandatory arguments:' + print '(/,1x,a)',' --geom PathToGeomFile/NameOfGeom' + print '(1x,a)', ' Specifies the location of the geometry definition file.' + print '(/,1x,a)',' --load PathToLoadFile/NameOfLoadFile' + print '(1x,a)', ' Specifies the location of the load case definition file.' + print '(/,1x,a)',' --material PathToMaterialConfigurationFile/NameOfMaterialConfigurationFile' + print '(1x,a)', ' Specifies the location of the material configuration file.' + print '(/,1x,a)','-----------------------------------------------------------------------' + print '(1x,a)', 'Optional arguments:' + print '(/,1x,a)',' --workingdirectory PathToWorkingDirectory' + print '(1x,a)', ' Specifies the base directory of relative paths.' + print '(/,1x,a)',' --restart N' + print '(1x,a)', ' Reads in increment N and continues with calculating' + print '(1x,a)', ' increment N+1, N+2, ... based on this.' + print '(1x,a)', ' Appends to existing results file' + print '(1x,a)', ' "NameOfGeom_NameOfLoadFile_NameOfMaterialConfigurationFile.hdf5".' + print '(1x,a)', ' Works only if the restart information for increment N' + print '(1x,a)', ' is available in the base directory.' + print '(/,1x,a)','-----------------------------------------------------------------------' + print '(1x,a)', 'Help:' + print '(/,1x,a)',' --help' + print '(1x,a,/)',' Prints this message and exits' call quit(0) ! normal Termination case ('-l', '--load', '--loadcase') loadCaseArg = getArg(i+1) @@ -160,8 +156,8 @@ subroutine CLI_init() case ('-r', '--rs', '--restart') arg = getArg(i+1) read(arg,*,iostat=stat) CLI_restartInc - if (CLI_restartInc < 0 .or. stat /=0) then - print'(/,a)', ' ERROR: Could not parse restart increment: '//trim(arg) + if (CLI_restartInc < 0 .or. stat /= 0) then + print'(/,1x,a)', 'ERROR: Could not parse restart increment: '//trim(arg) call quit(1) end if end select @@ -169,7 +165,7 @@ subroutine CLI_init() end do if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then - print'(/,a)', ' ERROR: Please specify geometry AND load case AND material configuration (-h for help)' + print'(/,1x,a)', 'ERROR: Please specify geometry AND load case AND material configuration (-h for help)' call quit(1) end if @@ -178,18 +174,19 @@ subroutine CLI_init() CLI_loadFile = getPathRelCWD(loadCaseArg,'load case') CLI_materialFile = getPathRelCWD(materialArg,'material configuration') - commandLine = getArg(0) - print'(/,a)', ' Host name: '//getHostName() - print'(a)', ' User name: '//getUserName() + commandLine = getArg(-1) - print'(/a/)', ' Command line call: '//trim(commandLine) - print'(a)', ' Working directory: '//IO_glueDiffering(getCWD(),workingDirArg) - print'(a)', ' Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg) - print'(a)', ' Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg) - print'(a)', ' Material config: '//IO_glueDiffering(CLI_materialFile,materialArg) - print'(a)', ' Solver job name: '//getSolverJobName() + print'(/,1x,a)', 'Host name: '//getHostName() + print'(1x,a)', 'User name: '//getUserName() + + print'(/,1x,a,/)', 'Command line call: '//trim(commandLine) + print'(1x,a)', 'Working directory: '//IO_glueDiffering(getCWD(),workingDirArg) + print'(1x,a)', 'Geometry: '//IO_glueDiffering(CLI_geomFile,geometryArg) + print'(1x,a)', 'Load case: '//IO_glueDiffering(CLI_loadFile,loadCaseArg) + print'(1x,a)', 'Material config: '//IO_glueDiffering(CLI_materialFile,materialArg) + print'(1x,a)', 'Solver job name: '//getSolverJobName() if (CLI_restartInc > 0) & - print'(a,i6.6)', ' Restart from increment: ', CLI_restartInc + print'(1x,a,i6.6)', 'Restart from increment: ', CLI_restartInc contains @@ -205,10 +202,18 @@ subroutine CLI_init() allocate(character(len=0)::getArg) - call get_command_argument(n,getArg,length=l) + 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) - call get_command_argument(n,getArg,status=err) + 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 @@ -237,7 +242,7 @@ subroutine setWorkingDirectory(workingDirectoryArg) workingDirectory = trim(normpath(workingDirectory)) error = setCWD(trim(workingDirectory)) if (error) then - print*, 'ERROR: Invalid Working directory: '//trim(workingDirectory) + print '(1x,a)', 'ERROR: Invalid Working directory: '//trim(workingDirectory) call quit(1) end if @@ -286,7 +291,7 @@ function getPathRelCWD(path,fileType) inquire(file=getPathRelCWD, exist=file_exists) if (.not. file_exists) then - print*, 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD) + print '(1x,a)', 'ERROR: '//fileType//' file does not exist: '//trim(getPathRelCWD) call quit(1) end if From e34ee255971b5d4b69d678019b098cbc0e693c4c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 23 Jun 2023 08:54:37 +0200 Subject: [PATCH 19/21] avoid access to unused variable, no need for nested function --- src/CLI.f90 | 62 ++++++++++++++++++++++++++--------------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index daf909d47..011b80d59 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -56,7 +56,6 @@ subroutine CLI_init() i integer, dimension(8) :: & dateAndTime - integer :: err external :: & quit @@ -161,7 +160,6 @@ subroutine CLI_init() call quit(1) end if end select - if (err /= 0) call quit(1) end do if (.not. all([allocated(loadcaseArg),allocated(geometryArg),allocated(materialArg)])) then @@ -188,38 +186,38 @@ subroutine CLI_init() if (CLI_restartInc > 0) & print'(1x,a,i6.6)', 'Restart from increment: ', CLI_restartInc - contains - - !------------------------------------------------------------------------------------------------ - !> @brief Get argument from command line. - !------------------------------------------------------------------------------------------------ - function getArg(n) - - integer, intent(in) :: n !< number of the argument - character(len=:), allocatable :: getArg - - integer :: l,err - - - 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 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, @@ -229,9 +227,11 @@ subroutine setWorkingDirectory(workingDirectoryArg) character(len=*), intent(in) :: workingDirectoryArg !< working directory argument character(len=:), allocatable :: workingDirectory + logical :: error external :: quit + absolutePath: if (workingDirectoryArg(1:1) == '/') then workingDirectory = workingDirectoryArg else absolutePath From f29e136108dd96b18daba03e8e9b5419e5846059 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 23 Jun 2023 13:31:07 +0200 Subject: [PATCH 20/21] [skip ci] updated version information after successful test of v3.0.0-alpha7-580-g3bb5319f7 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cff01db52..1ba0b6db0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha7-562-g04f9b3d16 +3.0.0-alpha7-580-g3bb5319f7 From 4cb3d9cd6b5cc56d2b8dec5df0f5faf2153e19ae Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 24 Jun 2023 00:42:23 +0200 Subject: [PATCH 21/21] [skip ci] updated version information after successful test of v3.0.0-alpha7-584-gaf7452edd --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 1ba0b6db0..e64a6d9e6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha7-580-g3bb5319f7 +3.0.0-alpha7-584-gaf7452edd