Skip to content

Reduce redundancy caused by optional arguments #528

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/stdlib_bitsets.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ module stdlib_bitsets
int16, &
int32, &
int64
use stdlib_optval, only : optval

use, intrinsic :: &
iso_fortran_env, only: &
Expand Down
45 changes: 13 additions & 32 deletions src/stdlib_bitsets_64.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 )
Expand Down
45 changes: 13 additions & 32 deletions src/stdlib_bitsets_large.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -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 )
Expand Down
7 changes: 2 additions & 5 deletions src/stdlib_logger.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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() // ': '
Expand Down
2 changes: 2 additions & 0 deletions src/stdlib_sorting.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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(<=)

Expand Down
7 changes: 1 addition & 6 deletions src/stdlib_sorting_ord_sort.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
7 changes: 1 addition & 6 deletions src/stdlib_sorting_sort.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
12 changes: 4 additions & 8 deletions src/stdlib_sorting_sort_index.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/stdlib_stats_distribution_PRNG.fypp
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
24 changes: 16 additions & 8 deletions src/stdlib_stats_moment_all.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
Loading