diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index 024fd410b..65f406668 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -147,7 +147,7 @@ end module DAMASK_interface #include "../YAML_types.f90" #include "../YAML_parse.f90" #include "../HDF5_utilities.f90" -#include "../results.f90" +#include "../result.f90" #include "../config.f90" #include "../LAPACK_interface.f90" #include "../math.f90" @@ -434,7 +434,7 @@ subroutine uedinc(inc,incsub) end do call discretization_Marc_UpdateNodeAndIpCoords(d_n) - call materialpoint_results(int(inc),cptim) + call materialpoint_result(int(inc),cptim) inc_written = int(inc) end if diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 405339b9b..b0cc8be61 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -15,7 +15,7 @@ module discretization_Marc use element use discretization use geometry_plastic_nonlocal - use results + use result implicit none(type,external) private @@ -110,7 +110,7 @@ subroutine discretization_Marc_init call geometry_plastic_nonlocal_setIParea(norm2(unscaledNormals,1)) call geometry_plastic_nonlocal_setIPareaNormal(unscaledNormals/spread(norm2(unscaledNormals,1),1,3)) call geometry_plastic_nonlocal_setIPneighborhood(IPneighborhood(elem)) - call geometry_plastic_nonlocal_results + call geometry_plastic_nonlocal_result end subroutine discretization_Marc_init @@ -167,23 +167,23 @@ subroutine writeGeometry(elem, & coordinates_points - call results_openJobFile - call results_closeGroup(results_addGroup('geometry')) + call result_openJobFile + call result_closeGroup(result_addGroup('geometry')) - call results_writeDataset(connectivity_elem,'geometry','T_e',& - 'connectivity of the elements','-') + call result_writeDataset(connectivity_elem,'geometry','T_e',& + 'connectivity of the elements','-') - call results_writeDataset(connectivity_cell_reshaped,'geometry','T_c', & - 'connectivity of the cells','-') - call results_addAttribute('VTK_TYPE',elem%vtkType,'geometry/T_c') + call result_writeDataset(connectivity_cell_reshaped,'geometry','T_c', & + 'connectivity of the cells','-') + call result_addAttribute('VTK_TYPE',elem%vtkType,'geometry/T_c') - call results_writeDataset(coordinates_nodes,'geometry','x_n', & - 'initial coordinates of the nodes','m') + call result_writeDataset(coordinates_nodes,'geometry','x_n', & + 'initial coordinates of the nodes','m') - call results_writeDataset(coordinates_points,'geometry','x_p', & - 'initial coordinates of the materialpoints (cell centers)','m') + call result_writeDataset(coordinates_points,'geometry','x_p', & + 'initial coordinates of the materialpoints (cell centers)','m') - call results_closeJobFile + call result_closeJobFile end subroutine writeGeometry @@ -216,11 +216,11 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt) mapElemSet !< list of elements in elementSet - call results_openJobFile - call results_writeDataset_str(IO_read(trim(getSolverJobName())//InputFileExtension), 'setup', & + call result_openJobFile + call result_writeDataset_str(IO_read(trim(getSolverJobName())//InputFileExtension), 'setup', & trim(getSolverJobName())//InputFileExtension, & 'MSC.Marc input deck') - call results_closeJobFile + call result_closeJobFile inputFile = IO_readlines(trim(getSolverJobName())//InputFileExtension) call inputRead_fileFormat(fileFormatVersion, & diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90 index 2b910217d..847834003 100644 --- a/src/Marc/materialpoint_Marc.f90 +++ b/src/Marc/materialpoint_Marc.f90 @@ -10,7 +10,7 @@ module materialpoint_Marc use YAML_types use YAML_parse use HDF5_utilities - use results + use result use config use math use rotations @@ -65,7 +65,7 @@ module materialpoint_Marc public :: & materialpoint_general, & materialpoint_initAll, & - materialpoint_results + materialpoint_result contains @@ -81,7 +81,7 @@ subroutine materialpoint_initAll() call YAML_types_init() call YAML_parse_init() call HDF5_utilities_init() - call results_init(.false.) + call result_init(.false.) call config_init() call math_init() call rotations_init() @@ -266,19 +266,19 @@ end subroutine materialpoint_forward !-------------------------------------------------------------------------------------------------- !> @brief Trigger writing of results. !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_results(inc,time) +subroutine materialpoint_result(inc,time) integer, intent(in) :: inc real(pReal), intent(in) :: time - call results_openJobFile - call results_addIncrement(inc,time) - call phase_results - call homogenization_results - call discretization_results - call results_finalizeIncrement - call results_closeJobFile + call result_openJobFile + call result_addIncrement(inc,time) + call phase_result + call homogenization_result + call discretization_result + call result_finalizeIncrement + call result_closeJobFile -end subroutine materialpoint_results +end subroutine materialpoint_result end module materialpoint_Marc diff --git a/src/config.f90 b/src/config.f90 index 7ab9c76f8..bb7386414 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -6,7 +6,7 @@ module config use IO use YAML_parse use YAML_types - use results + use result use parallelization implicit none(type,external) @@ -52,9 +52,9 @@ subroutine parse_material() if (worldrank == 0) then print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT) fileContent = IO_read('material.yaml') - call results_openJobFile(parallel=.false.) - call results_writeDataset_str(fileContent,'setup','material.yaml','main configuration') - call results_closeJobFile + call result_openJobFile(parallel=.false.) + call result_writeDataset_str(fileContent,'setup','material.yaml','main configuration') + call result_closeJobFile end if call parallelization_bcast_str(fileContent) @@ -81,9 +81,9 @@ subroutine parse_numerics() print'(1x,a)', 'reading numerics.yaml'; flush(IO_STDOUT) fileContent = IO_read('numerics.yaml') if (len(fileContent) > 0) then - call results_openJobFile(parallel=.false.) - call results_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration') - call results_closeJobFile + call result_openJobFile(parallel=.false.) + call result_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration') + call result_closeJobFile end if end if call parallelization_bcast_str(fileContent) @@ -113,9 +113,9 @@ subroutine parse_debug() print'(1x,a)', 'reading debug.yaml'; flush(IO_STDOUT) fileContent = IO_read('debug.yaml') if (len(fileContent) > 0) then - call results_openJobFile(parallel=.false.) - call results_writeDataset_str(fileContent,'setup','debug.yaml','debug configuration') - call results_closeJobFile + call result_openJobFile(parallel=.false.) + call result_writeDataset_str(fileContent,'setup','debug.yaml','debug configuration') + call result_closeJobFile end if end if call parallelization_bcast_str(fileContent) diff --git a/src/discretization.f90 b/src/discretization.f90 index 2c605b422..ad08c5bff 100644 --- a/src/discretization.f90 +++ b/src/discretization.f90 @@ -5,7 +5,7 @@ module discretization use prec - use results + use result implicit none(type,external) private @@ -29,7 +29,7 @@ module discretization public :: & discretization_init, & - discretization_results, & + discretization_result, & discretization_setIPcoords, & discretization_setNodeCoords @@ -76,21 +76,21 @@ end subroutine discretization_init !-------------------------------------------------------------------------------------------------- !> @brief write the displacements !-------------------------------------------------------------------------------------------------- -subroutine discretization_results +subroutine discretization_result() real(pReal), dimension(:,:), allocatable :: u - call results_closeGroup(results_addGroup('current/geometry')) + call result_closeGroup(result_addGroup('current/geometry')) u = discretization_NodeCoords (:,:discretization_sharedNodesBegin) & - discretization_NodeCoords0(:,:discretization_sharedNodesBegin) - call results_writeDataset(u,'current/geometry','u_n','displacements of the nodes','m') + call result_writeDataset(u,'current/geometry','u_n','displacements of the nodes','m') u = discretization_IPcoords & - discretization_IPcoords0 - call results_writeDataset(u,'current/geometry','u_p','displacements of the materialpoints (cell centers)','m') + call result_writeDataset(u,'current/geometry','u_p','displacements of the materialpoints (cell centers)','m') -end subroutine discretization_results +end subroutine discretization_result !-------------------------------------------------------------------------------------------------- diff --git a/src/geometry_plastic_nonlocal.f90 b/src/geometry_plastic_nonlocal.f90 index f0da5539b..a0ec3d644 100644 --- a/src/geometry_plastic_nonlocal.f90 +++ b/src/geometry_plastic_nonlocal.f90 @@ -7,7 +7,7 @@ !-------------------------------------------------------------------------------------------------- module geometry_plastic_nonlocal use prec - use results + use result implicit none(type,external) public @@ -110,39 +110,39 @@ end subroutine geometry_plastic_nonlocal_disable !--------------------------------------------------------------------------------------------------- !> @brief Write geometry data to results file !--------------------------------------------------------------------------------------------------- -subroutine geometry_plastic_nonlocal_results +subroutine geometry_plastic_nonlocal_result() integer, dimension(:), allocatable :: shp - call results_openJobFile + call result_openJobFile writeVolume: block real(pReal), dimension(:), allocatable :: temp shp = shape(geometry_plastic_nonlocal_IPvolume0) temp = reshape(geometry_plastic_nonlocal_IPvolume0,[shp(1)*shp(2)]) - call results_writeDataset(temp,'geometry','v_0',& - 'initial cell volume','m³') + call result_writeDataset(temp,'geometry','v_0',& + 'initial cell volume','m³') end block writeVolume writeAreas: block real(pReal), dimension(:,:), allocatable :: temp shp = shape(geometry_plastic_nonlocal_IParea0) temp = reshape(geometry_plastic_nonlocal_IParea0,[shp(1),shp(2)*shp(3)]) - call results_writeDataset(temp,'geometry','a_0',& - 'initial cell face area','m²') + call result_writeDataset(temp,'geometry','a_0',& + 'initial cell face area','m²') end block writeAreas writeNormals: block real(pReal), dimension(:,:,:), allocatable :: temp shp = shape(geometry_plastic_nonlocal_IPareaNormal0) temp = reshape(geometry_plastic_nonlocal_IPareaNormal0,[shp(1),shp(2),shp(3)*shp(4)]) - call results_writeDataset(temp,'geometry','n_0',& - 'initial cell face normals','-',transposed=.false.) + call result_writeDataset(temp,'geometry','n_0',& + 'initial cell face normals','-',transposed=.false.) end block writeNormals - call results_closeJobFile + call result_closeJobFile -end subroutine geometry_plastic_nonlocal_results +end subroutine geometry_plastic_nonlocal_result end module geometry_plastic_nonlocal diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index 2e21dec8d..1af6b474a 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -15,7 +15,7 @@ program DAMASK_grid use prec use parallelization - use signals + use signal use CLI use IO use config @@ -28,7 +28,7 @@ program DAMASK_grid use grid_mechanical_FEM use grid_damage_spectral use grid_thermal_spectral - use results + use result #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY) implicit none(type,external) @@ -73,7 +73,7 @@ program DAMASK_grid guess, & !< guess along former trajectory stagIterate, & cutBack = .false.,& - signal + sig integer :: & i, j, m, field, & errorID = 0, & @@ -145,9 +145,9 @@ program DAMASK_grid fileContent = IO_read(CLI_loadFile) fname = CLI_loadFile if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) - call results_openJobFile(parallel=.false.) - call results_writeDataset_str(fileContent,'setup',fname,'load case definition (grid solver)') - call results_closeJobFile + call result_openJobFile(parallel=.false.) + call result_writeDataset_str(fileContent,'setup',fname,'load case definition (grid solver)') + call result_closeJobFile end if call parallelization_bcast_str(fileContent) @@ -343,7 +343,7 @@ program DAMASK_grid writeUndeformed: if (CLI_restartInc < 1) then print'(/,1x,a)', '... writing initial configuration to file .................................' flush(IO_STDOUT) - call materialpoint_results(0,0.0_pReal) + call materialpoint_result(0,0.0_pReal) end if writeUndeformed loadCaseLooping: do l = 1, size(loadCases) @@ -465,17 +465,17 @@ program DAMASK_grid print'(/,1x,a,i0,a)', 'increment ', totalIncsCounter, ' NOT converged' end if; flush(IO_STDOUT) - call MPI_Allreduce(signals_SIGUSR1,signal,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) + call MPI_Allreduce(signal_SIGUSR1,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' - if (mod(inc,loadCases(l)%f_out) == 0 .or. signal) then + if (mod(inc,loadCases(l)%f_out) == 0 .or. sig) then print'(/,1x,a)', '... writing results to file ...............................................' flush(IO_STDOUT) - call materialpoint_results(totalIncsCounter,t) + call materialpoint_result(totalIncsCounter,t) end if - if (signal) call signals_setSIGUSR1(.false.) - call MPI_Allreduce(signals_SIGUSR2,signal,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) + if (sig) call signal_setSIGUSR1(.false.) + call MPI_Allreduce(signal_SIGUSR2,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' - if (mod(inc,loadCases(l)%f_restart) == 0 .or. signal) then + if (mod(inc,loadCases(l)%f_restart) == 0 .or. sig) then do field = 1, nActiveFields select case (ID(field)) case(FIELD_MECH_ID) @@ -488,10 +488,10 @@ program DAMASK_grid end do call materialpoint_restartWrite end if - if (signal) call signals_setSIGUSR2(.false.) - call MPI_Allreduce(signals_SIGINT,signal,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) + if (sig) call signal_setSIGUSR2(.false.) + call MPI_Allreduce(signal_SIGINT,sig,1_MPI_INTEGER_KIND,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,err_MPI) if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error' - if (signal) exit loadCaseLooping + if (sig) exit loadCaseLooping end if skipping end do incLooping diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 999b8f460..a4db30f6a 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -19,7 +19,7 @@ module discretization_grid use CLI use IO use config - use results + use result use discretization use geometry_plastic_nonlocal @@ -89,9 +89,9 @@ subroutine discretization_grid_init(restart) call IO_error(180,ext_msg='mismatch in # of material IDs and cells') fname = CLI_geomFile if (scan(fname,'/') /= 0) fname = fname(scan(fname,'/',.true.)+1:) - call results_openJobFile(parallel=.false.) - call results_writeDataset_str(fileContent,'setup',fname,'geometry definition (grid solver)') - call results_closeJobFile + call result_openJobFile(parallel=.false.) + call result_writeDataset_str(fileContent,'setup',fname,'geometry definition (grid solver)') + call result_closeJobFile else allocate(materialAt_global(0)) ! needed for IntelMPI end if @@ -147,12 +147,12 @@ subroutine discretization_grid_init(restart) !-------------------------------------------------------------------------------------------------- ! store geometry information for post processing if (.not. restart) then - call results_openJobFile - call results_closeGroup(results_addGroup('geometry')) - call results_addAttribute('cells', cells, '/geometry') - call results_addAttribute('size', geomSize,'/geometry') - call results_addAttribute('origin',origin, '/geometry') - call results_closeJobFile + call result_openJobFile + call result_closeGroup(result_addGroup('geometry')) + call result_addAttribute('cells', cells, '/geometry') + call result_addAttribute('size', geomSize,'/geometry') + call result_addAttribute('origin',origin, '/geometry') + call result_closeJobFile end if !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 2c89a1859..9f9b92bec 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -15,7 +15,7 @@ module homogenization use discretization use HDF5 use HDF5_utilities - use results + use result use lattice implicit none(type,external) @@ -101,20 +101,20 @@ module homogenization ce !< cell end subroutine mechanical_homogenize - module subroutine mechanical_results(group_base,ho) + module subroutine mechanical_result(group_base,ho) character(len=*), intent(in) :: group_base integer, intent(in) :: ho - end subroutine mechanical_results + end subroutine mechanical_result - module subroutine damage_results(ho,group) + module subroutine damage_result(ho,group) integer, intent(in) :: ho character(len=*), intent(in) :: group - end subroutine damage_results + end subroutine damage_result - module subroutine thermal_results(ho,group) + module subroutine thermal_result(ho,group) integer, intent(in) :: ho character(len=*), intent(in) :: group - end subroutine thermal_results + end subroutine thermal_result module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy) real(pReal), intent(in) :: & @@ -194,7 +194,7 @@ module homogenization homogenization_f_phi, & homogenization_set_phi, & homogenization_forward, & - homogenization_results, & + homogenization_result, & homogenization_restartRead, & homogenization_restartWrite @@ -349,35 +349,35 @@ end subroutine homogenization_mechanical_response2 !-------------------------------------------------------------------------------------------------- !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- -subroutine homogenization_results +subroutine homogenization_result integer :: ho character(len=:), allocatable :: group_base,group - call results_closeGroup(results_addGroup('current/homogenization/')) + call result_closeGroup(result_addGroup('current/homogenization/')) do ho=1,size(material_name_homogenization) group_base = 'current/homogenization/'//trim(material_name_homogenization(ho)) - call results_closeGroup(results_addGroup(group_base)) + call result_closeGroup(result_addGroup(group_base)) - call mechanical_results(group_base,ho) + call mechanical_result(group_base,ho) if (damage_active(ho)) then group = trim(group_base)//'/damage' - call results_closeGroup(results_addGroup(group)) - call damage_results(ho,group) + call result_closeGroup(result_addGroup(group)) + call damage_result(ho,group) end if if (thermal_active(ho)) then group = trim(group_base)//'/thermal' - call results_closeGroup(results_addGroup(group)) - call thermal_results(ho,group) + call result_closeGroup(result_addGroup(group)) + call thermal_result(ho,group) end if end do -end subroutine homogenization_results +end subroutine homogenization_result !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90 index 40c85cd2b..ffd07f1ef 100644 --- a/src/homogenization_damage.f90 +++ b/src/homogenization_damage.f90 @@ -172,7 +172,7 @@ end subroutine homogenization_set_phi !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- -module subroutine damage_results(ho,group) +module subroutine damage_result(ho,group) integer, intent(in) :: ho character(len=*), intent(in) :: group @@ -184,12 +184,12 @@ module subroutine damage_results(ho,group) outputsLoop: do o = 1,size(prm%output) select case(prm%output(o)) case ('phi') - call results_writeDataset(current(ho)%phi,group,prm%output(o),& - 'damage indicator','-') + call result_writeDataset(current(ho)%phi,group,prm%output(o),& + 'damage indicator','-') end select end do outputsLoop end associate -end subroutine damage_results +end subroutine damage_result end submodule damage diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90 index 5c93da7be..eb5ec75a4 100644 --- a/src/homogenization_mechanical.f90 +++ b/src/homogenization_mechanical.f90 @@ -43,10 +43,10 @@ submodule(homogenization) mechanical end function RGC_updateState - module subroutine RGC_results(ho,group) + module subroutine RGC_result(ho,group) integer, intent(in) :: ho !< homogenization type character(len=*), intent(in) :: group !< group name in HDF5 file - end subroutine RGC_results + end subroutine RGC_result end interface @@ -183,7 +183,7 @@ end function mechanical_updateState !-------------------------------------------------------------------------------------------------- !> @brief Write results to file. !-------------------------------------------------------------------------------------------------- -module subroutine mechanical_results(group_base,ho) +module subroutine mechanical_result(group_base,ho) character(len=*), intent(in) :: group_base integer, intent(in) :: ho @@ -193,12 +193,12 @@ module subroutine mechanical_results(group_base,ho) group = trim(group_base)//'/mechanical' - call results_closeGroup(results_addGroup(group)) + call result_closeGroup(result_addGroup(group)) select case(mechanical_type(ho)) case(MECHANICAL_RGC_ID) - call RGC_results(ho,group) + call RGC_result(ho,group) end select @@ -206,15 +206,15 @@ module subroutine mechanical_results(group_base,ho) select case (output_mechanical(ho)%label(ou)) case('F') - call results_writeDataset(reshape(homogenization_F,[3,3,discretization_nCells]),group,'F', & - 'deformation gradient','1') + call result_writeDataset(reshape(homogenization_F,[3,3,discretization_nCells]),group,'F', & + 'deformation gradient','1') case('P') - call results_writeDataset(reshape(homogenization_P,[3,3,discretization_nCells]),group,'P', & - 'first Piola-Kirchhoff stress','Pa') + call result_writeDataset(reshape(homogenization_P,[3,3,discretization_nCells]),group,'P', & + 'first Piola-Kirchhoff stress','Pa') end select end do -end subroutine mechanical_results +end subroutine mechanical_result !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index bc2fd71cf..8d56a26f2 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -705,7 +705,7 @@ end function RGC_updateState !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- -module subroutine RGC_results(ho,group) +module subroutine RGC_result(ho,group) integer, intent(in) :: ho character(len=*), intent(in) :: group @@ -713,25 +713,25 @@ module subroutine RGC_results(ho,group) integer :: o associate(stt => state(ho), dst => dependentState(ho), prm => param(ho)) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('M') - call results_writeDataset(dst%mismatch,group,trim(prm%output(o)), & - 'average mismatch tensor','1') - case('Delta_V') - call results_writeDataset(dst%volumeDiscrepancy,group,trim(prm%output(o)), & - 'volume discrepancy','m³') - case('max_dot_a') - call results_writeDataset(dst%relaxationrate_max,group,trim(prm%output(o)), & - 'maximum relaxation rate','m/s') - case('avg_dot_a') - call results_writeDataset(dst%relaxationrate_avg,group,trim(prm%output(o)), & - 'average relaxation rate','m/s') - end select - end do outputsLoop + outputsLoop: do o = 1,size(prm%output) + select case(trim(prm%output(o))) + case('M') + call result_writeDataset(dst%mismatch,group,trim(prm%output(o)), & + 'average mismatch tensor','1') + case('Delta_V') + call result_writeDataset(dst%volumeDiscrepancy,group,trim(prm%output(o)), & + 'volume discrepancy','m³') + case('max_dot_a') + call result_writeDataset(dst%relaxationrate_max,group,trim(prm%output(o)), & + 'maximum relaxation rate','m/s') + case('avg_dot_a') + call result_writeDataset(dst%relaxationrate_avg,group,trim(prm%output(o)), & + 'average relaxation rate','m/s') + end select + end do outputsLoop end associate -end subroutine RGC_results +end subroutine RGC_result !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 274c392e8..401a7df81 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -189,7 +189,7 @@ end subroutine homogenization_thermal_setField !-------------------------------------------------------------------------------------------------- !> @brief writes results to HDF5 output file !-------------------------------------------------------------------------------------------------- -module subroutine thermal_results(ho,group) +module subroutine thermal_result(ho,group) integer, intent(in) :: ho character(len=*), intent(in) :: group @@ -201,11 +201,11 @@ module subroutine thermal_results(ho,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case('T') - call results_writeDataset(current(ho)%T,group,'T','temperature','K') + call result_writeDataset(current(ho)%T,group,'T','temperature','K') end select end do outputsLoop end associate -end subroutine thermal_results +end subroutine thermal_result end submodule thermal diff --git a/src/material.f90 b/src/material.f90 index d1d9ca43e..991912fdd 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -7,7 +7,7 @@ module material use prec use config - use results + use result use math use IO use rotations @@ -69,10 +69,10 @@ subroutine material_init(restart) if (.not. restart) then - call results_openJobFile - call results_mapping_phase(material_phaseID,material_phaseEntry,material_name_phase) - call results_mapping_homogenization(material_homogenizationID,material_homogenizationEntry,material_name_homogenization) - call results_closeJobFile + call result_openJobFile + call result_mapping_phase(material_phaseID,material_phaseEntry,material_name_phase) + call result_mapping_homogenization(material_homogenizationID,material_homogenizationEntry,material_name_homogenization) + call result_closeJobFile end if end subroutine material_init diff --git a/src/materialpoint.f90 b/src/materialpoint.f90 index 8ce0e15a1..2490734be 100644 --- a/src/materialpoint.f90 +++ b/src/materialpoint.f90 @@ -5,7 +5,7 @@ !-------------------------------------------------------------------------------------------------- module materialpoint use parallelization - use signals + use signal use CLI use prec use IO @@ -13,7 +13,7 @@ module materialpoint use YAML_parse use HDF5 use HDF5_utilities - use results + use result use config use math use rotations @@ -45,7 +45,7 @@ subroutine materialpoint_initAll() call parallelization_init() call CLI_init() ! grid and mesh commandline interface - call signals_init() + call signal_init() call prec_init() call IO_init() #if defined(MESH) @@ -56,7 +56,7 @@ subroutine materialpoint_initAll() call YAML_types_init() call YAML_parse_init() call HDF5_utilities_init() - call results_init(restart=CLI_restartInc>0) + call result_init(restart=CLI_restartInc>0) call config_init() call math_init() call rotations_init() @@ -136,19 +136,19 @@ end subroutine materialpoint_forward !-------------------------------------------------------------------------------------------------- !> @brief Trigger writing of results. !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_results(inc,time) +subroutine materialpoint_result(inc,time) integer, intent(in) :: inc real(pReal), intent(in) :: time - call results_openJobFile() - call results_addIncrement(inc,time) - call phase_results() - call homogenization_results() - call discretization_results() - call results_finalizeIncrement() - call results_closeJobFile() + call result_openJobFile() + call result_addIncrement(inc,time) + call phase_result() + call homogenization_result() + call discretization_result() + call result_finalizeIncrement() + call result_closeJobFile() -end subroutine materialpoint_results +end subroutine materialpoint_result end module materialpoint diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index f10be4d0c..d28d064df 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -239,7 +239,7 @@ program DAMASK_mesh print'(/,1x,a)', '... writing initial configuration to file .................................' flush(IO_STDOUT) - call materialpoint_results(0,0.0_pReal) + call materialpoint_result(0,0.0_pReal) loadCaseLooping: do currentLoadCase = 1, size(loadCases) time0 = time ! load case start time @@ -325,7 +325,7 @@ program DAMASK_mesh if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then ! at output frequency print'(/,1x,a)', '... writing results to file ...............................................' call FEM_mechanical_updateCoords - call materialpoint_results(totalIncsCounter,time) + call materialpoint_result(totalIncsCounter,time) end if diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index abda549b7..192fdc9f9 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -20,7 +20,7 @@ module discretization_mesh use IO use config use discretization - use results + use result use FEM_quadrature use YAML_types use prec @@ -275,16 +275,16 @@ subroutine writeGeometry(coordinates_points,coordinates_nodes) coordinates_nodes, & coordinates_points - call results_openJobFile - call results_closeGroup(results_addGroup('geometry')) + call result_openJobFile + call result_closeGroup(result_addGroup('geometry')) - call results_writeDataset(coordinates_nodes,'geometry','x_n', & - 'initial coordinates of the nodes','m') + call result_writeDataset(coordinates_nodes,'geometry','x_n', & + 'initial coordinates of the nodes','m') - call results_writeDataset(coordinates_points,'geometry','x_p', & - 'initial coordinates of the materialpoints (cell centers)','m') + call result_writeDataset(coordinates_points,'geometry','x_p', & + 'initial coordinates of the materialpoints (cell centers)','m') - call results_closeJobFile + call result_closeJobFile end subroutine writeGeometry diff --git a/src/phase.f90 b/src/phase.f90 index f7088b892..d13fba3e8 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -13,7 +13,7 @@ module phase use IO use config use material - use results + use result use lattice use discretization use parallelization @@ -108,20 +108,20 @@ module phase end subroutine thermal_init - module subroutine mechanical_results(group,ph) + module subroutine mechanical_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph - end subroutine mechanical_results + end subroutine mechanical_result - module subroutine damage_results(group,ph) + module subroutine damage_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph - end subroutine damage_results + end subroutine damage_result - module subroutine thermal_results(group,ph) + module subroutine thermal_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph - end subroutine thermal_results + end subroutine thermal_result module subroutine mechanical_forward() end subroutine mechanical_forward @@ -343,7 +343,7 @@ module phase IO, & config, & material, & - results, & + result, & lattice, & discretization, & HDF5_utilities @@ -358,7 +358,7 @@ module phase phase_K_T, & phase_mu_phi, & phase_mu_T, & - phase_results, & + phase_result, & phase_allocateState, & phase_forward, & phase_restore, & @@ -513,26 +513,26 @@ end subroutine phase_forward !-------------------------------------------------------------------------------------------------- !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- -subroutine phase_results() +subroutine phase_result() integer :: ph character(len=:), allocatable :: group - call results_closeGroup(results_addGroup('/current/phase/')) + call result_closeGroup(result_addGroup('/current/phase/')) do ph = 1, size(material_name_phase) group = '/current/phase/'//trim(material_name_phase(ph))//'/' - call results_closeGroup(results_addGroup(group)) + call result_closeGroup(result_addGroup(group)) - call mechanical_results(group,ph) - call damage_results(group,ph) - call thermal_results(group,ph) + call mechanical_result(group,ph) + call damage_result(group,ph) + call thermal_result(group,ph) end do -end subroutine phase_results +end subroutine phase_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index ad592a846..d90045267 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -56,15 +56,15 @@ submodule(phase) damage end subroutine anisobrittle_dotState - module subroutine anisobrittle_results(phase,group) + module subroutine anisobrittle_result(phase,group) integer, intent(in) :: phase character(len=*), intent(in) :: group - end subroutine anisobrittle_results + end subroutine anisobrittle_result - module subroutine isobrittle_results(phase,group) + module subroutine isobrittle_result(phase,group) integer, intent(in) :: phase character(len=*), intent(in) :: group - end subroutine isobrittle_results + end subroutine isobrittle_result end interface @@ -339,26 +339,26 @@ end subroutine damage_restartRead !---------------------------------------------------------------------------------------------- !< @brief writes damage sources results to HDF5 output file !---------------------------------------------------------------------------------------------- -module subroutine damage_results(group,ph) +module subroutine damage_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph if (phase_damage(ph) /= DAMAGE_UNDEFINED_ID) & - call results_closeGroup(results_addGroup(group//'damage')) + call result_closeGroup(result_addGroup(group//'damage')) sourceType: select case (phase_damage(ph)) case (DAMAGE_ISOBRITTLE_ID) sourceType - call isobrittle_results(ph,group//'damage/') + call isobrittle_result(ph,group//'damage/') case (DAMAGE_ANISOBRITTLE_ID) sourceType - call anisobrittle_results(ph,group//'damage/') + call anisobrittle_result(ph,group//'damage/') end select sourceType -end subroutine damage_results +end subroutine damage_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index 072dbcb7f..9c1252567 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -141,9 +141,9 @@ end subroutine anisobrittle_dotState !-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file +!> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine anisobrittle_results(phase,group) +module subroutine anisobrittle_result(phase,group) integer, intent(in) :: phase character(len=*), intent(in) :: group @@ -155,12 +155,12 @@ module subroutine anisobrittle_results(phase,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') - call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') + call result_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') end select end do outputsLoop end associate -end subroutine anisobrittle_results +end subroutine anisobrittle_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 0e00974e3..c27ed36c5 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -124,7 +124,7 @@ end subroutine isobrittle_deltaState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine isobrittle_results(phase,group) +module subroutine isobrittle_result(phase,group) integer, intent(in) :: phase character(len=*), intent(in) :: group @@ -137,12 +137,12 @@ module subroutine isobrittle_results(phase,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') - call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') + call result_writeDataset(stt,group,trim(prm%output(o)),'driving force','-') end select end do outputsLoop end associate -end subroutine isobrittle_results +end subroutine isobrittle_result end submodule isobrittle diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90 index 9229abe23..d2473c5bf 100644 --- a/src/phase_mechanical.f90 +++ b/src/phase_mechanical.f90 @@ -129,35 +129,35 @@ submodule(phase) mechanical end subroutine plastic_LpAndItsTangents - module subroutine plastic_isotropic_results(ph,group) + module subroutine plastic_isotropic_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_isotropic_results + end subroutine plastic_isotropic_result - module subroutine plastic_phenopowerlaw_results(ph,group) + module subroutine plastic_phenopowerlaw_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_phenopowerlaw_results + end subroutine plastic_phenopowerlaw_result - module subroutine plastic_kinehardening_results(ph,group) + module subroutine plastic_kinehardening_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_kinehardening_results + end subroutine plastic_kinehardening_result - module subroutine plastic_dislotwin_results(ph,group) + module subroutine plastic_dislotwin_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_dislotwin_results + end subroutine plastic_dislotwin_result - module subroutine plastic_dislotungsten_results(ph,group) + module subroutine plastic_dislotungsten_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_dislotungsten_results + end subroutine plastic_dislotungsten_result - module subroutine plastic_nonlocal_results(ph,group) + module subroutine plastic_nonlocal_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group - end subroutine plastic_nonlocal_results + end subroutine plastic_nonlocal_result module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC) real(pReal), dimension(6,6) :: homogenizedC @@ -318,7 +318,7 @@ module subroutine mechanical_init(phases) end subroutine mechanical_init -module subroutine mechanical_results(group,ph) +module subroutine mechanical_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph @@ -329,27 +329,27 @@ module subroutine mechanical_results(group,ph) select case(phase_plasticity(ph)) case(PLASTIC_ISOTROPIC_ID) - call plastic_isotropic_results(ph,group//'mechanical/') + call plastic_isotropic_result(ph,group//'mechanical/') case(PLASTIC_PHENOPOWERLAW_ID) - call plastic_phenopowerlaw_results(ph,group//'mechanical/') + call plastic_phenopowerlaw_result(ph,group//'mechanical/') case(PLASTIC_KINEHARDENING_ID) - call plastic_kinehardening_results(ph,group//'mechanical/') + call plastic_kinehardening_result(ph,group//'mechanical/') case(PLASTIC_DISLOTWIN_ID) - call plastic_dislotwin_results(ph,group//'mechanical/') + call plastic_dislotwin_result(ph,group//'mechanical/') case(PLASTIC_DISLOTUNGSTEN_ID) - call plastic_dislotungsten_results(ph,group//'mechanical/') + call plastic_dislotungsten_result(ph,group//'mechanical/') case(PLASTIC_NONLOCAL_ID) - call plastic_nonlocal_results(ph,group//'mechanical/') + call plastic_nonlocal_result(ph,group//'mechanical/') end select -end subroutine mechanical_results +end subroutine mechanical_result !-------------------------------------------------------------------------------------------------- @@ -897,41 +897,41 @@ subroutine results(group,ph) integer :: ou - call results_closeGroup(results_addGroup(group//'/mechanical')) + call result_closeGroup(result_addGroup(group//'/mechanical')) do ou = 1, size(output_mechanical(ph)%label) select case (output_mechanical(ph)%label(ou)) case('F') - call results_writeDataset(phase_mechanical_F(ph)%data,group//'/mechanical/','F',& + call result_writeDataset(phase_mechanical_F(ph)%data,group//'/mechanical/','F',& 'deformation gradient','1') case('F_e') - call results_writeDataset(phase_mechanical_Fe(ph)%data,group//'/mechanical/','F_e',& + call result_writeDataset(phase_mechanical_Fe(ph)%data,group//'/mechanical/','F_e',& 'elastic deformation gradient','1') case('F_p') - call results_writeDataset(phase_mechanical_Fp(ph)%data,group//'/mechanical/','F_p', & + call result_writeDataset(phase_mechanical_Fp(ph)%data,group//'/mechanical/','F_p', & 'plastic deformation gradient','1') case('F_i') - call results_writeDataset(phase_mechanical_Fi(ph)%data,group//'/mechanical/','F_i', & + call result_writeDataset(phase_mechanical_Fi(ph)%data,group//'/mechanical/','F_i', & 'inelastic deformation gradient','1') case('L_p') - call results_writeDataset(phase_mechanical_Lp(ph)%data,group//'/mechanical/','L_p', & + call result_writeDataset(phase_mechanical_Lp(ph)%data,group//'/mechanical/','L_p', & 'plastic velocity gradient','1/s') case('L_i') - call results_writeDataset(phase_mechanical_Li(ph)%data,group//'/mechanical/','L_i', & + call result_writeDataset(phase_mechanical_Li(ph)%data,group//'/mechanical/','L_i', & 'inelastic velocity gradient','1/s') case('P') - call results_writeDataset(phase_mechanical_P(ph)%data,group//'/mechanical/','P', & + call result_writeDataset(phase_mechanical_P(ph)%data,group//'/mechanical/','P', & 'first Piola-Kirchhoff stress','Pa') case('S') - call results_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', & + call result_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', & 'second Piola-Kirchhoff stress','Pa') case('O') - call results_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical','O', & + call result_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical','O', & 'crystal orientation as quaternion q_0 (q_1 q_2 q_3)','1') - call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/O') + call result_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/O') if (any(phase_lattice(ph) == ['hP', 'tI'])) & - call results_addAttribute('c/a',phase_cOverA(ph),group//'/mechanical/O') + call result_addAttribute('c/a',phase_cOverA(ph),group//'/mechanical/O') end select end do diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index c363b32d5..7eb6af8a3 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -403,7 +403,7 @@ end subroutine dislotungsten_dependentState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotungsten_results(ph,group) +module subroutine plastic_dislotungsten_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group @@ -418,27 +418,27 @@ module subroutine plastic_dislotungsten_results(ph,group) select case(trim(prm%output(ou))) case('rho_mob') - call results_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & - 'mobile dislocation density','1/m²',prm%systems_sl) + call result_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & + 'mobile dislocation density','1/m²',prm%systems_sl) case('rho_dip') - call results_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & - 'dislocation dipole density','1/m²',prm%systems_sl) + call result_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & + 'dislocation dipole density','1/m²',prm%systems_sl) case('gamma_sl') - call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & - 'plastic shear','1',prm%systems_sl) + call result_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('Lambda_sl') - call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & - 'mean free path for slip','m',prm%systems_sl) + call result_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & + 'mean free path for slip','m',prm%systems_sl) case('tau_pass') - call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & - 'threshold stress for slip','Pa',prm%systems_sl) + call result_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'threshold stress for slip','Pa',prm%systems_sl) end select end do end associate -end subroutine plastic_dislotungsten_results +end subroutine plastic_dislotungsten_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index ab3aa65e0..f677c81b5 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -768,7 +768,7 @@ end subroutine dislotwin_dependentState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_dislotwin_results(ph,group) +module subroutine plastic_dislotwin_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group @@ -783,30 +783,30 @@ module subroutine plastic_dislotwin_results(ph,group) select case(trim(prm%output(ou))) case('rho_mob') - call results_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & - 'mobile dislocation density','1/m²',prm%systems_sl) + call result_writeDataset(stt%rho_mob,group,trim(prm%output(ou)), & + 'mobile dislocation density','1/m²',prm%systems_sl) case('rho_dip') - call results_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & - 'dislocation dipole density','1/m²',prm%systems_sl) + call result_writeDataset(stt%rho_dip,group,trim(prm%output(ou)), & + 'dislocation dipole density','1/m²',prm%systems_sl) case('gamma_sl') - call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & - 'plastic shear','1',prm%systems_sl) + call result_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('Lambda_sl') - call results_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & - 'mean free path for slip','m',prm%systems_sl) + call result_writeDataset(dst%Lambda_sl,group,trim(prm%output(ou)), & + 'mean free path for slip','m',prm%systems_sl) case('tau_pass') - call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & - 'passing stress for slip','Pa',prm%systems_sl) + call result_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'passing stress for slip','Pa',prm%systems_sl) case('f_tw') - call results_writeDataset(stt%f_tw,group,trim(prm%output(ou)), & - 'twinned volume fraction','m³/m³',prm%systems_tw) + call result_writeDataset(stt%f_tw,group,trim(prm%output(ou)), & + 'twinned volume fraction','m³/m³',prm%systems_tw) case('Lambda_tw') - call results_writeDataset(dst%Lambda_tw,group,trim(prm%output(ou)), & - 'mean free path for twinning','m',prm%systems_tw) + call result_writeDataset(dst%Lambda_tw,group,trim(prm%output(ou)), & + 'mean free path for twinning','m',prm%systems_tw) case('f_tr') - if (prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(ou)), & + if (prm%sum_N_tr>0) call result_writeDataset(stt%f_tr,group,trim(prm%output(ou)), & 'martensite volume fraction','m³/m³') end select @@ -815,7 +815,7 @@ module subroutine plastic_dislotwin_results(ph,group) end associate -end subroutine plastic_dislotwin_results +end subroutine plastic_dislotwin_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index c897c6c6d..c6d1c074b 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -285,7 +285,7 @@ end function isotropic_dotState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_isotropic_results(ph,group) +module subroutine plastic_isotropic_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group @@ -296,13 +296,13 @@ module subroutine plastic_isotropic_results(ph,group) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('xi') - call results_writeDataset(stt%xi,group,trim(prm%output(o)), & - 'resistance against plastic flow','Pa') + call result_writeDataset(stt%xi,group,trim(prm%output(o)), & + 'resistance against plastic flow','Pa') end select end do outputsLoop end associate -end subroutine plastic_isotropic_results +end subroutine plastic_isotropic_result end submodule isotropic diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 692501f42..b89a198d7 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -362,7 +362,7 @@ end subroutine plastic_kinehardening_deltaState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_kinehardening_results(ph,group) +module subroutine plastic_kinehardening_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group @@ -377,30 +377,30 @@ module subroutine plastic_kinehardening_results(ph,group) select case(trim(prm%output(ou))) case ('xi') - call results_writeDataset(stt%xi,group,trim(prm%output(ou)), & - 'resistance against plastic slip','Pa',prm%systems_sl) + call result_writeDataset(stt%xi,group,trim(prm%output(ou)), & + 'resistance against plastic slip','Pa',prm%systems_sl) case ('chi') - call results_writeDataset(stt%chi,group,trim(prm%output(ou)), & - 'back stress','Pa',prm%systems_sl) + call result_writeDataset(stt%chi,group,trim(prm%output(ou)), & + 'back stress','Pa',prm%systems_sl) case ('sgn(gamma)') - call results_writeDataset(int(stt%sgn_gamma),group,trim(prm%output(ou)), & - 'sense of shear','1',prm%systems_sl) + call result_writeDataset(int(stt%sgn_gamma),group,trim(prm%output(ou)), & + 'sense of shear','1',prm%systems_sl) case ('chi_0') - call results_writeDataset(stt%chi_0,group,trim(prm%output(ou)), & - 'back stress at last switch of stress sense','Pa',prm%systems_sl) + call result_writeDataset(stt%chi_0,group,trim(prm%output(ou)), & + 'back stress at last switch of stress sense','Pa',prm%systems_sl) case ('gamma_0') - call results_writeDataset(stt%gamma_0,group,trim(prm%output(ou)), & - 'plastic shear at last switch of stress sense','1',prm%systems_sl) + call result_writeDataset(stt%gamma_0,group,trim(prm%output(ou)), & + 'plastic shear at last switch of stress sense','1',prm%systems_sl) case ('gamma') - call results_writeDataset(stt%gamma,group,trim(prm%output(ou)), & - 'plastic shear','1',prm%systems_sl) + call result_writeDataset(stt%gamma,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) end select end do end associate -end subroutine plastic_kinehardening_results +end subroutine plastic_kinehardening_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index 2570014fb..790067b6d 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -1479,7 +1479,7 @@ end subroutine plastic_nonlocal_updateCompatibility !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_results(ph,group) +module subroutine plastic_nonlocal_result(ph,group) integer, intent(in) :: ph character(len=*),intent(in) :: group @@ -1493,63 +1493,63 @@ module subroutine plastic_nonlocal_results(ph,group) select case(trim(prm%output(ou))) case('rho_u_ed_pos') - call results_writeDataset(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), & - 'positive mobile edge density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_mob_edg_pos,group,trim(prm%output(ou)), & + 'positive mobile edge density','1/m²', prm%systems_sl) case('rho_b_ed_pos') - call results_writeDataset(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), & - 'positive immobile edge density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_imm_edg_pos,group,trim(prm%output(ou)), & + 'positive immobile edge density','1/m²', prm%systems_sl) case('rho_u_ed_neg') - call results_writeDataset(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), & - 'negative mobile edge density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_mob_edg_neg,group,trim(prm%output(ou)), & + 'negative mobile edge density','1/m²', prm%systems_sl) case('rho_b_ed_neg') - call results_writeDataset(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), & - 'negative immobile edge density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_imm_edg_neg,group,trim(prm%output(ou)), & + 'negative immobile edge density','1/m²', prm%systems_sl) case('rho_d_ed') - call results_writeDataset(stt%rho_dip_edg,group,trim(prm%output(ou)), & - 'edge dipole density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_dip_edg,group,trim(prm%output(ou)), & + 'edge dipole density','1/m²', prm%systems_sl) case('rho_u_sc_pos') - call results_writeDataset(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), & - 'positive mobile screw density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_mob_scr_pos,group,trim(prm%output(ou)), & + 'positive mobile screw density','1/m²', prm%systems_sl) case('rho_b_sc_pos') - call results_writeDataset(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), & - 'positive immobile screw density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_imm_scr_pos,group,trim(prm%output(ou)), & + 'positive immobile screw density','1/m²', prm%systems_sl) case('rho_u_sc_neg') - call results_writeDataset(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), & - 'negative mobile screw density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_mob_scr_neg,group,trim(prm%output(ou)), & + 'negative mobile screw density','1/m²', prm%systems_sl) case('rho_b_sc_neg') - call results_writeDataset(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), & - 'negative immobile screw density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_sgl_imm_scr_neg,group,trim(prm%output(ou)), & + 'negative immobile screw density','1/m²', prm%systems_sl) case('rho_d_sc') - call results_writeDataset(stt%rho_dip_scr,group,trim(prm%output(ou)), & - 'screw dipole density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_dip_scr,group,trim(prm%output(ou)), & + 'screw dipole density','1/m²', prm%systems_sl) case('rho_f') - call results_writeDataset(stt%rho_forest,group,trim(prm%output(ou)), & - 'forest density','1/m²', prm%systems_sl) + call result_writeDataset(stt%rho_forest,group,trim(prm%output(ou)), & + 'forest density','1/m²', prm%systems_sl) case('v_ed_pos') - call results_writeDataset(stt%v_edg_pos,group,trim(prm%output(ou)), & - 'positive edge velocity','m/s', prm%systems_sl) + call result_writeDataset(stt%v_edg_pos,group,trim(prm%output(ou)), & + 'positive edge velocity','m/s', prm%systems_sl) case('v_ed_neg') - call results_writeDataset(stt%v_edg_neg,group,trim(prm%output(ou)), & - 'negative edge velocity','m/s', prm%systems_sl) + call result_writeDataset(stt%v_edg_neg,group,trim(prm%output(ou)), & + 'negative edge velocity','m/s', prm%systems_sl) case('v_sc_pos') - call results_writeDataset(stt%v_scr_pos,group,trim(prm%output(ou)), & - 'positive srew velocity','m/s', prm%systems_sl) + call result_writeDataset(stt%v_scr_pos,group,trim(prm%output(ou)), & + 'positive srew velocity','m/s', prm%systems_sl) case('v_sc_neg') - call results_writeDataset(stt%v_scr_neg,group,trim(prm%output(ou)), & - 'negative screw velocity','m/s', prm%systems_sl) + call result_writeDataset(stt%v_scr_neg,group,trim(prm%output(ou)), & + 'negative screw velocity','m/s', prm%systems_sl) case('gamma') - call results_writeDataset(stt%gamma,group,trim(prm%output(ou)), & - 'plastic shear','1', prm%systems_sl) + call result_writeDataset(stt%gamma,group,trim(prm%output(ou)), & + 'plastic shear','1', prm%systems_sl) case('tau_pass') - call results_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & - 'passing stress for slip','Pa', prm%systems_sl) + call result_writeDataset(dst%tau_pass,group,trim(prm%output(ou)), & + 'passing stress for slip','Pa', prm%systems_sl) end select end do end associate -end subroutine plastic_nonlocal_results +end subroutine plastic_nonlocal_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 04ddbe13c..5e6ad4a32 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -380,7 +380,7 @@ end function phenopowerlaw_dotState !-------------------------------------------------------------------------------------------------- !> @brief Write results to HDF5 output file. !-------------------------------------------------------------------------------------------------- -module subroutine plastic_phenopowerlaw_results(ph,group) +module subroutine plastic_phenopowerlaw_result(ph,group) integer, intent(in) :: ph character(len=*), intent(in) :: group @@ -395,18 +395,18 @@ module subroutine plastic_phenopowerlaw_results(ph,group) select case(trim(prm%output(ou))) case('xi_sl') - call results_writeDataset(stt%xi_sl,group,trim(prm%output(ou)), & - 'resistance against plastic slip','Pa',prm%systems_sl) + call result_writeDataset(stt%xi_sl,group,trim(prm%output(ou)), & + 'resistance against plastic slip','Pa',prm%systems_sl) case('gamma_sl') - call results_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & - 'plastic shear','1',prm%systems_sl) + call result_writeDataset(stt%gamma_sl,group,trim(prm%output(ou)), & + 'plastic shear','1',prm%systems_sl) case('xi_tw') - call results_writeDataset(stt%xi_tw,group,trim(prm%output(ou)), & - 'resistance against twinning','Pa',prm%systems_tw) + call result_writeDataset(stt%xi_tw,group,trim(prm%output(ou)), & + 'resistance against twinning','Pa',prm%systems_tw) case('gamma_tw') - call results_writeDataset(stt%gamma_tw,group,trim(prm%output(ou)), & - 'twinning shear','1',prm%systems_tw) + call result_writeDataset(stt%gamma_tw,group,trim(prm%output(ou)), & + 'twinning shear','1',prm%systems_tw) end select @@ -414,7 +414,7 @@ module subroutine plastic_phenopowerlaw_results(ph,group) end associate -end subroutine plastic_phenopowerlaw_results +end subroutine plastic_phenopowerlaw_result !-------------------------------------------------------------------------------------------------- diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index fd79d3d46..de7dd9c3b 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -394,9 +394,9 @@ end function thermal_active !---------------------------------------------------------------------------------------------- -!< @brief writes thermal sources results to HDF5 output file +!< @brief Write thermal sources results to HDF5 output file. !---------------------------------------------------------------------------------------------- -module subroutine thermal_results(group,ph) +module subroutine thermal_result(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph @@ -406,20 +406,20 @@ module subroutine thermal_results(group,ph) if (.not. allocated(param(ph)%output)) return - call results_closeGroup(results_addGroup(group//'thermal')) + call result_closeGroup(result_addGroup(group//'thermal')) do ou = 1, size(param(ph)%output) select case(trim(param(ph)%output(ou))) case ('T') - call results_writeDataset(current(ph)%T,group//'thermal','T', 'temperature','K') + call result_writeDataset(current(ph)%T,group//'thermal','T', 'temperature','K') end select end do -end subroutine thermal_results +end subroutine thermal_result end submodule thermal diff --git a/src/results.f90 b/src/result.f90 similarity index 78% rename from src/results.f90 rename to src/result.f90 index 8cdc82c28..6c4f7de82 100644 --- a/src/results.f90 +++ b/src/result.f90 @@ -4,7 +4,7 @@ !> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !-------------------------------------------------------------------------------------------------- -module results +module result use prec use parallelization use IO @@ -28,46 +28,46 @@ module results #endif private - integer(HID_T) :: resultsFile + integer(HID_T) :: resultFile - interface results_writeDataset - module procedure results_writeTensorDataset_real - module procedure results_writeVectorDataset_real - module procedure results_writeScalarDataset_real + interface result_writeDataset + module procedure result_writeTensorDataset_real + module procedure result_writeVectorDataset_real + module procedure result_writeScalarDataset_real - module procedure results_writeTensorDataset_int - module procedure results_writeVectorDataset_int - end interface results_writeDataset + module procedure result_writeTensorDataset_int + module procedure result_writeVectorDataset_int + end interface result_writeDataset - interface results_addAttribute - module procedure results_addAttribute_str - module procedure results_addAttribute_int - module procedure results_addAttribute_real + interface result_addAttribute + module procedure result_addAttribute_str + module procedure result_addAttribute_int + module procedure result_addAttribute_real - module procedure results_addAttribute_str_array - module procedure results_addAttribute_int_array - module procedure results_addAttribute_real_array - end interface results_addAttribute + module procedure result_addAttribute_str_array + module procedure result_addAttribute_int_array + module procedure result_addAttribute_real_array + end interface result_addAttribute public :: & - results_init, & - results_openJobFile, & - results_closeJobFile, & - results_addIncrement, & - results_finalizeIncrement, & - results_addGroup, & - results_openGroup, & - results_closeGroup, & - results_writeDataset, & - results_writeDataset_str, & - results_setLink, & - results_addAttribute, & - results_removeLink, & - results_mapping_phase, & - results_mapping_homogenization + result_init, & + result_openJobFile, & + result_closeJobFile, & + result_addIncrement, & + result_finalizeIncrement, & + result_addGroup, & + result_openGroup, & + result_closeGroup, & + result_writeDataset, & + result_writeDataset_str, & + result_setLink, & + result_addAttribute, & + result_removeLink, & + result_mapping_phase, & + result_mapping_homogenization contains -subroutine results_init(restart) +subroutine result_init(restart) logical, intent(in) :: restart @@ -76,68 +76,68 @@ subroutine results_init(restart) character(len=:), allocatable :: date - print'(/,1x,a)', '<<<+- results init -+>>>'; flush(IO_STDOUT) + print'(/,1x,a)', '<<<+- result init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', 'M. Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017' print'( 1x,a)', 'https://doi.org/10.1007/s40192-017-0084-5' if (.not. restart) then - resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','w') - call results_addAttribute('DADF5_version_major',0) - call results_addAttribute('DADF5_version_minor',14) + resultFile = HDF5_openFile(getSolverJobName()//'.hdf5','w') + call result_addAttribute('DADF5_version_major',0) + call result_addAttribute('DADF5_version_minor',14) call get_command_argument(0,commandLine) - call results_addAttribute('creator',trim(commandLine)//' '//DAMASKVERSION) - call results_addAttribute('created',now()) + call result_addAttribute('creator',trim(commandLine)//' '//DAMASKVERSION) + call result_addAttribute('created',now()) call get_command(commandLine) - call results_addAttribute('call',trim(commandLine)) - call results_closeGroup(results_addGroup('cell_to')) - call results_addAttribute('description','mappings to place data in space','cell_to') - call results_closeGroup(results_addGroup('setup')) - call results_addAttribute('description','input data used to run the simulation','setup') + call result_addAttribute('call',trim(commandLine)) + call result_closeGroup(result_addGroup('cell_to')) + call result_addAttribute('description','mappings to place data in space','cell_to') + call result_closeGroup(result_addGroup('setup')) + call result_addAttribute('description','input data used to run the simulation','setup') else date = now() - call results_openJobFile + call result_openJobFile call get_command(commandLine) - call results_addAttribute('call (restart at '//date//')',trim(commandLine)) - call H5Gmove_f(resultsFile,'setup','tmp',hdferr) - call results_addAttribute('description','input data used to run the simulation up to restart at '//date,'tmp') - call results_closeGroup(results_addGroup('setup')) - call results_addAttribute('description','input data used to run the simulation','setup') - call H5Gmove_f(resultsFile,'tmp','setup/previous',hdferr) + call result_addAttribute('call (restart at '//date//')',trim(commandLine)) + call H5Gmove_f(resultFile,'setup','tmp',hdferr) + call result_addAttribute('description','input data used to run the simulation up to restart at '//date,'tmp') + call result_closeGroup(result_addGroup('setup')) + call result_addAttribute('description','input data used to run the simulation','setup') + call H5Gmove_f(resultFile,'tmp','setup/previous',hdferr) end if - call results_closeJobFile + call result_closeJobFile -end subroutine results_init +end subroutine result_init !-------------------------------------------------------------------------------------------------- -!> @brief opens the results file to append data +!> @brief opens the result file to append data !-------------------------------------------------------------------------------------------------- -subroutine results_openJobFile(parallel) +subroutine result_openJobFile(parallel) logical, intent(in), optional :: parallel - resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','a',parallel) + resultFile = HDF5_openFile(getSolverJobName()//'.hdf5','a',parallel) -end subroutine results_openJobFile +end subroutine result_openJobFile !-------------------------------------------------------------------------------------------------- -!> @brief closes the results file +!> @brief closes the result file !-------------------------------------------------------------------------------------------------- -subroutine results_closeJobFile +subroutine result_closeJobFile - call HDF5_closeFile(resultsFile) + call HDF5_closeFile(resultFile) -end subroutine results_closeJobFile +end subroutine result_closeJobFile !-------------------------------------------------------------------------------------------------- !> @brief creates the group of increment and adds time as attribute to the file !-------------------------------------------------------------------------------------------------- -subroutine results_addIncrement(inc,time) +subroutine result_addIncrement(inc,time) integer, intent(in) :: inc real(pReal), intent(in) :: time @@ -146,97 +146,97 @@ subroutine results_addIncrement(inc,time) write(incChar,'(i10)') inc - call results_closeGroup(results_addGroup(trim('increment_'//trim(adjustl(incChar))))) - call results_setLink(trim('increment_'//trim(adjustl(incChar))),'current') - call results_addAttribute('t/s',time,trim('increment_'//trim(adjustl(incChar)))) + call result_closeGroup(result_addGroup(trim('increment_'//trim(adjustl(incChar))))) + call result_setLink(trim('increment_'//trim(adjustl(incChar))),'current') + call result_addAttribute('t/s',time,trim('increment_'//trim(adjustl(incChar)))) -end subroutine results_addIncrement +end subroutine result_addIncrement !-------------------------------------------------------------------------------------------------- !> @brief finalize increment !> @details remove soft link !-------------------------------------------------------------------------------------------------- -subroutine results_finalizeIncrement +subroutine result_finalizeIncrement - call results_removeLink('current') + call result_removeLink('current') -end subroutine results_finalizeIncrement +end subroutine result_finalizeIncrement !-------------------------------------------------------------------------------------------------- -!> @brief open a group from the results file +!> @brief open a group from the result file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function results_openGroup(groupName) +integer(HID_T) function result_openGroup(groupName) character(len=*), intent(in) :: groupName - results_openGroup = HDF5_openGroup(resultsFile,groupName) + result_openGroup = HDF5_openGroup(resultFile,groupName) -end function results_openGroup +end function result_openGroup !-------------------------------------------------------------------------------------------------- -!> @brief adds a new group to the results file +!> @brief adds a new group to the result file !-------------------------------------------------------------------------------------------------- -integer(HID_T) function results_addGroup(groupName) +integer(HID_T) function result_addGroup(groupName) character(len=*), intent(in) :: groupName - results_addGroup = HDF5_addGroup(resultsFile,groupName) + result_addGroup = HDF5_addGroup(resultFile,groupName) -end function results_addGroup +end function result_addGroup !-------------------------------------------------------------------------------------------------- !> @brief close a group !-------------------------------------------------------------------------------------------------- -subroutine results_closeGroup(group_id) +subroutine result_closeGroup(group_id) integer(HID_T), intent(in) :: group_id call HDF5_closeGroup(group_id) -end subroutine results_closeGroup +end subroutine result_closeGroup !-------------------------------------------------------------------------------------------------- -!> @brief set link to object in results file +!> @brief set link to object in result file !-------------------------------------------------------------------------------------------------- -subroutine results_setLink(path,link) +subroutine result_setLink(path,link) character(len=*), intent(in) :: path, link - call HDF5_setLink(resultsFile,path,link) + call HDF5_setLink(resultFile,path,link) -end subroutine results_setLink +end subroutine result_setLink !-------------------------------------------------------------------------------------------------- -!> @brief Add a string attribute to an object in the results file. +!> @brief Add a string attribute to an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_str(attrLabel,attrValue,path) +subroutine result_addAttribute_str(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel, attrValue character(len=*), intent(in), optional :: path if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_str +end subroutine result_addAttribute_str !-------------------------------------------------------------------------------------------------- -!> @brief Add an integer attribute an object in the results file. +!> @brief Add an integer attribute an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_int(attrLabel,attrValue,path) +subroutine result_addAttribute_int(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel integer, intent(in) :: attrValue @@ -244,18 +244,18 @@ subroutine results_addAttribute_int(attrLabel,attrValue,path) if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_int +end subroutine result_addAttribute_int !-------------------------------------------------------------------------------------------------- -!> @brief Add a real attribute an object in the results file. +!> @brief Add a real attribute an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_real(attrLabel,attrValue,path) +subroutine result_addAttribute_real(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel real(pReal), intent(in) :: attrValue @@ -263,18 +263,18 @@ subroutine results_addAttribute_real(attrLabel,attrValue,path) if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_real +end subroutine result_addAttribute_real !-------------------------------------------------------------------------------------------------- -!> @brief Add a string array attribute an object in the results file. +!> @brief Add a string array attribute an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_str_array(attrLabel,attrValue,path) +subroutine result_addAttribute_str_array(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel character(len=*), intent(in), dimension(:) :: attrValue @@ -282,18 +282,18 @@ subroutine results_addAttribute_str_array(attrLabel,attrValue,path) if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_str_array +end subroutine result_addAttribute_str_array !-------------------------------------------------------------------------------------------------- -!> @brief Add an integer array attribute an object in the results file. +!> @brief Add an integer array attribute an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_int_array(attrLabel,attrValue,path) +subroutine result_addAttribute_int_array(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel integer, intent(in), dimension(:) :: attrValue @@ -301,18 +301,18 @@ subroutine results_addAttribute_int_array(attrLabel,attrValue,path) if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_int_array +end subroutine result_addAttribute_int_array !-------------------------------------------------------------------------------------------------- -!> @brief Add a real array attribute an object in the results file. +!> @brief Add a real array attribute an object in the result file. !-------------------------------------------------------------------------------------------------- -subroutine results_addAttribute_real_array(attrLabel,attrValue,path) +subroutine result_addAttribute_real_array(attrLabel,attrValue,path) character(len=*), intent(in) :: attrLabel real(pReal), intent(in), dimension(:) :: attrValue @@ -320,51 +320,51 @@ subroutine results_addAttribute_real_array(attrLabel,attrValue,path) if (present(path)) then - call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path) + call HDF5_addAttribute(resultFile,attrLabel, attrValue, path) else - call HDF5_addAttribute(resultsFile,attrLabel, attrValue) + call HDF5_addAttribute(resultFile,attrLabel, attrValue) end if -end subroutine results_addAttribute_real_array +end subroutine result_addAttribute_real_array !-------------------------------------------------------------------------------------------------- !> @brief remove link to an object !-------------------------------------------------------------------------------------------------- -subroutine results_removeLink(link) +subroutine result_removeLink(link) character(len=*), intent(in) :: link integer :: hdferr - call H5Ldelete_f(resultsFile,link, hdferr) - if (hdferr < 0) call IO_error(1,ext_msg = 'results_removeLink: H5Ldelete_soft_f ('//trim(link)//')') + call H5Ldelete_f(resultFile,link, hdferr) + if (hdferr < 0) call IO_error(1,ext_msg = 'result_removeLink: H5Ldelete_soft_f ('//trim(link)//')') -end subroutine results_removeLink +end subroutine result_removeLink !-------------------------------------------------------------------------------------------------- !> @brief Store string dataset. !> @details Not collective, must be called by one process at at time. !-------------------------------------------------------------------------------------------------- -subroutine results_writeDataset_str(dataset,group,label,description) +subroutine result_writeDataset_str(dataset,group,label,description) character(len=*), intent(in) :: label,group,description,dataset integer(HID_T) :: groupHandle - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) call HDF5_write_str(dataset,groupHandle,label) call executionStamp(group//'/'//label,description) call HDF5_closeGroup(groupHandle) -end subroutine results_writeDataset_str +end subroutine result_writeDataset_str !-------------------------------------------------------------------------------------------------- !> @brief Store real scalar dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeScalarDataset_real(dataset,group,label,description,SIunit) +subroutine result_writeScalarDataset_real(dataset,group,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit @@ -373,18 +373,18 @@ subroutine results_writeScalarDataset_real(dataset,group,label,description,SIuni integer(HID_T) :: groupHandle - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) call HDF5_closeGroup(groupHandle) -end subroutine results_writeScalarDataset_real +end subroutine result_writeScalarDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store real vector dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeVectorDataset_real(dataset,group,label,description,SIunit,systems) +subroutine result_writeVectorDataset_real(dataset,group,label,description,SIunit,systems) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit @@ -394,21 +394,21 @@ subroutine results_writeVectorDataset_real(dataset,group,label,description,SIuni integer(HID_T) :: groupHandle - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) if (present(systems) .and. HDF5_objectExists(groupHandle,label)) & - call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) + call HDF5_addAttribute(resultFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) -end subroutine results_writeVectorDataset_real +end subroutine result_writeVectorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store real tensor dataset with associated metadata. !> @details Data is transposed to compenstate transposed storage order. !-------------------------------------------------------------------------------------------------- -subroutine results_writeTensorDataset_real(dataset,group,label,description,SIunit,transposed) +subroutine result_writeTensorDataset_real(dataset,group,label,description,SIunit,transposed) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit @@ -427,7 +427,7 @@ subroutine results_writeTensorDataset_real(dataset,group,label,description,SIuni transposed_ = .true. end if - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) if (transposed_) then if (size(dataset,1) /= size(dataset,2)) error stop 'transpose non-symmetric tensor' allocate(dataset_transposed,mold=dataset) @@ -441,13 +441,13 @@ subroutine results_writeTensorDataset_real(dataset,group,label,description,SIuni call executionStamp(group//'/'//label,description,SIunit) call HDF5_closeGroup(groupHandle) -end subroutine results_writeTensorDataset_real +end subroutine result_writeTensorDataset_real !-------------------------------------------------------------------------------------------------- !> @brief Store integer vector dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeVectorDataset_int(dataset,group,label,description,SIunit,systems) +subroutine result_writeVectorDataset_int(dataset,group,label,description,SIunit,systems) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit @@ -457,20 +457,20 @@ subroutine results_writeVectorDataset_int(dataset,group,label,description,SIunit integer(HID_T) :: groupHandle - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) if (present(systems) .and. HDF5_objectExists(groupHandle,label)) & - call HDF5_addAttribute(resultsFile,'systems',systems,group//'/'//label) + call HDF5_addAttribute(resultFile,'systems',systems,group//'/'//label) call HDF5_closeGroup(groupHandle) -end subroutine results_writeVectorDataset_int +end subroutine result_writeVectorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief Store integer tensor dataset with associated metadata. !-------------------------------------------------------------------------------------------------- -subroutine results_writeTensorDataset_int(dataset,group,label,description,SIunit) +subroutine result_writeTensorDataset_int(dataset,group,label,description,SIunit) character(len=*), intent(in) :: label,group,description character(len=*), intent(in), optional :: SIunit @@ -479,19 +479,19 @@ subroutine results_writeTensorDataset_int(dataset,group,label,description,SIunit integer(HID_T) :: groupHandle - groupHandle = results_openGroup(group) + groupHandle = result_openGroup(group) call HDF5_write(dataset,groupHandle,label) call executionStamp(group//'/'//label,description,SIunit) call HDF5_closeGroup(groupHandle) -end subroutine results_writeTensorDataset_int +end subroutine result_writeTensorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- -subroutine results_mapping_phase(ID,entry,label) +subroutine result_mapping_phase(ID,entry,label) integer, dimension(:,:), intent(in) :: ID !< phase ID at (co,ce) integer, dimension(:,:), intent(in) :: entry !< phase entry at (co,ce) @@ -611,7 +611,7 @@ subroutine results_mapping_phase(ID,entry,label) call H5Pset_preserve_f(plist_id, .true., hdferr) if (hdferr < 0) error stop 'HDF5 error' - loc_id = results_openGroup('/cell_to') + loc_id = result_openGroup('/cell_to') call H5Dcreate_f(loc_id, 'phase', dtype_id, filespace_id, dset_id, hdferr) if (hdferr < 0) error stop 'HDF5 error' @@ -641,13 +641,13 @@ subroutine results_mapping_phase(ID,entry,label) call executionStamp('cell_to/phase','cell ID and constituent ID to phase results') -end subroutine results_mapping_phase +end subroutine result_mapping_phase !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- -subroutine results_mapping_homogenization(ID,entry,label) +subroutine result_mapping_homogenization(ID,entry,label) integer, dimension(:), intent(in) :: ID !< homogenization ID at (ce) integer, dimension(:), intent(in) :: entry !< homogenization entry at (ce) @@ -763,7 +763,7 @@ subroutine results_mapping_homogenization(ID,entry,label) call H5Pset_preserve_f(plist_id, .true., hdferr) if (hdferr < 0) error stop 'HDF5 error' - loc_id = results_openGroup('/cell_to') + loc_id = result_openGroup('/cell_to') call H5Dcreate_f(loc_id, 'homogenization', dtype_id, filespace_id, dset_id, hdferr) if (hdferr < 0) error stop 'HDF5 error' @@ -794,7 +794,7 @@ subroutine results_mapping_homogenization(ID,entry,label) call executionStamp('cell_to/homogenization','cell ID to homogenization results') -end subroutine results_mapping_homogenization +end subroutine result_mapping_homogenization !-------------------------------------------------------------------------------------------------- @@ -806,14 +806,14 @@ subroutine executionStamp(path,description,SIunit) character(len=*), intent(in), optional :: SIunit - if (HDF5_objectExists(resultsFile,path)) & - call HDF5_addAttribute(resultsFile,'creator','DAMASK '//DAMASKVERSION,path) - if (HDF5_objectExists(resultsFile,path)) & - call HDF5_addAttribute(resultsFile,'created',now(),path) - if (HDF5_objectExists(resultsFile,path)) & - call HDF5_addAttribute(resultsFile,'description',description,path) - if (HDF5_objectExists(resultsFile,path) .and. present(SIunit)) & - call HDF5_addAttribute(resultsFile,'unit',SIunit,path) + if (HDF5_objectExists(resultFile,path)) & + call HDF5_addAttribute(resultFile,'creator','DAMASK '//DAMASKVERSION,path) + if (HDF5_objectExists(resultFile,path)) & + call HDF5_addAttribute(resultFile,'created',now(),path) + if (HDF5_objectExists(resultFile,path)) & + call HDF5_addAttribute(resultFile,'description',description,path) + if (HDF5_objectExists(resultFile,path) .and. present(SIunit)) & + call HDF5_addAttribute(resultFile,'unit',SIunit,path) end subroutine executionStamp @@ -834,4 +834,4 @@ character(len=24) function now() end function now -end module results +end module result diff --git a/src/signals.f90 b/src/signal.f90 similarity index 61% rename from src/signals.f90 rename to src/signal.f90 index 3f0397d3d..43e823efa 100644 --- a/src/signals.f90 +++ b/src/signal.f90 @@ -2,7 +2,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Handling of UNIX signals. !-------------------------------------------------------------------------------------------------- -module signals +module signal use prec use system_routines @@ -10,15 +10,15 @@ module signals private logical, volatile, public, protected :: & - signals_SIGINT = .false., & !< interrupt signal - signals_SIGUSR1 = .false., & !< 1. user-defined signal - signals_SIGUSR2 = .false. !< 2. user-defined signal + signal_SIGINT = .false., & !< interrupt signal + signal_SIGUSR1 = .false., & !< 1. user-defined signal + signal_SIGUSR2 = .false. !< 2. user-defined signal public :: & - signals_init, & - signals_setSIGINT, & - signals_setSIGUSR1, & - signals_setSIGUSR2 + signal_init, & + signal_setSIGINT, & + signal_setSIGUSR1, & + signal_setSIGUSR2 contains @@ -26,100 +26,100 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief Register signal handlers. !-------------------------------------------------------------------------------------------------- -subroutine signals_init() +subroutine signal_init() call signalint_c(c_funloc(catchSIGINT)) call signalusr1_c(c_funloc(catchSIGUSR1)) call signalusr2_c(c_funloc(catchSIGUSR2)) -end subroutine signals_init +end subroutine signal_init !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGINT to .true. +!> @brief Set global variable signal_SIGINT to .true. !> @details This function can be registered to catch signals send to the executable. !-------------------------------------------------------------------------------------------------- -subroutine catchSIGINT(signal) bind(C) +subroutine catchSIGINT(sig) bind(C) - integer(C_INT), value :: signal + integer(C_INT), value :: sig - print'(a,i0)', ' received signal ',signal - call signals_setSIGINT(.true.) + print'(a,i0)', ' received signal ',sig + call signal_setSIGINT(.true.) end subroutine catchSIGINT !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGUSR1 to .true. +!> @brief Set global variable signal_SIGUSR1 to .true. !> @details This function can be registered to catch signals send to the executable. !-------------------------------------------------------------------------------------------------- -subroutine catchSIGUSR1(signal) bind(C) +subroutine catchSIGUSR1(sig) bind(C) - integer(C_INT), value :: signal + integer(C_INT), value :: sig - print'(a,i0)', ' received signal ',signal - call signals_setSIGUSR1(.true.) + print'(a,i0)', ' received signal ',sig + call signal_setSIGUSR1(.true.) end subroutine catchSIGUSR1 !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGUSR2 to .true. +!> @brief Set global variable signal_SIGUSR2 to .true. !> @details This function can be registered to catch signals send to the executable. !-------------------------------------------------------------------------------------------------- -subroutine catchSIGUSR2(signal) bind(C) +subroutine catchSIGUSR2(sig) bind(C) - integer(C_INT), value :: signal + integer(C_INT), value :: sig - print'(a,i0,a)', ' received signal ',signal - call signals_setSIGUSR2(.true.) + print'(a,i0,a)', ' received signal ',sig + call signal_setSIGUSR2(.true.) end subroutine catchSIGUSR2 !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGINT. +!> @brief Set global variable signal_SIGINT. !-------------------------------------------------------------------------------------------------- -subroutine signals_setSIGINT(state) +subroutine signal_setSIGINT(state) logical, intent(in) :: state - signals_SIGINT = state + signal_SIGINT = state print*, 'set SIGINT to',state -end subroutine signals_setSIGINT +end subroutine signal_setSIGINT !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGUSR. +!> @brief Set global variable signal_SIGUSR. !-------------------------------------------------------------------------------------------------- -subroutine signals_setSIGUSR1(state) +subroutine signal_setSIGUSR1(state) logical, intent(in) :: state - signals_SIGUSR1 = state + signal_SIGUSR1 = state print*, 'set SIGUSR1 to',state -end subroutine signals_setSIGUSR1 +end subroutine signal_setSIGUSR1 !-------------------------------------------------------------------------------------------------- -!> @brief Set global variable signals_SIGUSR2. +!> @brief Set global variable signal_SIGUSR2. !-------------------------------------------------------------------------------------------------- -subroutine signals_setSIGUSR2(state) +subroutine signal_setSIGUSR2(state) logical, intent(in) :: state - signals_SIGUSR2 = state + signal_SIGUSR2 = state print*, 'set SIGUSR2 to',state -end subroutine signals_setSIGUSR2 +end subroutine signal_setSIGUSR2 -end module signals +end module signal