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.

Sign up for GitHub

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 6 commits into from
Sep 21, 2021
Merged

Reduce redundancy caused by optional arguments #528

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
53109cf
Use the optval function in the log_message routine
Sep 17, 2021
49dc570
Use the optval function in the bitset routines
Sep 17, 2021
818c071
Use the optval function in the sorting routines
Sep 17, 2021
0e6c2f6
Use the optval function in the splitmix64 routine
Sep 17, 2021
4be0916
Reduce redundancy in moment_all functions
Sep 17, 2021
a928996
Use the optval function in the string routines
Sep 17, 2021
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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
View file
Open in desktop
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