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 ) 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() // ': ' 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 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 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 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