From 53109cfca060f3b9c9af57a66f95329185e3ce89 Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 12:28:26 +0200 Subject: [PATCH 1/6] Use the optval function in the log_message routine This commit replaces the if-else-block handling the optional prefix arguments. The colon which was previously appended, if the prefix argument was present, is only appended if the prefix argument contains any characters. Previously, prefix='' would end up getting extended to pref=': '. --- src/stdlib_logger.f90 | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 7951ae643..bc0e1253f 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1147,11 +1147,8 @@ subroutine log_message( self, message, module, procedure, prefix ) character(:), allocatable :: d_and_t, m_and_p, pref character(:), allocatable :: buffer - if ( present(prefix) ) then - pref = prefix // ': ' - else - pref = '' - end if + pref = optval(prefix, '') + if ( len(pref) > 0 ) pref = pref // ': ' if ( self % time_stamp ) then d_and_t = time_stamp() // ': ' From 49dc570a9ab82862fdfcb403b41ff2a2021eaa44 Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 13:36:31 +0200 Subject: [PATCH 2/6] Use the optval function in the bitset routines The optional advance argument leads to a redundant call of read/write routines which can be deduplicated by making use of the optval-function. --- src/stdlib_bitsets.fypp | 1 + src/stdlib_bitsets_64.fypp | 45 ++++++++++------------------------- src/stdlib_bitsets_large.fypp | 45 ++++++++++------------------------- 3 files changed, 27 insertions(+), 64 deletions(-) diff --git a/src/stdlib_bitsets.fypp b/src/stdlib_bitsets.fypp index ad52517ab..f4cd7013e 100644 --- a/src/stdlib_bitsets.fypp +++ b/src/stdlib_bitsets.fypp @@ -13,6 +13,7 @@ module stdlib_bitsets int16, & int32, & int64 + use stdlib_optval, only : optval use, intrinsic :: & iso_fortran_env, only: & diff --git a/src/stdlib_bitsets_64.fypp b/src/stdlib_bitsets_64.fypp index 3cdd0b17a..82ad1397c 100644 --- a/src/stdlib_bitsets_64.fypp +++ b/src/stdlib_bitsets_64.fypp @@ -812,23 +812,13 @@ contains end if end do - if ( present(advance) ) then - read( unit, & - advance=advance, & - FMT='(A1)', & - err=997, & - end=998, & - iostat=ierr, & - iomsg=message ) char - else - read( unit, & - advance='YES', & - FMT='(A1)', & - err=997, & - end=998, & - iostat=ierr, & - iomsg=message ) char - end if + read( unit, & + advance=optval(advance, 'YES'), & + FMT='(A1)', & + err=997, & + end=998, & + iostat=ierr, & + iomsg=message ) char if ( char == '0' ) then call self % clear( bits-bit ) else if ( char == '1' ) then @@ -1080,21 +1070,12 @@ contains end if - if ( present( advance ) ) then - write( unit, & - FMT='(A)', & - advance=advance, & - iostat=ierr, & - iomsg=message ) & - string - else - write( unit, & - FMT='(A)', & - advance='YES', & - iostat=ierr, & - iomsg=message ) & - string - end if + write( unit, & + FMT='(A)', & + advance=optval(advance, 'YES'), & + iostat=ierr, & + iomsg=message ) & + string if (ierr /= 0) then call error_handler( 'Failure on a WRITE statement for UNIT.', & write_failure, status, module_name, procedure ) diff --git a/src/stdlib_bitsets_large.fypp b/src/stdlib_bitsets_large.fypp index 2bcd1c659..324f19741 100644 --- a/src/stdlib_bitsets_large.fypp +++ b/src/stdlib_bitsets_large.fypp @@ -997,23 +997,13 @@ contains end if end do - if ( present(advance) ) then - read( unit, & - advance=advance, & - FMT='(A1)', & - err=997, & - end=998, & - iostat=ierr, & - iomsg=message ) char - else - read( unit, & - advance='YES', & - FMT='(A1)', & - err=997, & - end=998, & - iostat=ierr, & - iomsg=message ) char - end if + read( unit, & + advance=optval(advance, 'YES'), & + FMT='(A1)', & + err=997, & + end=998, & + iostat=ierr, & + iomsg=message ) char if ( char == '0' ) then call self % clear( bits-bit ) @@ -1302,21 +1292,12 @@ contains end if - if ( present( advance ) ) then - write( unit, & - FMT='(A)', & - advance=advance, & - iostat=ierr, & - iomsg=message ) & - string - else - write( unit, & - FMT='(A)', & - advance='YES', & - iostat=ierr, & - iomsg=message ) & - string - end if + write( unit, & + FMT='(A)', & + advance=optval(advance, 'YES'), & + iostat=ierr, & + iomsg=message ) & + string if (ierr /= 0) then call error_handler( 'Failure on a WRITE statement for UNIT.', & write_failure, status, module_name, procedure ) From 818c07185ce3087768788da8902c5aade86c64db Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 15:25:02 +0200 Subject: [PATCH 3/6] Use the optval function in the sorting routines The optval function replaces some nested if statemens and allows to remove the reverse_ variable which is a clone of the optional reverse variable. --- src/stdlib_sorting.fypp | 2 ++ src/stdlib_sorting_ord_sort.fypp | 7 +------ src/stdlib_sorting_sort.fypp | 7 +------ src/stdlib_sorting_sort_index.fypp | 12 ++++-------- 4 files changed, 8 insertions(+), 20 deletions(-) diff --git a/src/stdlib_sorting.fypp b/src/stdlib_sorting.fypp index c4cd56b89..1f85a54cf 100644 --- a/src/stdlib_sorting.fypp +++ b/src/stdlib_sorting.fypp @@ -123,6 +123,8 @@ module stdlib_sorting dp, & qp + use stdlib_optval, only: optval + use stdlib_string_type, only: string_type, assignment(=), operator(>), & operator(>=), operator(<), operator(<=) diff --git a/src/stdlib_sorting_ord_sort.fypp b/src/stdlib_sorting_ord_sort.fypp index 0aaf9b4f4..a5d950447 100644 --- a/src/stdlib_sorting_ord_sort.fypp +++ b/src/stdlib_sorting_ord_sort.fypp @@ -75,12 +75,7 @@ contains ${t3}$, intent(out), optional :: work(0:) logical, intent(in), optional :: reverse - logical :: reverse_ - - reverse_ = .false. - if(present(reverse)) reverse_ = reverse - - if (reverse_) then + if (optval(reverse, .false.)) then call ${name1}$_decrease_ord_sort(array, work) else call ${name1}$_increase_ord_sort(array, work) diff --git a/src/stdlib_sorting_sort.fypp b/src/stdlib_sorting_sort.fypp index c6d23ae83..ecc2c3154 100644 --- a/src/stdlib_sorting_sort.fypp +++ b/src/stdlib_sorting_sort.fypp @@ -78,12 +78,7 @@ contains ${t1}$, intent(inout) :: array(0:) logical, intent(in), optional :: reverse - logical :: reverse_ - - reverse_ = .false. - if(present(reverse)) reverse_ = reverse - - if(reverse_)then + if(optval(reverse, .false.))then call ${name1}$_decrease_sort(array) else call ${name1}$_increase_sort(array) diff --git a/src/stdlib_sorting_sort_index.fypp b/src/stdlib_sorting_sort_index.fypp index 30c9620c3..b2a100d92 100644 --- a/src/stdlib_sorting_sort_index.fypp +++ b/src/stdlib_sorting_sort_index.fypp @@ -107,10 +107,8 @@ contains index(i) = i+1 end do - if ( present(reverse) ) then - if ( reverse ) then - call reverse_segment( array, index ) - end if + if ( optval(reverse, .false.) ) then + call reverse_segment( array, index ) end if ! If necessary allocate buffers to serve as scratch memory. @@ -148,10 +146,8 @@ contains end if end if - if ( present(reverse) ) then - if ( reverse ) then - call reverse_segment( array, index ) - end if + if ( optval(reverse, .false.) ) then + call reverse_segment( array, index ) end if contains From 0e6c2f67c2ecf5bd14d369175c050474b9a2febe Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 15:47:22 +0200 Subject: [PATCH 4/6] Use the optval function in the splitmix64 routine By using the optval function only one write operation to the si variable is necessary. --- src/stdlib_stats_distribution_PRNG.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stats_distribution_PRNG.fypp b/src/stdlib_stats_distribution_PRNG.fypp index 60448c778..94a696640 100644 --- a/src/stdlib_stats_distribution_PRNG.fypp +++ b/src/stdlib_stats_distribution_PRNG.fypp @@ -1,6 +1,7 @@ #:include "common.fypp" module stdlib_stats_distribution_PRNG use stdlib_kinds, only: int8, int16, int32, int64 + use stdlib_optval, only: optval use stdlib_error, only: error_stop implicit none private @@ -118,8 +119,7 @@ module stdlib_stats_distribution_PRNG ! Values are converted from C unsigned integer of 0x9e3779b97f4a7c15, ! 0xbf58476d1ce4e5b9, 0x94d049bb133111eb - if(present(s)) si = s - res = si + res = optval(s, si) si = res + int01 res = ieor(res, shiftr(res, 30)) * int02 res = ieor(res, shiftr(res, 27)) * int03 From 4be091622c04b0c759a91a5d06caf5c05d3da3bf Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 17:09:23 +0200 Subject: [PATCH 5/6] Reduce redundancy in moment_all functions The if-else-blocks in the moment_all functions couldn't be replaced with the optval function, because this would lead to poor performance. If the center variable is present, the calculation of the mean can be skipped, but the optval function prevents this optimisation. --- src/stdlib_stats_moment_all.fypp | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/stdlib_stats_moment_all.fypp b/src/stdlib_stats_moment_all.fypp index 34aef0d56..bc5ae00c7 100644 --- a/src/stdlib_stats_moment_all.fypp +++ b/src/stdlib_stats_moment_all.fypp @@ -22,6 +22,7 @@ contains ${t1}$ :: res real(${k1}$) :: n + ${t1}$ :: center_ if (.not.optval(mask, .true.)) then res = ieee_value(1._${k1}$, ieee_quiet_nan) @@ -31,10 +32,11 @@ contains n = real(size(x, kind = int64), ${k1}$) if (present(center)) then - res = sum((x - center)**order) / n + center_ = center else - res = sum((x - mean(x))**order) / n + center_ = mean(x) end if + res = sum((x - center_)**order) / n end function ${RName}$ #:endfor @@ -52,6 +54,7 @@ contains real(dp) :: res real(dp) :: n + real(dp) :: center_ if (.not.optval(mask, .true.)) then res = ieee_value(1._dp, ieee_quiet_nan) @@ -61,10 +64,11 @@ contains n = real(size(x, kind = int64), dp) if (present(center)) then - res = sum((real(x, dp) - center)**order) / n + center_ = center else - res = sum((real(x, dp) - mean(x))**order) / n + center_ = mean(x) end if + res = sum((real(x, dp) - center_)**order) / n end function ${RName}$ #:endfor @@ -82,14 +86,16 @@ contains ${t1}$ :: res real(${k1}$) :: n + ${t1}$ :: center_ n = real(count(mask, kind = int64), ${k1}$) if (present(center)) then - res = sum((x - center)**order, mask) / n + center_ = center else - res = sum((x - mean(x, mask))**order, mask) / n + center_ = mean(x, mask) end if + res = sum((x - center_)**order, mask) / n end function ${RName}$ #:endfor @@ -107,14 +113,16 @@ contains real(dp) :: res real(dp) :: n + real(dp) :: center_ n = real(count(mask, kind = int64), dp) if (present(center)) then - res = sum((real(x, dp) - center)**order, mask) / n + center_ = center else - res = sum((real(x, dp) - mean(x,mask))**order, mask) / n + center_ = mean(x, mask) end if + res = sum((real(x, dp) - center_)**order, mask) / n end function ${RName}$ #:endfor From a928996fce094b897fc291455034d6df4067951e Mon Sep 17 00:00:00 2001 From: Carl Burkert Date: Fri, 17 Sep 2021 17:47:07 +0200 Subject: [PATCH 6/6] Use the optval function in the string routines Each routine using the optional 'back' argument could be shortend to a single line of code. --- src/stdlib_string_type.fypp | 55 +++++++------------------------------ 1 file changed, 10 insertions(+), 45 deletions(-) diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index 632ba8cc1..5d488f29d 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -16,6 +16,7 @@ module stdlib_string_type use stdlib_ascii, only: to_lower_ => to_lower, to_upper_ => to_upper, & & to_title_ => to_title, to_sentence_ => to_sentence, reverse_ => reverse use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool + use stdlib_optval, only: optval implicit none private @@ -569,11 +570,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = index(maybe(string), maybe(substring), back) - else - pos = index(maybe(string), maybe(substring), .false.) - end if + pos = index(maybe(string), maybe(substring), optval(back, .false.)) end function index_string_string @@ -585,11 +582,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = index(maybe(string), substring, back) - else - pos = index(maybe(string), substring, .false.) - end if + pos = index(maybe(string), substring, optval(back, .false.)) end function index_string_char @@ -601,11 +594,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = index(string, maybe(substring), back) - else - pos = index(string, maybe(substring), .false.) - end if + pos = index(string, maybe(substring), optval(back, .false.)) end function index_char_string @@ -619,11 +608,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = scan(maybe(string), maybe(set), back) - else - pos = scan(maybe(string), maybe(set), .false.) - end if + pos = scan(maybe(string), maybe(set), optval(back, .false.)) end function scan_string_string @@ -635,11 +620,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = scan(maybe(string), set, back) - else - pos = scan(maybe(string), set, .false.) - end if + pos = scan(maybe(string), set, optval(back, .false.)) end function scan_string_char @@ -651,11 +632,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = scan(string, maybe(set), back) - else - pos = scan(string, maybe(set), .false.) - end if + pos = scan(string, maybe(set), optval(back, .false.)) end function scan_char_string @@ -669,11 +646,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = verify(maybe(string), maybe(set), back) - else - pos = verify(maybe(string), maybe(set), .false.) - end if + pos = verify(maybe(string), maybe(set), optval(back, .false.)) end function verify_string_string @@ -686,11 +659,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = verify(maybe(string), set, back) - else - pos = verify(maybe(string), set, .false.) - end if + pos = verify(maybe(string), set, optval(back, .false.)) end function verify_string_char @@ -703,11 +672,7 @@ contains logical, intent(in), optional :: back integer :: pos - if (present(back)) then - pos = verify(string, maybe(set), back) - else - pos = verify(string, maybe(set), .false.) - end if + pos = verify(string, maybe(set), optval(back, .false.)) end function verify_char_string