diff --git a/src/IO.f90 b/src/IO.f90 index 4fcd43c7b..ba33a8a5c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -11,6 +11,7 @@ module IO IO_STDERR => ERROR_UNIT use prec + use constants use misc implicit none(type,external) @@ -20,13 +21,8 @@ module IO IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters IO_QUOTES = "'"//'"' character, parameter, public :: & - IO_EOL = new_line('DAMASK'), & !< end of line character + IO_EOL = LF, & !< end of line character IO_COMMENT = '#' - character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - character, parameter :: & - CR = achar(13), & - LF = IO_EOL public :: & IO_init, & @@ -34,7 +30,6 @@ module IO IO_readlines, & IO_isBlank, & IO_wrapLines, & - IO_postfix, & IO_strPos, & IO_strValue, & IO_intValue, & @@ -241,30 +236,6 @@ pure function IO_strPos(str) end function IO_strPos -!-------------------------------------------------------------------------------------------------- -!> @brief Append postfix to each indicator character that is followed by a lowercase letter. -!-------------------------------------------------------------------------------------------------- -function IO_postfix(string,indicator,postfix) - - character(len=*), intent(in) :: string - character, intent(in) :: indicator - character(len=*), intent(in) :: postfix - character(len=:), allocatable :: IO_postfix - - integer :: i,N - - - IO_postfix = '' - N = len(string) - do i = 1, N - IO_postfix = IO_postfix//string(i:i) - if (string(i:i) == indicator .and. verify(IO_lc(string(min(i+1,N):min(i+1,N))),LOWER) == 0) & - IO_postfix = IO_postfix//postfix - end do - -end function IO_postfix - - !-------------------------------------------------------------------------------------------------- !> @brief Read string value at myChunk from string. !-------------------------------------------------------------------------------------------------- @@ -873,10 +844,6 @@ subroutine selfTest() if ('abc,'//IO_EOL//'xxdefg,'//IO_EOL//'xxhij' /= IO_wrapLines('abc,defg, hij',filler='xx',length=4)) & error stop 'IO_wrapLines/7' - str='-a -1 -more 123 -flag -' - out=IO_postfix(str,'-+','p_') - if (out /= '-p_a -1 -p_more 123 -p_flag -') error stop 'IO_postfix' - end subroutine selfTest end module IO diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90 index fc63a8ab1..f2f6488f1 100644 --- a/src/Marc/DAMASK_Marc.f90 +++ b/src/Marc/DAMASK_Marc.f90 @@ -142,8 +142,8 @@ end function solverIsSymmetric end module DAMASK_interface #include "../parallelization.f90" -#include "../misc.f90" #include "../constants.f90" +#include "../misc.f90" #include "../IO.f90" #include "../YAML_types.f90" #include "../YAML_parse.f90" diff --git a/src/constants.f90 b/src/constants.f90 index 29d5ac69a..1402154c7 100644 --- a/src/constants.f90 +++ b/src/constants.f90 @@ -13,4 +13,11 @@ module constants K_B = 1.380649e-23_pREAL, & !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook) N_A = 6.02214076e23_pREAL !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook) + character, parameter :: & + CR = achar(13), & + LF = new_line('DAMASK') + + character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' + character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + end module constants diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 3ab994f93..47809a04e 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -16,6 +16,7 @@ module grid_damage_spectral use prec use parallelization use IO + use misc use CLI use HDF5_utilities use HDF5 @@ -118,8 +119,8 @@ subroutine grid_damage_spectral_init(num_grid) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - petsc_options = IO_postfix('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// & - num_grid_damage%get_asStr('PETSc_options',defaultVal=''), '-','damage_') + petsc_options = misc_prefixOptions('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// & + num_grid_damage%get_asStr('PETSc_options',defaultVal=''),'damage_') call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index d9824dc63..424f60c07 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -15,8 +15,9 @@ module grid_mechanical_FEM use prec use parallelization - use CLI use IO + use misc + use CLI use HDF5 use HDF5_utilities use math @@ -152,8 +153,8 @@ subroutine grid_mechanical_FEM_init(num_grid) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - petsc_options = IO_postfix('-snes_type newtonls -ksp_type fgmres -ksp_max_it 25 '// & - num_grid_mech%get_asStr('PETSc_options',defaultVal=''), '-','mechanical_') + petsc_options = misc_prefixOptions('-snes_type newtonls -ksp_type fgmres -ksp_max_it 25 '// & + num_grid_mech%get_asStr('PETSc_options',defaultVal='') ,'mechanical_') call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 7c0ba2e37..03dbfdbf0 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -16,6 +16,7 @@ module grid_mechanical_spectral_basic use prec use parallelization use CLI + use misc use IO use HDF5 use HDF5_utilities @@ -155,7 +156,8 @@ subroutine grid_mechanical_spectral_basic_init(num_grid) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - petsc_options = IO_postfix('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), '-','mechanical_') + petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), & + 'mechanical_') call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/grid/grid_mech_spectral_polarization.f90 b/src/grid/grid_mech_spectral_polarization.f90 index df7beb077..a5a5f4809 100644 --- a/src/grid/grid_mech_spectral_polarization.f90 +++ b/src/grid/grid_mech_spectral_polarization.f90 @@ -16,6 +16,7 @@ module grid_mechanical_spectral_polarization use prec use parallelization use CLI + use misc use IO use HDF5 use HDF5_utilities @@ -174,7 +175,8 @@ subroutine grid_mechanical_spectral_polarization_init(num_grid) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - petsc_options = IO_postfix('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), '-','mechanical_') + petsc_options = misc_prefixOptions('-snes_type ngmres '//num_grid_mech%get_asStr('PETSc_options',defaultVal=''), & + 'mechanical_') call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 1bfaa89d4..cc5d79e1b 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -16,6 +16,7 @@ module grid_thermal_spectral use prec use parallelization use IO + use misc use CLI use HDF5_utilities use HDF5 @@ -111,8 +112,8 @@ subroutine grid_thermal_spectral_init(num_grid) if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg)) !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc - petsc_options = IO_postfix('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// & - num_grid_thermal%get_asStr('PETSc_options',defaultVal=''), '-','thermal_') + petsc_options = misc_prefixOptions('-snes_type newtonls -snes_mf -snes_ksp_ew -ksp_type fgmres '// & + num_grid_thermal%get_asStr('PETSc_options',defaultVal=''), 'thermal_') call PetscOptionsInsertString(PETSC_NULL_OPTIONS,petsc_options,err_PETSc) CHKERRQ(err_PETSc) diff --git a/src/misc.f90 b/src/misc.f90 index 0ba3d6970..47c23757f 100644 --- a/src/misc.f90 +++ b/src/misc.f90 @@ -5,6 +5,7 @@ !-------------------------------------------------------------------------------------------------- module misc use prec + use constants implicit none(type,external) private @@ -18,7 +19,8 @@ module misc public :: & misc_init, & - misc_optional + misc_optional, & + misc_prefixOptions contains @@ -110,6 +112,28 @@ pure function misc_optional_str(given,default) result(var) end function misc_optional_str +!-------------------------------------------------------------------------------------------------- +!> @brief Add prefix to options in string. +!> @detail An option starts with a dash followed by at least one letter. +!-------------------------------------------------------------------------------------------------- +pure function misc_prefixOptions(string,prefix) result(prefixed) + + character(len=*), intent(in) :: string,prefix + character(len=:), allocatable :: prefixed + + integer :: i,N + + + prefixed = '' + N = len(string) + do i = 1, N + prefixed = prefixed//string(i:i) + if (string(i:i) == '-' .and. verify(string(min(i+1,N):min(i+1,N)),LOWER//UPPER) == 0) & + prefixed = prefixed//prefix + end do + +end function misc_prefixOptions + !-------------------------------------------------------------------------------------------------- !> @brief Check correctness of some misc functions. @@ -117,6 +141,8 @@ end function misc_optional_str subroutine misc_selfTest() real(pREAL) :: r + character(len=:), allocatable :: str,out + call random_number(r) if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present' @@ -132,6 +158,10 @@ subroutine misc_selfTest() if (.not. test_bool()) error stop 'optional_bool, not present' if (misc_optional(default=r>0.5_pREAL) .neqv. r>0.5_pREAL) error stop 'optional_bool, default only' + str='-a -1 -more 123 -flag -' + out=misc_prefixOptions(str,'p_') + if (out /= '-p_a -1 -p_more 123 -p_flag -') error stop 'misc_prefixOptions' + contains function test_str(str_in) result(str_out)