184 lines
5.6 KiB
Fortran
184 lines
5.6 KiB
Fortran
!--------------------------------------------------------------------------------------------------
|
|
!> @author Martin Diehl, KU Leuven
|
|
!> @author Philip Eisenlohr, Michigan State University
|
|
!> @brief Miscellaneous tools.
|
|
!--------------------------------------------------------------------------------------------------
|
|
module misc
|
|
use prec
|
|
|
|
implicit none(type,external)
|
|
private
|
|
|
|
interface misc_optional
|
|
module procedure misc_optional_bool
|
|
module procedure misc_optional_integer
|
|
module procedure misc_optional_real
|
|
module procedure misc_optional_string
|
|
end interface misc_optional
|
|
|
|
public :: &
|
|
misc_init, &
|
|
misc_optional
|
|
|
|
contains
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Do self test.
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine misc_init()
|
|
|
|
print'(/,1x,a)', '<<<+- misc init -+>>>'
|
|
|
|
call misc_selfTest()
|
|
|
|
end subroutine misc_init
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Return bool value if given, otherwise default.
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function misc_optional_bool(given,default) result(var)
|
|
|
|
logical, intent(in), optional :: given
|
|
logical, intent(in) :: default
|
|
logical :: var
|
|
|
|
|
|
if (present(given)) then
|
|
var = given
|
|
else
|
|
var = default
|
|
end if
|
|
|
|
end function misc_optional_bool
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Return integer value if given, otherwise default.
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function misc_optional_integer(given,default) result(var)
|
|
|
|
integer, intent(in), optional :: given
|
|
integer, intent(in) :: default
|
|
integer :: var
|
|
|
|
|
|
if (present(given)) then
|
|
var = given
|
|
else
|
|
var = default
|
|
end if
|
|
|
|
end function misc_optional_integer
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Return real value if given, otherwise default.
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function misc_optional_real(given,default) result(var)
|
|
|
|
real(pReal), intent(in), optional :: given
|
|
real(pReal), intent(in) :: default
|
|
real(pReal) :: var
|
|
|
|
|
|
if (present(given)) then
|
|
var = given
|
|
else
|
|
var = default
|
|
end if
|
|
|
|
end function misc_optional_real
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Return string value if given, otherwise default.
|
|
!--------------------------------------------------------------------------------------------------
|
|
pure function misc_optional_string(given,default) result(var)
|
|
|
|
character(len=*), intent(in), optional :: given
|
|
character(len=*), intent(in) :: default
|
|
character(len=:), allocatable :: var
|
|
|
|
|
|
if (present(given)) then
|
|
var = given
|
|
else
|
|
var = default
|
|
end if
|
|
|
|
end function misc_optional_string
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
!> @brief Check correctness of some misc functions.
|
|
!--------------------------------------------------------------------------------------------------
|
|
subroutine misc_selfTest()
|
|
|
|
real(pReal) :: r
|
|
|
|
call random_number(r)
|
|
if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_string, present'
|
|
if (test_str() /= 'default') error stop 'optional_string, not present'
|
|
if (misc_optional(default='default') /= 'default') error stop 'optional_string, default only'
|
|
if (test_int(20191102) /= 20191102) error stop 'optional_int, present'
|
|
if (test_int() /= 42) error stop 'optional_int, not present'
|
|
if (misc_optional(default=20191102) /= 20191102) error stop 'optional_int, default only'
|
|
if (dNeq(test_real(r),r)) error stop 'optional_float, present'
|
|
if (dNeq(test_real(),0.0_pReal)) error stop 'optional_float, not present'
|
|
if (dNeq(misc_optional(default=r),r)) error stop 'optional_float, default only'
|
|
if (test_bool(r<0.5_pReal) .neqv. r<0.5_pReal) error stop 'optional_bool, present'
|
|
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'
|
|
|
|
contains
|
|
|
|
function test_str(str_in) result(str_out)
|
|
|
|
character(len=:), allocatable :: str_out
|
|
character(len=*), intent(in), optional :: str_in
|
|
|
|
|
|
str_out = misc_optional_string(str_in,'default')
|
|
|
|
end function test_str
|
|
|
|
|
|
function test_int(int_in) result(int_out)
|
|
|
|
integer :: int_out
|
|
integer, intent(in), optional :: int_in
|
|
|
|
|
|
int_out = misc_optional_integer(int_in,42)
|
|
|
|
end function test_int
|
|
|
|
|
|
function test_real(real_in) result(real_out)
|
|
|
|
real(pReal) :: real_out
|
|
real(pReal), intent(in), optional :: real_in
|
|
|
|
|
|
real_out = misc_optional_real(real_in,0.0_pReal)
|
|
|
|
end function test_real
|
|
|
|
|
|
function test_bool(bool_in) result(bool_out)
|
|
|
|
logical :: bool_out
|
|
logical, intent(in), optional :: bool_in
|
|
|
|
|
|
bool_out = misc_optional_bool(bool_in,.true.)
|
|
|
|
end function test_bool
|
|
|
|
|
|
end subroutine misc_selfTest
|
|
|
|
end module misc
|