From cf74a687c5e69409282bd8124c73e4f40d2539c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Jul 2023 20:40:22 +0200 Subject: [PATCH 1/6] not needed --- src/grid/grid_mech_FEM.f90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 534cf952f..6500f30ce 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -351,15 +351,8 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai rotation_BC PetscErrorCode :: err_PETSc - PetscScalar, pointer, dimension(:,:,:,:) :: & - u,u_lastInc - call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc) - CHKERRQ(err_PETSc) - call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) - CHKERRQ(err_PETSc) - if (cutBack) then C_volAvg = C_volAvgLastInc else @@ -408,10 +401,6 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai call VecAXPY(solution_current,Delta_t,solution_rate,err_PETSc) CHKERRQ(err_PETSc) - call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc) - CHKERRQ(err_PETSc) - call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) - CHKERRQ(err_PETSc) !-------------------------------------------------------------------------------------------------- ! set module wide available data From 15e5bce7e4a535ab54573f50a3b2087139295963 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Jul 2023 20:50:24 +0200 Subject: [PATCH 2/6] indicate read-only access --- src/grid/grid_damage_spectral.f90 | 6 +++--- src/grid/grid_mech_FEM.f90 | 20 ++++++++++---------- src/grid/grid_mech_spectral_basic.f90 | 12 ++++++------ src/grid/grid_mech_spectral_polarisation.f90 | 12 ++++++------ src/grid/grid_thermal_spectral.f90 | 6 +++--- 5 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 4724f03d0..90680daea 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -307,7 +307,7 @@ end subroutine grid_damage_spectral_forward !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file. !-------------------------------------------------------------------------------------------------- -subroutine grid_damage_spectral_restartWrite +subroutine grid_damage_spectral_restartWrite() PetscErrorCode :: err_PETSc DM :: dm_local @@ -316,7 +316,7 @@ subroutine grid_damage_spectral_restartWrite call SNESGetDM(SNES_damage,dm_local,err_PETSc); CHKERRQ(err_PETSc) - call DMDAVecGetArrayF90(dm_local,solution_vec,phi,err_PETSc); + call DMDAVecGetArrayReadF90(dm_local,solution_vec,phi,err_PETSc); CHKERRQ(err_PETSc) print'(1x,a)', 'saving damage solver data required for restart'; flush(IO_STDOUT) @@ -328,7 +328,7 @@ subroutine grid_damage_spectral_restartWrite call HDF5_closeGroup(groupHandle) call HDF5_closeFile(fileHandle) - call DMDAVecRestoreArrayF90(dm_local,solution_vec,phi,err_PETSc); + call DMDAVecRestoreArrayReadF90(dm_local,solution_vec,phi,err_PETSc); CHKERRQ(err_PETSc) end subroutine grid_damage_spectral_restartWrite diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 6500f30ce..17bf01ac0 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -414,7 +414,7 @@ end subroutine grid_mechanical_FEM_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_FEM_updateCoords +subroutine grid_mechanical_FEM_updateCoords() call utilities_updateCoords(F) @@ -424,16 +424,16 @@ end subroutine grid_mechanical_FEM_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_FEM_restartWrite +subroutine grid_mechanical_FEM_restartWrite() PetscErrorCode :: err_PETSc integer(HID_T) :: fileHandle, groupHandle PetscScalar, dimension(:,:,:,:), pointer :: u,u_lastInc - call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc) + call DMDAVecGetArrayReadF90(mechanical_grid,solution_current,u,err_PETSc) CHKERRQ(err_PETSc) - call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) + call DMDAVecGetArrayReadF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) CHKERRQ(err_PETSc) print'(1x,a)', 'saving solver data required for restart'; flush(IO_STDOUT) @@ -460,9 +460,9 @@ subroutine grid_mechanical_FEM_restartWrite call HDF5_closeFile(fileHandle) end if - call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc) + call DMDAVecRestoreArrayReadF90(mechanical_grid,solution_current,u,err_PETSc) CHKERRQ(err_PETSc) - call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) + call DMDAVecRestoreArrayReadF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc) CHKERRQ(err_PETSc) end subroutine grid_mechanical_FEM_restartWrite @@ -555,7 +555,7 @@ subroutine formResidual(da_local,x_local, & !-------------------------------------------------------------------------------------------------- ! get deformation gradient - call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc) + call DMDAVecGetArrayReadF90(da_local,x_local,x_scal,err_PETSc) CHKERRQ(err_PETSc) do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1) ctr = 0 @@ -565,7 +565,7 @@ subroutine formResidual(da_local,x_local, & end do; end do; end do F(1:3,1:3,i,j,k-cells3Offset) = params%rotation_BC%rotate(F_aim,active=.true.) + transpose(matmul(BMat,x_elem)) end do; end do; end do - call DMDAVecRestoreArrayF90(da_local,x_local,x_scal,err_PETSc) + call DMDAVecRestoreArrayReadF90(da_local,x_local,x_scal,err_PETSc) CHKERRQ(err_PETSc) !-------------------------------------------------------------------------------------------------- @@ -585,7 +585,7 @@ subroutine formResidual(da_local,x_local, & ! constructing residual call DMDAVecGetArrayF90(da_local,f_local,r,err_PETSc) CHKERRQ(err_PETSc) - call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc) + call DMDAVecGetArrayReadF90(da_local,x_local,x_scal,err_PETSc) CHKERRQ(err_PETSc) ele = 0 r = 0.0_pREAL @@ -606,7 +606,7 @@ subroutine formResidual(da_local,x_local, & r(0:2,i+ii,j+jj,k+kk) = r(0:2,i+ii,j+jj,k+kk) + f_elem(ctr,1:3) end do; end do; end do end do; end do; end do - call DMDAVecRestoreArrayF90(da_local,x_local,x_scal,err_PETSc) + call DMDAVecRestoreArrayReadF90(da_local,x_local,x_scal,err_PETSc) CHKERRQ(err_PETSc) !-------------------------------------------------------------------------------------------------- diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 81d00db3f..70e764549 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -377,15 +377,15 @@ end subroutine grid_mechanical_spectral_basic_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_spectral_basic_updateCoords +subroutine grid_mechanical_spectral_basic_updateCoords() PetscErrorCode :: err_PETSc real(pREAL), dimension(:,:,:,:), pointer :: F - call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc) + call DMDAVecGetArrayReadF90(da,solution_vec,F,err_PETSc) CHKERRQ(err_PETSc) call utilities_updateCoords(F) - call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) + call DMDAVecRestoreArrayReadF90(da,solution_vec,F,err_PETSc) CHKERRQ(err_PETSc) end subroutine grid_mechanical_spectral_basic_updateCoords @@ -394,13 +394,13 @@ end subroutine grid_mechanical_spectral_basic_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_spectral_basic_restartWrite +subroutine grid_mechanical_spectral_basic_restartWrite() PetscErrorCode :: err_PETSc integer(HID_T) :: fileHandle, groupHandle real(pREAL), dimension(:,:,:,:), pointer :: F - call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc) + call DMDAVecGetArrayReadF90(da,solution_vec,F,err_PETSc) CHKERRQ(err_PETSc) if (num%update_gamma) C_minMaxAvgRestart = C_minMaxAvg @@ -428,7 +428,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite call HDF5_closeFile(fileHandle) end if - call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) + call DMDAVecRestoreArrayReadF90(da,solution_vec,F,err_PETSc) CHKERRQ(err_PETSc) end subroutine grid_mechanical_spectral_basic_restartWrite diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 73d2b89f2..168794316 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -434,15 +434,15 @@ end subroutine grid_mechanical_spectral_polarisation_forward !-------------------------------------------------------------------------------------------------- !> @brief Update coordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_spectral_polarisation_updateCoords +subroutine grid_mechanical_spectral_polarisation_updateCoords() PetscErrorCode :: err_PETSc real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau - call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc) + call DMDAVecGetArrayReadF90(da,solution_vec,FandF_tau,err_PETSc) CHKERRQ(err_PETSc) call utilities_updateCoords(FandF_tau(0:8,:,:,:)) - call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc) + call DMDAVecRestoreArrayReadF90(da,solution_vec,FandF_tau,err_PETSc) CHKERRQ(err_PETSc) end subroutine grid_mechanical_spectral_polarisation_updateCoords @@ -451,13 +451,13 @@ end subroutine grid_mechanical_spectral_polarisation_updateCoords !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file !-------------------------------------------------------------------------------------------------- -subroutine grid_mechanical_spectral_polarisation_restartWrite +subroutine grid_mechanical_spectral_polarisation_restartWrite() PetscErrorCode :: err_PETSc integer(HID_T) :: fileHandle, groupHandle real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau - call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc) + call DMDAVecGetArrayReadF90(da,solution_vec,FandF_tau,err_PETSc) CHKERRQ(err_PETSc) F => FandF_tau(0: 8,:,:,:) F_tau => FandF_tau(9:17,:,:,:) @@ -489,7 +489,7 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite call HDF5_closeFile(fileHandle) end if - call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc) + call DMDAVecRestoreArrayReadF90(da,solution_vec,FandF_tau,err_PETSc) CHKERRQ(err_PETSc) end subroutine grid_mechanical_spectral_polarisation_restartWrite diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 70d307ed9..1c3f2129a 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -285,7 +285,7 @@ end subroutine grid_thermal_spectral_forward !-------------------------------------------------------------------------------------------------- !> @brief Write current solver and constitutive data for restart to file. !-------------------------------------------------------------------------------------------------- -subroutine grid_thermal_spectral_restartWrite +subroutine grid_thermal_spectral_restartWrite() PetscErrorCode :: err_PETSc DM :: dm_local @@ -294,7 +294,7 @@ subroutine grid_thermal_spectral_restartWrite call SNESGetDM(SNES_thermal,dm_local,err_PETSc); CHKERRQ(err_PETSc) - call DMDAVecGetArrayF90(dm_local,solution_vec,T,err_PETSc); + call DMDAVecGetArrayReadF90(dm_local,solution_vec,T,err_PETSc); CHKERRQ(err_PETSc) print'(1x,a)', 'saving thermal solver data required for restart'; flush(IO_STDOUT) @@ -307,7 +307,7 @@ subroutine grid_thermal_spectral_restartWrite call HDF5_closeGroup(groupHandle) call HDF5_closeFile(fileHandle) - call DMDAVecRestoreArrayF90(dm_local,solution_vec,T,err_PETSc); + call DMDAVecRestoreArrayReadF90(dm_local,solution_vec,T,err_PETSc); CHKERRQ(err_PETSc) end subroutine grid_thermal_spectral_restartWrite From 3dafb26bb10eb5143cc030ca9c0046d7b1712b3b Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 11 Jul 2023 15:13:06 +0200 Subject: [PATCH 3/6] [skip ci] updated version information after successful test of v3.0.0-alpha7-614-gad6220c26 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 888ca7265..772fa9b96 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -3.0.0-alpha7-610-g716600299 +3.0.0-alpha7-614-gad6220c26 From 83db176e1b82c24d31f97cf68de038385d51973c Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 11 Jul 2023 13:19:31 -0400 Subject: [PATCH 4/6] specific error per missing mandatory argument --- src/CLI.f90 | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/src/CLI.f90 b/src/CLI.f90 index f2575657c..2774ee855 100644 --- a/src/CLI.f90 +++ b/src/CLI.f90 @@ -158,36 +158,46 @@ subroutine CLI_init() print'(1x,a,/)',' Prints this message and exits' call quit(0) ! normal Termination case ('-g', '--geom', '--geometry') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --geom' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --geom' geomArg = getArg(i+1) case ('-l', '--load', '--loadcase') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --load' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --load' loadArg = getArg(i+1) case ('-m', '--material', '--materialconfig') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --material' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --material' materialArg = getArg(i+1) case ('-n', '--numerics', '--numericsconfig') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --numerics' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --numerics' numericsArg = getArg(i+1) case ('-j', '--job', '--jobname') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --jobname' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --jobname' solverJobname = getArg(i+1) case ('-w', '--wd', '--workingdir', '--workingdirectory') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --workingdirectory' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --workingdirectory' workingDirArg = getArg(i+1) case ('-r', '--rs', '--restart') - if (.not. hasArg) print'(/,1x,a)', 'ERROR: Missing argument for --restart' + if (.not. hasArg) print'(/,1x,a)', 'ERROR: missing argument for --restart' arg = getArg(i+1) read(arg,*,iostat=stat) CLI_restartInc if (CLI_restartInc < 0 .or. stat /= 0) then - print'(/,1x,a)', 'ERROR: Could not parse restart increment: '//trim(arg) + print'(/,1x,a)', 'ERROR: could not parse restart increment: '//trim(arg) call quit(1) end if end select end do - if (.not. all([allocated(loadArg),allocated(geomArg),allocated(materialArg)])) then - print'(/,1x,a)', 'ERROR: Please specify geometry AND load case AND material configuration (-h for help)' + if (.not. allocated(loadArg)) then + print'(/,1x,a)', 'Error: no load case specified (-h for help)' + call quit(1) + end if + + if (.not. allocated(geomArg)) then + print'(/,1x,a)', 'Error: no geometry specified (-h for help)' + call quit(1) + end if + + if (.not. allocated(materialArg)) then + print'(/,1x,a)', 'Error: no material configuration specified (-h for help)' call quit(1) end if @@ -276,7 +286,7 @@ subroutine setWorkingDirectory(workingDirectoryArg) workingDirectory = trim(normpath(workingDirectory)) error = setCWD(trim(workingDirectory)) if (error) then - print'(1x,a)', 'ERROR: Invalid Working directory: '//trim(workingDirectory) + print'(1x,a)', 'ERROR: invalid working directory: '//trim(workingDirectory) call quit(1) end if From 0e7c9f101c85c98df2aa0cda80ed5182035458ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Jul 2023 20:37:21 +0200 Subject: [PATCH 5/6] avoid file name clashes --- src/Marc/discretization_Marc.f90 | 6 ++--- src/config.f90 | 2 +- src/grid/DAMASK_grid.f90 | 2 +- src/grid/discretization_grid.f90 | 2 +- src/result.f90 | 41 ++++++++++++++++++++++++++++---- 5 files changed, 43 insertions(+), 10 deletions(-) diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 63fe3f194..3d9778e0e 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -210,9 +210,9 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt) call result_openJobFile() - call result_writeDataset_str(IO_read(trim(getSolverJobName())//InputFileExtension), 'setup', & - trim(getSolverJobName())//InputFileExtension, & - 'MSC.Marc input deck') + call result_addSetupFile(IO_read(trim(getSolverJobName())//InputFileExtension), & + trim(getSolverJobName())//InputFileExtension, & + 'MSC.Marc input deck') call result_closeJobFile() inputFile = IO_readlines(trim(getSolverJobName())//InputFileExtension) diff --git a/src/config.f90 b/src/config.f90 index edb72fbd3..0d7b9e385 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -121,7 +121,7 @@ function parse(fname,description) print'(/,1x,a)', 'reading '//description; flush(IO_STDOUT) fileContent = IO_read(fname) call result_openJobFile(parallel=.false.) - call result_writeDataset_str(fileContent,'setup',fname(scan(fname,'/',.true.)+1:),description) + call result_addSetupFile(fileContent,fname,description) call result_closeJobFile() end if call parallelization_bcast_str(fileContent) diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 6015648b4..443f69f9c 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -146,7 +146,7 @@ program DAMASK_grid fname = CLI_loadFile if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) call result_openJobFile(parallel=.false.) - call result_writeDataset_str(fileContent,'setup',fname,'load case definition (grid solver)') + call result_addSetupFile(fileContent,fname,'load case definition (grid solver)') call result_closeJobFile() end if diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index f2f9ca126..e77a173e3 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -89,7 +89,7 @@ subroutine discretization_grid_init(restart) fname = CLI_geomFile if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) call result_openJobFile(parallel=.false.) - call result_writeDataset_str(fileContent,'setup',fname,'geometry definition (grid solver)') + call result_addSetupFile(fileContent,fname,'geometry definition (grid solver)') call result_closeJobFile() else allocate(materialAt_global(0)) ! needed for IntelMPI diff --git a/src/result.f90 b/src/result.f90 index b21429fa8..b8facc26a 100644 --- a/src/result.f90 +++ b/src/result.f90 @@ -62,6 +62,7 @@ module result result_writeDataset, & result_writeDataset_str, & result_setLink, & + result_addSetupFile, & result_addAttribute, & result_removeLink, & result_mapping_phase, & @@ -166,7 +167,7 @@ end subroutine result_finalizeIncrement !-------------------------------------------------------------------------------------------------- -!> @brief open a group from the result file +!> @brief Open a group from the result file. !-------------------------------------------------------------------------------------------------- integer(HID_T) function result_openGroup(groupName) @@ -179,7 +180,7 @@ end function result_openGroup !-------------------------------------------------------------------------------------------------- -!> @brief adds a new group to the result file +!> @brief Add a new group to the result file. !-------------------------------------------------------------------------------------------------- integer(HID_T) function result_addGroup(groupName) @@ -192,7 +193,7 @@ end function result_addGroup !-------------------------------------------------------------------------------------------------- -!> @brief close a group +!> @brief Close a group. !-------------------------------------------------------------------------------------------------- subroutine result_closeGroup(group_id) @@ -205,7 +206,7 @@ end subroutine result_closeGroup !-------------------------------------------------------------------------------------------------- -!> @brief set link to object in result file +!> @brief Set link to object in result file. !-------------------------------------------------------------------------------------------------- subroutine result_setLink(path,link) @@ -216,6 +217,38 @@ subroutine result_setLink(path,link) end subroutine result_setLink + +!-------------------------------------------------------------------------------------------------- +!> @brief Add file to setup folder and ensure unique name. +!-------------------------------------------------------------------------------------------------- +subroutine result_addSetupFile(content,fname,description) + + character(len=*), intent(in) :: content, fname, description + + integer(HID_T) :: groupHandle + character(len=:), allocatable :: fname_ + integer :: i + + groupHandle = result_openGroup('setup') + fname_ = fname(scan(fname,'/',.true.)+1:) + if (.not. HDF5_objectExists(groupHandle,fname_)) then + call result_writeDataset_str(content,'setup',fname_,description) + else + i = 1 + do + fname_ = fname(scan(fname,'/',.true.)+1:)//'.'//IO_intAsStr(i) + if (.not. HDF5_objectExists(groupHandle,fname_)) then + call result_writeDataset_str(content,'setup',fname_,description) + exit + i = i+1 + end if + end do + end if + call result_closeGroup(groupHandle) + +end subroutine result_addSetupFile + + !-------------------------------------------------------------------------------------------------- !> @brief Add a string attribute to an object in the result file. !-------------------------------------------------------------------------------------------------- From 4d8fc08a2f1971bab21f3ef9ff583eb866bfa222 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 11 Jul 2023 16:11:59 -0400 Subject: [PATCH 6/6] shorter logic for addSetupFile --- src/result.f90 | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/result.f90 b/src/result.f90 index b8facc26a..de9db4091 100644 --- a/src/result.f90 +++ b/src/result.f90 @@ -226,24 +226,19 @@ subroutine result_addSetupFile(content,fname,description) character(len=*), intent(in) :: content, fname, description integer(HID_T) :: groupHandle - character(len=:), allocatable :: fname_ + character(len=:), allocatable :: name,suffix integer :: i groupHandle = result_openGroup('setup') - fname_ = fname(scan(fname,'/',.true.)+1:) - if (.not. HDF5_objectExists(groupHandle,fname_)) then - call result_writeDataset_str(content,'setup',fname_,description) - else - i = 1 - do - fname_ = fname(scan(fname,'/',.true.)+1:)//'.'//IO_intAsStr(i) - if (.not. HDF5_objectExists(groupHandle,fname_)) then - call result_writeDataset_str(content,'setup',fname_,description) - exit - i = i+1 - end if - end do - end if + name = fname(scan(fname,'/',.true.)+1:) + suffix = '' + i = 0 + + do while (HDF5_objectExists(groupHandle,name//suffix)) + i = i+1 + suffix = '.'//IO_intAsStr(i) + end do + call result_writeDataset_str(content,'setup',name//suffix,description) call result_closeGroup(groupHandle) end subroutine result_addSetupFile